Cod sursa(job #545150)

Utilizator zseeZabolai Zsolt zsee Data 2 martie 2011 19:53:00
Problema Sortare prin comparare Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.16 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 inss(b,e:longword);
var i:longword;
 t,p:longword;
begin
 for i:=b+1 to e do
  begin
   t := i-1;
   p := v[i];
   while (t>=b)and(p < v[t]) do
    begin
     v[t+1] := v[t];
     dec(t);
    end;
   v[t+1] := p;
  end;
end;

procedure qsort(b,e:longword);
var m:longword;
begin
 if e-b < 15 then
  begin
   inss(b,e);
   exit;
  end;
 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.