Напишите программу для двумерной обработки массива - Pascal - Ответ 5874222

{uses
  Crt;} (*<-- раскомментируйте эти строки, если используете Турбо Паскаль*)   
 
const
  n = 8;
 
type
  matrix = array [1..n, 1..n] of integer;
  vector = array [1..n * n] of integer;
 
var
  a: matrix;
  b: vector;
  num: integer;
 
procedure CreateDiagonalMatrix(var x: matrix);
var
  i, j: integer;
begin
  for i := 1 to n do
    for j := 1 to n do
      if i = j then
        x[i, j] := Random(76) - 30
      else
        x[i, j] := 0
end;
 
procedure CreateLowTriangularMatrix(var x: matrix);
var
  i, j: integer;
begin
  for i := 1 to n do
    for j := 1 to n do
      if i < j then
        x[i, j] := 0
      else
        x[i, j] := Random(76) - 30
end;
 
procedure CreateHighTriangularMatrix(var x: matrix);
var
  i, j: integer;
begin
  for i := 1 to n do
    for j := 1 to n do
      if i > j then
        x[i, j] := 0
      else
        x[i, j] := Random(76) - 30
end;
 
procedure CreateSymmetricMatrix(var x: matrix);
var
  i, j, k: integer;
begin
  for i := 1 to n do
    for j := 1 to n do
      if i > j then
      begin
        k := Random(76) - 30;
        x[i, j] := k;
        x[j, i] := k
      end
      else
      if i = j then
        x[i, j] := Random(76) - 30
end;
 
procedure PrintMatrix(x: matrix);
var
  i, j: integer;
begin
  for i := 1 to n do
  begin
    for j := 1 to n do
      Write(x[i, j]:4);
    WriteLn
  end
end;
 
procedure Transform(x: matrix; var y: vector);
var
  i, j, k: integer;
begin
  k := 0;
  for i := 1 to n do
    for j := 1 to n do
    begin
      k := k + 1;
      y[k] := x[i, j]
    end
end;
 
procedure PrintVector(y: vector);
var
  i: integer;
begin
  for i := 1 to Sqr(n) do
    Write(y[i], ' ');
  WriteLn
end;
 
procedure Search(y: vector; element: integer);
var
  i: integer;
  f: boolean;
begin
  f := false;
  for i := 1 to Sqr(n) do
    if y[i] = element then
    begin
      f := true;
      Write(i, ' ');
    end;
  if f = false then
    WriteLn('Нет таких элементов')
  else
    WriteLn
end;
 
procedure BubbleSort(var y: vector);
var
  i, j, tmp: integer;
begin
  for i := 1 to Sqr(n) - 1 do
    for j := i + 1 to Sqr(n) do
      if y[i] > y[j] then
      begin
        tmp := y[i];
        y[i] := y[j];
        y[j] := tmp
      end
end;
 
procedure InsertionSort(var y: vector);
var
  i, j, tmp: integer;
begin
  for i := 2 to Sqr(n) do
  begin
    tmp := y[i];
    j := i - 1;
    while (j >= 1) and (y[j] > tmp) do
    begin
      y[j + 1] := y[j];
      j := j - 1
    end;
    y[j + 1] := tmp
  end
end;
 
procedure SelectionSort(var y: vector);
var
  i, j, min, tmp: integer;
begin
  for i := 1 to Sqr(n) - 1 do
  begin
    min := i;
    for j := i + 1 to Sqr(n) do
      if y[min] > y[j] then
        min := j;
    if min <> i then
    begin
      tmp := y[i];
      y[i] := y[min];
      y[min] := tmp
    end
  end
end;
 
begin
  {TextMode(C80 + Font8x8);
  ClrScr;}   (*<-- раскомментируйте эти строки, если используете Турбо Паскаль*)  
  Randomize;
  WriteLn('Выберите тип матрицы:');
  WriteLn('1) Диагональная');
  WriteLn('2) Нижнетреугольная');
  WriteLn('3) Верхнетреугольная');
  WriteLn('4) Симметричная');
  repeat
    ReadLn(num);
  until num in [1..4];
  case num of
    1: CreateDiagonalMatrix(a);
    2: CreateLowTriangularMatrix(a);
    3: CreateHighTriangularMatrix(a);
    4: CreateSymmetricMatrix(a);
  end;
  PrintMatrix(a);
  Transform(a, b);
  WriteLn('Полученный вектор:');
  PrintVector(b);
  WriteLn('Введите элемент для поиска: ');
  ReadLn(num);
  WriteLn('Индексы искомого элемента:');
  Search(b, num);
  WriteLn('Выберите метод сортировки:');
  WriteLn('1) Пузырьком');
  WriteLn('2) Вставками');
  WriteLn('3) Выбором');
  repeat
    ReadLn(num);
  until num in [1..3];
  case num of
    1: BubbleSort(b);
    2: InsertionSort(b);
    3: SelectionSort(b);
  end;
  WriteLn('Отсортированный вектор:');
  PrintVector(b);
  ReadLn
end.