117 lines
2.5 KiB
ObjectPascal
117 lines
2.5 KiB
ObjectPascal
program PrimePyramid;
|
|
{$IFDEF FPC}
|
|
{$MODE delphi}{$Optimization ON,ALL}{$CodeAlign proc=32}
|
|
{$IFEND}
|
|
const
|
|
MAX = 21;//max 8 different SumToPrime : array[0..MAX,0..7] of byte;
|
|
//MAX = 57;//max 16 different SumToPrime : array[0..MAX,0..15] of byte;
|
|
cMaxAlign32 = (((MAX-1)DIV 32)+1)*32-1;//MAX > 0
|
|
type
|
|
tPrimeRange = set of 0..127;
|
|
var
|
|
SetOfPrimes :tPrimeRange =[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,
|
|
53,59,61,67,71,73,79,83,89,97,101,103,107,
|
|
109,113,127];
|
|
|
|
SumToPrime : array[0..cMaxAlign32,0..7] of byte;
|
|
// SumToPrime : array[0..MAX,0..15] of byte;
|
|
SumToPrimeMaxIdx,
|
|
SumMaxIdx,
|
|
Solution,
|
|
FirstSolution : array[0..cMaxAlign32] of byte;
|
|
|
|
free : array[0..cMaxAlign32] of boolean;
|
|
|
|
maxused : integer;
|
|
digitcount,SolCount : integer;
|
|
|
|
procedure InitSumToPrime;
|
|
var
|
|
i,j,idx : integer;
|
|
begin
|
|
For i := 1 to MAX do
|
|
Begin
|
|
idx := 0;
|
|
For j := 1 to MAX do
|
|
If (i+j) in SetOfPrimes then
|
|
Begin
|
|
SumToPrime[i,idx] := j;
|
|
inc(idx);
|
|
end;
|
|
SumToPrimeMaxIdx[i] := idx;
|
|
end;
|
|
end;
|
|
|
|
procedure InitFree(maxused : integer);
|
|
var
|
|
i,j : Integer;
|
|
begin
|
|
For i := 0 to 1 do
|
|
Free[i] := false;
|
|
For i := 2 to maxused-1 do
|
|
Free[i] := true;
|
|
For i := maxused to MAX do
|
|
Free[i] := false;
|
|
// search maxidx of max neighour sum to prime
|
|
For i := 1 to maxused-1 do
|
|
begin
|
|
j := SumToPrimeMaxIdx[i]-1;
|
|
while SumToPrime[i,j] > maxused-1 do
|
|
j -= 1;
|
|
SumMaxIdx[i] := j+1;
|
|
end;
|
|
end;
|
|
|
|
procedure CountSolution(digit:integer);
|
|
begin
|
|
// check if maxused can follow
|
|
if (digit+maxused) in SetOfPrimes then
|
|
Begin
|
|
if solcount = 0 then
|
|
FirstSolution := Solution;
|
|
inc(solCount);
|
|
end;
|
|
end;
|
|
|
|
procedure checkDigits(digit:integer);
|
|
var
|
|
idx,nextDigit: integer;
|
|
begin
|
|
idx := 0;
|
|
repeat
|
|
nextDigit := SumToPrime[digit,idx];
|
|
if Free[nextdigit] then
|
|
Begin
|
|
Solution[digitcount] := nextDigit;
|
|
dec(digitcount);
|
|
IF digitcount = 0 then
|
|
CountSolution(nextDigit);
|
|
free[nextdigit]:= false;
|
|
checkDigits(nextdigit);
|
|
inc(digitcount);
|
|
free[nextdigit]:= true;
|
|
end;
|
|
inc(idx);
|
|
until idx >= SumMaxIdx[digit];
|
|
end;
|
|
|
|
var
|
|
i,j : integer;
|
|
Begin
|
|
InitSumToPrime;
|
|
writeln('number| count| first solution');
|
|
writeln(' 2| 1| 1 2');
|
|
For i := 3 to 20 do
|
|
Begin
|
|
maxused := i;
|
|
InitFree(i);
|
|
digitcount := i-2;
|
|
solCount := 0;
|
|
checkDigits(1);
|
|
write(i:4,'|',solcount:10,'| 1');
|
|
For j := i-2 downto 1 do
|
|
write( FirstSolution[j]:3);
|
|
writeln(i:3);
|
|
end;
|
|
end.
|