Cod sursa(job #545146)

Utilizator zseeZabolai Zsolt zsee Data 2 martie 2011 19:42:50
Problema Sortare prin comparare Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 0.87 kb
program algsort_;
var v:array[1..500000] of longword;
 n:longword;

function feloszt(b,e:longword):longword;
var p:longword;
 h:longword;
begin
 h:= v[(b+e)div 2];
 while b<e do
  begin
   while v[b]<h do
    inc(b);
   while v[e]>h do
    dec(e);
   if b<>e then
    begin
     p:=v[b];
     v[b]:=v[e];
     v[e]:=p;
     if v[e]=v[b] then dec(e);
    end;
  end;
 feloszt := b;
end;

procedure qsort(b,e:longword);
var m:longword;
begin
 if b>=e then exit;
 m := feloszt(b,e);
 qsort(b,m-1);
 qsort(m+1,e);
end;

var be,ki:text;
 i:longword;
 buf:array[1..32000] of byte;

begin
 assign(be,'algsort.in');
 assign(ki,'algsort.out');
 settextbuf(be,buf);
 reset(be);
 readln(be,n);
 for i:=1 to n do
  read(be,v[i]);
 close(be);
 settextbuf(ki,buf);
 rewrite(ki);
 qsort(1,n);
 for i:=1 to n do
  write(ki,v[i],' ');
 close(ki);
end.