Rosetta Code

Additive primes: Difference between revisions

Page Discussion

Additive primes (view source)

Revision as of 20:22, 27 February 2022

170 bytes added ,  2 years ago
Added compatibility for Delphi
(add PicoLisp)
(Added compatibility for Delphi)
Line 1,976:
<pre>%1 = [54, 54, 54, 54]</pre>
=={{header|Pascal}}==
{{works with|Free Pascal}}{{works with|Delphi}} checking isPrime(sum of digits) before testimg isprime(num) improves speed.<br>Tried to speed up calculation of sum of digits.
<lang pascal>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;//
ColWidth = Trunc(ln(MAX_OFFSET+RANGE)/ln(10))+2;▼
MAXCOLUMNS = 80;▼
NextRowCnt = MAXCOLUMNS DIV ColWidth;▼
 
type
tNum = array [0 .. 15] of byte;
 
tNumSum = record
dgtNum, dgtSum: tNum;
dgtNum,▼
dgtLen, dgtSumnum: tNumUint32;
end;▼
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,
3153, 37,41,43,4759, 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;
Line 2,024 ⟶ 2,022:
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;
dgle: UInt32Int32;
le : Int32;
Begin
if delta = 0 then
Line 2,048 ⟶ 2,045:
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;
Line 2,064 ⟶ 2,061:
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;
Line 2,076 ⟶ 2,073:
var
NumSum: tNumSum;
s : AnsiString;
i, k, cnt, Nr: NativeUintNativeUInt;
ColWidth, MAXCOLUMNS, NextRowCnt: NativeUInt;
 
BEGIN
▲ ColWidth := Trunc(ln(MAX_OFFSET + RANGE) / ln(10)) + 2;
fillchar(NumSum,SizeOf(NumSum),#0);▼
▲ 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 NumsumNumSum do
Begin
For i := dgtlendgtLen - 1 downto 0 do
s[ColWidth - i] := chrAnsiChar(dgtNum[i] + 48);
// reset digits lenght to get the max changed digits since last update of string
dgtlendgtLen := 0;
end;
cnt := 0;
Nr := NextRowCnt;
For i := 0 to RANGE do
with NumSum do
begin
if isprimeisPrime(dgtSum[0]) then
if isprimeisPrime(num) then
Begin
cnt +:= cnt + 1;
dec(nrNr);
 
// correct changed digits in string s
For k := dgtlendgtLen - 1 downto 0 do
s[ColWidth - k] := chrAnsiChar(dgtNum[k] + 48);
dgtlen dgtLen := 0;
{$IFDEF DO_OUTPUT}
write(s);
if nrNr = 0 then
begin
writeln;
nr Nr := NextRowCnt;
▲ dgtNum,end;
{$ENDIF}▼
end;
IncNum(NumSum, 1);▼
▲{$ENDIF}
▲ end;
▲ IncNum(NumSum,1);
end;
if nrNr <> NextRowCnt then
write(#10);
writeln(cnt, ' additive primes found.');
END.
</lang>
MaiconSoft
478

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/309843"