Cod sursa(job #381113)

Utilizator andrey932Andrei andrey932 Data 9 ianuarie 2010 02:04:27
Problema Sortare prin comparare Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 0.88 kb
var t:text;
    x:array[0..500010] of longint;

var i,p,ls,ld,loc,n:longint;
procedure qsort(var x:array of longint; l1,l2:longint);
var pi:longint;
begin
  pi:=random(l2-l1)+l1;
  p:=x[pi];
  x[pi]:=x[l1];
  x[l1]:=p;
  ls:=l1; ld:=l2;
  loc:=ls;
  while (ls<ld) do
    begin
      while ((p<=x[ld]) and (ls<ld)) do ld:=ld-1;
      x[loc]:=x[ld];
      loc:=ld;
      while ((x[ls]<p) and (ls<ld)) do ls:=ls+1;
      x[loc]:=x[ls];
      loc:=ls;
    end;
  x[loc]:=p;
  pi:=loc;

  if l1<pi-1 then
    qsort(x,l1,pi-1);
  if pi+1<l2 then
    qsort(x,pi+1,l2);
end;


procedure quicksort(var x:array of longint; l:longint);
begin
  qsort(x,1,l);
end;

begin
assign(t,'algsort.in');  reset(t);
readln(t,n);
for i:=1 to n do read(t,x[i]);
quicksort(x,n);
close(t);
assign(t,'algsort.out'); rewrite(t);
for i:=1 to n do write(t,x[i],' ');
close(t);

end.