Cod sursa(job #408111)

Utilizator zseeZabolai Zsolt zsee Data 2 martie 2010 20:42:17
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.08 kb
program shells;
type vektor=^longint;
var n,i:longint;
    be,ki:text;
    v:vektor;

procedure ShellSort3;
var h,i,j:longint;
    Hold:longint;
    k:byte;
const ShellCols:array[0..15] of longint = (1391376,463792,198768,86961,
                              33936,13776,4592,1968,861,336,
                              112,48,21,7,3,1);
//predefine the column sequence to be used
begin
  for k:=0 to 15 do
  begin
    h:=ShellCols[k];
    {the inner loop will not execute if the number of columns is
     greater than ACount.}
    for i:=h to n - 1 do
    begin
      Hold:=V[i];
      j:=i;
      while ((j >= h) and (V[j-h] > HOld)) do
      begin
        V[j]:=V[j-h];
        dec(j,h);
      end;
      {In the inner loop we do a simplified insertion sort}
      V[j]:=Hold;
    end;
  end;
end;

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