Cod sursa(job #380984)

Utilizator ScriamTertiuc Afanasie Scriam Data 8 ianuarie 2010 15:04:20
Problema Sortare prin comparare Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.29 kb
Program quick;
type vector=array[1..500001] of longint;
var a : vector;
    size,i : longint;
    f,g : text;
    buf : array[1..50001] of byte;


Procedure quicksort(n : longint);


  Procedure qsortrec(start,stop : longint);
  var m,splitpt : longint;


    Function split(start,stop : longint) : longint;
    var left,right,pivot : longint;


      Procedure swap(var a,b : longint);
      var t : longint;
      begin
      t:=a; a:=b; b:=t;
      end;

    begin{split}
    pivot:=a[start];
    left:=start+1;
    right:=stop;

    while left<=right do
    begin
       while (left<=stop) and (a[left]<pivot) do
       inc(left);
       while (right>start) and (a[right]>=pivot) do
       dec(right);
       if left<right then
       swap(a[left],a[right]);
     end;

     swap(a[start],a[right]);
     split:=right;
     end;
begin{qsortrec}
if start<stop then
begin
  splitpt:=split(start,stop);
  qsortRec(start,splitpt-1);
  qsortRec(splitpt+1,stop);
end;
end;


begin   {quicksort}
qsortRec(1,n)
end;



begin
assign(f,'algsort.in');
reset(f);
settextbuf(f,buf);
readln(f,size);
for i:=1 to size do
read(f,a[i]);
close(f);
quicksort(size);
assign(g,'algsort.out');
rewrite(g);
for i:=1 to size do
write(g,a[i],' ');
close(g);
end.