Cod sursa(job #579428)

Utilizator promix2012petruta andrei promix2012 Data 12 aprilie 2011 09:42:29
Problema Sortare prin comparare Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.87 kb
program heapsort;
const fi='algsort.in';
      fo='algsort.out';

var f,g:text;
 v:array[1..500000] of longint;
 bufin,bufout:array[1..65000] of byte;
 i,n:longint;
procedure qsort(st,dr:longint);
var d,r,di,aux,p1:longint;
begin
p1:=v[(st+dr) div 2];
d:=st;
r:=dr;
while d<=r do
   begin
   while(v[d]<p1) do
   inc(d);
   while (v[r]>=p1) do
   dec(r);
   if d<=r then
     begin
     aux:=v[d];
     v[d]:=v[r];
     v[r]:=aux;
     inc(d);
     dec(r);
     end;

   end;
   aux:=v[st];
   v[st]:=v[r];
   v[r]:=aux;
   if r>st then
   qsort(st,r);
   if dr>d then
   qsort(d,dr);
end;
begin
assign(f,fi);
reset(f);
assign(g,fo);
rewrite(g);
settextbuf(f,bufin);
settextbuf(g,bufout);
read(f,n);
for i:=1 to n do
   begin
   read(f,v[i]);
   end;
   qsort(1,n);
   for i:=1 to n do
   write(g,v[i],' ');
close(f);
close(g);
end.