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

• Circular primes
• Ormiston pairs
• Emirp primes

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++

Library: Primesieve

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

Translation of: Wren

Library: Go-rcu

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

Works with: 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

Translation of: Wren

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

Library: ntheory

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

Translation of: Julia

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

Library: Wren-math

Library: Wren-fmt

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