Надо отсортировать строки матрицы по невозрастанию их наибольших элементов
Написал такую программу
Код:
{$F+}
program sortmatr;
uses crt;
const n=4;m=4;
type matr=array[1..n,1..m] of real;
type func=function(a:matr;i:byte):real;
var a:matr;
function maxl(a:matr;i:byte):real;
var j:byte;x:real;
begin
x:=a[i,1];
for j:=1 to m do
if a[i,j]>x then x:=a[i,j];
maxl:=x;
end;
procedure output(a:matr);
var i,j:byte;
begin
for i:=1 to n do begin
for j:=1 to m do
write('a[',i,',',j,']=',a[i,j]:1:1,' ');
writeln;
end;
end;
procedure MergeSort( a:matr;f:func);
procedure Merge(var a,b:matr;size:byte);
var i,j,k,r1,r2,l:byte;
begin
k:=1;
while k<=n do begin
i:=k; r1:=i+size-1;
if r1>n then r1:=n;
j:=r1+1; r2:=j+size-1;
if r2>n then r2:=n;
while ((i<=r1)and(j<=r2)) do begin
if f(a,i)<=f(a,j) then begin
for l:=1 to m do b[k,l]:=a[i,l];
i:=i+1;
end
else begin
for l:=1 to m do b[k,l]:=a[j,l];
j:=j+1;
end;
k:=k+1;
end;
while i<=r1 do begin
for l:=1 to m do b[k,l]:=a[i,l];
i:=i+1;
k:=k+1;
end;
while j<=r2 do begin
for l:=1 to m do b[k,l]:=a[j,l];
j:=j+1;
k:=k+1;
end;
end;
end;
var i,size:byte; b:matr;
begin
i:=0; size:=1;
repeat
i:=i+1;
if i mod 2=1 then merge(a,b,size)
else merge(b,a,size);
size:=size*2;
until size>=n;
if (i mod 2=1) then a:=b;
end;
procedure input(var a:matr);
var i,j:byte;
begin
for i:=1 to n do begin
for j:=1 to m do begin
write('a[',i,',',j,']=');
read(a[i,j]);
end;
writeln;
end;
end;
begin
clrscr;
input(a);
mergesort(a,maxl);
output(a);
readln;
end.
но она не сортирует вообще
Алгоритм брал из лекций
15.12.2009, 01:05 
