Var I,j:integer;
summa:integer;
begin
summa:=0;
j:=0;
for i:=1 to N do
if (Mas[i] mod K =0) then{если кратно К}
sum:=summa+Mas[i]; {то ищем сумму}
end;
ЗАДАЧА 10 Написать процедуру, которой передается исходный целочисленный массив длиной N элементов имя выходного массива и имя переменной для длины выходного массива. Процедура должна заполнить выходной массив каждым третьим элементом исходного массива и вернуть точную получившуюся длину. N не больше 999.
Type
Massiv = array [1..999] of integer; { описание типа массива}
PROCEDURE obrabotka (var Mas,Mas1:massiv; var Nstr,Mstr:integer);
var
summa:real;
i,j:integer;
begin
j:=0;
Mstr:=0;
for i:=1 to Nstr do
if (i mod 3=0) then {если третий по счету элемент}
begin
j:=j+1;
Mas1[j]:=Mas[i];
end;
Mstr:=j;{возвращаем количество элементов во втором массиве}
end;
ЗАДАЧА 11 Написать функцию, возвращающую в вызывающую программу самое большое из 4-х передаваемых ей вещественных значений, не используя при этом работу с массивами. (Функция от 4-х аргументов).
{funk}
FUNCTION MAXIM(a,b,c,d:real):real;
Var
w:real;
begin
if (a>b) then
if (a>c) then
if (a>d) then
MAXIM:=a
else MAXIM:=d
else
if (d>c) then MAXIM:=d
else MAXIM:=c
else
if (b>c) then
if (b>d) then MAXIM:=b
else MAXIM:=d
else if (c>d) then MAXIM:=c
else MAXIM:=d;
end;
ЗАДАЧА 12 Написать функцию, которая из передаваемого ей произвольного одномерного вещественного массива длиной N элементов выбирает и суммирует каждый третий элемент (если он положительный) и возвращает полученную сумму. N не больше 999.
Type
Massiv = array [1..999] of real; { описание типа массива}
FUNCTION sum(Var Mas:Massiv; N:integer):real;
Var i:integer;
summ:real;
Begin
summ:=0.0;
for i:=1 to N do
if (i mod 3)=0 then {если элемент третий}
if Mas[i]>0 then {если элемент положительный}
summ:=summ+Mas[i];
sum:=summ; {присваиваем значение для передачи в основную прогрмму}
end;
ЗАДАЧА 13 Написать процедуру, которая в передаваемом ей произвольном квадратном вещественном массиве размерами 10 х 10 элементов меняла бы местами заказанную строку и главную диагональ. Номер строки включить в список параметров.
Type
Massiv = array [1..10,1..10] of real; { описание типа массива}
Procedure obmen (Var Mas:Massiv;N,Nst:integer);
Var I,j:integer;
K:real;
Begin
for i:=1 to N do begin
for j:=1 to N do begin
if (i=j) then {если главная диагональ}
begin {меняем элемент с заданной строкой}
K:=Mas[i,j];
Mas[i,j]:=Mas[Nst,j];
Mas[Nst,j]:=K;
end;
write (Fout,Mas[i,j]:6:2); {распечатываем массив}
end;
writeln(Fout);
end;
end;
ЗАДАЧА 14 Написать функцию, которая вычисляет разность самого большого и самого маленького элементов вещественного массива произвольной длины, но не более 1000 чисел. Имя и длина массива передаются функции через параметры.
Type
Massiv = array [1..1000] of real; { описание типа массива}
FUNCTION razn(Var Mas:Massiv; N:integer):real;
Var i:integer;
raz,max,min:real;
Begin
raz:=0.0;
max:=0.0;
min:=0.0;
for i:=1 to N do begin
if Mas[i]>max then max:=Mas[i]; {если элемент больше максимального, то становится максимальным}
if Mas[i]<min then min:=Mas[i]; {если элемент меньше минимального, то становится минимальным}
end;
writeln ('max=',max);
writeln ('min=',min);
razn:=max-min; {возвращаем значение в основную программу}
end;
ЗАДАЧА 15 Написать функцию, вычисляющую разность номеров самого большого и самого маленького элементов передаваемого (через параметры) в функцию одномерного вещественного массива произвольной длины, но не более 999 чисел.
Type
Massiv = array [1..1000] of real; { описание типа массива}
FUNCTION razn(Var Mas:Massiv; N:integer):real;
Var i,imax,imin:integer;
raz,max,min:real;
Begin
raz:=0.0;{значение разности}
max:=0.0; { значение максимального элемента}
min:=0.0; { значение минимального элемента }
imin:=1; { значение индекса минимального элемента }
imax:=1; { значение индекса максимального элемента }
for i:=1 to N do begin
if Mas[i]>max then begin max:=Mas[i]; imax:=i; end; {ищем максимальный элемент}
if Mas[i]<min then begin min:=Mas[i]; imin:=i;end; {ищем минимальный элемент}
end;
writeln ('max=',max,' imax=',imax);
writeln ('min=',min,' imin=',imin);
razn:=imax-imin; {возвращаем значение разности в основную программу}
end;
ЗАДАЧА 16 Написать процедуру, которая переписывает из исходного вещественного массива в выходной только те элементы, которые входят в переданный процедуре интервал. Имена массивов, длины массивов и границы интервала должны входить в список параметров
Type
Massiv = array [1..999] of integer;
PROCEDURE obrabotka (var Mas,Mas1:massiv; var Nst,Mst:integer;Min,Max:real);
var
i,j:integer;
begin
j:=0;
for i:=1 to Nst do
if ((Mas[i]>Min) and (Mas[i]<Max)) then begin
j:=j+1;
Mas1[j]:=Mas[i];
end;
Mst:=j;
for j:=1 to Mst do
write (Mas1[j]);
writeln('j= ',Mst);
end;
ЗАДАЧА 17 Написать процедуру, возвращающую в вызывающую программу номера строки, столбца и слоя, где расположен максимальный элемент передаваемого в подпрограмму произвольного вещественного массива размерами M х N х K элементов. Все размеры не больше 10.
{}
Type
Massiv = array [1..10,1..10,1..10] of real; { описание типа массива}
Procedure MProc (Var Mas:Massiv;var st,kol,sloi:integer);
Var i,j,z:integer;
max:real; {переменная для максимального числа}
imax,jmax,zmax:integer; {переменные для коэфициентов}
Begin
max:=0;
imax:=0;
jmax:=0;
zmax:=0;
for i:=1 to st do
for j:=1 to kol do
for z:=1 to sloi do
if Mas[i,j,z]>max then {если число больше максимального}
begin
max:=Mas[i,j,z];
imax:=i;
jmax:=j;
zmax:=z;
end;
{дальше 3 присвоения для того чтобы возвращать значения в основную программу}
st:=imax;
kol:=jmax;
sloi:=zmax;
writeln ('st=',st);
writeln ('kol=',kol);
writeln ('sloi=',sloi);
end;
ЗАДАЧА 18 Написать функцию, вычисляющую сумму всех положительных элементов нечетных строк передаваемого ей произвольного вещественного массива размерами 15 х N элементов. N не больше 99.
Type
Massiv = array [1..15,1..99] of real; { описание типа массива}
Summa:=Sum(A,15,M); {вызов функции в основной программе}
FUNCTION Sum(Var Mas:Massiv; const N;M:integer):real;