Initial data commit

Task/Additive-primes/Pascal/additive-primes.pas

@@ -0,0 +1,148 @@
+program AdditivePrimes;
+{$IFDEF FPC}
+{$MODE DELPHI}{$CODEALIGN proc=16}
+{$ELSE}
+{$APPTYPE CONSOLE}
+{$ENDIF}
+{$DEFINE DO_OUTPUT}
+
+uses
+  sysutils;
+
+const
+  RANGE = 500; // 1000*1000;//
+  MAX_OFFSET = 0; // 1000*1000*1000;//
+
+type
+  tNum = array [0 .. 15] of byte;
+
+  tNumSum = record
+    dgtNum, dgtSum: tNum;
+    dgtLen, num: Uint32;
+  end;
+
+  tpNumSum = ^tNumSum;
+
+function isPrime(n: Uint32): boolean;
+const
+  wheeldiff: array [0 .. 7] of Uint32 = (+6, +4, +2, +4, +2, +4, +6, +2);
+var
+  p: NativeUInt;
+  flipflop: Int32;
+begin
+  if n < 64 then
+    EXIT(n in [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47,
+      53, 59, 61])
+  else
+  begin
+    IF (n AND 1 = 0) OR (n mod 3 = 0) OR (n mod 5 = 0) then
+      EXIT(false);
+    result := true;
+    p := 1;
+    flipflop := 6;
+
+    while result do
+    Begin
+      p := p + wheeldiff[flipflop];
+      if p * p > n then
+        BREAK;
+      result := n mod p <> 0;
+      flipflop := flipflop - 1;
+      if flipflop < 0 then
+        flipflop := 7;
+    end
+  end
+end;
+
+procedure IncNum(var NumSum: tNumSum; delta: Uint32);
+const
+  BASE = 10;
+var
+  carry, dg: Uint32;
+  le: Int32;
+Begin
+  if delta = 0 then
+    EXIT;
+  le := 0;
+  with NumSum do
+  begin
+    num := num + delta;
+    repeat
+      carry := delta div BASE;
+      delta := delta - BASE * carry;
+      dg := dgtNum[le] + delta;
+      IF dg >= BASE then
+      Begin
+        dg := dg - BASE;
+        inc(carry);
+      end;
+      dgtNum[le] := dg;
+      inc(le);
+      delta := carry;
+    until carry = 0;
+    if dgtLen < le then
+      dgtLen := le;
+    // correct sum of digits // le is >= 1
+    delta := dgtSum[le];
+    repeat
+      dec(le);
+      delta := delta + dgtNum[le];
+      dgtSum[le] := delta;
+    until le = 0;
+  end;
+end;
+
+var
+  NumSum: tNumSum;
+  s: AnsiString;
+  i, k, cnt, Nr: NativeUInt;
+  ColWidth, MAXCOLUMNS, NextRowCnt: NativeUInt;
+
+BEGIN
+  ColWidth := Trunc(ln(MAX_OFFSET + RANGE) / ln(10)) + 2;
+  MAXCOLUMNS := 80;
+  NextRowCnt := MAXCOLUMNS DIV ColWidth;
+
+  fillchar(NumSum, SizeOf(NumSum), #0);
+  NumSum.dgtLen := 1;
+  IncNum(NumSum, MAX_OFFSET);
+  setlength(s, ColWidth);
+  fillchar(s[1], ColWidth, ' ');
+  // init string
+  with NumSum do
+  Begin
+    For i := dgtLen - 1 downto 0 do
+      s[ColWidth - i] := AnsiChar(dgtNum[i] + 48);
+    // reset digits lenght to get the max changed digits since last update of string
+    dgtLen := 0;
+  end;
+  cnt := 0;
+  Nr := NextRowCnt;
+  For i := 0 to RANGE do
+    with NumSum do
+    begin
+      if isPrime(dgtSum[0]) then
+        if isPrime(num) then
+        Begin
+          cnt := cnt + 1;
+          dec(Nr);
+
+          // correct changed digits in string s
+          For k := dgtLen - 1 downto 0 do
+            s[ColWidth - k] := AnsiChar(dgtNum[k] + 48);
+          dgtLen := 0;
+{$IFDEF DO_OUTPUT}
+          write(s);
+          if Nr = 0 then
+          begin
+            writeln;
+            Nr := NextRowCnt;
+          end;
+{$ENDIF}
+        end;
+      IncNum(NumSum, 1);
+    end;
+  if Nr <> NextRowCnt then
+    write(#10);
+  writeln(cnt, ' additive primes found.');
+END.