Cod sursa(job #411923)

Utilizator skullLepadat Mihai-Alexandru skull Data 5 martie 2010 11:27:02
Problema Sortare prin comparare Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.23 kb
var v:array [1..500000] of longint;
    buf,bug:array [1..32000] of byte;
    n,i,x:longint;
    f,g:text;

procedure inv(var x,y:longint);
var aux:longint;
          begin
          aux:=x;
          x:=y;
          y:=aux;
          end;

procedure poz(st,dr:longint;var k:longint);
var ii,jj,i,j:longint;
          begin
          ii:=0;jj:=1;i:=st;j:=dr;
          while i<j do
                begin
                if v[i]>v[j] then
                   begin
                   inv(v[i],v[j]);
                   inv(ii,jj);
                   end;
                i:=i+ii;
                j:=j-jj;
                end;
          k:=i;
          end;

procedure quick(st,dr:longint);
var k:longint;
          begin
          if st<dr then
             begin
             poz(st,dr,k);
             quick(st,k-1);
             quick(k+1,dr);
             end;
          end;

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