Additive primes: Difference between revisions

Content added Content deleted
(add PicoLisp)
(Added compatibility for Delphi)
Line 1,976: Line 1,976:
<pre>%1 = [54, 54, 54, 54]</pre>
<pre>%1 = [54, 54, 54, 54]</pre>
=={{header|Pascal}}==
=={{header|Pascal}}==
{{works with|Free Pascal}} checking isPrime(sum of digits) before testimg isprime(num) improves speed.<br>Tried to speed up calculation of sum of digits.
{{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;
<lang pascal>program AdditivePrimes;
{$IFDEF FPC}
{$IFDEF FPC}
{$MODE DELPHI}{$CODEALIGN proc=16}
{$MODE DELPHI}{$CODEALIGN proc=16}
{$ELSE}
{$ELSE}
{$APPTYPE CONSOLE}
{$APPTYPE CONSOLE}
{$ENDIF}
{$ENDIF}
{$DEFINE DO_OUTPUT}
{$DEFINE DO_OUTPUT}

uses
uses
sysutils;
sysutils;


const
const
RANGE = 500;//1000*1000;//
RANGE = 500; // 1000*1000;//
MAX_OFFSET = 0;//1000*1000*1000;//
MAX_OFFSET = 0; // 1000*1000*1000;//
⚫
ColWidth = Trunc(ln(MAX_OFFSET+RANGE)/ln(10))+2;
⚫
MAXCOLUMNS = 80;
⚫
NextRowCnt = MAXCOLUMNS DIV ColWidth;


type
type
tNum = array[0..15] of byte;
tNum = array [0 .. 15] of byte;

tNumSum = record
tNumSum = record
dgtNum, dgtSum: tNum;
⚫
dgtNum,
dgtSum: tNum;
dgtLen, num: Uint32;
⚫
end;
dgtLen,

num : Uint32;
end;
tpNumSum = ^tNumSum;
tpNumSum = ^tNumSum;


function isPrime(n:Uint32):boolean;
function isPrime(n: Uint32): boolean;
const
const
wheeldiff : array[0..7] of Uint32 = (+6,+4,+2,+4,+2,+4,+6,+2);
wheeldiff: array [0 .. 7] of Uint32 = (+6, +4, +2, +4, +2, +4, +6, +2);
var
var
p: NativeUInt;
p: NativeUInt;
flipflop : Int32;
flipflop: Int32;
begin
begin
if n< 64 then
if n < 64 then
EXIT(n in [ 2,3,5,7,11,13,17,19,23,29,
EXIT(n in [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47,
31, 37,41,43,47, 53,59,61])
53, 59, 61])
else
else
begin
begin
IF (n AND 1=0) OR (n mod 3 = 0 ) OR (n mod 5 = 0 ) then
IF (n AND 1 = 0) OR (n mod 3 = 0) OR (n mod 5 = 0) then
EXIT(false);
EXIT(false);
result := true;
result := true;
Line 2,024: Line 2,022:
while result do
while result do
Begin
Begin
p += wheeldiff[flipflop];
p := p + wheeldiff[flipflop];
if p*p>n then
if p * p > n then
BREAK;
BREAK;
result := n mod p <> 0;
result := n mod p <> 0;
flipflop -= 1;
flipflop := flipflop - 1;
if flipflop<0 then
if flipflop < 0 then
flipflop :=7;
flipflop := 7;
end
end
end
end
end;
end;


procedure IncNum(var NumSum: tNumSum;delta: Uint32);
procedure IncNum(var NumSum: tNumSum; delta: Uint32);
const
const
BASE = 10;
BASE = 10;
var
var
carry,
carry, dg: Uint32;
dg: UInt32;
le: Int32;
le : Int32;
Begin
Begin
if delta = 0 then
if delta = 0 then
Line 2,048: Line 2,045:
with NumSum do
with NumSum do
begin
begin
num +=delta;
num := num + delta;
repeat
repeat
carry := delta div BASE;
carry := delta div BASE;
delta -= BASE*carry;
delta := delta - BASE * carry;
dg := dgtNum[le]+delta;
dg := dgtNum[le] + delta;
IF dg >= BASE then
IF dg >= BASE then
Begin
Begin
dg -= BASE;
dg := dg - BASE;
inc(carry);
inc(carry);
end;
end;
Line 2,064: Line 2,061:
if dgtLen < le then
if dgtLen < le then
dgtLen := le;
dgtLen := le;
//correct sum of digits // le is >= 1
// correct sum of digits // le is >= 1
delta := dgtSum[le];
delta := dgtSum[le];
repeat
repeat
dec(le);
dec(le);
delta+= dgtNum[le];
delta := delta + dgtNum[le];
dgtSum[le]:= delta;
dgtSum[le] := delta;
until le = 0;
until le = 0;
end;
end;
Line 2,076: Line 2,073:
var
var
NumSum: tNumSum;
NumSum: tNumSum;
s : AnsiString;
s: AnsiString;
i,k,cnt,Nr: NativeUint;
i, k, cnt, Nr: NativeUInt;
ColWidth, MAXCOLUMNS, NextRowCnt: NativeUInt;

BEGIN
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;
NumSum.dgtLen := 1;
IncNum(NumSum,MAX_OFFSET);
IncNum(NumSum, MAX_OFFSET);
setlength(s,ColWidth);
setlength(s, ColWidth);
fillchar(s[1],ColWidth,' ');
fillchar(s[1], ColWidth, ' ');
//init string
// init string
with Numsum do
with NumSum do
Begin
Begin
For i := dgtlen-1 downto 0 do
For i := dgtLen - 1 downto 0 do
s[ColWidth-i] := chr(dgtNum[i]+48);
s[ColWidth - i] := AnsiChar(dgtNum[i] + 48);
//reset digits lenght to get the max changed digits since last update of string
// reset digits lenght to get the max changed digits since last update of string
dgtlen := 0;
dgtLen := 0;
end;
end;
cnt := 0;
cnt := 0;
Nr := NextRowCnt;
Nr := NextRowCnt;
For i := 0 to RANGE do
For i := 0 to RANGE do
with NumSum do
with NumSum do
begin
begin
if isprime(dgtSum[0]) then
if isPrime(dgtSum[0]) then
if isprime(num) then
if isPrime(num) then
Begin
Begin
cnt +=1;
cnt := cnt + 1;
dec(nr);
dec(Nr);


//correct changed digits in string s
// correct changed digits in string s
For k := dgtlen-1 downto 0 do
For k := dgtLen - 1 downto 0 do
s[ColWidth-k] := chr(dgtNum[k]+48);
s[ColWidth - k] := AnsiChar(dgtNum[k] + 48);
dgtlen := 0;
dgtLen := 0;
{$IFDEF DO_OUTPUT}
{$IFDEF DO_OUTPUT}
write(s);
write(s);
if nr = 0 then
if Nr = 0 then
begin
begin
writeln;
writeln;
nr := NextRowCnt;
Nr := NextRowCnt;
⚫
end;
⚫
{$ENDIF}
end;
end;
⚫
IncNum(NumSum, 1);
⚫
{$ENDIF}
⚫
end;
⚫
IncNum(NumSum,1);
end;
end;
if nr <>NextRowCnt then
if Nr <> NextRowCnt then
write(#10);
write(#10);
writeln(cnt,' additive primes found.');
writeln(cnt, ' additive primes found.');
END.
END.
</lang>
</lang>
Retrieved from "https://rosettacode.org/wiki/Additive_primes"