16. Дан одном массив поменять местами наиб и наим элем

Program aa;

uses crt;

Type mas=array[1..50] of integer;

procedure vvod(k:integer;Var c:mas);

var i:integer; begin For i:=1 to k do

begin Writeln('Введите ',i,' число'); Readln(c[i]); end;end;

procedure vivod (k:integer;c:mas);

var i:integer; begin for i:=1 to k do write (c[i]:5); Writeln; end;

Procedure men(k:integer; var c:mas);

Var i,s,max,min:integer; Begin max:=c[1]; min:=c[1]; For i:=2 to k do Begin

if c[i]<min then min:=c[i]; if c[i]>max then max:=c[i]; end;

//Writeln(min);

//Writeln(max);

For i:=1 to k do if c[i]=max Then c[i]:=min Else if c[i]=min Then c[i]:=max end;

var a,d:mas; n:integer; begin

Writeln('ввести количество злементов массива');Readln(n);

If (n>1)and(n<40) Then begin vvod(n,a); Writeln('Исходный массив');

Vivod(n,a); men(n,a); Writeln('Новый массив'); Vivod(n,a); end

Else Writeln ('Неправильно введено количество элементов массива!!!');end.

17. Дан текст, в котором слова отделяются пробелами, в конце стоит точка. Определить количество слов и вывести на экран каждое слово, стоящее на четном месте в предложении.

Program Z_1; Uses Crt; Type Stroka=String;

Var x,y,z:Stroka; l,t,r:Integer; Begin Writeln('Введите текст');

Readln(x); t:=Length(x); l:=0; z:=Copy(x,1,t-1)+' ';

Writeln('Слова которые стоят на четном месте в предложении:');

While z<>'' do Begin r:=Pos(' ',z); y:=Copy(z,1,r-1); l:=l+1; If l mod 2=0

Then Write(y,' '); Delete(z,1,r); End; Writeln; Writeln('Общее количество слов в предложении:'); Writeln(l); End.

18. Дан неупор массив. Найти простые числа.

program s1; Procedure step(a,b:integer);

Var j,s,i,n,k:integer;

Begin for i:=a to b do begin s:=0; for n:=1 to abs(i) do

if i mod n=0 Then s:=s+1; s=2 Then begin Write (i:5); k:=k+1; end; end;

if k=0 Then Writeln ('На указанном отрезке простых чисел нет!!!'); end;

Var m,n,i:integer; begin Writeln ('ввести начало и конец отрезка'); Readln(m,n);

step(m,n); Writeln ();End.

19. Дан двум массив. Найти средн арифм мин и макс элем каждого столбца.

Program z1; uses crt; Type tabl=array [1..10,1..10] of integer;

Var a:tabl;h,v,f:integer; sr:real;

Procedure wwod(k,m:integer;Var c:tabl);

var i,j:integer; Begin For i:=1 to k do For j:=1 to m do c[i,j]:=Random(60);

End;

Procedure wiwod (k,m:integer;Var c:tabl);

var i,j:integer; Begin For i:=1 to k do begin For j:=1 to m do

Write(c[i,j]:6); writeln; end; End;

Procedure poisk(k,m:integer;c:tabl;var p:real);

Var i,j,s,s1,max,min:integer; begin s:=c[1,1]; s1:=c[1,1]; for i:=1 to k do begin

if s<c[i,f] Then s:=c[i,m]; if s1>c[i,f] Then s1:=c[i,m]; end;

//Writeln ('максимальный элемент=',s); //Writeln ('минимальный элемент=',s1);

p:=(s+s1)/2; end; begin writeln('ввести количество строк'); readln(h);

If (h>=1)and(h<10)Then begin writeln('ввести количество столбцов');

readln(v); If (v>=1)and(v<10)Then begin wwod(h,v,a); writeln('Исходный массив');

wiwod(h,v,a); for f:=1 to v do begin poisk(h,f,a,sr);

Writeln ('Среднее арифметическое ',f,' столбца=',sr); end; end

Else Writeln ('Неправильно введены размеры массива!!!'); end

Else Writeln ('Неправильно введены размеры массива!!!'); end.