Cod sursa(job #451152)

Utilizator sapiensCernov Vladimir sapiens Data 9 mai 2010 09:07:34
Problema Sortare prin comparare Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 0.86 kb
Program Algsort;
 var f,g:text; a:array[1..500000]of longint;
     i,n:longint;
 procedure swap (x,y:longint);
  var z:longint;
  begin
   z:=a[x]; a[x]:=a[y]; a[y]:=z;
  end;
 function partition (l,r,p:longint):longint;
  var x,y:longint;
  begin
   swap (p,r); y:=l;
   for x:=l to r-1 do
     if a[x]<=a[r] then begin
       swap (x,y);
       inc (y);
     end;
   swap (y,r);
   partition:=y;
  end;
 procedure qsort (l,r:longint);
  var p,np:longint;
  begin
   if r>l then begin
     p:=random (r-l+1)+l;
     np:=partition (l,r,p);
     qsort (l,np-1); qsort (np+1,r);
   end;
  end;
 begin
  assign (f,'algsort.in'); reset (f);
  assign (g,'algsort.out'); rewrite (g);
  readln (f,n); randomize;
  for i:=1 to n do read (f,a[i]);
  qsort (1,n);
  for i:=1 to n-1 do write (g,a[i],' ');
  writeln (g,a[n]);
  close (f); close (g);
 end.