Собственно требуется упорядочить 4 одномерных массива, 4 массива получаются путём создания их из 4рех первых строк матрицы.
Нужно упорядочить их по убыванию.
Читал это http://forum.pascal.net.ru/index.php?showtopic=3065
Пробовал и способом вставки и пузырьковым методом, видимо я немного криворукий...
Прошу вашей помощи) Сделал всю лабу, осталось всего лишь эта мелочь...
Сама прога.
Program xD;
Uses Graph, Crt;
const
Nmax = 10; {Максимальная размерность матрицы}
type
Matrix = array [1..Nmax, 1..Nmax] of real;
Vector = array [1..Nmax] of real;
var
G, H : Matrix;
a, b, c, d, x, z: Vector;
MaxX, MaxY, Driver, Regim,
font, i, j, M, t, k, N: integer;
buf, max:real;
ch: char;
s: string;
sv: boolean;
f: text;
Procedure oform; {Вывод фона программы}
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');
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);
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;
procedure rand; {Генератор случайных значений}
var
i, j: integer;
begin
write('Введите размерность матрицы (M*N, M>3: ');
readln(M,N);
randomize;
for i:=1 to m do
for j:=1 to n do
G[i,j]:=random(50);
end;
Function DivAMin(var A: Matrix; M, N: integer;var st:string): real;
{Вычисление минимального элемента каждого столбца и умножение на
этот элемент текущий столбец}
var
min: real;
i, j: integer;
begin
DivAMin := 0;
for j:=1 to n do
begin
min:=A[1,j];
for i:=1 to m do
if A[i,j]<min
then min:=A[i,j];
for i:=1 to m do
begin
z[j]:=min;
A[i,j]:=A[i,j]*min;
end;
end;
DivAMin:=n;
end;
begin
font := InstallUserFont('small');
Driver := VGA; Regim := VGAHi;
InitGraph(Driver, Regim, '');
MaxX := GetMaxX; MaxY := GetMaxY;
oform;
sv := False;
DirectVideo := False;
repeat
ch := ReadKey;
case ch of
#59: begin {Клавиатура}
RestoreCRTMode;
INPUT;
sv := True;
SetGraphMode(VGAHi);
oform;
SetColor(0);
end;
#60: begin {Рандом}
RestoreCRTMode;
rand;
sv := True;
SetGraphMode(VGAHi);
oform;
setcolor(0);
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, 'v1'); 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;
DivAMin(G, M, N, S);
writeln(f, 'Минимумы');
for i:=1 to n do
write(f,z[i]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.
Procedure Bubble(Var ar: Vector; n: integer);, передавай в нее свои массивы - они будут упорядочены. Если тебе нужно их каким-то специальным образом создавать массивы из матрицы - то уточняй, каким именно. А еще лучше - привести формулировку задачи, ибо ты написал все, что угодно, только не то, что нужно для понимания задачи...
Var
i, j: Integer;
T: real;
Begin
For i := 1 To n Do
For j := n DownTo i+1 Do
If ar[Pred(j)] < ar[j] Then
Begin
T := ar[Pred(j)]; ar[Pred(j)] := ar[j]; ar[j] := T
End
End;
IUnknown, спасибо.
Начинал не с *мелочи* граф оболочка писалась несколько минут.
И тем не менее это одна из важных частей защиты лабы на отлично.
Само условие:
Дан двумерный массив размером MxN. Преобразовать его по правилу - все элементы каждого столбца матрицы умножить на элемент этого столбца. Из первых четырех строк массива сформировать четыре новых вектора (одномерных массива). Упорядочить каждый вектор по убыванию.
Процедура есть, говорил же что пытался вставить, увы, было с ошибками.
P.S. Нет, конечно) исправлено.
Всё же немного туплю, когда вставляем процедуру в программу, bubble( ), что в скобках? судя по примеру, массивы a и b, a - исходный, b - это что?
Глупый вопрос, но пока не разберешься, тупо подставлять буковки пока не заработает хреново))
const, а фактически у тебя содержится только N нужных столбцов. Остальные - либо 0, либо мусор (в твоем случае нули, поскольку переменная типа Matrix описана глобально). Будешь вызывать так:
Nmax = 10; {Максимальная размерность матрицы}
type
Matrix = array [1..Nmax, 1..Nmax] of real;
bubble (G[1], NMax);- эти самые никому не нужные нули тоже упорядочатся. И результат будет не такой, какой ожидался. Следовательно, надо передать правильную длину массива:
bubble (G[1], N);Вот теперь все нежелательные элементы (начиная с N+1-го не будут задействованы)...
Спасибо! Полностью разобрался, что думаю в следующий раз смогу повторить это без подсказок и не абы как!
Ещё раз большое спасибо.