Cod sursa(job #404004)

Utilizator zseeZabolai Zsolt zsee Data 25 februarie 2010 17:37:54
Problema Sortare prin comparare Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.82 kb
program shells;
type vektor=^longint;
var n,i:longint;
    be,ki:text;
    v:vektor;
    
procedure shellsort;
var inc,i,j:longint;
    tmp:longint;
begin
 inc:=trunc(n / 2.71828 );
 while inc >= 1 do
   begin
    for i:=inc+1 to n do
      begin
       tmp:=v[i];
       j:=i;
       while (j >= inc)and(v[j-inc]>tmp) do
          begin
           v[j]:=v[j-inc];
           j:=j-inc;
          end;
       v[j]:=tmp;
      end;
    if inc < 11 then
       if inc=1 then
         inc:=0
        else inc:=1
     else inc:=trunc(inc / 2.71828);
   end;
end;

begin
 assign(be,'algsort.in');
 assign(ki,'algsort.out');
 reset(be);
 rewrite(ki);
 readln(be,n);
 getmem(v,sizeof(longint)*(n+1));
 for i:=1 to n do
    read(be,v[i]);
 shellsort;
 for i:=1 to n do
  write(ki,v[i],' ');
 close(ki);
end.