Cod sursa(job #545030)

Utilizator Luncasu_VictorVictor Luncasu Luncasu_Victor Data 2 martie 2011 16:56:48
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 0.82 kb
program pheap;
type
        hp = array[1..500000] of longint;
var
        h : hp;
        n : longint;

procedure qs(var h : hp; l ,r : longint);
var
        i ,j ,m ,p : longint;
begin
i := l; j := r; p := h[(l + r) div 2];
repeat
while (i < r) and (h[i] < p) do inc(i);
while (j > l) and (h[j] > p) do dec(j);
if i <= j then
begin
 if i < j then
 begin
  m := h[i];
  h[i] := h[j];
  h[j] := m;
 end;
 inc(i); dec(j);
end;
until i > j;
if j > l then qs(h,l,j);
if i < r then qs(h,i,r);
end;

procedure rd;
var
        f : text;
        i ,x : longint;
begin
        assign(f,'algsort.in'); reset(f);
 readln(f,n);
 for i := 1 to n do read(f,h[i]);
 close(f);
 qs(h,1,n);
        assign(f,'algsort.out'); rewrite(f);
 for i := 1 to n do write(f,h[i],#32);
 close(f);
end;

begin
rd;
end.