Правила форума
Прочтите прежде чем задавать вопрос!
Исходные данные:
- число строк и столбцов 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 -
