Rosetta Code

Anaprimes: Difference between revisions

Page Discussion

Anaprimes (view source)

Revision as of 23:13, 9 December 2023

13,412 bytes added ,  5 months ago
m
→‎{{header|Sidef}}: sort the groups before printing
m (→‎{{header|J}}: quicky documentation)
m (→‎{{header|Sidef}}: sort the groups before printing)
 
(15 intermediate revisions by 10 users not shown)
Line 31:
 
 
 
=={{header|ALGOL 68}}==
If running this with Algol 68G, a large heap size must be requested on the command line with, e.g.: <code>-heap 512M</code> for version 2 under Windows. On TIO.RUN, it wanted <code>-heap=512M</code>. If max prime is set to 100 000 000, the heap size needs to be 1536M (which I think is thge largest size Algol 68G allows).
<syntaxhighlight lang="algol68">
BEGIN # find some anaprimes: groups of primes that have the same digits and #
# so are anagrams #
INT max prime = 10 000 000; # maximum number we will consider #
[ 0 : max prime ]BOOL prime; # sieve the primes to max prime #
prime[ 0 ] := prime[ 1 ] := FALSE;
prime[ 2 ] := TRUE;
FOR i FROM 3 BY 2 TO UPB prime DO prime[ i ] := TRUE OD;
FOR i FROM 4 BY 2 TO UPB prime DO prime[ i ] := FALSE OD;
FOR i FROM 3 BY 2 TO ENTIER sqrt( UPB prime ) DO
IF prime[ i ] THEN
FOR s FROM i * i BY i + i TO UPB prime DO prime[ s ] := FALSE OD
FI
OD;
# construct a table of ordered digits of primes #
# pd[ i ] 0 if no prime with its digits in order = i, #
# > 0 if there is a group of primes with ordered digits = i #
# pd[ i ] is then the final prime in the group #
# < 0 if there is a group of primes with ordered digits = i #
# ABS pd[ i ] is then the next prime in the group #
# if i is not itself prime, the final element in the chain will #
# be 0 #
[ 0 : max prime ]INT pd; FOR i FROM LWB pd TO UPB pd DO pd[ i ] := 0 OD;
FOR p FROM UPB prime BY -1 TO LWB prime DO
IF prime[ p ] THEN
# have a prime - order its digits #
[ 0 : 9 ]INT d count; FOR i FROM 0 TO 9 DO d count[ i ] := 0 OD;
INT v := p;
WHILE d count[ v MOD 10 ] +:= 1;
( v OVERAB 10 ) > 0
DO SKIP OD;
# get the digits in descending order, so e.g.: 103 yields 310 #
INT ordered digits := 0;
FOR i FROM 9 BY -1 TO 0 DO
FOR n TO d count[ i ] DO
ordered digits *:= 10 +:= i
OD
OD;
IF pd[ ordered digits ] /= 0 THEN
# there was a previous prime with these digits #
pd[ p ] := - pd[ ordered digits ]
FI;
pd[ ordered digits ] := p
FI
OD;
# display information about the groups #
INT p10 := 10;
WHILE p10 < max prime DO
# find the groups in p10..p10*10 #
INT min element := 0;
INT max element := 0;
INT group count := 0;
INT group length := 0;
INT length count := 0;
INT range end = ( p10 * 10 ) - 1;
FOR g FROM p10 TO range end DO
IF pd[ g ] < 0 THEN
# a group starts here #
group count +:= 1;
INT this max := ABS pd[ g ];
INT this length := 2;
WHILE pd[ this max ] < 0 DO
INT prev max := this max;
this max := ABS pd[ this max ];
this length +:= 1;
pd[ prev max ] := 0
OD;
IF this length > group length THEN
# found a longer group #
IF pd[ this max ] > 0 THEN
min element := pd[ this max ]
ELSE
min element := g
FI;
max element := this max;
group length := this length;
length count := 1
ELIF this length = group length THEN
# have another group of the same length #
length count +:= 1
FI
FI
OD;
print( ( "Anaprime groups in ", whole( p10, 0 )
, "..", whole( range end, 0 )
, ": ", whole( group count, 0 )
, "; "
, IF group count = length count
THEN "all"
ELSE whole( length count, 0 )
FI
, IF length count = 1
THEN " has"
ELSE " have"
FI
, " maximum length(", whole( group length, 0 )
, "), first: ", whole( min element, 0 )
, IF group length = 2
THEN ", "
ELSE ", ... "
FI
, whole( max element, 0 )
, newline
)
);
p10 *:= 10
OD
END
</syntaxhighlight>
{{out}}
<pre>
Anaprime groups in 10..99: 4; all have maximum length(2), first: 13, 31
Anaprime groups in 100..999: 42; 3 have maximum length(4), first: 149, ... 941
Anaprime groups in 1000..9999: 261; 2 have maximum length(11), first: 1237, ... 7321
Anaprime groups in 10000..99999: 1006; 1 has maximum length(39), first: 13789, ... 98731
Anaprime groups in 100000..999999: 2868; 1 has maximum length(148), first: 123479, ... 974213
Anaprime groups in 1000000..9999999: 6973; 1 has maximum length(731), first: 1235789, ... 9875321
</pre>
 
=={{header|C++}}==
Line 234 ⟶ 355:
largest=: 0 {:: big</syntaxhighlight>
 
Here, <code>dgt</code> gives use the base 10 digits of a number, <code>dgrp</code> groups numbers which contain the same digits, <code>pgrp</code> groups all primes of a given digit count by their digits, <code>big</code> sorts groups of numbers in descending order by their sum and <code>largest</code> extracts a group of numbers with the largest sum.
 
With these definitions, the count, min and max of prime groups with various (base 10) digit lengths are:
Line 256 ⟶ 377:
(#,<./,>./) largest pgrp 9
26455 103456789 987654103</syntaxhighlight>
 
Note that we could instead look for a longest group, where length is defined as the count of the primes in a group. That would give us:
 
<syntaxhighlight lang=J> longest=: 0 {:: (\: #@>)
(#,<./,>./) longest pgrp 1
1 7 7
(#,<./,>./) longest pgrp 2
2 79 97
(#,<./,>./) longest pgrp 3
4 179 971
(#,<./,>./) longest pgrp 4
11 1279 9721
(#,<./,>./) longest pgrp 5
39 13789 98731
(#,<./,>./) longest pgrp 6
148 123479 974213
(#,<./,>./) longest pgrp 7
731 1235789 9875321
(#,<./,>./) longest pgrp 8
4333 12345769 97654321
(#,<./,>./) longest pgrp 9
26519 102345697 976542103</syntaxhighlight>
 
=={{header|jq}}==
Line 264 ⟶ 407:
'''General utilities'''
<syntaxhighlight lang=jq>
# Input: a positive integer
# return an array, $a, of length .+1 or .+2 such that
# $a[$i]Output: isan $i ifarray, $ia, isof prime,length and.+1 falsesuch otherwise.that
# $a[$i] is $i if $i is prime, and false otherwise.
def primeSieve:
# erase(i) sets .[i*j] to false for integral j > 1
def erase($i):
if .[$i] then
reduce (range(2*$i; (1 + length) /; $i)) as $j (.; .[i * $j] = false)
else .
end;
Line 378 ⟶ 522:
For 10-digit primes, a largest anagram group, [1123465789, ..9876543211], has a group size of 152526.
186.920326 seconds (455.94 M allocations: 72.961 GiB, 1.54% gc time, 0.02% compilation time)
</pre>
 
=={{header|Nim}}==
{{trans|Wren}}
Run in 14 seconds on an Intel Core i5-8250U (four cores at 1.60GHz).
<syntaxhighlight lang="Nim">import std/[algorithm, bitops, math, strformat, strutils, tables]
 
type Sieve = object
data: seq[byte]
 
func `[]`(sieve: Sieve; idx: Positive): bool =
## Return value of element at index "idx".
let idx = idx shr 1
let iByte = idx shr 3
let iBit = idx and 7
result = sieve.data[iByte].testBit(iBit)
 
func `[]=`(sieve: var Sieve; idx: Positive; val: bool) =
## Set value of element at index "idx".
let idx = idx shr 1
let iByte = idx shr 3
let iBit = idx and 7
if val: sieve.data[iByte].setBit(iBit)
else: sieve.data[iByte].clearBit(iBit)
 
func newSieve(lim: Positive): Sieve =
## Create a sieve with given maximal index.
result.data = newSeq[byte]((lim + 16) shr 4)
 
func initPrimes(lim: Positive): seq[Natural] =
## Initialize the list of primes from 2 to "lim".
var composite = newSieve(lim)
composite[1] = true
for n in countup(3, sqrt(lim.toFloat).int, 2):
if not composite[n]:
for k in countup(n * n, lim, 2 * n):
composite[k] = true
result.add 2
for n in countup(3, lim, 2):
if not composite[n]:
result.add n
 
proc digits(n: Positive): seq[0..9] =
var n = n.Natural
while n != 0:
result.add n mod 10
n = n div 10
 
const Limit = 1_000_000_000
const MaxIndex = log10(Limit.toFloat).int
let primes = initPrimes(Limit)
 
var anaPrimes: Table[int, seq[int]]
for p in primes:
var key = 1
for digit in p.digits:
key *= primes[digit]
anaPrimes.mgetOrPut(key, @[]).add p
 
var largest: array[1..MaxIndex, int]
var groups: array[1..MaxIndex, seq[seq[int]]]
for key, values in anaPrimes.pairs:
let nd = values[0].digits.len
if values.len > largest[nd]:
largest[nd] = values.len
groups[nd] = @[values]
elif values.len == largest[nd]:
groups[nd].add values
 
var j = 1000
for i in 3..MaxIndex:
echo &"Largest group(s) of anaprimes before {insertSep($j)}: {largest[i]} members:"
groups[i].sort(proc (x, y: seq[int]): int = cmp(x[0], y[0]))
for g in groups[i]:
echo &" First: {insertSep($g[0])} Last: {insertSep($g[^1])}"
j *= 10
echo()
</syntaxhighlight>
 
{{out}}
<pre>Largest group(s) of anaprimes before 1_000: 4 members:
First: 149 Last: 941
First: 179 Last: 971
First: 379 Last: 937
 
Largest group(s) of anaprimes before 10_000: 11 members:
First: 1_237 Last: 7_321
First: 1_279 Last: 9_721
 
Largest group(s) of anaprimes before 100_000: 39 members:
First: 13_789 Last: 98_731
 
Largest group(s) of anaprimes before 1_000_000: 148 members:
First: 123_479 Last: 974_213
 
Largest group(s) of anaprimes before 10_000_000: 731 members:
First: 1_235_789 Last: 9_875_321
 
Largest group(s) of anaprimes before 100_000_000: 4333 members:
First: 12_345_769 Last: 97_654_321
 
Largest group(s) of anaprimes before 1_000_000_000: 26519 members:
First: 102_345_697 Last: 976_542_103
</pre>
 
=={{header|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">
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
sysutils;
Line 530 ⟶ 780:
{$ALIGN 32}
type
tFreeColtCol = Array[0..CMaxCardsUsed] of Int32;
tFreeCol = Array[0..CMaxCardsUsed] of tCol;
var
 
RemainSets : tRemainSet;
ValuesPrmDgts :tFreeCol;
maxDgt,
gblMaxCardsUsed,
Line 545 ⟶ 796:
j,k : NativeUint;
Begin
j := ValuesPrmDgts[0];
for k := 1 to maxDgt do
j := 10*j+ValuesPrmDgts[k];
If PrimeSieve[j] then
begin
Line 558 ⟶ 809:
end;
end;
 
procedurefunction PermutateshouldSwap(Row:Int32;var ValuesPrmDgts: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
mask = (1 shl 1) OR (1 shl 3) OR (1 shl 7) OR (1 shl 9);
var
i,Col : Int32;
tmp : tCol;
begin
begin
IF row <= maxDgt then
if index < maxDgt then
begin
begin
Permutate(Row+1,Values);
For for i := row+1index 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] := Colend;
// check next row
Permutate(Row+1,Values);
//Undo
Values[Row] := Values[i];
Values[i] := Col;
end;
end
else
if PrmDgts[0] <> 0 then
begin
if Values(1 shl PrmDgts[0maxDgt]) AND mask <> 0 then
if (1 shl Values[maxDgt]) AND mask <> 0 then
Begin
inc(gblpermCount);
EvaluatePerm;
end;
end;
end;
 
Line 602 ⟶ 852:
gblTestChain.chainLength := 0;
fillChar(dgts,SizeOF(dgts),#0);
fillChar(ValuesPrmDgts,SizeOF(ValuesPrmDgts),#0);
For i := 1 to dgtcnt do
Begin
Line 610 ⟶ 860:
idx := 0;
For i := 0 to 9 do
For k := 1 to dgts[i] downto 1 do
begin
ValuesPrmDgts[idx]:= i;
inc(idx);
end;
Permutate(0PrmDgts,Values0);
end;
 
Line 652 ⟶ 902:
lmt := lmt*10+9;
until lmt>LIMIT;
 
end.</syntaxhighlight>
{{out|@TIO.RUN}}
Line 663 ⟶ 914:
7 1235789 9127583 731
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|Perl}}==
{{libheader|ntheory}}
<syntaxhighlight lang="perl" line>use v5.36;
use ntheory 'primes';
use List::Util 'max';
use Lingua::EN::Numbers qw(num2en);
 
for my $l (3..9) {
my %p;
$p{ join '', sort split //, "$_" } .= "$_ " for @{ primes 10**($l-1), 10**$l };
my $m = max map { length $p{$_} } keys %p;
printf "Largest group of anaprimes before %s: %d members.\n", num2en(10**$l), $m/($l+1);
for my $k (sort grep { $m == length $p{$_} } keys %p) {
printf "First: %d Last: %d\n", $p{$k} =~ /^(\d+).* (\d+) $/;
}
say '';
}</syntaxhighlight>
{{out}}
<pre>Largest group of anaprimes before one thousand: 4 members.
First: 149 Last: 941
First: 179 Last: 971
First: 379 Last: 937
 
Largest group of anaprimes before ten thousand: 11 members.
First: 1237 Last: 7321
First: 1279 Last: 9721
 
Largest group of anaprimes before one hundred thousand: 39 members.
First: 13789 Last: 98731
 
Largest group of anaprimes before one million: 148 members.
First: 123479 Last: 974213
 
Largest group of anaprimes before ten million: 731 members.
First: 1235789 Last: 9875321
 
Largest group of anaprimes before one hundred million: 4333 members.
First: 12345769 Last: 97654321
 
Largest group of anaprimes before one billion: 26519 members.
First: 102345697 Last: 976542103</pre>
 
=={{header|Phix}}==
Line 744 ⟶ 1,045:
<syntaxhighlight lang="raku" line>use Lingua::EN::Numbers;
use Math::Primesieve;
use List::Allmax;
 
my $p = Math::Primesieve.new;
 
for 3 .. 9 {
my $@largest = $p.primes(10**($_-1), 10**$_).classify(*.comb.sort.join).List.&all-max(:by(+*.value)).valuevalues;
 
put "\nLargest group of anaprimes before {cardinal 10 ** $_}: {+$@largest[0].value} members.";
put 'First: ', ' Last: ' Z~ $largest.value[0, *-1] for sort @largest;
}</syntaxhighlight>
{{out}}
<pre>Largest group of anaprimes before one thousand: 4 members.
First: 149 Last: 941
First: 179 Last: 971
First: 379 Last: 937
 
Largest group of anaprimes before ten thousand: 11 members.
First: 1237 Last: 7321
First: 1279 Last: 9721
 
Largest group of anaprimes before one hundred thousand: 39 members.
Line 774 ⟶ 1,079:
Largest group of anaprimes before one billion: 26,519 members.
First: 102345697 Last: 976542103</pre>
=={{header|Ruby}}==
9 digit takes about 4 minutes (not done here). Could use something like Raku's Allmax.
 
<syntaxhighlight lang="ruby" line>require 'prime'
 
upto = 100_000_000
h = Hash.new {|hash, key| hash[key] = []}
Prime.each(upto) {|pr| h[pr.digits.sort] << pr }
 
(3..(upto.digits.size-1)).each do |num_digits|
group = h.select {|k,v| k.size == num_digits}
sizes = group.values.group_by(&:size)
max = sizes.keys.max
maxes = sizes[max]
puts "Anaprime groups of #{num_digits} digits: #{maxes.size} ha#{maxes.size == 1 ? "s" : "ve"} #{max} primes."
maxes.each{|group| puts " First: #{group.first} Last: #{group.last}"}
end
</syntaxhighlight>
{{out}}
<pre>Anaprime groups of 3 digits: 3 have 4 primes.
First: 149 Last: 941
First: 179 Last: 971
First: 379 Last: 937
Anaprime groups of 4 digits: 2 have 11 primes.
First: 1237 Last: 7321
First: 1279 Last: 9721
Anaprime groups of 5 digits: 1 has 39 primes.
First: 13789 Last: 98731
Anaprime groups of 6 digits: 1 has 148 primes.
First: 123479 Last: 974213
Anaprime groups of 7 digits: 1 has 731 primes.
First: 1235789 Last: 9875321
Anaprime groups of 8 digits: 1 has 4333 primes.
First: 12345769 Last: 97654321</pre>
 
=={{header|Sidef}}==
Up to 8 digits, takes about 30 seconds, using ~800 MB of RAM.
<syntaxhighlight lang="ruby">for k in (3..8) {
var P = primes(10**(k-1), 10**k).group_by{ Str(_).sort }
var G = P.values
var m = G.map{.len}.max
printf("Largest group of anaprimes before %s: %s members.\n", commify(10**k), m)
G.grep { .len == m }.sort.each {|group|
say "First: #{group.head} Last: #{group.tail}"
}
say ""
}</syntaxhighlight>
{{out}}
<pre>
Largest group of anaprimes before 1,000: 4 members.
First: 149 Last: 941
First: 179 Last: 971
First: 379 Last: 937
 
Largest group of anaprimes before 10,000: 11 members.
First: 1237 Last: 7321
First: 1279 Last: 9721
 
Largest group of anaprimes before 100,000: 39 members.
First: 13789 Last: 98731
 
Largest group of anaprimes before 1,000,000: 148 members.
First: 123479 Last: 974213
 
Largest group of anaprimes before 10,000,000: 731 members.
First: 1235789 Last: 9875321
 
Largest group of anaprimes before 100,000,000: 4333 members.
First: 12345769 Last: 97654321
</pre>
 
=={{header|Wren}}==
Line 779 ⟶ 1,154:
{{libheader|Wren-fmt}}
Getting up to 1 billion takes around 2 minutes 25 seconds on my Core i7 machine. I've left it at that.
<syntaxhighlight lang="ecmascriptwren">import "./math" for Int
import "./fmt" for Fmt
 
Trizen
2,747

edits

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