is_chernick_carmichael_number.pl

#!/usr/bin/perl

# Author: Daniel "Trizen" Șuteu
# Date: 21 July 2018
# https://github.com/trizen

# Efficient algorithm for factoring (and identifying) an extended Chernick-Carmichael number.

# First few extended Chernick-Carmichael numbers are:
#   1729, 63973, 294409, 56052361

# See also:
#   https://projecteuclid.org/euclid.bams/1183501763
#   https://oeis.org/wiki/Carmichael_numbers
#   https://en.wikipedia.org/wiki/Carmichael_number

use 5.024;
use warnings;
use experimental qw(signatures);

use List::Util qw(all);
use ntheory qw(is_prob_prime);
use Math::AnyNum qw(bsearch iroot ipow2 ilog2 prod);

sub chernick_carmichael_factors ($k, $r) {
    (6 * $k + 1, 12 * $k + 1, 18 * $k + 1, (map { ipow2($_ - 2) * 9 * $k + 1 } 4 .. $r));
}

sub is_chernick_carmichael ($n) {

    foreach my $r (3 .. ilog2($n)) {

        return 0 if (prod(chernick_carmichael_factors(1, $r)) > $n);

        my $k = bsearch(1, iroot($n, $r), sub {
            prod(chernick_carmichael_factors($_, $r)) <=> $n;
        });

        if (defined($k)) {
            if (all { is_prob_prime($_) } chernick_carmichael_factors($k, $r)) {
                return [$r, $k];
            }
        }
    }

    return 0;
}

while (defined(my $n = <DATA>)) {

    $n =~ /\S/ or do { say ''; next };
    $n = Math::AnyNum->new($n);

    if (my $indices = is_chernick_carmichael($n)) {
        my ($r, $k) = @$indices;
        say "C($r, $k) = $n";
    }
    else {
        say "Not a Chernick-Carmichael number: $n";
    }
}

__DATA__
8325544586081174440728309072452661246289
1486602098904402652768057938393756060862115780408050129
3378179316469672624194241840042044950902156938854178152235606615241
499363105138762800665090830700779256789861194424677603719907844311565991734904219234049
1052541934726120302251454117065809600311128515412938768050107822597914636735491079562159895572772335029969

179888061095822220624012979873
63295903488856146099776074891976628857941
1724903525088632276776203991973751571437217198753
125987992642689799129021757759222604492631818017403553
74630998863011672833530378836051056508973606035192155974373
150807169001103453136788769176330405141656863663445656308543366854744067292801145941
21481148526108486207494916467772828869885661326738699922267375224852562302202790454088898856458273

521635331852681575100906881
115062400756082746082903913434881
328163039680360319939589778453584981903661
11870677991315757722817424115344135399200189518509
694757711287970946444438020864958912321095838203403981194280844652135041
222047766292417414109702829403660230521393563058846142752440148661965564062512001
2149862240504463136613099818734059855038070454228745908492682225005023324481983560300180977379301646829
8708697287275863064616447198348134859079135616902774104816953554105827536430199092250104748403143942843541581649
837766669080429652091578576905732301415513036087717526534117797730213142822067681852966424142891732971385451048036269

261398323061911176816691559756701
3783580131711518790634677710442261470580569797344541
435371627429039040724001132527124473123288702163349741876813423106621
14719770617180585920139917829493719272506560558845969856660560241654606362030081
8639174282669715206025361687559030161351650277392264712967444363592650828493196768893181
5626560312723043583857755308221019825156276365042073078860543702210734827773374603314058575101

24556868549786120178074590558386520603888321
6039952244643618043250948311869286217356083814166356276064323543587107521
67237835600056002507521755422513656134639570320064261052894337496662546902793661
9812486963666228314195838164491424691687915196563926066688165613493816842244920774774301
16734371894003494165203863331927626808333173646940855138811711887045893525137741919908066470621