Двумерный массив и процедуры. Преобразования двумерного массива. Опции

[DarkGhost]

Дан двумерный массив размером MxN. Преобразовать его по правилу – все элементы каждого столбца матрицы умножить на элемент этого столбца. Из первых четырех строк массива сформировать четыре новых вектора (одномерные массивы). Упорядочить каждый вектор по убыванию.
Исходные данные:
- число строк и столбцов M и N;
- двумерный массив действительных чисел размерностью MхN.
Выходные данные:
- минимальный элемент каждого столбца;
- матрица, полученная делением каждого столбца на минимальный элемент в этом столбце;
- четыре упорядоченных вектора по убыванию, полученные из первых строк матрицы;

Всё это нужно сделать в простейшей графической оболочке с использованием процедур.
Вот то, что я попробовал/смог сделать сам.

Program DivMax;
Uses Graph, Crt;
const
  Nmax = 10; {максимальная размерность матрицы}
type
  Matrix = array [1..Nmax, 1..Nmax] of real;
  Vector = array [1..Nmax] of real;
  Vecint = array [1..Nmax] of integer;
var
  G: Matrix;
  q: vecint;
  a, b, c, d, x: Vector;
  MaxX, MaxY, Driver, Regim,
  font, i, j, M, N: integer;
  ch: char;
  s: string;
  sv: boolean;
  f: text;
Procedure POLE; {Вывод фона программы}
begin
  SetFillStyle(1, 15);
  Bar(0, 0, MaxX, MaxY);
  SetFillStyle(1, 1);
  Bar(0, 0, MaxX, 25);
  Bar(0, MaxY - 25, MaxX, MaxY);
  SetLineStyle(0, 0, 1);
  SetTextStyle(font, 0, 5);
  SetTextJustify(0, 0);
  SetColor(15);
  OutTextXY(300, 20, 'Вариант 1');
  SetTextStyle(1, 0, 1);
  SetColor(12);
  OutTextXY(10, MaxY - 7, 'F1');
  OutTextXY(130, MaxY - 7, 'F2');
  OutTextXY(240, MaxY - 7, 'F3');
  OutTextXY(390, MaxY - 7, 'F4');
  OutTextXY(550, MaxY - 7, 'Esc');
  SetColor(15);
  SetTextStyle(font, 0, 5);
  OutTextXY(40, MaxY - 8, 'Клавиатура');
  OutTextXY(160, MaxY - 8, 'Сохранить');
  OutTextXY(270, MaxY - 8, 'Загрузить');
  OutTextXY(420, MaxY - 8, 'Преобразовать');
  OutTextXY(590, MaxY - 8, 'Выход');
end;
Procedure INPUT; {ввод матрицы}
var
  i, j: integer;
begin
  Write('Введите размерность матрицы (M*N, M>3): ');
  ReadLn(M, N);
  WriteLn('Ввод матрицы');
    for i := 1 to M do
      for j := 1 to N do
        begin
          Write('G(', i, ',', j, ')=');
          ReadLn(G[i, j]);
        end;
end;
Function DivAMin(var A: Matrix; M, N: integer): real;
{Вычисление минимального элемента каждого столбца и умножение на
этот элемент текущий столбец}
var
  min: real;
  i, j: integer;
begin
  DivAMin := 0;
  for j:=1 to N do
  begin
  A[1,j]:=min;
    for i:=1 to M do
    if A[i,j]<min
    then min:=A[i,j];
    if min=0
    then Exit;
    x[j]:=min;
    for i:=1 to M do
    A[i,j]:=A[i,j]*min;
    end;
end;
Procedure swap(var x,y: integer);
{Процедура обмена}
var
  t:integer;
begin
  t:=x;
  x:=y;
  y:=t;
end;
procedure Ypor;
{Упорядочивание строк элементов методом вставки}
begin
for j:=1 to N-1 do
for i:=1 to M-1 do
if Q[i] < Q[i+1]
then swap (Q[i],Q[i+1]);
end;
begin
  font := InstallUserFont('smal');
  Driver := VGA; Regim := VGAHi;
  InitGraph(Driver, Regim, '');
  MaxX := GetMaxX;  MaxY := GetMaxY;
  POLE;
  sv := False;
  DirectVideo := False;
  repeat
    ch := ReadKey;
    case ch of
      #59: begin {клавиатура}
             RestoreCRTMode;
             INPUT;
             sv := True;
             SetGraphMode(VGAHi);
             POLE;
             SetColor(0);
           end;
      #60: begin {сохранить}
             if not sv then Continue;
             SetFillStyle(1, 15);
             Bar(0, 26, MaxX, MaxY - 26);
             Window(2, 4, 78, 24);
             Write('Имя файла: ');
             Readln(s);
             Assign(f, s); Rewrite(f);
             WriteLn(f, M, ' ', N);
             for i := 1 to M do
               begin
                 for j := 1 to N - 1 do
                   Write(f, G[i, j]1,' ');
                 WriteLn(f, G[i, N]1);
               end;
             Close(f);
             SetFillStyle(1, 15);
             Bar(0, 26, MaxX, MaxY - 26);
           end;
      #61: begin {загрузить}
             SetFillStyle(1, 15);
             Bar(0, 26, MaxX, MaxY - 26);
             Window(2, 4, 78, 24);
             Write('Имя файла: ');
             Readln(s);
             {$I-} Assign(f, s); Reset(f); {$I+}
             if IOResult <> 0 then Continue;
             ReadLn(f, M, N);
             for i := 1 to M do
               begin
                 for j := 1 to N do
                   Read(f, G[i, j]);
                 ReadLn(f);
               end;
             Close(f);
             sv := True;
             SetFillStyle(1, 15);
             Bar(0, 26, MaxX, MaxY - 26);
           end;
      #62: begin {Преобразовать}
             if not sv then Continue;
             SetColor(0);
             SetFillStyle(1, 15);
             Bar(0, 26, MaxX, MaxY - 26);
             Assign(f, 'v12'); Rewrite(f);
             WriteLn(f, 'Исходная матрица');
             for i := 1 to M do
               begin
                 for j := 1 to N do
                   Write(f, G[i, j]:8:1);
                 WriteLn(f);
               end;
             writeln(f, 'Минимумы');
             Write(f,DivAMin(G, M, N)1,' ');
             writeln(f);
             WriteLn(f, 'Преобразованная матрица');
             for i := 1 to M do
               begin
                 for j := 1 to N do
                   Write(f, G[i, j]:8:2);
                 WriteLn(f);
               end;
             for i := 1 to N do
               begin
                 a[i] := G[1, i]; b[i] := G[2, i];
                 c[i] := G[3, i]; d[i] := G[4, i];
               end;
             WriteLn(f, 'Вектор из 1-й строки');
             for j := 1 to N do
               Write(f, a[j]:8:2);
             WriteLn(f);
             WriteLn(f, 'Вектор из 2-й строки');
             for j := 1 to N do
               Write(f, b[j]:8:2);
             WriteLn(f);
             WriteLn(f, 'Вектор из 3-й строки');
             for j := 1 to N do
               Write(f, c[j]:8:2);
             WriteLn(f);
             WriteLn(f, 'Вектор из 4-й строки');
             for j := 1 to N do
               Write(f, d[j]:8:2);
             WriteLn(f);
             Close(f);
             Reset(f);
             j := 40;
             while not EOF(f) do
               begin
                 ReadLn(f, s);
                 OutTextXY(10, j, s);
                 j := j + 11;
               end;
             Close(f);
           end;
    end;
  until ch = #27;
  CloseGraph;
end.

Сообщение отредактировано: DarkGhost - 9.05.2011 20:12