Программа

Program Problem5;

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('Заданный двумерный массив целых чисел');

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('Массив расположения элементов по схеме');

for i := 1 to n do

begin

for j := 1 to m do write(a[i, j]:6, ' '); writeln

end

end.