Cod sursa(job #545061)

Utilizator Luncasu_VictorVictor Luncasu Luncasu_Victor Data 2 martie 2011 17:27:04
Problema Sortare prin comparare Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.84 kb
program palgsort;
var
        a : array[1..500000] of longint;
        n ,i : longint;
        f1 ,f2 : text;
        bufin : array[1..1 shl 22] of char;

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

procedure qs(l ,r : longint);
var
        i ,j ,p : longint;
begin
i := l; j := r; 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 < r then qs(i,r);
 if j > l then qs(l,j);
end;

begin
        assign(f1,'algsort.in');
        assign(f2,'algsort.out');
        reset(f1);
        rewrite(f2);
        readln(f1,n);
 for i := 1 to n do read(f1,a[i]);
 qs(1,n);

 settextbuf(f2,bufin);
 for i := 1 to n do write(f2,a[i],' ');
 close(f2);
end.