Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Упорядочивание матрицы или одном. массивов.

Автор: DarkGhost 27.05.2011 16:37

Собственно требуется упорядочить 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]2.gif1,' ');
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.


Добавлено через 1 мин.
Как я понял, можно упорядочить уже векторы, или матрицу до создания векторов, но и так и так у меня ничего не получилось, увы...(

Автор: IUnknown 27.05.2011 19:45

Цитата
Сделал всю лабу, осталось всего лишь эта мелочь...
Вообще-то с "этой мелочи" нужно начинать делать работу. Сначала - пишешь функционал, потом - наводишь красоту. Ты пошел другим путем. Навел красоту? Гордись. Теперь у тебя есть никому не нужная, зато жутко красивая (наверное, я не запускал, но судя по размеру исходника - она обязана быть красивой) программа. Только это тебе не поможет: программа должна выполнять свою работу, а не утомлять зрение.

Цитата
Собственно требуется упорядочить 4 одномерных массива
Собственно, там, в FAQ-е есть для этого процедура. Для твоего случая она будет выглядеть так:

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;
, передавай в нее свои массивы - они будут упорядочены. Если тебе нужно их каким-то специальным образом создавать массивы из матрицы - то уточняй, каким именно. А еще лучше - привести формулировку задачи, ибо ты написал все, что угодно, только не то, что нужно для понимания задачи...

P.S. ТЫ что, шрифт SMALL сам написал? Нет? А почему же используется InstallUserFont, а не RegisterBGIfont? (это просто бросилось в глаза, я программу даже не компилировал...)

Автор: DarkGhost 28.05.2011 5:39

IUnknown, спасибо.
Начинал не с *мелочи* граф оболочка писалась несколько минут.
И тем не менее это одна из важных частей защиты лабы на отлично.
Само условие:
Дан двумерный массив размером MxN. Преобразовать его по правилу - все элементы каждого столбца матрицы умножить на элемент этого столбца. Из первых четырех строк массива сформировать четыре новых вектора (одномерных массива). Упорядочить каждый вектор по убыванию.
Процедура есть, говорил же что пытался вставить, увы, было с ошибками.

P.S. Нет, конечно) исправлено.

Автор: DarkGhost 28.05.2011 6:20

Всё же немного туплю, когда вставляем процедуру в программу, bubble( ), что в скобках? судя по примеру, массивы a и b, a - исходный, b - это что?
Глупый вопрос, но пока не разберешься, тупо подставлять буковки пока не заработает хреново))

Автор: IUnknown 28.05.2011 13:54

Цитата
судя по примеру, массивы a и b, a - исходный, b - это что?
Это не массивы. Это массив (он передается как Var-параметр, так что он же и будет результатом) и количество элементов в нем, которые надо упорядочить (на случай, если понадобится упорядочивать только часть массива). Скажем, вот ты описываешь матрицу так:
const
Nmax = 10; {Максимальная размерность матрицы}
type
Matrix = array [1..Nmax, 1..Nmax] of real;
, а фактически у тебя содержится только N нужных столбцов. Остальные - либо 0, либо мусор (в твоем случае нули, поскольку переменная типа Matrix описана глобально). Будешь вызывать так:
bubble (G[1], NMax);
- эти самые никому не нужные нули тоже упорядочатся. И результат будет не такой, какой ожидался. Следовательно, надо передать правильную длину массива:
bubble (G[1], N);
Вот теперь все нежелательные элементы (начиная с N+1-го не будут задействованы)...

Автор: DarkGhost 28.05.2011 15:22

Спасибо! Полностью разобрался, что думаю в следующий раз смогу повторить это без подсказок и не абы как!
Ещё раз большое спасибо.