Cod sursa(job #572096)

Utilizator gicu_01porcescu gicu gicu_01 Data 5 aprilie 2011 00:27:26
Problema Sortare prin comparare Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.82 kb
var a:array[1..500000]of longint;
    buf:array[1..500000]of char;
    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);
 settextbuf(f,buf);
 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.