Cod sursa(job #413968)

Utilizator ivanhoeNociv Hasis ivanhoe Data 9 martie 2010 15:32:23
Problema Sortare prin comparare Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.83 kb
type
 vector=array[1..50000] of double;
var
 x:vector;
 n,i:longint;
 f,g:text;
function partitie(var x:vector;p,q:byte):byte;
var
 i,j:byte;
 a,temp:integer;
begin
 a:=x[p]; i:=p-1; j:=q+1;
 while (i<j) do
  begin
   Repeat
    j:=j-1
   Until (x[j]<=a);
   Repeat
    i:=i+1;
   until (x[i]>=a);
   if i<j
    then
     begin
      temp:=x[i];
      x[i]:=x[j];
      x[j]:=temp;
     end;
  end;
 partitie:=j;
end;
procedure quicksort(var x:vector;p,q:byte);
var
 m:byte;
begin
 if p<q
  then
   begin
    m:=partitie(x,p,q);
    quicksort(x,p,m);
    quicksort(x,m+1,q);
   end;
end;
begin
 assign(f,'algsort.in');
 reset(f);
 readln(f,n);
 for i:=1 to n do
  read(f,x[i]);
 close(f);
 quicksort(x,1,n);
 assign(g,'algsort.out');
 rewrite(g);
 for i:=1 to n do
  writeln(g,x[i],' ');
end.