For sikli yordamida amalga oshirish mumkin. Elementni massiv boshiga (birinchi o’ringa) ko’chirish uchun prosedura

Program L223;
uses Crt;
 const
n = 5; m = 6;
type
s = array[1..m] of integer; t = array[1..n] of s; f = array[1..n*m] of integer;
 var
a : t;
b : f;
i, j, k, v : integer;
{----------------------------------------------------------------------------------------}
Procedure create_two(n, m : integer; var a : t);
var
i, j : integer;
 begin
writeln('Berilgan ikki o’lchovli butun sonli massiv');
randomize;
for i := 1 to n do
begin
for j := 1 to m do
begin
a[i, j] := random(201) - 100;
write(a[i, j]:6, ' ')
 end;
writeln
end
end;
{----------------------------------------------------------------------------------------}
 Procedure sprain(n, m : integer; a : t; var b : f);
var
k, i, j : integer;
 begin
k := 0;
for i := 1 to n do
 for j := 1 to m do
begin
k := k + 1;
b[k] := a[i, j]
end
end;
{----------------------------------------------------------------------------------------}
Procedure fast(q, p : integer; var b : f);
var
s, l, r : integer;
 begin
l := q; r := p;
s := b[l];
 repeat
while (b[r] >= s) and (l < r) do r := r - 1;
b[l] := b[r];
 while (b[l] <= s) and (l < r) do l := l + 1;
b[r] := b[l]
until l = r;
b[l] := s;
 if q < l - 1 then fast(q, l - 1, b);
 if l + 1 < p then fast(l + 1, p, b)
end;
{----------------------------------------------------------------------------------------}
begin
create_two(n, m, a);
sprain(n, m, a, b);
fast(1, n*m, b);
 for i := 1 to n*m do write(b[i], ' '); writeln;
v := 1; k := 0;
repeat
 if v mod 2 <> 0 then
for i := 1 to n do
begin
k := k + 1;
a[i, v] := b[k]
end
else
for i := n downto 1 do
begin
k := k + 1;
a[i, v] := b[k]
end;
v := v + 1
 until v = m + 1;
writeln('Elementlarning chizma bo’yicha joylashish massivi');
for i := 1 to n do
begin
 for j := 1 to m do write(a[i, j]:6, ' '); writeln
end
end.
224-misol. 1 dan 100 gacha bo’lgan tasodifiy sonlardan m*n kattalikdagi matrisani tuzing. Ularni quyidagi chizmalar bo’yicha o’sib borish tartibida joylashting (2-rasmga qarang):

Program L224a;
uses Crt;
const
n = 5; m =6 ;
type
s = array[1..m] of integer;
t = array[1..n] of s;
f = array[1..n*m] of integer;
var
a : t;
b : f;
i, j, k, v : integer;
{----------------------------------------------------------------------------------------}
Procedure create_two(n, m : integer; var a : t);
var
i, j : integer;
begin
writeln('Berilgan ikki o’lchovli butun sonli massiv');
randomize;
for i := 1 to n do
begin
for j := 1 to m do
begin
a[i, j] := random(201) - 100;
write(a[i, j]:6, ' ')
end;
writeln
end
end;
{----------------------------------------------------------------------------------------}
 Procedure sprain(n, m : integer; a : t; var b : f);
var
k, i, j : integer;
 begin
k := 0;
for i := 1 to n do
 for j := 1 to m do
begin
k := k + 1;
b[k] := a[i, j]
end
end;
{----------------------------------------------------------------------------------------}
Procedure fast(q, p : integer; var b : f);
var
s, l, r : integer;
begin
l := q;
r := p;
s := b[l];
repeat
while (b[r] >= s) and (l < r) do r := r - 1;
b[l] := b[r];
while (b[l] <= s) and (l < r) do l := l + 1;
b[r] := b[l]
until l = r;
b[l] := s;
if q < l - 1 then fast(q, l - 1, b);
if l + 1 < p then fast(l + 1, p, b)
end;
{----------------------------------------------------------------------------------------}
begin
create_two(n, m, a);
sprain(n, m, a, b);
fast(1, n*m, b);
v := 1; k := 0;
repeat
if v mod 2 <> 0
then
for j := 1 to m do
begin
k := k + 1;
a[v, j] := b[k]
end
else
for j := m downto 1 do
begin
k := k + 1;
a[v, j] := b[k]
end;
v := v + 1
until v = n + 1;
writeln('Elementlarning (a) chizma bo’yicha joylashish massivi');
for i := 1 to n do
begin
for j := 1 to m do write(a[i, j]:6, ' '); writeln
end
end.
Program L224b;
uses Crt;
const
n = 5; m = 6;
type
s = array[1..m] of integer;
t = array[1..n] of s;
f = array[1..n*m] of integer;
var
a : t; b : f;
i, j, k, v : integer;
{----------------------------------------------------------------------------------------}
Procedure create_two(n, m: integer; var a : t);
var
i, j : integer;
begin
writeln('Berilgan butun sonli ikki o’lchovli massiv');
randomize;
for i := 1 to n do
begin
for j := 1 to m do
begin
a[i, j] := random(201) - 100;
write(a[i, j]:6, ' ')
end;
writeln
end
end;
{----------------------------------------------------------------------------------------}
 Procedure sprain(n, m : integer; a : t; var b : f);
var
k, i, j : integer;
 begin
k := 0;
for i := 1 to n do
 for j := 1 to m do
begin
k := k + 1;
b[k] := a[i, j]
end
end;
{----------------------------------------------------------------------------------------}
Procedure fast(q, p : integer; var b : f);
var
s, l, r : integer;
begin
l := q; r := p; s := b[l];
repeat
while (b[r] >= s) and (l < r) do r := r - 1;
b[l] := b[r];
while (b[l] <= s) and (l < r) do l := l + 1;
b[r] := b[l]
until l = r;
b[l] := s;
if q < l - 1 then fast(q, l - 1, b);
if l + 1 < p then fast(l + 1, p, b)
end;
{----------------------------------------------------------------------------------------}
begin
create_two(n, m, a);
sprain(n, m, a, b);
fast(1, n*m, b);
v := n; k := 0;
repeat
if v mod 2 <> 0
then
for j := 1 to m do
begin
k := k + 1; a[v, j] := b[k]
end
else
for j := m downto 1 do
begin
k := k + 1;
a[v, j] := b[k]
end;
v := v - 1
until v = 0;
writeln(''Elementlarning (b) chizma bo’yicha joylashish massivi');
for i := 1 to n do
begin
for j := 1 to m do write(a[i, j]:6, ' '); writeln
end
end.