Cod sursa(job #744403)

Utilizator ScriamTertiuc Afanasie Scriam Data 8 mai 2012 17:21:54
Problema Sortare prin comparare Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.83 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;




Procedure sort(i,j : longint);
var li,lj,t : longint;
begin
if i>j then exit;
li:=i;
lj:=j-1;
while (li<lj) do
   begin
   while (a[li]<=a[j])  and (li<lj) do inc(li);
   while (a[lj]>a[j])  and (li<lj) do dec(lj);
   if (li<lj) then begin t:=a[li]; a[li]:=a[lj];  a[lj]:=t; end;
   end;
  t:=a[j]; a[j]:=a[li]; a[li]:=t;
sort(i,li-1);
sort(li+1,j);

end;

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


begin
citire;

sort(1,n);

scrie;

end.