Задача: Array. Массивы
Описание
Характеристики решённой задачи
Список файлов
В массиве поставить элемент с минимальным значением перед элементом с максимальным значением.
**************************************** ***************program anc;
type mas=array[1..100]of real;
var a:mas;
i,n,nmax,nmin:integer;
max,min,r:real;
begin
writeln('vvedyte kol-vo elementov');
readln(n);
for i:=1 to n do begin
write('vvedite ',i,' element: ');
read(a[i]);
end;
writeln('Massiv: ');
for i:=1 to n do
begin
write(a[i],' ');
end;
writeln;
max:=a[1]; nmin:=1;
min:=a[1]; nmax:=1;
for i:=1 to n do begin
if a[i]>max then begin
max:=a[i];
nmax:=i; end;
if a[i]<min then begin
min:=a[i];
nmin:=i; end;
end;
write(' min - ',nmin,' element and ');
write(' max - ',nmax,' element ');
writeln;
if nmin<nmax then begin
for i:=nmin to (nmax-2) do begin
r:=a[i]; a[i]:=a[i+1];
a[i+1]:=r;
end; end
else begin
for i:=nmin downto nmax+1 do begin
r:=a[i-1]; a[i-1]:=a[i]; a[i]:=r;
end;
end;
writeln('novyy Massiv: ');
for i:=1 to n do
begin
write(a[i],' ');
end;
writeln;
end.
Продолжаем рубрику "Инфа для мужика"program Project1;
**************************************** ******************Задача про обмен строк с минимальной и максимальной суммой.
{$APPTYPE CONSOLE}
type mas=array[1..100,1..100]of integer;
procedure input(var a:mas; var n,m:integer);
var i,j:integer;
begin
writeln('vvedyte N,M: ');
read(n,m);
for i:=1 to n do begin
for j:=1 to m do begin
writeln('vvedyte element (',i,',',j,') :');
read(a[i,j]);
end;
end;
end;
procedure output(a:mas;n,m:integer);
var i,j:integer;
begin
for i:=1 to n do begin writeln;
for j:=1 to m do begin
write(a[i,j],' ');
end;
end; writeln;
end;
procedure obmen(var a:mas; n,m:integer);
var i,j,nmin,nmax,t : integer;
smax,smin,sum:real;
begin
smax:=0; smin:=0; nmax:=1; nmin:=1;
for j:=1 to m do begin
smax:=smax+a[1,j];
smin:=smin+a[1,j]; end;
for i:=2 to n do begin
sum:=0;
for j:=1 to m do begin
sum:=sum+a[i,j]; end;
if sum>smax then begin smax:=sum; nmax:=i; end;
if sum<smin then begin smin:=sum; nmin:=i; end;
end;
writeln('maximalnaya summa v ',nmax,' stroke, ravna ',smax);
writeln('minimalnaya summa v ',nmin,' stroke, ravna ',smin);
for j:=1 to m do begin
t:=a[nmin,j];
a[nmin,j]:=a[nmax,j];
a[nmax,j]:=t;
end; end;
var a:mas; n,m:integer; c:array[1..100]of real;
begin
input(a,n,m);
output(a,n,m);
obmen(a,n,m);
writeln('novaya matrica: ');
output(a,n,m);
readln;
readln;
end.
"Инфа бла-бла"
Ставим столб с минимальным значением перед столбом с максимальным или наоборот (х.з. проверьте сами - все работает);
**************************************** ******************program Project1;
{$APPTYPE CONSOLE}
type mas=array[1..100,1..100]of integer;
procedure input(var a:mas; var n,m:integer);
var i,j:integer;
begin
writeln('vvedyte N,M: ');
read(n,m);
for i:=1 to n do begin
for j:=1 to m do begin
writeln('vvedyte element (',i,',',j,') :');
read(a[i,j]);
end;
end;
end;
procedure output(a:mas;n,m:integer);
var i,j:integer;
begin
for i:=1 to n do begin writeln;
for j:=1 to m do begin
write(a[i,j],' ');
end;
end; writeln;
end;
procedure obmen(var a:mas; n,m:integer);
var i,j,nmin,nmax,t : integer;
max,min,sum:real;
begin
max:=a[1,1]; min:=a[1,1]; nmax:=1; nmin:=1;
for i:=1 to n do begin
for j:=1 to m do begin
if a[i,j]>max then begin max:=a[i,j]; nmax:=j; end;
if a[i,j]<min then begin min:=a[i,j]; nmin:=j; end;
end; end;
writeln('maximalnyv element v',nmax,' stolbe, raven ',max);
writeln('minimalnyy element v ',nmin,' stolbe, raven ',min);
if nmax<nmin then begin
for j:=nmax to nmin-2 do begin
for i:=1 to n do begin
t:=a[i,j+1];
a[i,j+1]:=a[i,j];
a[i,j]:=t; end; end; end
else begin
for j:=nmax downto nmin+1 do begin
for i:=1 to n do begin
t:=a[i,j-1];
a[i,j-1]:=a[i,j];
a[i,j]:=t;
end; end;end;
end;
var a:mas; n,m:integer; c:array[1..100]of real;
begin
input(a,n,m);
output(a,n,m);
obmen(a,n,m);
writeln('novaya matrica: ');
output(a,n,m);
readln;
readln;
end.
Старая задача с сортировкой массива записей по росту. Очень поможет решить последнюю задачу с сортировкой в typefiles.
**************************************** *************program Project68;
type man=record
name:string;
st:integer; end;
mas=array[1..10] of man;
procedure input(var a:mas; var n:integer);
var i: integer;
begin
write('vvedyte N: '); readln(n); writeln('name_rost :');
for i:=1 to n do begin write(i,' : ');
readln(a[i].name); write('st',i,' : ');
readln(a[i].st);
end; end;
procedure sort(var a:mas; n:integer);
var i,k,j:integer; b:man;
begin
k:=1; i:=1;
while k<>0 do
begin
k:=0;
for j:=1 to n-i do
if a[j].st<a[j+1].st then
begin
b:=a[j];
a[j]:=a[j+1];
a[j+1]:=b; k:=k+1 end;
i:=i+1; end; end;
procedure output(a:mas; n:integer);
var i:integer;
begin
writeln('Spisok : ');
for i:=1 to n do
writeln(a[i].name,' ',a[i].st);
end;
procedure vst(var a:mas; var n:integer);
var i,j:integer; b:man; t:boolean;
begin n:=n+1;
writeln(n,' : '); readln(b.name); readln(b.st);
i:=0; t:=false;
repeat i:=i+1;
if b.st > a[i].st then begin t:=true;
for j:=n-1 downto i do
a[j+1]:=a[j] end;
until t=true;
a[i]:=b;
end;
var a:mas; n,i,k:integer;
begin
input(a,n);
sort(a,n);
output(a,n);
write('skolko man-off dovavit?! '); readln(k);
for i:=1 to k do begin
vst(a,n); end;
output(a,n);
end.
Инфа бла-бла"
Ставим столб с минимальным значением перед столбом с максимальным или наоборот (х.з. проверьте сами - все работает);
**************************************** ******************program Project1;
{$APPTYPE CONSOLE}
type mas=array[1..100,1..100]of integer;
procedure input(var a:mas; var n,m:integer);
var i,j:integer;
begin
writeln('vvedyte N,M: ');
read(n,m);
for i:=1 to n do begin
for j:=1 to m do begin
writeln('vvedyte element (',i,',',j,') :');
read(a[i,j]);
end;
end;
end;
procedure output(a:mas;n,m:integer);
var i,j:integer;
begin
for i:=1 to n do begin writeln;
for j:=1 to m do begin
write(a[i,j],' ');
end;
end; writeln;
end;
procedure obmen(var a:mas; n,m:integer);
var i,j,nmin,nmax,t : integer;
max,min,sum:real;
begin
max:=a[1,1]; min:=a[1,1]; nmax:=1; nmin:=1;
for i:=1 to n do begin
for j:=1 to m do begin
if a[i,j]>max then begin max:=a[i,j]; nmax:=j; end;
if a[i,j]<min then begin min:=a[i,j]; nmin:=j; end;
end; end;
writeln('maximalnyv element v',nmax,' stolbe, raven ',max);
writeln('minimalnyy element v ',nmin,' stolbe, raven ',min);
if nmax<nmin then begin
for j:=nmax to nmin-2 do begin
for i:=1 to n do begin
t:=a[i,j+1];
a[i,j+1]:=a[i,j];
a[i,j]:=t; end; end; end
else begin
for j:=nmax downto nmin+1 do begin
for i:=1 to n do begin
t:=a[i,j-1];
a[i,j-1]:=a[i,j];
a[i,j]:=t;
end; end;end;
end;
var a:mas; n,m:integer; c:array[1..100]of real;
begin
input(a,n,m);
output(a,n,m);
obmen(a,n,m);
writeln('novaya matrica: ');
output(a,n,m);
readln;
readln;
end.