Соседние разделы

Форум Компьютеры и сети

Компьютеры, сети, программное обеспечение, гаджеты

Задачи с готовым решением на языке pascal

Дата публикации: 2018-01-17 20:17:22
Дата модификации: 2018-01-17 20:17:22
Просмотров: 1237
Автор: fantome

Устали от программирования ? надоели эти проклятые задачи ? фантом спешит на помощь !

Задачи с готовым решением по информатике (все задачи на языке pascal):

Описание материала: Устали от программирования ? надоели эти проклятые задачи ? фантом спешит на помощь ! Задачи с готовым решением по информатике (все задачи на языке pascal):

Остальные материалы раздела: Компьютерный форум

Предыдущая Кто работал со сми2 отзывы и рекомендации
Следующая представлен ИКС основного домена-как бороться, как пересчитать ИКС поддомена

Комментарии Всего: 26

2018-01-17 19:28:01 Пользователь: fantome От имени: fantome

{ Ввести стpоку символов. Гpуппу символов, pазделенную с одной или обеих

стоpон одним или несколькими пpобелами и не содеpжащую внутpи себя пpобелов,

назовем словом.

Распечатать все слова четной длины. Если таких слов нет, то выдать

соответствующее текстовое сообщение. }

{ пpимечание ! pаботает только пpи включенном пpинтеpе }

{ если необходимо вывести данные просто на экран, нужно

отменить вывод на печать - просто удалить переменную f из writeln,

убрать назначение файла на печать и его закрытие close(f)}

Program ZD1;

var

f:text; { файл вывода на принтер }

slovo:string; { стpока символов }

slovo2:string; { слово }

tom:integer; { счетчик четных слов, если он pавен нулю,то выводится

сообщение о том, что таких слов нету }

probel:integer;{ счетчик пpобелов }

bin:integer; { длинна слова }

reven:integer; { счетчик количества букв в слове }

i:integer;

dlina :integer;{ длинна стpоки символов }

god:integer; { втоpой счетчик пpобелов }

begin

{ пеpвая часть, pазбивает стpоку символов на слова, если кол-во букв в слове

четное, то слово выводится на печать }

assign(f,'prn'); { назначим файл вывода - пpинтеp }

rewrite(f); { откpоем файл для вывода}

tom:=0; { обнуляем счетчики }

probel:=0; { обнуляем счетчики }

reven:=0; { обнуляем счетчики }

slovo2:=''; { пеpеменная слова пуста }

writeln ('Введите стpоку символов');

readln (slovo);

dlina:=length(slovo); { вычисляем длинну слова, пишем в пеpеменную dlina}

for i:=1 to dlina do { Цикл, от 1 до конца стpоки символов }

if slovo[i]<>' ' { пока символ не pавен пpобелу }

then

begin

reven:=reven+1; { счетчик слов +1 }

slovo2:=slovo2+slovo[i]; { в пеpеменную слова пpибавляем букву }

end

else { если символ pавен пpобелу }

begin

if reven mod 2=0 { если кол-во букв в слове четное, то }

then

begin

writeln (f,slovo2);{ выводим полученное слово на печать }

tom:=tom+1; { счетчик четных слов +1 }

end;

reven:=0; { обнуляем счетчик букв }

slovo2:=''; { очищяем пеpеменную слова }

end;

{ втоpая часть, необходима, т.к пеpвая часть не учитывает последнего слова }

slovo2:=''; { очищаем пеpеменную слова }

for i:=1 to dlina do { Цикл, от 1 до конца стpоки символов }

if slovo[i]=' ' { если символ pавен пpобелу }

then

probel:=probel+1; { счетчик пpобелов +1 }

for i:=1 to dlina do { Цикл, от 1 до конца стpоки символов }

begin

if slovo[i]=' ' { если символ pавен пpобелу }

then

god:=god+1; { втоpой счетчик пpобелов +1}

if god=probel { если счетчик пpобелов 2 = пеpвому }

then

slovo2:=slovo2+slovo[i+1]; {в пеpеменную слова

пpибавляем букву, +1 нужен, чтобы не учитывался

пpобел }

end;

{втоpая часть pаботает по следующему пpинципу: сначала машина считает

сколько пpобелов содеpжит стpока символов, потом если кол-во

пpобелов (счетчик 2) будет pавно кол-ву пpобелов (счетчик 1) - это

будет знаком тому, что мы подошли к последнему слову, потом мы заносим

в пеpеменную слово последнее слово, пpобел нужно убиpать потому

что он будет учитываться как часть последнего слова}

{тpетья часть}

bin:=length(slovo2); { заносим длинну последнего в пеpеменную bin }

if bin mod 2<>0 { ! если число букв не четное !, то }

{ --------- }

then

begin

writeln (f,slovo2); { выводим слово на печать }

tom:=tom+1; { счетчик четных слов +1 }

end;

if tom=0 { если счетчик четных слов=0, то }

then

writeln ('Слов четной длинны нет !');

close (f);

readln;

end.

2018-01-17 19:31:49 Пользователь: fantome От имени: fantome

{Программа для нахождения наибольшего

общего делителя двух целых чисел}

{(по алгоритму Евклида)}

program nodd;

var chislo1, {первое число}

chislo2, {второе число}

nod, {наибольший общий делитель}

r:integer; {остаток отделения 1-го числа на 2-е}

begin

Writeln ('Введите два целых числа:');

Readln (chislo1,chislo2); {ввод двух чисел с клавиатуры}

while (chislo1 mod chislo2)<>0 do {цикл выполняется пока остаток <> 0}

begin

r:=chislo1 mod chislo2; {вычисление остатка 1-го числа на 2-ое}

chislo1:=chislo2; {присваиваем 2-е число 1-му}

chislo2:=r; {присваиваем остаток от деления 2-му числу}

end;

nod:=chislo2; {присваиваем 2-е число переменной nod}

Writeln ('НОД: ',nod); {Вывод НОД}

Readln;

end.

2018-01-17 19:35:37 Пользователь: fantome От имени: fantome

{Посчитать факториал заданного числа N! Предполагается, что результат превысит

разрядную сетку преставления целых чисел (например, n=1000), но при этом все цифры

результата должны быть выведены на печать}

var x:array[1..32403]of integer;

l,n,c,i,j:integer;

begin

write('Введите факториал');

readln(n);

x[1]:=1;

l:=1;

for j:=1 to n do

begin

c:=0;

for i:=1 to l do

begin

x[i]:=x[i]*j+c;

c:=x[i] div 10;

x[i]:=x[i] mod 10;

end;

if c<>0 then

repeat

inc(l);

x[l]:=c mod 10;

c:=c div 10;

until c=0;

end;

for i:=l downto 1 do write(x[i]);

writeln;

readln;

end.

2018-01-17 19:44:32 Пользователь: fantome От имени: fantome

{ Написать программу, которая заполняет массив A(10,10) случайными

целыми числами из интервала [-38,56]. Определить и вывести на печать

строку массива, сумма элементов которой минимальна. }

uses crt;

const n=10;

m=10;

type dmyarray=array [1..n,1..m] of integer;

omyarray=array [1..n] of integer;

var a:dmyarray;

{ первая часть, создаем массив }

procedure dinit (var a:dmyarray);

var i,j:integer;

begin

randomize;

for i:=1 to n do

begin

for j:=1 to m do

a[i,j]:=random(95)-38;

end;

{вторая часть, выводим массив на экран}

procedure dprint (a:dmyarray);

var i,j:integer;

begin

for i:=1 to n do

begin

for j:=1 to m do

write (a[i,j]:5);

writeln;

end;

{ третья часть, сначала определяем в какой строке минимальная сумма элементов

и одновременно заносим в переменную номер этой строки,

потом выводим эту строку }

procedure nomer (a:dmyarray);

var i:integer; { строка }

j:integer; { столбец }

k:integer; { сумма минимальных элементов }

min:integer; { самая минимальная сумма элементов }

l:integer; { номер строки, сумма элементов которой минимальна }

begin

l:=0; { обнуляем счетчики }

min:=0; { обнуляем счетчики }

k:=0; { обнуляем счетчики }

for i:=1 to n do

begin

for j:=1 to m do

if a[i,j]<0 { если элемент массива<0, то }

then

k:=k+a[i,j]; { сумма мин. элементов + мин.элемент }

if k<min { если сумма мин.элементов меньше самой минимальной

суммы элементов, то }

then

begin

min:=k; { самая минимальная сумма элементов, автоматически

приравнивается к сумме мин. элементов, т.е. идет

поиск самой минимальной суммы элементов }

l:=i; { к l приравниваем i, в итоге получаем номер строки,

сумма элементов которой минимальна }

end;

k:=0; { обнуляем k, т.к общий цикл не закончен }

end;

writeln (' Строка массива, сумма элементов которой минимальна: ');

for j:=1 to 10 do

write (a[l,j]:5); { вывод строки сумма элементов кторой минимальна }

end;

begin

repeat

clrscr;

writeln ('Массив 10x10');

dinit(a);

dprint(a);

writeln;

nomer (a);

writeln;

write ('*** Esc - выход, anykey - продолжить ***');

writeln;

until readkey=#27;

end.

2018-01-17 19:48:11 Пользователь: fantome От имени: fantome

{ Дана матpица натуpальных чисел A[M,N], где M и N - заданные натуpальные числа. Все элементы матpицы

pазличные. Сфоpмиpовать одномеpный массив B[N], в котоpом B[j] pавен сpеднему аpифметическому

значению наибольшего и наименьшего элемента в j-ом столбце матpицы A. }

type dmyarray=array [1..25,1..25] of integer;

omyarray=array [1..25] of real;

var a:dmyarray;

b:omyarray;

n,m:integer;

procedure dinit (var a:dmyarray);

var i,j:integer;

begin

randomize;

for i:=1 to n do

for j:=1 to m do

a[i,j]:=-38+random(95);

end;

procedure dprint (a:dmyarray);

var i,j:integer;

begin

for i:=1 to n do

begin

for j:=1 to m do

write (a[i,j]:4);

writeln;

end;

procedure oinit (var b:omyarray);

var bin,j,i:integer;

min,max:real;

begin

max:=0;

min:=0;

for j:=1 to n do

begin

for i:=1 to m do

begin

if min>a[i,j] then min:=a[i,j];

if max<a[i,j] then max:=a[i,j];

end;

b[j]:=(min+max)/2;

min:=0;

max:=0;

end;

writeln;

for j:=1 to n do

write (b[j]:8:1);

end;

begin

writeln ('Введите M');

readln (m);

writeln ('Введите N');

readln (n);

writeln;

writeln (' Матpица MxN: ');

writeln;

dinit(a);

dprint(a);

writeln;

writeln (' Массив B[N]: ');

oinit (b);

readln;

end.

2018-01-17 19:51:39 Пользователь: fantome От имени: fantome

{Дан массив натуральных чисел. Найти сумму элементов, кратных данному К.}

const n=20;

type myarray=array [1..n] of integer;

var a:myarray;

c:integer;

procedure init1 (var a:myarray);

var i:integer;

begin

randomize;

for i:=1 to n do

a[i]:=-13+random(27);

end;

procedure print (a:myarray);

var i:integer;

begin

for i:=1 to n do

write (a[i]:6);

writeln;

end;

procedure nomer (a:myarray);

var c,s,i:integer;

begin

s:=0;

writeln ('Введите К');

readln (c);

for i:=1 to n do

if a[i] mod c=0 then s:=s+a[i];

writeln (' Сумма ',s);

readln;

end;

begin

init1(a);

writeln('Массив');

print(a);

nomer(a);

readln;

end.

2018-01-17 21:54:56 Пользователь: fantome От имени: fantome

{Даны действительные числа а1 а2 а3 а4 а5, поменять местами наибольший и наименьший элементы}

const n=5;

type myarray=array[1..n] of integer;

var i:longint;

l,s:integer;

a:myarray;

procedure init(var a:myarray);

var i:integer;

begin

for i:=1 to n do

read (a[i]);

readln;

end;

procedure maza(a:myarray);

var s,q,w,i,b,l:integer;

begin

i:=1;

s:=0;

q:=a[i];

w:=a[i];

for i:=1 to n do

if q<a[i] then q:=a[i];

for i:=1 to n do

if w>a[i] then w:=a[i];

for i:=1 to n do

begin

if a[i]=q then write (w,' ');

if a[i]=w then write (q,' ');

if (a[i]<>q) and (a[i]<>w) then write (a[i],' ');

end;

begin

writeln ('Введите числа числа чеpез пpобел');

init (a);

maza (a);

readln;

end.

2018-01-17 22:23:05 Пользователь: fantome От имени: fantome

{Даны целые числа а1, а2...аn. Вывести на печать только те

числа, для которых выполняется a от i<=i }

const n=20;

type myarray=array [1..n] of integer;

var a:myarray;

c:integer;

procedure init1 (var a:myarray);

var i:integer;

begin

randomize;

for i:=1 to n do

a[i]:=-13+random(27);

end;

procedure print (a:myarray);

var i:integer;

begin

for i:=1 to n do

write (a[i]:6);

writeln;

end;

procedure nomer (a:myarray);

var c,s,i:integer;

begin

s:=0;

for i:=1 to n do

if a[i]<=i then write (a[i],' ');

readln;

end;

begin

init1(a);

writeln('Массив');

print(a);

writeln ('Новый массив');

nomer(a);

end.

2018-01-17 22:44:59 Пользователь: fantome От имени: fantome

{Определить номера тех строк целочисленной матрицы a[N,K],

которые совпадают с массивом D[K]. Если таких строк нет,

выдать соответствующее сообщение.

Т.к. совпадения очень редки, то 2-й массив генерируется

как 1-я строка 1-го массива, если изменить генерацию,

то совпадение придется ждать долго, если не обходимо просто

уменьшете 1-й массив заменив значения m и n}

const n=10;

m=10;

type dmyarray=array [1..n,1..m] of integer;

omyarray=array [1..n] of integer;

var a:dmyarray;

b:omyarray;

c:integer;

procedure dinit (var a:dmyarray);

var i,j:integer;

begin

randomize;

for i:=1 to n do

begin

for j:=1 to m do

a[i,j]:=5+random(25); {Генерация 2-х мерного массива}

end;

procedure dprint (a:dmyarray);

var i,j:integer;

begin

for i:=1 to n do

begin

for j:=1 to m do

write (a[i,j]:5);

writeln;

end;

procedure oinit (var b:omyarray); {Тут генерится 2-й массив}

var i:integer;

begin

randomize;

for i:=1 to n do

b[i]:=5+random(25); {Тут задаются какие числа будут в массиве}

end;

procedure oprint (b:omyarray);

var i:integer;

begin

for i:=1 to n do

write (b[i]:6);

writeln;

end;

procedure nomer (a:dmyarray;b:omyarray);

var j,i,c,v:integer;

begin

v:=0;

for j:=1 to n do

begin

c:=0;

for i:=1 to m do

if a[j,i]=b[i] then

begin

c:=c+1;

if c=5 then

begin

writeln ('Номера совпадающих строк: ',j:5);

v:=v+1;

end;

if v=0 then writeln (' Таких строк нет ')

end;

begin

writeln ('Матpица 10x10');

dinit(a);

oinit (b);

dprint(a);

writeln;

writeln('Одномеpный массив');

oprint(b);

nomer (a,b);

readln;

end.

2018-01-17 22:45:47 Пользователь: fantome От имени: fantome

{Даны натуральные числа а1, а2,...,аn. Указать те числа,

у которых остаток от деления на M равен L (0<=L<=M-1). }

const n=20;

type myarray=array [1..n] of integer;

var a:myarray;

m:integer;

procedure init1 (var a:myarray);

var i:integer;

begin

randomize;

for i:=1 to n do

a[i]:=-13+random(27);

end;

procedure print (a:myarray);

var i:integer;

begin

for i:=1 to n do

write (a[i]:6);

writeln;

end;

procedure nomer (var a:myarray);

var l,m,i:integer;

begin

l:=m-1;

for i:=1 to n do

if a[i]>0 then

if a[i] mod m<=l then write (' ',a[i],' ');

end;

begin

init1(a);

writeln('Массив');

print(a);

writeln ('Введите M');

readln (m);

writeln ('Результат ');

nomer(a);

readln;

end.

2018-01-17 22:46:23 Пользователь: fantome От имени: fantome

{ Расположить столбцы матрицы D[M,N] в порядке возрастания элементов k-ой строки (1<=k<=M). }

const n=5;

m=5;

type dmyarray=array [1..n,1..m] of integer;

omyarray=array [1..n] of integer;

var a:dmyarray;

procedure dinit (var a:dmyarray);

var i,j:integer;

begin

randomize;

for i:=1 to n do

begin

for j:=1 to m do

a[i,j]:=5+random(25);

end;

procedure dprint (a:dmyarray);

var i,j:integer;

begin

for i:=1 to n do

begin

for j:=1 to m do

write (a[i,j]:5);

writeln;

end;

2018-01-17 22:46:54 Пользователь: fantome От имени: fantome

{Матрица A[N,M](M кратно 4) разделена по вертикали на две

половины. Определить сумму элементов каждого столбца левой половины

и сумму элементов каждого четного столбца правой половины матрицы А.}

const n=8;

m=10;

type dmyarray=array [1..n,1..m] of integer;

omyarray=array [1..n] of integer;

var a:dmyarray;

procedure dinit (var a:dmyarray);

var i,j:integer;

begin

randomize;

for i:=1 to n do

begin

for j:=1 to m do

a[i,j]:=5+random(25);

end;

procedure dprint (a:dmyarray);

var i,j:integer;

begin

for i:=1 to n do

begin

for j:=1 to m do

write (a[i,j]:6);

writeln;

end;

procedure nomer (a:dmyarray);

var j,i,b,s:integer;

begin

writeln(' Результат ');

for j:=1 to m div 2 do

begin

s:=0;

for i:=1 to n do

s:=s+a[i,j];

write (s:6);

end;

for j:=m div 2+1 to m do

begin

s:=0;

if j mod 2 =0 then

for i:=1 to n do

s:=s+a[i,j];

write (s:6);

end;

begin

writeln ('Матpица 5x10');

dinit(a);

dprint(a);

writeln;

nomer (a);

readln;

end.

2018-01-17 22:47:28 Пользователь: fantome От имени: fantome

{Дана квадратная целочисленная матрица порядка n.

Сформировать результирующий одномерный массив, элементами которого

являются строчные суммы тех строк, которые начинаются с k

идущих подряд положительных чисел.}

const n=5;

m=5;

type dmyarray=array [1..n,1..m] of integer;

omyarray=array [1..n] of integer;

var a:dmyarray;

b:omyarray;

procedure dinit (var a:dmyarray);

var i,j:integer;

begin

randomize;

for i:=1 to n do

begin

for j:=1 to m do

a[i,j]:=5+random(25);

end;

procedure dprint (a:dmyarray);

var i,j:integer;

begin

for i:=1 to n do

begin

for j:=1 to m do

write (a[i,j]:5);

writeln;

end;

{procedure oinit (var b:omyarray; a:dmyarray);

var i,j,s:integer;

begin

for i:=1 to n do

b[i]:=s;

end;

}

procedure oprint (b:omyarray; v:integer);

var i:integer;

begin

for i:=1 to v do

write (b[i]:6);

writeln;

end;

procedure nomer (a:dmyarray);

var v,i,j,k,s:integer;

b:omyarray;

begin

writeln ('Введите К');

readln (k);

for j:=1 to n do

begin

s:=0;

if a[j,1]=k then

for i:=1 to n do

s:=s+a[j,i];

if s<>0 then

begin

inc(v);

b[v]:=s;

writeln(b[v]);

end;

oprint(b,v);

end;

begin

writeln ('Матpица 5x5');

dinit(a);

dprint(a);

nomer (a);

writeln;

{writeln('Одномеpный массив');}

{oprint(b);}

readln;

end.

2018-01-17 22:48:12 Пользователь: fantome От имени: fantome

{При поступлении в вуз абитуриенты, получившие двойку

на первом экзамене, ко второму не допускаются. В массиве

A[n] записаны оценки экзаменующихся, полученные на первом

экзамене. Подсчитать, сколько человек недопущено ко

второму экзамену.}

const n=20;

type myarray=array [1..n] of integer;

var a:myarray;

c:integer;

procedure init1 (var a:myarray);

var i:integer;

begin

randomize;

for i:=1 to n do

a[i]:=2+random(4);

end;

procedure print (a:myarray);

var i:integer;

begin

for i:=1 to n do

write (a[i]:6);

writeln;

end;

procedure nomer (a:myarray);

var s,i:integer;

begin

s:=0;

for i:=1 to n do

if a[i] =2 then s:=s+1;

writeln (' Кол-во учеников получивших двлйки ',s);

end;

begin

init1(a);

writeln('Массив');

print(a);

nomer(a);

readln;

end.

2018-01-17 22:48:41 Пользователь: fantome От имени: fantome

{В целочисленной последовательности есть нулевые элементы.

Создать массив из номеров этих элементов}

const n=20;

type myarray=array [1..n] of integer;

var a:myarray;

procedure init1 (var a:myarray);

var i:integer;

begin

randomize;

for i:=1 to n do

a[i]:=-13+random(27);

end;

procedure print (a:myarray);

var i:integer;

begin

for i:=1 to n do

write (a[i]:6);

writeln;

end;

procedure nomer (a:myarray);

var s,i:integer;

begin

s:=0;

for i:=1 to n do

if a[i]=0 then write ( i,' ');

readln;

end;

begin

init1(a);

writeln('Массив');

print(a);

writeln ('Новый массив');

nomer(a);

readln;

end.

2018-01-17 22:49:14 Пользователь: fantome От имени: fantome

{В последовательности действительных чисел a1,a2,...,an есть только положительные и отрицательные элементы.

Вычислить произведение отрицтельных элементов Р1 и произведение положительных элементов Р2.

Сравнить модуль Р2 с модулем Р1, указать, какое из произведений по модулю больше.}

const n=10;

type myarray=array [1..n] of integer;

var a:myarray;

procedure init1 (var a:myarray);

var i:integer;

begin

randomize;

for i:=1 to n do

a[i]:=-12+random(37);

end;

procedure print (a:myarray);

var i:integer;

begin

for i:=1 to n do

write (' ',a[i]);

writeln;

end;

procedure nomer (var a:myarray);

var i,p1,p2:longint;

begin

p1:=1;

p2:=1;

for i:=1 to n do

if a[i]>0 then p1:=p1*a[i]

else p2:=p2*a[i];

writeln (' ',p1,' ',p2);

p1:=abs(p1);

p2:=abs(p2);

if p1>p2 then writeln ('p1 по модулю > p2')

else writeln ('p2 по модулю > p1');

end;

begin

init1(a);

writeln('Массив');

print(a);

nomer(a);

readln;

end.

2018-01-17 22:50:00 Пользователь: fantome От имени: fantome

{Дан массив действительных чисел. Среди них есть равные.

Найти первый максимальный элемент массива и заменить его нулем.}

const n=10;

type myarray=array [1..n] of longint;

var a:myarray;

procedure init1 (var a:myarray);

var i:integer;

begin

randomize;

for i:=1 to n do

a[i]:=-7+random(27);

end;

procedure print (a:myarray);

var i:integer;

begin

for i:=1 to n do

write (' ',a[i]);

writeln;

end;

procedure nomer (var a:myarray);

var i,s,b:integer;

begin

b:=0;

s:=a[1];

for i:=1 to n do

if a[i]>=abs(s) then s:=a[i];

for i:=1 to n do

if a[i]>=abs(s) then a[i]:=0;

for i:=1 to n do

write (' ',a[i]);

end;

begin

init1(a);

writeln('Массив');

print(a);

nomer(a);

readln;

end.

2018-01-17 22:50:29 Пользователь: fantome От имени: fantome

{Дана последовательность целых чисел a1,a2,...,an.

Выяснить, какое число встречается раньше - положительное

или отрицательное.}

const n=20;

type myarray=array [1..n] of integer;

var a:myarray;

procedure init1 (var a:myarray);

var i:integer;

begin

randomize;

for i:=1 to n do

a[i]:=-13+random(27);

end;

procedure print (a:myarray);

var i:integer;

begin

for i:=1 to n do

write (a[i]:6);

writeln;

end;

procedure nomer (a:myarray);

var s,i:integer;

begin

s:=0;

i:=1;

if a[i]=0 then inc(i);

if a[i]>0 then write ('Положительное')

else writeln ('Отpицательное');

readln;

end;

begin

init1(a);

writeln('Массив');

print(a);

nomer(a);

end.

2018-01-17 22:51:10 Пользователь: fantome От имени: fantome

{В массиве целых чисел с количеством элементов n найти

наиболее часто встречающееся число. Если таких чисел

несколько, то определить наименьшее из них.}

const n=10;

type myarray=array [1..n] of longint;

var a:myarray;

procedure init1 (var a:myarray);

var i:integer;

begin

randomize;

for i:=1 to n do

a[i]:=-5+random(14);

end;

procedure print (a:myarray);

var i:integer;

begin

for i:=1 to n do

write (' ',a[i]);

writeln;

end;

procedure nomer (var a:myarray);

var i,s,b,k,j:integer;

begin

s:=1;

b:=0;

k:=0;

for i:=1 to n do

if a[s]=a[i] then

begin

writeln (' ',a[i]);

b:=b+1;

end;

if b>1 then writeln (' Наименьшее ',a[i]);

end;

begin

init1(a);

writeln('Массив');

print(a);

nomer(a);

readln;

end.

2018-01-17 22:51:40 Пользователь: fantome От имени: fantome

{Каждый солнечный день улитка, сидящая на дереве, поднимается вверх на 2см, а каждый

пасмурный день опускается на 1 см. В начале набдюдения улитка находилась в А см от

земли а В-метровом дереве. Имеется 30-элементный массив, содержащий сведения о том,

был ли соответствующий день наблюдения пасмурным или солнечным.

Написать программу, определяющую местоположение улитки к концу 30-го дня набдюдения.}

const n=30;

type myarray=array [1..n] of integer;

var a:myarray;

procedure init1 (var a:myarray);

var i:integer;

begin

randomize;

for i:=1 to n do

a[i]:=0+random(2);

end;

procedure print (a:myarray);

var i:integer;

begin

for i:=1 to n do

write (' ',a[i]);

writeln;

end;

procedure nomer (var a:myarray);

var i,am,bm:integer;

begin

writeln ('Введите Am');

readln (am);

writeln ('Введите Bm');

readln (bm);

bm:=bm*100;

for i:=1 to n do

if a[i]=1 then am:=am+2

else am:=am-1;

if am>bm then write ('Улитка упала с деpева');

write (' ',' К концу 30-го дня улитка будет находится в ',am, ' ','см от земли');

writeln;

end;

begin

init1(a);

writeln('Массив');

print(a);

nomer(a);

readln;

end.

2018-01-17 22:52:26 Пользователь: fantome От имени: fantome

{Дана последовательность целых чисел a1,a2,...,an. Выяснить, будет ли она возрастающей.}

const n=5;

type myarray=array[1..n] of integer;

var i,s:longint;

l:integer;

a:myarray;

procedure init(var a:myarray);

var i:integer;

begin

for i:=1 to n do

read (a[i]);

readln;

end;

procedure maza(a:myarray);

var i,b,l:integer;

begin

l:=0;

for i:=2 to n do

begin

b:=i-1;

if a[b]<a[i] then l:=l+1

else l:=l-1;

end;

if l=4 then writeln ('Возpастающая')

else writeln ('Не возpастающая');

end;

begin

writeln ('Введите числа числа чеpез пpобел');

init (a);

maza (a);

readln;

end.

2018-01-17 22:52:50 Пользователь: fantome От имени: fantome

{Дана послдовательность натуральных чисел a1,a2,...,an.

Создать массив из четных чисел этой последовательности.

Если таких чисел нет, то выдать сообщение об этом.}

const n=20;

type myarray=array [1..n] of integer;

var a:myarray;

procedure init1 (var a:myarray);

var i:integer;

begin

randomize;

for i:=1 to n do

a[i]:=-13+random(27);

end;

procedure print (a:myarray);

var i:integer;

begin

for i:=1 to n do

write (a[i]:6);

writeln;

end;

procedure nomer (a:myarray);

var l,i:integer;

begin

for i:=1 to n do

if a[i] mod 2=0 then

begin

write (' ', a[i] ,' ');

l:=l+1;

end;

if l=0 then writeln ('Четных чисел нет ');

readln;

end;

begin

init1(a);

writeln('Массив');

print(a);

writeln ('Новый массив');

nomer(a);

readln;

end.

2018-01-17 22:53:28 Пользователь: fantome От имени: fantome

{Дан массив из n четырехзначных натуральных чисел.

Вывести на экран только те, у которых сумма первых двух

цифр равна сумме двух последних.}

const n=100;

type myarray=array [1..n] of integer;

var a:myarray;

c:integer;

procedure init1 (var a:myarray);

var i:integer;

begin

randomize;

for i:=1 to n do

a[i]:=1000+random(9999);

end;

procedure print (a:myarray);

var i:integer;

begin

for i:=1 to n do

write (a[i]:6);

writeln;

end;

procedure nomer (a:myarray);

var c,s,p,q,i:integer;

begin

for i:=1 to n do

begin

c:=a[i] div 100;

s:=(c div 10) + (c mod 10);

p:=a[i] mod 100;

q:=(p div 10)+(p mod 10);

if s=q then write (a[i]:6);

end;

begin

init1(a);

writeln('Массив');

print(a);

writeln ('Результат');

nomer(a);

readln;

end.

2018-01-17 22:54:04 Пользователь: fantome От имени: fantome

{Дана последовательность действительных чисел a1,a2,...,an.

Заменить все ее члены, большие данного Z, этим числом.

Подсчитать количество замен.}

const n=20;

type myarray=array [1..n] of integer;

var a:myarray;

procedure init1 (var a:myarray);

var i:integer;

begin

randomize;

for i:=1 to n do

a[i]:=-13+random(27);

end;

procedure print (a:myarray);

var i:integer;

begin

for i:=1 to n do

write (a[i]:6);

writeln;

end;

procedure nomer (a:myarray);

var z,l,i:integer;

begin

l:=0;

writeln ('Введите число ');

readln (z);

for i:=1 to n do

begin

if a[i]>z then

begin

write (z);

inc(l);

end

else write (' ',a[i],' ');

end;

writeln;

writeln ('Было замен ', l);

readln;

end;

begin

init1(a);

writeln('Массив');

print(a);

nomer(a);

readln;

end.

2018-01-17 22:54:28 Пользователь: fantome От имени: fantome

{Дан массив действительных чисел, размерность которого N.

Подсчитать, сколько в нем отрицательных, положительных и

нулевых элментов.}

const n=20;

type myarray=array [1..n] of integer;

var a:myarray;

procedure init1 (var a:myarray);

var i:integer;

begin

randomize;

for i:=1 to n do

a[i]:=-13+random(27);

end;

procedure print (a:myarray);

var i:integer;

begin

for i:=1 to n do

write (a[i]:6);

writeln;

end;

procedure nomer (a:myarray);

var p,o,t,i:integer;

begin

p:=0;

o:=0;

t:=0;

for i:=1 to n do

begin

if a[i]>0 then inc(p);

if a[i]<0 then inc(o);

if a[i]=0 then inc(t);

end;

writeln ('Положительные - ',p);

writeln ('Отpицательные - ',o);

writeln ('Нулевые - ',t);

end;

begin

init1(a);

writeln('Массив');

print(a);

nomer(a);

readln;

end.

2018-01-17 22:54:51 Пользователь: fantome От имени: fantome

{Имеется n судей, которые ставят оценки.

Найти среднюю оценку.}

program njudge;

var n, {кол-во судей}

i, {переменная цикла}

m, {кол-во не нулевых элементов}

j:integer; {кол-во совпадающих элементов}

min, {минимальная оценка}

max, {максимальная оценка}

sumsred,{средняя оценка}

sum:real; {сумма всех оценок}

marks: array[1..10] of real;{}

begin

Writeln ('Введите количество судей');

Readln (n);

for i:=1 to n do

Readln (marks[i]);

{проверка, если все оценки совпадают}

for i:=1 to n do

if marks[1]=marks[i] then

begin

inc(j);

end;

if j=n then Writeln ('Средняя оценка ',marks[1]);

{поиск минимальной оценки}

min:=marks[1];

for i:=1 to n do

if min>marks[i] then min:=marks[i];

{поиск максимальной оценки}

max:=marks[1];

for i:=1 to n do

if max<marks[i] then max:=marks[i];

{выбрасывание из учета макс. и мин. оценки}

for i:=1 to n do

if marks[i]=min then marks[i]:=0;

for i:=1 to n do

if marks [i]=max then marks[i]:=0;

{вычисление средней оценки}

m:=0;

sum:=0;

for i:=1 to n do

if marks[i]<>0 then inc(m);

for i:=1 to n do

sum:=sum+marks[i];

if j<>n then

begin

sumsred:=sum/m;

Writeln ('Средняя оценка ',n,' судей');

Writeln ('равна: ',sumsred);

end;

Readln;

end.

work-flow-Initiative

Главная страница
Форум
Компьютерный форум

Язык [ РУССКИЙ ]

Соседние разделы

Форум Компьютеры и сети

Задачи с готовым решением на языке pascal

Остальные материалы раздела: Компьютерный форум

Комментарии Всего: 26

work-flow-Initiative

Главная страницаФорумКомпьютерный форум

Язык [ РУССКИЙ ]

Соседние разделы

Форум Компьютеры и сети

Задачи с готовым решением на языке pascal

Остальные материалы раздела: Компьютерный форум

Комментарии Всего: 26

Главная страница
Форум
Компьютерный форум