149 lines
3.0 KiB
ObjectPascal
149 lines
3.0 KiB
ObjectPascal
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.
|