Алгоритм

Эта задача является логическим продолжением задачи примера 4. В самом деле, чтобы расположить элементы массива по такой схеме и выполнить условие задачи - упорядочить элементы в порядке возрастания, надо:

1) "растянуть" матрицу в одномерный массив;

2) упорядочить полученный массив в порядке возрастания;

3) "выбрать" из полученного одномерного массива столбцы с расположением элементов по предложенной схеме.

Первый пункт этого алгоритма выполнить нетрудно, основываясь на предыдущем примере.

Упорядочить полученный одномерный массив можно с помощью процедуры быстрой сортировки.

Третий пункт является для нас новым. Чтобы выполнить его, надо заметить следующую закономерность. Если столбец двумерного массива имеет нечетный номер, т. е. 1-й, 3-й, 5-й и т.д., тогда элементы располагаются в порядке возрастания от 1-го элемента столбца до n-го - "сверху вниз".

Если номера столбцов четные, т. е. 2-й, 4-й, 6-й и т. д., тогда элементы располагаются от n-го до 1-го - "снизу вверх".

Теперь можно составить схему программы.

Схема программы

Program Problem18;

Описание массивов и переменных.

Процедура быстрой сортировки.

begin

Создание двумерного массива с помощью функции случайных чисел и одновременное "растягивание" в одномерный массив, а также вывод полученной матрицы на экран.

Вызов процедуры быстрой сортировки и сортировка одномерного массива в порядке возрастания.

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;

Вывод массива на экран.

end.

Program Problem18;

uses WinCrt;

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.

Задача 19. Составить программу умножения матрицы A(n, k) на B(k, m).

Решение

Program Problem19;

uses WinCrt;

const

n = 6; m = 6;

type

s = array[1..m, 1..n] of integer;

t = array[1..n, 1..m] of integer;

f = array[1..m, 1..n] of integer;

var

a : s; b : t; c : f; i , j : integer;

{----------------------------------------------------------------------------------------}

Procedure create_two1(n, m : integer; var a : s);

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(21) - 10;

write(a[i, j]:6, ' ')

end;

writeln

end

end;

{----------------------------------------------------------------------------------------}

Procedure create_two2(n, m : integer; var b : t);

var

i, j : integer;

begin

writeln('Вторая заданная матрица');

randomize;

for i := 1 to n do

begin

for j := 1 to m do

begin

b[i, j] := random(11);

write(b[i, j]:6, ' ')

end;

writeln

end

end;

{----------------------------------------------------------------------------------------}

Procedure div_matrix(n, m : integer; a : s; b : t; var c : f);

var

i, j, k : integer;

begin

for i := 1 to n do

for j := 1 to m do

begin

c[j, i] := 0;

for k := 1 to m do c[j, i] := c[j, i] + a[j, k]*b[k, i]

end

end;

{----------------------------------------------------------------------------------------}

begin

create_two1(n, m, a);

create_two2(n, m, b);

div_matrix(n, m, a, b, c);

writeln('Результат умножения матриц');

for i := 1 to n do

begin

for j := 1 to n do write(c[i, j]:6, ' ');

writeln

end

end.

Задача 20. Процедура удаления заданной строки из массива и вывод нового массива на экран:

n - число строк, m - число столбцов, k - номер удаляемой строки.

Решение

Procedure distance_line(n, m, k : integer; var a : t);

var

i, j : integer;

begin

for i := k to n - 1 do a[i] := a[i+1];

writeln('Новый массив без ', k, '-й строки ');

for i := 1 to n - 1 do

begin

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

end

end;

Задача 21. Процедура вставки нового столбца в заданный двумерный массив будет следующей: n - число строк заданного массива, m - число столбцов заданного массива, k - номер вставляемой строки, c - массив элементов - новой вставляемой строки.

Решение

Procedure insert_column(n, m, k : integer; c : f; var a : t);

var

i, j : integer;

begin

{Перемещение столбцов в конец для освобождения места}

for i := 1 to n do

for j := m + 1 downto k + 1 do a[i, j] := a[i, j - 1];

{Вставка нового столбца}

writeln('Массив с новым ', k, '-м столбцом');

for i := 1 to n do a[i, k] := c[i];

for i := 1 to n do

begin

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

writeln

end

end;

Задача 22. Процедура транспонирования матрицы.

Решение

Описание массивов может быть таким:

const

n = 5; m = 6;

type

s = array[1..n, 1..m] of integer;

t = array[1..m, 1..n] of integer;

var

a : s;

b : t;

{----------------------------------------------------------------------------------------}

Procedure transpose(n, m : integer; a : s; var b : t);

var

i, j : integer;

begin

for i := 1 to n do

for j := 1 to m do b[j, i] := a[i, j];

end;

Задача 23. Процедура упорядочивания и перестановки элементов массива по суммам элементов строк.

Решение

Procedure order_summ_column(n, m : integer; var a : t);

var

i, j, k, f, p : integer;

begin

for i := 1 to m do

begin

k := i;

for j := i + 1 to m do if a[n + 1, j] <= a[n + 1, k] then k := j;

for f := 1 to n + 1 do

begin

p := a[f, i]; a[f, i] := a[f, k]; a[f, k] := p

end

end

end;

Задача 24. Генератор сочетаний

Решение

Program Generator_combination; {Генератор сочетаний}

uses WinCrt;

const

n = 5; k = 3; n1 = 100;

type

t = array[1..n1] of integer;

var

x, min, max : t;

i, j, r : integer;

begin

for j := 1 to k do

begin

max[j] := n - j + 1; min[j] := k - j + 1; x[j] := min[j]

end;

writeln('Сочетания из ',n,' элементов по ', k, ' элементов');

while i <= k do

begin

for j := k downto 1 do write(x[j], ' '); writeln;

r := r + 1; i := 1;

while (i <= k) and (x[i] = max[i]) do i := i + 1;

if i <= k then x[i] := x[i] + 1;

for j := i - 1 downto 1 do

begin

min[j] := x[j + 1] + 1;

x[j] := min[j]

end

end;

writeln('Общее число сочетаний равно r = ', r)

end.