Cod sursa(job #549193)

Utilizator gicu_01porcescu gicu gicu_01 Data 8 martie 2011 11:08:53
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 0.77 kb
var a:array[1..1000000]of longint;
    n:longint;
procedure init;
var i:longint; f:text;
begin
 assign(f,'algsort.in');
 reset(f);
 readln(f,n);
 for i:=1 to n do read(f,a[i]);
 close(f);
end;

procedure afis;
var i:longint;f:text;
begin
 assign(f,'algsort.out');
 rewrite(f);
 for i:=1 to n do write(f,a[i],' ');
 close(f);
end;

procedure sw(var a,b:longint);
var t:longint;
begin
 t:=a;a:=b;b:=t;
end;

procedure qs(left,right:longint);
var i,j,p:longint;
begin
 i:=left; j:=right; p:=a[(i+j)div 2];
 while i<j do
  begin
   while a[i]<p do inc(i);
   while a[j]>p do dec(j);
   if i<=j then begin sw(a[i],a[j]); inc(i); dec(j); end;
  end;
 if i<right then qs(i,right);
 if j>left then qs(left,j);
end;

begin
 init;
 qs(1,n);
 afis;
end.