Anaprimes: Difference between revisions

← Older editNewer edit →
Content deleted Content added
Rdm (talk | contribs)
6,963 edits
→‎{{header|J}}: add a "longest" variant
Horst (talk | contribs)
135 edits
m →‎{{header|Free Pascal}}: now using anagram permutation of GO to speed up.
Line 404: Line 404:
=={{header|Pascal}}==
=={{header|Pascal}}==
==={{header|Free Pascal}}===
==={{header|Free Pascal}}===
Not as fast as other versions, with runtime of 260s for 10 digits. ( Ryzen 5600G, 16 GB, 4.4 Ghz )
A little bit lazy, creating permutation instead of anagrams of digits cost much time.
<syntaxhighlight lang="pascal">
<syntaxhighlight lang="pascal">
program AnaPrimes;
program AnaPrimes;
{$IFDEF FPC}
{$IFDEF FPC} {$MODE DELPHI} {$OPTIMIZATION ON,ALL} {$ENDIF}
{$MODE DELPHI}
⚫
{$IFDEF WINDOWS}{$APPLICATION CONSOLE} {$ENDIF}
{$OPTIMIZATION ON,ALL}

{$ELSE}
⚫
{$APPLICATION CONSOLE}
{$ENDIF}
uses
uses
sysutils;
sysutils;
Line 552: Line 555:
{$ALIGN 32}
{$ALIGN 32}
type
type
tFreeCol = Array[0..CMaxCardsUsed] of Int32;
tCol = Int32;
tFreeCol = Array[0..CMaxCardsUsed] of tCol;
var
var


RemainSets : tRemainSet;
RemainSets : tRemainSet;
Values :tFreeCol;
PrmDgts :tFreeCol;
maxDgt,
maxDgt,
gblMaxCardsUsed,
gblMaxCardsUsed,
Line 567: Line 571:
j,k : NativeUint;
j,k : NativeUint;
Begin
Begin
j := Values[0];
j := PrmDgts[0];
for k := 1 to maxDgt do
for k := 1 to maxDgt do
j := 10*j+Values[k];
j := 10*j+PrmDgts[k];
If PrimeSieve[j] then
If PrimeSieve[j] then
begin
begin
Line 580: Line 584:
end;
end;
end;
end;

procedure Permutate(Row:Int32;var Values:tFreeCol);
function shouldSwap(var PrmDgts:tFreeCol;start,curr :int32):boolean;
⚫
begin
//stolen from nqueens // 2 swaps per permutation isn't good but small
for start := start to curr-1 do
if PrmDgts[start] = PrmDgts[curr] then
EXIT(false);
result := true;
⚫
end;
procedure Permutate(var PrmDgts:tFreeCol;index:Int32);
const
const
mask = (1 shl 1) OR (1 shl 3) OR (1 shl 7) OR (1 shl 9);
mask = (1 shl 1) OR (1 shl 3) OR (1 shl 7) OR (1 shl 9);
var
var
i,Col : Int32;
i : Int32;
tmp : tCol;
⚫
begin
begin
IF row <= maxDgt then
if index < maxDgt then
begin
begin
⚫
Permutate(Row+1,Values);
For i := row+1 to maxDgt do
for i := index to maxDgt do
if shouldSwap(PrmDgts, index, i) then
begin
Col := Values[i];
begin
tmp:= PrmDgts[i];PrmDgts[i] := PrmDgts[index];PrmDgts[index]:= tmp;
//swap FreeRow[Row<->i]
⚫
Permutate(PrmDgts, index+1);
Values[i] := Values[Row];
tmp:= PrmDgts[i];PrmDgts[i] := PrmDgts[index];PrmDgts[index]:= tmp;
//next row
Values[Row] := Col;
end;
// check next row
Permutate(Row+1,Values);
//Undo
Values[Row] := Values[i];
Values[i] := Col;
end;
end
end
else
else
if PrmDgts[0] <> 0 then
begin
if Values[0] <> 0 then
if (1 shl PrmDgts[maxDgt]) AND mask <> 0 then
if (1 shl Values[maxDgt]) AND mask <> 0 then
Begin
Begin
inc(gblpermCount);
inc(gblpermCount);
EvaluatePerm;
EvaluatePerm;
end;
end;
⚫
end;
end;
end;


Line 624: Line 627:
gblTestChain.chainLength := 0;
gblTestChain.chainLength := 0;
fillChar(dgts,SizeOF(dgts),#0);
fillChar(dgts,SizeOF(dgts),#0);
fillChar(Values,SizeOF(Values),#0);
fillChar(PrmDgts,SizeOF(PrmDgts),#0);
For i := 1 to dgtcnt do
For i := 1 to dgtcnt do
Begin
Begin
Line 632: Line 635:
idx := 0;
idx := 0;
For i := 0 to 9 do
For i := 0 to 9 do
For k := 1 to dgts[i] do
For k := dgts[i] downto 1 do
begin
begin
Values[idx]:= i;
PrmDgts[idx]:= i;
inc(idx);
inc(idx);
end;
end;
Permutate(0,Values);
Permutate(PrmDgts,0);
end;
end;


Line 674: Line 677:
lmt := lmt*10+9;
lmt := lmt*10+9;
until lmt>LIMIT;
until lmt>LIMIT;

end.</syntaxhighlight>
end.</syntaxhighlight>
{{out|@TIO.RUN}}
{{out|@TIO.RUN}}
Line 685: Line 689:
7 1235789 9127583 731
7 1235789 9127583 731
8 12345769 91274563 4333
8 12345769 91274563 4333
Real time: 4.228 s User time: 4.116 s Sys. time: 0.081 s CPU share: 99.26 %
Real time: 16.973 s
//before Real time: 16.973 s
</pre>

@home
time for sieving 00:17.377
....
9 102345697 901263457 26519
10 1123465789 9811325467 152526

real 4m19.653s user 4m17.515s sys 0m2.134s</pre>


=={{header|Phix}}==
=={{header|Phix}}==
Retrieved from "https://rosettacode.org/wiki/Anaprimes"