2016 Update

Task/Hailstone-sequence/Pascal/hailstone-sequence.pascal

@@ -4,91 +4,106 @@ program ShowHailstoneSequence;
 {$Else}
   {$Apptype Console} // for delphi
 {$ENDIF}
-
 uses
   SysUtils;// format
-type
-  tIntArr = record
-               iaAktPos : integer;
-               iaMaxPos : integer;
-               iaArr    : array of integer;
-            end;
+const
+  maxN = 10*1000*1000;// for output 1000*1000*1000
 
-procedure GetHailstoneSequence(aStartingNumber: Integer;var aHailstoneList: tIntArr);
+type
+  tiaArr = array[0..1000] of Uint64;
+  tIntArr = record
+               iaMaxPos : integer;
+               iaArr    : tiaArr
+            end;
+  tpiaArr = ^tiaArr;
+
+function HailstoneSeqCnt(n: UInt64): NativeInt;
+begin
+  result := 0;
+  //ensure n to be odd
+  while not(ODD(n)) do
+  Begin
+    inc(result);
+    n := n shr 1;
+  end;
+
+  IF n > 1 then
+  repeat
+    //now n == odd -> so two steps in one can be made
+    repeat
+      n := (3*n+1) SHR 1;inc(result,2);
+    until NOT(Odd(n));
+    //now n == even -> so only one step can be made
+    repeat
+      n := n shr 1;      inc(result);
+    until odd(n);
+  until n = 1;
+end;
+
+procedure GetHailstoneSequence(aStartingNumber: NativeUint;var aHailstoneList: tIntArr);
 var
+  maxPos: NativeInt;
   n: UInt64;
+  pArr : tpiaArr;
 begin
   with aHailstoneList do
   begin
-    iaAktPos := 0;
-    iaArr[iaAktPos] := aStartingNumber;
-    n := aStartingNumber;
-    while n <> 1 do
-    begin
-      if Odd(n) then
-        n := (3 * n) + 1
-      else
-        n := n div 2;
-      inc(iaAktPos);
-      IF iaAktPos>iaMaxPos then
-      Begin
-        iaMaxPos := round(iaMaxPos*1.62)+2;
-        setlength(iaArr,iaMaxPos+1);
-      end;
-      iaArr[iaAktPos] := n;
-    end;
+    maxPos := 0;
+    pArr := @iaArr;
   end;
+  n  := aStartingNumber;
+  pArr^[maxPos] := n;
+  while n <> 1 do
+  begin
+    if odd(n) then
+      n := (3*n+1)
+    else
+      n := n shr 1;
+    inc(maxPos);
+    pArr^[maxPos] := n;
+  end;
+  aHailstoneList.iaMaxPos  := maxPos;
 end;
 
 var
-  i,Limit: Integer;
+  i,Limit: NativeInt;
   lList: tIntArr;
-  lMaxSequence: Integer;
-  lMaxLength: Integer;
+  lAverageLength:Uint64;
+  lMaxSequence: NativeInt;
+  lMaxLength,lgth: NativeInt;
 begin
-  try
-    with lList do
-    begin
-      setlength(iaArr,0+1);
-      iaMaxPos := 0;
-      iaAktPos := 0;
-    end;
-
-    GetHailstoneSequence(27, lList);
-    with lList do
-    begin
-      i := iaAktPos+1;
-      Writeln(Format('27: %d elements', [i]));
-      Writeln(Format('[%d,%d,%d,%d ... %d,%d,%d,%d]',
-        [iaArr[0], iaArr[1], iaArr[2], iaArr[3],
-      iaArr[i - 4], iaArr[i - 3], iaArr[i - 2], iaArr[i - 1]]));
-      Writeln;
-
-      lMaxSequence := 0;
-      lMaxLength := 0;
-      limit := 10;
-      for i := 1 to 10000000 do
-      begin
-        GetHailstoneSequence(i, lList);
-        if iaAktPos >= lMaxLength then
-        begin
-          IF i> limit then
-          begin
-            Writeln(Format('Longest sequence under %8d : %7d with %3d elements',
-                           [limit,lMaxSequence, lMaxLength]));
-            limit := limit*10;
-          end;
-          lMaxSequence := i;
-          lMaxLength := iaAktPos+1;
-        end;
-      end;
-      Writeln(Format('Longest sequence under %8d : %7d with %3d elements',
-                     [limit,lMaxSequence, lMaxLength]));
-
-    end;
-  finally
-    setlength(lList.iaArr,0);
+  lList.iaMaxPos := 0;
+  GetHailstoneSequence(27, lList);//319804831
+  with lList do
+  begin
+    Limit := iaMaxPos;
+    writeln(Format('sequence of %d has %d  elements',[iaArr[0],Limit+1]));
+    write(iaArr[0],',',iaArr[1],',',iaArr[2],',',iaArr[3],'..');
+    For i := iaMaxPos-3 to iaMaxPos-1 do
+       write(iaArr[i],',');
+    writeln(iaArr[iaMaxPos]);
   end;
-  writeln('game over, wait for >ENTER< ');
-  Readln;
+  Writeln;
+
+  lMaxSequence := 0;
+  lMaxLength := 0;
+  i := 1;
+  limit := 10*i;
+  writeln(' Limit      : number with max length | average length');
+  repeat
+    lAverageLength:= 0;
+    repeat
+      lgth:= HailstoneSeqCnt(i);
+      inc(lAverageLength, lgth);
+      if lgth >= lMaxLength then
+      begin
+        lMaxSequence := i;
+        lMaxLength := lgth+1;
+      end;
+      inc(i);
+    until i = Limit;
+    Writeln(Format(' %10d : %9d    |  %4d   |      %7.3f',
+                   [limit,lMaxSequence, lMaxLength,0.9*lAverageLength/Limit]));
+    limit := limit*10;
+  until Limit > maxN;
 end.