Cod sursa(job #744413)

Utilizator ScriamTertiuc Afanasie Scriam Data 8 mai 2012 17:35:22
Problema Sortare prin comparare Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 0.93 kb
Program sortare;
var a : array[1..500000] of longint;
    n : longint;


Procedure citire;
var fin : text;
    i : longint;
begin
assign(fin,'algsort.in');
reset(fin);
readln(fin,n);
for i:=1 to n do
read(fin,a[i]);
close(fin);

end;

Function part(s,d : longint) : longint;
var i,j,t,piv : longint;
begin
if s>d then exit;
i:=s-1; j:=d+1;  piv:=a[(s+d) div 2];
while true do
 begin
 repeat inc(i) until a[i]>=piv;
 repeat dec(j) until a[j]<=piv;
 if i<j then begin t:=a[i]; a[i]:=a[j]; a[j]:=t; end else
 begin
 part:=j;
 exit;
 end;

 end;




end;


Procedure sort(s,d : longint);
var m : longint;
begin
if s<d then
begin
m:=part(s,d);
sort(s,m);
sort(m+1,d);

end;


end;


Procedure scrie;
var fout : text;
    i : longint;
begin
assign(fout,'algsort.out');
rewrite(fout);
for i:=1 to n do
write(fout,a[i],' ');
close(fout);
end;


begin
citire;

sort(1,n);

scrie;

end.