Anaprimes
Anaprimes is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.
Anaprimes are prime numbers that are anagrams of each other, i.e. they use exactly the same digits with the same frequency but in a different order.
Anaprimes are very common. To illustrate this, we will investigate the sizes of the equivalence classes defined by the "is an anagram of" relation.
For example, the equivalence class of 149 has four anaprimes: {149, 419, 491, 941}. It turns out that there is no larger equivalence class of 3-digit anaprimes.
- Task
- Find prime numbers that are anagrams of each other.
- Find the largest anagram group of prime numbers and display the count, and minimum and maximum members for prime numbers:
- up to three digits long (before 1,000)
- up to four digits long (before 10,000)
- up to five digits long (before 100,000)
- up to six digits long (before 1,000,000)
- Stretch
- Find the largest anagram group and display the count, and smallest and largest members for prime numbers:
- up to seven digits long (before 10,000,000)
- up to eight digits long (before 100,000,000)
- up to nine digits long (before 1,000,000,000)
- ???!
- Related tasks
ALGOL 68
If running this with Algol 68G, a large heap size must be requested on the command line with, e.g.: -heap 512M for version 2 under Windows. On TIO.RUN, it wanted -heap=512M. 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).
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- Output:
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
C++
This takes about 70 seconds on my system. Memory usage is 4G.
#include <array>
#include <iostream>
#include <map>
#include <vector>
#include <primesieve.hpp>
using digit_set = std::array<int, 10>;
digit_set get_digits(uint64_t n) {
digit_set result = {};
for (; n > 0; n /= 10)
++result[n % 10];
return result;
}
int main() {
std::cout.imbue(std::locale(""));
primesieve::iterator pi;
using map_type =
std::map<digit_set, std::vector<uint64_t>, std::greater<digit_set>>;
map_type anaprimes;
for (uint64_t limit = 1000; limit <= 10000000000;) {
uint64_t prime = pi.next_prime();
if (prime > limit) {
size_t max_length = 0;
std::vector<map_type::iterator> groups;
for (auto i = anaprimes.begin(); i != anaprimes.end(); ++i) {
if (i->second.size() > max_length) {
groups.clear();
max_length = i->second.size();
}
if (max_length == i->second.size())
groups.push_back(i);
}
std::cout << "Largest group(s) of anaprimes before " << limit
<< ": " << max_length << " members:\n";
for (auto i : groups) {
std::cout << " First: " << i->second.front()
<< " Last: " << i->second.back() << '\n';
}
std::cout << '\n';
anaprimes.clear();
limit *= 10;
}
anaprimes[get_digits(prime)].push_back(prime);
}
}
- Output:
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: 4,333 members: First: 12,345,769 Last: 97,654,321 Largest group(s) of anaprimes before 1,000,000,000: 26,519 members: First: 102,345,697 Last: 976,542,103 Largest group(s) of anaprimes before 10,000,000,000: 152,526 members: First: 1,123,465,789 Last: 9,876,543,211
F#
This task uses Extensible Prime Generator (F#)
// Anaprimes. Nigel Galloway: February 2nd., 2023
let fN g=let i=Array.zeroCreate<int>10
let rec fN g=if g<10 then i[g]<-i[g]+1 else i[g%10]<-i[g%10]+1; fN (g/10)
fN g; i
let aP n=let _,n=primes32()|>Seq.skipWhile((>)(pown 10 (n-1)))|>Seq.takeWhile((>)(pown 10 n-1))|>Seq.groupBy fN|>Seq.maxBy(fun(_,n)->Seq.length n)
let n=Array.ofSeq n
(n.Length,Array.min n,Array.max n)
[3..9]|>List.map aP|>List.iteri(fun i (n,g,l)->printfn $"%d{i+3} digits: Count=%d{n} Min=%d{g} Max=%d{l}")
- Output:
3 digits: Count=4 Min=149 Max=941 4 digits: Count=11 Min=1237 Max=7321 5 digits: Count=39 Min=13789 Max=98731 6 digits: Count=148 Min=123479 Max=974213 7 digits: Count=731 Min=1235789 Max=9875321 8 digits: Count=4333 Min=12345769 Max=97654321 9 digits: Count=26519 Min=102345697 Max=976542103
Go
Getting up to 10 billion takes around 2 minutes 28 seconds on my Core i7 machine.
package main
import (
"fmt"
"rcu"
"sort"
)
func main() {
const limit = int(1e10)
const maxIndex = 9
primes := rcu.Primes(limit)
anaprimes := make(map[int][]int)
for _, p := range primes {
digs := rcu.Digits(p, 10)
key := 1
for _, dig := range digs {
key *= primes[dig]
}
if _, ok := anaprimes[key]; ok {
anaprimes[key] = append(anaprimes[key], p)
} else {
anaprimes[key] = []int{p}
}
}
largest := make([]int, maxIndex+1)
groups := make([][][]int, maxIndex+1)
for key := range anaprimes {
v := anaprimes[key]
nd := len(rcu.Digits(v[0], 10))
c := len(v)
if c > largest[nd-1] {
largest[nd-1] = c
groups[nd-1] = [][]int{v}
} else if c == largest[nd-1] {
groups[nd-1] = append(groups[nd-1], v)
}
}
j := 1000
for i := 2; i <= maxIndex; i++ {
js := rcu.Commatize(j)
ls := rcu.Commatize(largest[i])
fmt.Printf("Largest group(s) of anaprimes before %s: %s members:\n", js, ls)
sort.Slice(groups[i], func(k, l int) bool {
return groups[i][k][0] < groups[i][l][0]
})
for _, g := range groups[i] {
fmt.Printf(" First: %s Last: %s\n", rcu.Commatize(g[0]), rcu.Commatize(g[len(g)-1]))
}
j *= 10
fmt.Println()
}
}
- Output:
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: 4,333 members: First: 12,345,769 Last: 97,654,321 Largest group(s) of anaprimes before 1,000,000,000: 26,519 members: First: 102,345,697 Last: 976,542,103 Largest group(s) of anaprimes before 10,000,000,000: 152,526 members: First: 1,123,465,789 Last: 9,876,543,211
J
Here, we'll define the "largeness" of a group of primes as its sum.
dgt=: 10&#.inv
dgrp=: </.~ /:~"1&.dgt
pgrp=: {{dgrp p:(+ i.)/(-/)\ p:inv 0 _1+10^_1 0+y}}
big=: \: +/@>
largest=: 0 {:: big
Here, dgt gives use the base 10 digits of a number, dgrp groups numbers which contain the same digits, pgrp groups all primes of a given digit count by their digits, big sorts groups of numbers in descending order by their sum and largest 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:
(#,<./,>./) largest pgrp 1
1 7 7
(#,<./,>./) largest pgrp 2
2 79 97
(#,<./,>./) largest pgrp 3
4 379 937
(#,<./,>./) largest pgrp 4
10 1789 9871
(#,<./,>./) largest pgrp 5
39 13789 98731
(#,<./,>./) largest pgrp 6
141 136879 987631
(#,<./,>./) largest pgrp 7
708 1345879 9874531
(#,<./,>./) largest pgrp 8
4192 13456879 98765431
(#,<./,>./) largest pgrp 9
26455 103456789 987654103
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:
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
jq
One point of interest here is the definition of `maximals_by/2` so that [size, min, max] details about all the maximally-sized groups in each category can be displayed.
General utilities
# Input: a positive integer
# Output: an array, $a, of length .+1 such 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; length; $i)) as $j (.; .[$j] = false)
else .
end;
(. + 1) as $n
| (($n|sqrt) / 2) as $s
| [null, null, range(2; $n)]
| reduce (2, 1 + (2 * range(1; $s))) as $i (.; erase($i))
;
# Produce a stream of maximal elements in the stream s.
# To emit both the item and item|f, run: maximal_by( s | [., f]; .[1])
def maximals_by(s; f):
reduce s as $x ({v:null, a:[]};
($x|f) as $y
| if $y == .v then .a += [$x] elif $y > .v then .v = $y | .a = [$x] else . end)
| .a[];
# Input: the size of the sieve
def primes: primeSieve | map(select(.));Anaprimes
# Input: null or a suitable array of primes
# Output: for each maximally sized group: [number, min, max]
def anaprimes($limit):
def stats:
maximals_by(.[]; length)
| [length, min, max];
def groupOf: tostring | explode | sort | implode;
(if . then . else $limit|primes end) as $primes
| reduce $primes[] as $p ({}; .[$p|groupOf] += [$p])
| stats;
def task($digits):
# Avoid recomputing the primes array:
(pow(10;$digits) | primes) as $primes
| range(3; $digits+1) as $i
| pow(10; $i) as $p
| "For \($i) digit numbers:",
($primes | map(select(.<$p)) | anaprimes($p)),
"";
task(7)- Output:
For 3 digit numbers: [4,149,941] [4,179,971] [4,379,937] For 4 digit numbers: [11,1237,7321] [11,1279,9721] For 5 digit numbers: [39,13789,98731] For 6 digit numbers: [148,123479,974213] For 7 digit numbers: [731,1235789,9875321]
Julia
Takes a bit over 1.5 minutes on a 10-year-old Haswell i7 machine.
""" rosettacode.org task Anaprimes """
using Primes
@time for pow10 = 2:9
parr = primes(10^pow10, 10^(pow10 + 1))
anap = map(n -> evalpoly(10, sort!(digits(n))), parr)
anasorted = sort(anap)
longest, maxlen, maxstart, maxend = 0, 1, 1, 1
while maxstart < length(anasorted)
maxend = searchsortedfirst(anasorted, anasorted[maxstart] + 1)
if maxlen <= maxend - maxstart
maxlen = maxend - maxstart
longest = anasorted[maxend - 1]
end
maxstart = maxend
end
println(
"For $(pow10 + 1)-digit primes, a largest anagram group, [",
parr[findfirst(==(longest), anap)],
", ..",
parr[findlast(==(longest), anap)],
"], has a group size of $maxlen.",
)
end
- Output:
For 3-digit primes, a largest anagram group, [379, ..937], has a group size of 4. For 4-digit primes, a largest anagram group, [1279, ..9721], has a group size of 11. For 5-digit primes, a largest anagram group, [13789, ..98731], has a group size of 39. For 6-digit primes, a largest anagram group, [123479, ..974213], has a group size of 148. For 7-digit primes, a largest anagram group, [1235789, ..9875321], has a group size of 731. For 8-digit primes, a largest anagram group, [12345769, ..97654321], has a group size of 4333. For 9-digit primes, a largest anagram group, [102345697, ..976542103], has a group size of 26519. 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)
Nim
Run in 14 seconds on an Intel Core i5-8250U (four cores at 1.60GHz).
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()
- Output:
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
Pascal
Free Pascal
Not as fast as other versions, with runtime of 260s for 10 digits. ( Ryzen 5600G, 16 GB, 4.4 Ghz )
program AnaPrimes;
{$IFDEF FPC}
{$MODE DELPHI}
{$OPTIMIZATION ON,ALL}
{$ELSE}
{$APPLICATION CONSOLE}
{$ENDIF}
uses
sysutils;
const
Limit= 100*1000*1000;
type
tPrimesSieve = array of boolean;
tElement = Uint64;
tarrElement = array of tElement;
tpPrimes = pBoolean;
const
cTotalSum = 16;
cMaxCardsOnDeck = cTotalSum;
CMaxCardsUsed = cTotalSum;
type
tDeckIndex = 0..cMaxCardsOnDeck-1;
tSequenceIndex = 0..CMaxCardsUsed;
tDiffCardCount = Byte;
tSetElem = packed record
Elemcount : tDeckIndex;
Elem : tDiffCardCount;
end;
tSetRange = low(tDeckIndex)..High(tDeckIndex);
tRemSet = array [low(tDeckIndex)..High(tDeckIndex)] of tSetElem;
tpRemSet = ^tRemSet;
tRemainSet = array [tSequenceIndex] of tRemSet;
tCardSequence = array [tSequenceIndex] of tDiffCardCount;
tChain = record
StartNum,
EndNum,
chainLength : Int64;
end;
var
PrimeSieve : tPrimesSieve;
gblTestChain : tChain;
//*********** Sieve of erathostenes
procedure ClearAll;
begin
setlength(PrimeSieve,0);
end;
function BuildWheel(pPrimes:tpPrimes;lmt:Uint64): Uint64;
var
wheelSize, wpno, pr, pw, i, k: NativeUint;
wheelprimes: array[0..15] of byte;
begin
pr := 1;//the mother of all numbers 1 ;-)
pPrimes[1] := True;
WheelSize := 1;
wpno := 0;
repeat
Inc(pr);
//pw = pr projected in wheel of wheelsize
pw := pr;
if pw > wheelsize then
Dec(pw, wheelsize);
if pPrimes[pw] then
begin
k := WheelSize + 1;
//turn the wheel (pr-1)-times
for i := 1 to pr - 1 do
begin
Inc(k, WheelSize);
if k < lmt then
move(pPrimes[1], pPrimes[k - WheelSize], WheelSize)
else
begin
move(pPrimes[1], pPrimes[k - WheelSize], Lmt - WheelSize * i);
break;
end;
end;
Dec(k);
if k > lmt then
k := lmt;
wheelPrimes[wpno] := pr;
pPrimes[pr] := False;
Inc(wpno);
WheelSize := k;//the new wheelsize
//sieve multiples of the new found prime
i := pr;
i := i * i;
while i <= k do
begin
pPrimes[i] := False;
Inc(i, pr);
end;
end;
until WheelSize >= lmt;
//re-insert wheel-primes 1 still stays prime
while wpno > 0 do
begin
Dec(wpno);
pPrimes[wheelPrimes[wpno]] := True;
end;
result := pr;
end;
procedure Sieve(pPrimes:tpPrimes;lmt:Uint64);
var
sieveprime, fakt, i: UInt64;
begin
sieveprime := BuildWheel(pPrimes,lmt);
repeat
repeat
Inc(sieveprime);
until pPrimes[sieveprime];
fakt := Lmt div sieveprime;
while Not(pPrimes[fakt]) do
dec(fakt);
if fakt < sieveprime then
BREAK;
i := (fakt + 1) mod 6;
if i = 0 then
i := 4;
repeat
pPrimes[sieveprime * fakt] := False;
repeat
Dec(fakt, i);
i := 6 - i;
until pPrimes[fakt];
if fakt < sieveprime then
BREAK;
until False;
until False;
pPrimes[1] := False;//remove 1
end;
procedure InitAndGetPrimes;
begin
setlength(PrimeSieve,Limit+1);
Sieve(@PrimeSieve[0],Limit);
end;
//*********** End Sieve of erathostenes
{$ALIGN 32}
type
tCol = Int32;
tFreeCol = Array[0..CMaxCardsUsed] of tCol;
var
RemainSets : tRemainSet;
PrmDgts :tFreeCol;
maxDgt,
gblMaxCardsUsed,
gblMaxUsedIdx,
gblPermCount : NativeInt;
//**************** Permutator
procedure EvaluatePerm;
var
j,k : NativeUint;
Begin
j := PrmDgts[0];
for k := 1 to maxDgt do
j := 10*j+PrmDgts[k];
If PrimeSieve[j] then
begin
PrimeSieve[j] := false;
with gblTestChain do
begin
EndNum := j;
inc(ChainLength);
end;
end;
end;
function shouldSwap(var PrmDgts:tFreeCol;start,curr :int32):boolean;
begin
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 : Int32;
tmp : tCol;
begin
if index < maxDgt then
begin
for i := index to maxDgt do
if shouldSwap(PrmDgts, index, i) then
begin
tmp:= PrmDgts[i];PrmDgts[i] := PrmDgts[index];PrmDgts[index]:= tmp;
Permutate(PrmDgts, index+1);
tmp:= PrmDgts[i];PrmDgts[i] := PrmDgts[index];PrmDgts[index]:= tmp;
end;
end
else
if PrmDgts[0] <> 0 then
if (1 shl PrmDgts[maxDgt]) AND mask <> 0 then
Begin
inc(gblpermCount);
EvaluatePerm;
end;
end;
procedure CheckChain(n,dgtcnt:Uint64);
var
dgts : array[0..9] of Uint32;
i,k,idx : Int32;
begin
gblTestChain.StartNum := n;
gblTestChain.chainLength := 0;
fillChar(dgts,SizeOF(dgts),#0);
fillChar(PrmDgts,SizeOF(PrmDgts),#0);
For i := 1 to dgtcnt do
Begin
inc(dgts[n MOD 10]);
n := n div 10;
end;
idx := 0;
For i := 0 to 9 do
For k := dgts[i] downto 1 do
begin
PrmDgts[idx]:= i;
inc(idx);
end;
Permutate(PrmDgts,0);
end;
var
T1,T0: TDateTime;
MaxChain : tChain;
dgtCount : LongInt;
pr,lmt :nativeInt;
Begin
T0 := now;
InitAndGetPrimes;
T1 := now;
Writeln('time for sieving ',FormatDateTime('NN:SS.ZZZ',T1-T0));
dgtCount := 2;
lmt := 99;
pr := 10;
repeat
write(dgtCount:2);
maxDgt := dgtCount-1;
MaxChain.Chainlength := 0;
gblpermCount := 0;
repeat
while (pr<lmt) AND Not primeSieve[pr] do
inc(pr);
if pr >lmt then
BREAK;
CheckChain(pr,dgtCount);
If gblTestChain.chainLength > MaxChain.chainLength then
MaxChain := gblTestChain;
inc(pr);
until pr>lmt;
with MaxChain do
writeln(StartNUm:12,EndNum:12,ChainLength:8);
inc(dgtCount);
lmt := lmt*10+9;
until lmt>LIMIT;
end.
- @TIO.RUN:
time for sieving 00:00.318 2 13 31 2 3 149 941 4 4 1237 7321 11 5 13789 91387 39 6 123479 917243 148 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 % //before Real time: 16.973 s @home time for sieving 00:17.377 .... 9 102345697 901263457 26519 10 1123465789 9811325467 152526 real 4m19.653s user 4m17.515s sys 0m2.134s
Perl
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 '';
}
- Output:
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
Phix
with javascript_semantics atom t0 = time(), t1 = time()+1 integer start = length(get_primes_le(1e2))+1 printf(1,"Largest anagram groups:\n") for pow10=3 to iff(platform()=JS?7:9) do atom t2 = time() progress("getting_primes...\r") -- (~12s in total) sequence primes = get_primes_le(power(10,pow10)), anap = primes[start..$], digits = repeat(0,9) for i,a in anap do -- (~2M/s, 30s in total) if time()>t1 then progress("converting %d/%d...\r",{i,length(anap)}) t1 = time()+1 end if -- convert eg 791 to 179: while a do integer r = remainder(a,10) if r then digits[r] += 1 end if a = floor(a/10) end while for d=1 to length(digits) do for dc=1 to digits[d] do a = a*10+d end for digits[d] = 0 end for anap[i] = a end for progress("sorting...\r") -- (~45s in total) sequence anasorted = sort(deep_copy(anap)) progress("scanning...\r") -- (pretty fast) integer longest=0, maxlen = 1, maxstart = 1, l = length(anasorted) while maxstart <= length(anasorted) do atom am = anasorted[maxstart] integer maxend = maxstart+1 while maxend<=l and anasorted[maxend]=am do maxend += 1 end while if maxlen<maxend-maxstart then maxlen = maxend-maxstart longest = am end if maxstart = maxend end while progress("") integer lodx = find(longest,anap)+start-1, hidx = rfind(longest,anap)+start-1 string e = elapsed_short(time()-t0) printf(1,"%d-digits: [%d..%d], size %d (%s)\n",{pow10,primes[lodx],primes[hidx],maxlen,e}) start = length(primes)+1 end for
- Output:
Largest anagram groups: 3-digits: [149..941], size 4 (0s) 4-digits: [1237..7321], size 11 (0s) 5-digits: [13789..98731], size 39 (0s) 6-digits: [123479..974213], size 148 (0s) 7-digits: [1235789..9875321], size 731 (0s) 8-digits: [12345769..97654321], size 4333 (8s) 9-digits: [102345697..976542103], size 26519 (1:26)
For comparison, on the same (ten year old 16GB) box the Julia entry took 38s (2nd run) to complete to 9 digits.
I simply don't have enough memory to attempt 10 digits, and in fact trying to run the Julia entry as-is forced a hard reboot.
When transpiled to JavaScript and run in a web browser, 8 digits took 39s, so I capped it at 7 (3s).
Raku
9 digit is slooow. I didn't have the patience for 10.
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)).values;
put "\nLargest group of anaprimes before {cardinal 10 ** $_}: {+@largest[0].value} members.";
put 'First: ', ' Last: ' Z~ .value[0, *-1] for sort @largest;
}
- Output:
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: 4,333 members. First: 12345769 Last: 97654321 Largest group of anaprimes before one billion: 26,519 members. First: 102345697 Last: 976542103
Ruby
9 digit takes about 4 minutes (not done here). Could use something like Raku's Allmax.
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
- Output:
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
Sidef
Up to 8 digits, takes about 30 seconds, using ~800 MB of RAM.
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 ""
}
- Output:
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
Wren
Getting up to 1 billion takes around 2 minutes 25 seconds on my Core i7 machine. I've left it at that.
import "./math" for Int
import "./fmt" for Fmt
var limit = 1e9
var maxIndex = 8
var primes = Int.primeSieve(limit)
var anaprimes = {}
for (p in primes) {
var digs = Int.digits(p)
var key = 1
for (dig in digs) key = key * primes[dig]
if (anaprimes.containsKey(key)) {
anaprimes[key].add(p)
} else {
anaprimes[key] = [p]
}
}
var largest = List.filled(maxIndex + 1, 0)
var groups = List.filled(maxIndex + 1, null)
for (key in anaprimes.keys) {
var v = anaprimes[key]
var nd = Int.digits(v[0]).count
var c = v.count
if (c > largest[nd-1]) {
largest[nd-1] = c
groups[nd-1] = [v]
} else if (c == largest[nd-1]) {
groups[nd-1].add(v)
}
}
var j = 1000
for (i in 2..maxIndex) {
Fmt.print("Largest group(s) of anaprimes before $,d: $,d members:", j, largest[i])
groups[i].sort { |a, b| a[0] < b[0] }
for (g in groups[i]) Fmt.print(" First: $,d Last: $,d", g[0], g[-1])
j = j * 10
System.print()
}
- Output:
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: 4,333 members: First: 12,345,769 Last: 97,654,321 Largest group(s) of anaprimes before 1,000,000,000: 26,519 members: First: 102,345,697 Last: 976,542,103