Помощь - Поиск - Пользователи - Календарь
Полная версия: Сортировка матрицы
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
punkska
Проверрить, Все лия строки матрицы упорядочны по убыванию. Упорядочить массив по неубыванию элементов второго столбца. Сортировка вставкаими.


program laba2;
uses Crt;
type
 Mas=array[1..1] of integer;
 dinmas=^mas;

function takesize:integer;
var
 i:integer;
begin
 writeln('KO/\U4ECTBO ELEMEHTOB MACCUBA:');
 repeat
  readln(i);
 until i>0;
 takesize:=i;
end;

procedure EnterMassive(var A:dinmas; const n:integer);
var
 i:integer;
begin
 writeln;
 writeln('BBEgUTE MACCUB:');
 i:=0;
 repeat
  i:=i+1;
  write(i,' element = ');
  readln(A^[i]);
 until i=n;
end;

procedure ShowMassive(var A:dinmas; const n:integer);
var
 i:integer;
begin
 writeln;
 writeln('BBEgEHHb|U MACCUB:');
 i:=0;
 repeat
  i:=i+1;
  write(A^[i],' ');
 until i=n;
 writeln;
end;

procedure sorting(var A:dinmas; const n:integer);
var
 j,i:integer;
 endof:boolean;
 add:integer;
begin
 writeln;
 writeln('COPTUPOBKA MACCUBA...');
 for i:=2 to n do
 begin
  j:=i;
  endof:=true;
  while( j>1 ) and endof do
   if (A^[j]<A^[j-1]) then
   begin
    add:=A^[j-1];
    A^[j-1]:=A^[j];
    A^[j]:=add;
    j:=j-1;
   end
   else
    endof:=false;
 end;
end;


var
 n:integer;
 A:dinmas;

begin
clrscr;
writeln('LABA 2');

n:=takesize;
GetMem(A,sizeof(real)*n);
EnterMassive(A,n);
showMassive(A,n);

{////}
sorting(A,n);
showMassive(A,n);
Freemem(A,sizeof(real)*n);
writeln('THE END.');
readln;
end. 





1 вопрос как сделать сортировку *по неубыванию элементов второго столбца. Сортировка вставкаими.*
я написал..но явно не для 2ого столбца....что-то я не понял...
и пока что-то ни как ни хочет работать *Проверрить, Все лия строки матрицы упорядочны по убыванию*
хелп
punkska
блин матрица а не массив! ёмоё
volvo
Цитата
Упорядочить массив по неубыванию элементов второго столбца
Задание уточни... Что именно тебе нужно - отстртировать ТОЛЬКО второй столбец по неубыванию, не трогая остальные, или поменять местами строки матрицы так, что второй столбец окажется отсортированным по неубыванию?

Это разные вещи...
punkska
т.к. сказано Упорядочить массив, то я думаю нужно *поменять строки матрицы так, что второй столбец окажется отсортированным по неубыванию* unsure.gif
volvo
Ну, тогда я могу тебе сказать, что ты СОВСЕМ неправильно работаешь с матрицей... Тот способ, которым ты пользуешься - работает с массивами... Матрицы - вот так: FAQ: Работа с динамическими матрицами

Ну, а вот рабочий каркас программы, только поставь где тебе нужно функции/процедуры...
{$R-}
Type
  TType = Word;
Type
  PVector = ^TVector;
  TVector = Array[1 .. 1] of TType;

  PDynMatrix = ^TDynMatrix;
  TDynMatrix = Array[1 .. 1] of PVector;

Var
  mxDynamic: PDynMatrix;
  n, i, j: Word;
  T: PVector;
Begin
  Write('n = '); ReadLn(n);
  { Alloc }
  GetMem(mxDynamic, n * SizeOf(PVector));
  For i := 1 To n Do
    GetMem(mxDynamic^[i], n * SizeOf(TType));

  { Enter Data }
  Randomize;
  For i := 1 To n Do
    For j := 1 To n Do
      mxDynamic^[I]^[J]:=random(20);
  { Show: Before }
  For i := 1 To n Do Begin
    WriteLn;
    For j := 1 To n Do
       Write(mxDynamic^[I]^[J]:4);
  End;

  {Sorting}
  For i := 1 To n do Begin
    T := mxDynamic^[i];
    j := Pred(i);
    While (T^[2] < mxDynamic^[j]^[2]) and (j > 0) Do Begin
      mxDynamic^[Succ(j)] := mxDynamic^[j]; Dec(j);
    End;
    mxDynamic^[Succ(j)] := T;
  End;


  { Show: After }
  For i := 1 To n Do Begin
    WriteLn;
    For j := 1 To n Do
       Write(mxDynamic^[I]^[J]:4);
  End;

  { Free }
  For i := 1 To n Do
    FreeMem(mxDynamic^[i], n * SizeOf(TType));
  FreeMem(mxDynamic, n * SizeOf(PVector));
End.
punkska

{$R-}
uses Crt;
Type
  TType = Word;
Type
  PVector = ^TVector;
  TVector = Array[1 .. 1] of TType;

  PDynMatrix = ^TDynMatrix;
  TDynMatrix = Array[1 .. 1] of PVector;

procedure EnterMatr(var mxDynamic: PDynMatrix; const n:integer );
  Var i,j:integer;
  Begin
    For i := 1 To n Do
    For j := 1 To n Do
     read( mxDynamic^[I]^[J]);
  end;

procedure ShowMatr(var mxDynamic: PDynMatrix; const n:integer );
  Var i,j:integer;
  Begin
  For i := 1 To n Do Begin
    WriteLn;
    For j := 1 To n Do
       Write(mxDynamic^[I]^[J]:4);
    End;
  End;

procedure TakeSize(var mxDynamic: PDynMatrix; const n:integer );
  Var i,j:integer;
  Begin
   GetMem(mxDynamic, n * SizeOf(PVector));
  For i := 1 To n Do
    GetMem(mxDynamic^[i], n * SizeOf(TType));
  end;

procedure FreeSize(var mxDynamic: PDynMatrix; const n:integer );
 Var i,j:integer;
 Begin
 For i := 1 To n Do
  FreeMem(mxDynamic^[i], n * SizeOf(TType));
  FreeMem(mxDynamic, n * SizeOf(PVector));
 end;


procedure SortMatr( mxDynamic: PDynMatrix; const n:integer );
 Var i,j:integer;
     T: PVector;
  Begin
   For 
    i := 1 To n do Begin
    T := mxDynamic^[i];
    j := Pred(i);
    While (T^[2] < mxDynamic^[j]^[2]) and (j > 0) Do Begin
      mxDynamic^[Succ(j)] := mxDynamic^[j]; Dec(j);
    End;
    mxDynamic^[Succ(j)] := T;
  End;

Var
  mxDynamic: PDynMatrix;
  n, i, j: Word;
  
Begin
  Write('n = '); ReadLn(n);
 
  
  takesize(mxDynamic,n);
  EnterMatr(mxDynamic,n);
  clrscr;
  ShowMatr(mxDynamic,n); 
  FreeSize(mxDynamic,n);
  
End.




сортировку ни пойму как заставить работать!(
volvo
Во-первых, у тебя не хватает одного End-а в процедуре сортировки, а во-вторых, поменяй условие
While (T^[2] < mxDynamic^[j]^[2]) and (j > 0) Do Begin

на
While (j > 0) and (T^[2] < mxDynamic^[j]^[2]) Do Begin

, тогда оно перестанет зависеть от настроек компилятора...
punkska
unsure.gif не перестал
ему всё равно не нравиться что-то T^[2] Error 76 wacko.gif
volvo
Пример входных данных и версию компилятора приведи...
У меня как на FPC 2.0.0 так и на TP70 при матрице размером 3*3:
Цитата
1 8 3
4 1 5
2 7 3
прекрасно отрабатывает...

Вот так тоже попробуй, иногда помогает:
procedure SortMatr( mxDynamic: PDynMatrix; const n:integer );
Var
  i,j:integer;
  T: PVector;
Var
  Two: Byte;
Begin
  Two := 2;

  For i := 1 To n do Begin
    T := mxDynamic^[i];
    j := Pred(i);
    While (j > 0) and (T^[Two] < mxDynamic^[j]^[Two]) Do Begin
      mxDynamic^[Succ(j)] := mxDynamic^[j]; Dec(j);
    End;
    mxDynamic^[Succ(j)] := T;
  End;
End;
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.