Помощь - Поиск - Пользователи - Календарь
Полная версия: Упорядочивание матрицы или одном. массивов.
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
DarkGhost
Собственно требуется упорядочить 4 одномерных массива, 4 массива получаются путём создания их из 4рех первых строк матрицы.
Нужно упорядочить их по убыванию.
Читал это Методы сортировок
Пробовал и способом вставки и пузырьковым методом, видимо я немного криворукий...
Прошу вашей помощи) Сделал всю лабу, осталось всего лишь эта мелочь...
Сама прога.
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.


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

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

P.S. Нет, конечно) исправлено.
DarkGhost
Всё же немного туплю, когда вставляем процедуру в программу, bubble( ), что в скобках? судя по примеру, массивы a и b, a - исходный, b - это что?
Глупый вопрос, но пока не разберешься, тупо подставлять буковки пока не заработает хреново))
IUnknown
Цитата
судя по примеру, массивы 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
Спасибо! Полностью разобрался, что думаю в следующий раз смогу повторить это без подсказок и не абы как!
Ещё раз большое спасибо.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.