Сортировка матрицы, динамика, файлы, драйверы Опции

[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]

т.к. сказано Упорядочить массив, то я думаю нужно *поменять строки матрицы так, что второй столбец окажется отсортированным по неубыванию*

Сообщение отредактировано: punkska - 6.01.2006 23:03

[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]

не перестал
ему всё равно не нравиться что-то T^[2] Error 76

[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;