old/PAS/!SPbSTU/ShellSort.pas

Program ShellSort;
{‘®àâ¨à®¢ª  ˜¥«« , ã«ãç襭¨¥  «£®à¨â¬  ¯àאַ£® ¢ª«î祭¨ï, à §­¨æ  ¢ ⮬,
 çâ® ¯à®æ¥áá á®àâ¨à®¢ª¨ ¡ì¥âáï ­  T íâ ¯®¢, ¢ ª ¦¤®¬ ¨§ ª®â®àëå ¤¥« ¥âáï 
 ®¤¨­ ¯à®å®¤ ¯àאַ£® ¢ª«î祭¨ï, ­® ⮫쪮 ­  í«¥¬¥­âë, ®âáâ®ï騥 ¤à㣠®â 
 ¤à㣠 ­  h[i] í«-⮢ (i in [1..T] ¨ h[T] = 1)

 ’ ª¦¥ ¤«ï  «£®à¨â¬  ¯àאַ© ¢áâ ¢ª¨ 㤮¡­® ¨á¯®«ì§®¢ âì "¡ àì¥àë". „ ¡ë
 ¯à¨ ¯¥à¥¬¥é¥­¨¨ ­¥ ᢥàïâì ¨­¤¥ªá í«-â  á ­ ç «®¬ ¬ áᨢ , 㤮¡­® 
 à áè¨à¨âì ¬ áᨢ ­  1 í«-â (¢ ¤ ­­®¬ á«ãç ¥ ­  h[1]) ¨ â㤠 ¯¨á âì í«-â,
 ª®â®à®¬ã ᮡ¨à ¥¬áï ¨áª âì ¬¥áâ®. ’ ª¨¬ ®¡à §®¬ à §¬¥à ¬ áᨢ  ¡ã¤¥â
 [-h[1]..TotalCount]. ‚á«¥¤á⢨¥ ¦¥« ­¨ï ᮧ¤ âì ã­¨¢¥àá «ì­ë©  «£®à¨â¬
 á ¨á¯®«ì§®¢ ­¨¥¬ ¤¨­ ¬¨ç¥áª¨å áâàãªâãà (­ ¬ § à ­¥¥ ­¥ ¨§¢¥áâ­® T ¨ 
 ᮮ⢥âá⢥­­® h[1]) ¡ã¤¥â ¨á¯®«ì§®¢ ìáï ᬥ饭­ ï ¨­¤¥ªá æ¨ï ¬ áᨢ 
 ( A[i] -> A[h[1]+i]).

 ˆá¯®«ì§ãîâáï ã«ãç襭¨ï „. Š­ãâ :
 h[k-1] := 3*h[k]+1;
 T := LOG(N,3)-1

 PS. � ¤¥îáì ¢¥áì íâ®â ¡à¥¤ ¯®¬®¦¥â ¢ ¬ à §®¡à âìáï ¢ ¯à¥¤«®¦¥­­®¬  «£®à¨â¬¥.}

type
 item = word;
const
 MaxCount = 65530 div SizeOf(item); {Œ ªá¨¬ «ì­®¥ ç¨á«® í«-⮢ ¬ áᨢ }
 TotalCount = 20000;

type
 pArray = ^tArray;
 tArray = array [1..MaxCount] of Item;
 tIndex  = 1..MaxCount;

var
 T  : tIndex; {—¨á«® "à §¡¨¥­¨©"}
 h  : pArray;
 Fi : tIndex; {�¥ «ì­ë© ¨­¤¥ªá ¯¥à¢®£® í«-â  (­¥ ¡ àì¥à )}
 A  : pArray;

{--------------------------------------------------------------}
Procedure Init; {“áâ ­ ¢«¨¢ îâáï ã«ãçè. Š­ãâ , ¨­¨æ. ¬ áᨢë}
var
 i : tIndex;
begin
 T := round(Ln(TotalCount)/Ln(3)-1); {(‘) Š­ãâ}
 GetMem(h,T*SizeOf(item)); {ˆ­¨æ. ¬ áᨢ à ááâ®ï­¨©}
 h^[T] := 1;
 for i := T-1 DownTo 1 do h^[i] := 3*h^[i+1]+1;
 Fi := h^[1]; {“áâ ­®¢¨¬ £«®¡. ¨­¤¥ªá "ᬥ饭­®£®" ᬥ饭¨ï}
 GetMem(A,(TotalCount+Fi)*Sizeof(Item)); {ˆ­¨æ «¨§¨à㥬 ®á­. ¬ áᨢ}
                 {^^^ „«ï ¡ àì¥à®¢} 
end;{Init}
{--------------------------------------------------------------}
Procedure Done; {Žá¢. ¢áî ¯ ¬ïâì}
begin
  FreeMem(h,T*SizeOf(Item));
  FreeMem(A,TotalCount*SizeOf(Item));
end;{Done}
{--------------------------------------------------------------}
Procedure SetArray; {�à®æ¥¤ãઠ § ¯®«­¥­¨ï í«-⮢ ¬ áᨢ  á«ãç. ç¨á« ¬¨}
var
 i : tIndex;
begin
  Randomize;
  For i := 1 To TotalCount Do A^[Fi+i] := Random(65535);
                                {^^^ Ž¯ïâì ¡ àì¥àë}
end;{SetArray}
{--------------------------------------------------------------}

{Žá­®¢­ ï ¯à®£à ¬¬ }
Var
 i,j,k,m,s : tIndex;
 Times     : pArray;
 x         : Item;

BEGIN
  Init;
  SetArray;

  GetMem(Times,T*SizeOF(Word));
  FillChar(Times^,T*SizeOF(Word),0);

  For m := 1 to T do
  begin
   k := h^[m]; {� ááâ®ï­¨¥ ¬¥¦¤ã í«-â ¬¨}
   s := Fi-k;  {"¡ àì¥à"}
   For i := k+1 to TotalCount do
   begin
     x := A^[Fi+i]; {�«-â, á ª®â®àë¬ à ¡®â ¥¬}
     If S=Fi then S := Fi-k;
     inc(s);
     A^[s] := x;         {“áâ ­®¢¨¬ "¡ àì¥à"}
     j := i-k;           {�।ë¤ã騩 ç¥à¥§ à ááâ®ï­¨¥}
     while A^[Fi+j] > x do
      begin
       Inc(Times^[m]);
       A^[Fi+j+k] := A^[Fi+j]; {„¢¨£ ¥¬ ¬ áᨢ}
       dec(j,k);
      end;
     A^[Fi+j+k] := x;
   end;
  end;

  For i := 1 to TotalCount do
  begin
   if ((i-1) mod 10) = 0 then WriteLN;
   Write(A^[Fi+i]:7);
  end;

  WriteLN(#10#13'—¨á«® ¯¥à¥áâ ­®¢®ª ­  ª ¦¤®¬ íâ ¯¥:');
  for i := 1 to T do WriteLn(i,'(',H^[i],') -> ',Times^[i]);

  FreeMem(Times,T*SizeOF(Word));

  Done;
END.