Cod sursa(job #545567)

Utilizator zseeZabolai Zsolt zsee Data 3 martie 2011 16:16:29
Problema Sortare prin comparare Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.89 kb
var v:array[0..500000] of longint;
 n,i:longint;
 be,ki:text;
 rbuf,wbuf : array[0..32000] of byte;
 
procedure sort;
var i:longint;
 p,t:longint;
 inc : longint;
begin
 inc := n div 2;
 while inc > 0 do
   begin
    writeln('inc = ',inc);
    for i := 1 + inc to n do
      begin
       t := i-inc;
       p := v[i];
       while (t>=1)and( v[t] > p ) do
         begin
          v[t+inc] := v[t];
          t := t - inc;
         end;
       v[t+inc] := p;
      end;
    if inc < 15 then
     begin
      if inc = 1 then inc := 0
        else inc :=1;
     end
       else inc := trunc(inc / 2.7128);
   end;
end;

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