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

C++

Library: Primesieve

This takes about 70 seconds on my system. Memory usage is 4G.

#include <algorithm>
#include <iomanip>
#include <iostream>
#include <map>
#include <vector>

#include <primesieve.hpp>

class digit_set {
public:
    digit_set() {}
    explicit digit_set(uint64_t n) {
        for (; n > 0; n /= 10)
            ++count_[n % 10];
    }
    bool operator==(const digit_set& other) const {
        return std::equal(count_, count_ + 10, other.count_);
    }
    bool operator<(const digit_set& other) const {
        return std::lexicographical_compare(other.count_, other.count_ + 10,
                                            count_, count_ + 10);
    }

private:
    int count_[10] = {};
};

int main() {
    std::cout.imbue(std::locale(""));
    primesieve::iterator pi;
    using map_type = std::map<digit_set, std::vector<uint64_t>>;
    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[digit_set(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

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

# return an array, $a, of length .+1 or .+2 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; (1 + length) / i) as $j (.; .[i * $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)

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;

my $p = Math::Primesieve.new;

for 3 .. 9 {
    my $largest = $p.primes(10**($_-1), 10**$_).classify(*.comb.sort.join).max(+*.value).value;

    put "\nLargest group of anaprimes before {cardinal 10 ** $_}: {+$largest} members.";
    put 'First: ', ' Last: ' Z~ $largest[0, *-1];
}

Output:

Largest group of anaprimes before one thousand: 4 members.
First: 179  Last: 971

Largest group of anaprimes before ten thousand: 11 members.
First: 1237  Last: 7321

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

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