Код: Выделить всё
{Programma reschaet sleduyuschuyu zadachu:
Otsortirovatq pryamougolqnuyu matricu razmerom N*M po neubqivaniyu i
vqivesti ee na ekran
0 2 3
1 4 7
5 6 8
Metod sortirovki: оптимизированная пузырьковая сортировка}
uses
Crt;
const
nMax=100;
type
TIndex = 0..nMax;
TElement = integer; {tip matricqi}
K = array [0..nMax*nMax] of integer;
Matrix = array [TIndex,TIndex] of TElement;
var
N,M,Min : integer;
e,d,R,T : integer;
a,b : Matrix;
c : K;
{Procedura zapolnyaet matricu sluchajnqimi znacheniyami}
Procedure MakeMatrix (M : Integer; var a : Matrix );
var
i,j : TIndex;
begin {MakeMatrix}
Randomize;
for i:=0 to m-1 do
for j:=0 to M-1 do
a[i,j]:=random(51);
end; {MakeMatrix}
Procedure Swap ( var k, d: TElement);
var
t:TElement;
Begin {Swap}
t:=k;
k:=d;
d:=t;
End; {Swap}
{Procedura zapolnyaet matricu znacheniyami}
Procedure Make (a: Matrix; c: K; T,R: integer);
var
i,j,ii,jj : TIndex;
s : Integer;
begin {Make}
for i:=0 to m-1 do
for j:=0 to M-1 do
begin
s:=c[M*i+j];
If s<=R then
begin
e:=s;
d:=0;
while e>d do
begin
e:=e-d-1;
inc(d);
end;
If d mod 2=1 then
begin
ii:=d-e;
jj:=M-1-e;
end
else
begin
ii:=e;
jj:=M-1-d+e;
end;
end;
If (s>R) and (s<T-R) then
begin
d:=Min + (s-R-1) div Min;
e:=(s-R-1) mod Min;
If m>=M then {matrica pryamougolqnaya}
If d mod 2 = 0 then
begin
ii:=d-e;
jj:=M-1-e;
end
else
begin
ii:=1+d-M+e;
jj:=e;
end
else
begin
If d mod 2 = 1 then
begin
ii:=m-1-e;
jj:=M-d+Min-e-2;
end
else
begin
ii:=e;
jj:=M-1-d+e;
end;
end;
end;
If (s>=T-R) and (s<=T) then
begin
e:=T-s;
d:=0;
while e>d do
begin
e:=e-d-1;
inc(d);
end;
If ((d mod 2 = 0) and ((m+M) mod 2 = 0)) or {chetnostq diagonali}
((d mod 2 = 1) and ((m+M)mod 2 = 1)) then
begin
ii:=N-1-e;
jj:=d-e;
end
else
begin
ii:=m-1-d+e;
jj:=e;
end;
end;
b[ii,jj]:=a[i,j];
end;
end; {Make}
Procedure Sorting (m:tElement; Var a:Matrix);
Var bound,t,j,i1,j1,i2,j2:TElement;
Begin {Sorting}
bound:=m*m-1;
Repeat
t:=0; {место последнего обмена**}
For j:=0 to bound-1 do
Begin
If a[i1,j1] < a[i2,j2] then
Begin
Swap(a[i1,j1],a[i2,j2]);
t:=j;
End;
End;
Bound:=t;
Until t=0;
End; {Sorting}
{Procedura vqivodit matricu na ekran}
Procedure PrintMatrix (a: Matrix; M:integer);
var
i,j :integer;
begin {PrintMatrix}
for i:=0 to m-1 do
begin
for j:=M-1 downto 0 do
write(a[i,j]:4);
writeln;
writeln;
end;
end; {PrintMatrix}
begin {Program}
ClrScr;
writeln('Vvedite razmernostq matricqi * (1<N<10):');
readln(M);
if m>=M then
Min:=M
else
Min:=m;
T:=m*M-1;
R:=-1+(Min*(Min+1)) div 2;
MakeMatrix(M,a);
Writeln('Ishodnaya Matrica');
PrintMatrix(a,M);
Sorting(m,a);
Make(a,c,T,R);
Writeln('Poluchennaya matrica');
PrintMatrix(b,M);
readln;
end.
