Data commit

Task/Gapful-numbers/Pascal/gapful-numbers-1.pas

@@ -0,0 +1,180 @@
+program gapful;
+
+
+{$IFDEF FPC}
+   {$MODE DELPHI}{$OPTIMIZATION ON,ALL}
+{$ELSE}
+  {$APPTYPE CONSOLE}
+{$ENDIF}
+
+uses
+  sysutils // IntToStr
+{$IFDEF FPC}
+  ,strUtils // Numb2USA aka commatize
+{$ENDIF};
+
+const
+  cIdx = 5;
+  starts: array[0..cIdx - 1] of Uint64 = (100, 1000 * 1000, 10 * 1000 * 1000,
+    1000 * 1000 * 1000, 7123);
+  counts: array[0..cIdx - 1] of Uint64 = (30, 15, 15, 10, 25);
+  //100|  74623687  =>    1000*1000*1000
+  //100| 746236131  => 10*1000*1000*1000
+  //100|7462360431  =>100*1000*1000*1000
+  Base = 10;
+
+var
+  ModsHL: array[0..99] of NativeUint;
+  Pow10: Uint64;    //global, seldom used
+  countLmt: NativeUint; //Uint64; only for extreme counting
+
+{$IFNDEF FPC}
+
+function Numb2USA(const S: string): string;
+var
+  i, NA: Integer;
+begin
+  i := Length(S);
+  Result := S;
+  NA := 0;
+  while (i > 0) do
+  begin
+    if ((Length(Result) - i + 1 - NA) mod 3 = 0) and (i <> 1) then
+    begin
+      insert(',', Result, i);
+      inc(NA);
+    end;
+    Dec(i);
+  end;
+end;
+{$ENDIF}
+
+procedure OutHeader(i: NativeInt);
+begin
+  writeln('First ', counts[i], ', gapful numbers starting at ', Numb2USA(IntToStr
+    (starts[i])));
+end;
+
+procedure OutNum(n: Uint64);
+begin
+  write(' ', n);
+end;
+
+procedure InitMods(n: Uint64; H_dgt: NativeUint);
+//calculate first mod of n, when it reaches n
+var
+  i, j: NativeInt;
+begin
+  j := H_dgt; //= H_dgt+i
+  for i := 0 to Base - 1 do
+  begin
+    ModsHL[j] := n mod j;
+    inc(n);
+    inc(j);
+  end;
+end;
+
+procedure InitMods2(n: Uint64; H_dgt, L_Dgt: NativeUint);
+//calculate first mod of n, when it reaches n
+//beware, that the lower n are reached in the next base round
+var
+  i, j: NativeInt;
+begin
+  j := H_dgt;
+  n := n - L_Dgt;
+  for i := 0 to L_Dgt - 1 do
+  begin
+    ModsHL[j] := (n + base) mod j;
+    inc(n);
+    inc(j);
+  end;
+  for i := L_Dgt to Base - 1 do
+  begin
+    ModsHL[j] := n mod j;
+    inc(n);
+    inc(j);
+  end;
+end;
+
+procedure Main(TestNum: Uint64; Cnt: NativeUint);
+var
+  LmtNextNewHiDgt: Uint64;
+  tmp, LowDgt, GapNum: NativeUint;
+begin
+  countLmt := Cnt;
+  Pow10 := Base * Base;
+  LmtNextNewHiDgt := Base * Pow10;
+  while LmtNextNewHiDgt <= TestNum do
+  begin
+    Pow10 := LmtNextNewHiDgt;
+    LmtNextNewHiDgt := LmtNextNewHiDgt * Base;
+  end;
+  LowDgt := TestNum mod Base;
+  GapNum := TestNum div Pow10;
+  LmtNextNewHiDgt := (GapNum + 1) * Pow10;
+  GapNum := Base * GapNum;
+  if LowDgt <> 0 then
+    InitMods2(TestNum, GapNum, LowDgt)
+  else
+    InitMODS(TestNum, GapNum);
+
+  GapNum := GapNum + LowDgt;
+  repeat
+//     if TestNum MOD (GapNum) = 0 then
+    if ModsHL[GapNum] = 0 then
+    begin
+      tmp := countLmt - 1;
+      if tmp < 32 then
+        OutNum(TestNum);
+      countLmt := tmp;
+      // Test and BREAK only if something has changed
+      if tmp = 0 then
+        BREAK;
+    end;
+    tmp := Base + ModsHL[GapNum];
+    //translate into "if-less" version 3.35s -> 1.85s
+    //bad branch prediction :-(
+    //if tmp >= GapNum then tmp -= GapNum;
+    tmp := tmp - (-ORD(tmp >= GapNum) and GapNum);
+    ModsHL[GapNum] := tmp;
+
+    TestNum := TestNum + 1;
+    tmp := LowDgt + 1;
+
+    inc(GapNum);
+    if tmp >= Base then
+    begin
+      tmp := 0;
+      GapNum := GapNum - Base;
+    end;
+    LowDgt := tmp;
+    //next Hi Digit
+    if TestNum >= LmtNextNewHiDgt then
+    begin
+      LowDgt := 0;
+      GapNum := GapNum + Base;
+      LmtNextNewHiDgt := LmtNextNewHiDgt + Pow10;
+      //next power of 10
+      if GapNum >= Base * Base then
+      begin
+        Pow10 := Pow10 * Base;
+        LmtNextNewHiDgt := 2 * Pow10;
+        GapNum := Base;
+      end;
+      initMods(TestNum, GapNum);
+    end;
+  until false;
+end;
+
+var
+  i: integer;
+
+begin
+  for i := 0 to High(starts) do
+  begin
+    OutHeader(i);
+    Main(starts[i], counts[i]);
+    writeln(#13#10);
+  end;
+  {$IFNDEF LINUX}  readln; {$ENDIF}
+end.

Task/Gapful-numbers/Pascal/gapful-numbers-2.pas

@@ -0,0 +1,95 @@
+program gapful;
+{$IFDEF FPC}
+   {$MODE DELPHI}{$OPTIMIZATION ON,ALL}
+{$ELSE}
+  {$APPTYPE CONSOLE}
+{$ENDIF}
+uses
+  sysutils,// IntToStr
+  strUtils;// Numb2USA aka commatize
+
+var
+  LCMsHL : array of NativeInt;
+
+function GCD(a, b: Int64): Int64;
+var
+  temp: Int64;
+begin
+  while b <> 0 do
+  begin
+    temp := b;
+    b := a mod b;
+    a := temp
+  end;
+  result := a
+end;
+
+function LCM(a, b: Int64): Int64;
+begin
+  LCM := (a DIV GCD(a,b)) * b;
+end;
+
+procedure InitLCM(Base:NativeInt);
+var
+  i : integer;
+Begin
+  For i := Base to (Base*Base-1) do
+    LCMsHL[i] := LCM(i,Base);
+end;
+
+function CountGapFul(H_Digit,Base:NativeInt;PotBase:Uint64):Uint64;
+//Counts gapfulnumbers [n*PotBase..(n+1)*PotBase -1] ala [100..199]
+var
+  EndDgt,Dgt : NativeInt;
+  P,k,lmt,sum,dSum: UInt64;
+begin
+  P := PotBase*H_Digit;
+  lmt := P+PotBase-1;
+  Dgt := H_Digit*Base;
+  sum := (PotBase-1) DIV dgt +1;
+  For EndDgt := 1 to Base-1 do
+  Begin
+    inc(Dgt);
+    //search start
+    //first value divisible by dgt
+    k := p-(p MOD dgt)+ dgt;
+    //value divisible by dgt ending in the right digit
+    while (k mod Base) <> EndDgt do
+      inc(k,dgt);
+    IF k> lmt then
+      continue;
+    //one found +1
+    //count the occurences in (lmt-k)
+    dSum := (lmt-k) DIV LCMsHL[dgt] +1;
+    inc(sum,dSum);
+    //writeln(dgt:5,k:21,dSum:21,Sum:21);
+  end;
+  //writeln(p:21,Sum:21);
+  CountGapFul := sum;
+end;
+
+procedure Main(Base:NativeUInt);
+var
+  i : NativeUInt;
+  pot,total,lmt: Uint64;//High(Uint64) = 2^64-1
+Begin
+  lmt := High(pot) DIV Base;
+  pot := sqr(Base);//"100" in Base
+  setlength(LCMsHL,pot);
+  InitLCM(Base);
+  total := 0;
+  repeat
+    IF pot > lmt then
+      break;
+    For i := 1 to Base-1 do //ala  100..199 ,200..299,300..399,..,900..999
+      inc(total,CountGapFul(i,base,pot));
+    pot *= Base;
+    writeln('Total [',sqr(Base),'..',Numb2USA(IntToStr(pot)),'] : ',Numb2USA(IntToStr(total+1)));
+  until false;
+  setlength(LCMsHL,0);
+end;
+
+BEGIN
+  Main(10);
+  Main(100);
+END.