Windows NT DGPENSV2LPKMN 10.0 build 14393 (Windows Server 2016) AMD64
Apache/2.4.46 (Win64) OpenSSL/1.1.1h PHP/7.3.25
: 172.16.0.66 | : 172.16.0.254
Cant Read [ /etc/named.conf ]
7.3.25
SYSTEM
www.github.com/MadExploits
Terminal
AUTO ROOT
Adminer
Backdoor Destroyer
Linux Exploit
Lock Shell
Lock File
Create User
CREATE RDP
PHP Mailer
BACKCONNECT
UNLOCK SHELL
HASH IDENTIFIER
CPANEL RESET
CREATE WP USER
BLACK DEFEND!
README
+ Create Folder
+ Create File
[ A ]
[ C ]
[ D ]
C: /
xampp7 /
perl /
vendor /
lib /
Math /
Prime /
Util /
[ HOME SHELL ]
Name
Size
Permission
Action
ChaCha.pm
13.23
KB
-rw-rw-rw-
ECAffinePoint.pm
6.15
KB
-rw-rw-rw-
ECProjectivePoint.pm
6.4
KB
-rw-rw-rw-
Entropy.pm
5.17
KB
-rw-rw-rw-
GMP.pm
92.42
KB
-rw-rw-rw-
MemFree.pm
2.08
KB
-rw-rw-rw-
PP.pm
208.51
KB
-rw-rw-rw-
PPFE.pm
27.51
KB
-rw-rw-rw-
PrimalityProving.pm
31.14
KB
-rw-rw-rw-
PrimeArray.pm
11.76
KB
-rw-rw-rw-
PrimeIterator.pm
6.75
KB
-rw-rw-rw-
RandomPrimes.pm
37.95
KB
-rw-rw-rw-
ZetaBigFloat.pm
26.87
KB
-rw-rw-rw-
Delete
Unzip
Zip
${this.title}
Close
Code Editor : PP.pm
package Math::Prime::Util::PP; use strict; use warnings; use Carp qw/carp croak confess/; BEGIN { $Math::Prime::Util::PP::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::PP::VERSION = '0.73'; } BEGIN { do { require Math::BigInt; Math::BigInt->import(try=>"GMP,Pari"); } unless defined $Math::BigInt::VERSION; } # The Pure Perl versions of all the Math::Prime::Util routines. # # Some of these will be relatively similar in performance, some will be # very slow in comparison. # # Most of these are pretty simple. Also, you really should look at the C # code for more detailed comments, including references to papers. BEGIN { use constant OLD_PERL_VERSION=> $] < 5.008; use constant MPU_MAXBITS => (~0 == 4294967295) ? 32 : 64; use constant MPU_64BIT => MPU_MAXBITS == 64; use constant MPU_32BIT => MPU_MAXBITS == 32; #use constant MPU_MAXPARAM => MPU_32BIT ? 4294967295 : 18446744073709551615; #use constant MPU_MAXDIGITS => MPU_32BIT ? 10 : 20; use constant MPU_MAXPRIME => MPU_32BIT ? 4294967291 : 18446744073709551557; use constant MPU_MAXPRIMEIDX => MPU_32BIT ? 203280221 : 425656284035217743; use constant MPU_HALFWORD => MPU_32BIT ? 65536 : OLD_PERL_VERSION ? 33554432 : 4294967296; use constant UVPACKLET => MPU_32BIT ? 'L' : 'Q'; use constant MPU_INFINITY => (65535 > 0+'inf') ? 20**20**20 : 0+'inf'; use constant BZERO => Math::BigInt->bzero; use constant BONE => Math::BigInt->bone; use constant BTWO => Math::BigInt->new(2); use constant INTMAX => (!OLD_PERL_VERSION || MPU_32BIT) ? ~0 : 562949953421312; use constant BMAX => Math::BigInt->new('' . INTMAX); use constant B_PRIM767 => Math::BigInt->new("261944051702675568529303"); use constant B_PRIM235 => Math::BigInt->new("30"); use constant PI_TIMES_8 => 25.13274122871834590770114707; } my $_precalc_size = 0; sub prime_precalc { my($n) = @_; croak "Parameter '$n' must be a positive integer" unless _is_positive_int($n); $_precalc_size = $n if $n > $_precalc_size; } sub prime_memfree { $_precalc_size = 0; eval { Math::Prime::Util::GMP::_GMP_memfree(); } if defined $Math::Prime::Util::GMP::VERSION && $Math::Prime::Util::GMP::VERSION >= 0.49; } sub _get_prime_cache_size { $_precalc_size } sub _prime_memfreeall { prime_memfree; } sub _is_positive_int { ((defined $_[0]) && $_[0] ne '' && ($_[0] !~ tr/0123456789//c)); } sub _bigint_to_int { #if (OLD_PERL_VERSION) { # my $pack = ($_[0] < 0) ? lc(UVPACKLET) : UVPACKLET; # return unpack($pack,pack($pack,"$_[0]")); #} int("$_[0]"); } sub _upgrade_to_float { do { require Math::BigFloat; Math::BigFloat->import(); } if !defined $Math::BigFloat::VERSION; Math::BigFloat->new(@_); } # Get the accuracy of variable x, or the max default from BigInt/BigFloat # One might think to use ref($x)->accuracy() but numbers get upgraded and # downgraded willy-nilly, and it will do the wrong thing from the user's # perspective. sub _find_big_acc { my($x) = @_; my $b; $b = $x->accuracy() if ref($x) =~ /^Math::Big/; return $b if defined $b; my ($i,$f) = (Math::BigInt->accuracy(), Math::BigFloat->accuracy()); return (($i > $f) ? $i : $f) if defined $i && defined $f; return $i if defined $i; return $f if defined $f; ($i,$f) = (Math::BigInt->div_scale(), Math::BigFloat->div_scale()); return (($i > $f) ? $i : $f) if defined $i && defined $f; return $i if defined $i; return $f if defined $f; return 18; } sub _bfdigits { my($wantbf, $xdigits) = (0, 17); if (defined $bignum::VERSION || ref($_[0]) =~ /^Math::Big/) { do { require Math::BigFloat; Math::BigFloat->import(); } if !defined $Math::BigFloat::VERSION; if (ref($_[0]) eq 'Math::BigInt') { my $xacc = ($_[0])->accuracy(); $_[0] = Math::BigFloat->new($_[0]); ($_[0])->accuracy($xacc) if $xacc; } $_[0] = Math::BigFloat->new("$_[0]") if ref($_[0]) ne 'Math::BigFloat'; $wantbf = _find_big_acc($_[0]); $xdigits = $wantbf; } ($wantbf, $xdigits); } sub _validate_num { my($n, $min, $max) = @_; croak "Parameter must be defined" if !defined $n; return 0 if ref($n); croak "Parameter '$n' must be a positive integer" if $n eq '' || ($n =~ tr/0123456789//c && $n !~ /^\+\d+$/); croak "Parameter '$n' must be >= $min" if defined $min && $n < $min; croak "Parameter '$n' must be <= $max" if defined $max && $n > $max; substr($_[0],0,1,'') if substr($n,0,1) eq '+'; return 0 unless $n < ~0 || int($n) eq ''.~0; 1; } sub _validate_positive_integer { my($n, $min, $max) = @_; croak "Parameter must be defined" if !defined $n; if (ref($n) eq 'CODE') { $_[0] = $_[0]->(); $n = $_[0]; } if (ref($n) eq 'Math::BigInt') { croak "Parameter '$n' must be a positive integer" if $n->sign() ne '+' || !$n->is_int(); $_[0] = _bigint_to_int($_[0]) if $n <= BMAX; } elsif (ref($n) eq 'Math::GMPz') { croak "Parameter '$n' must be a positive integer" if Math::GMPz::Rmpz_sgn($n) < 0; $_[0] = _bigint_to_int($_[0]) if $n <= INTMAX; } else { my $strn = "$n"; if ($strn eq '-0') { $_[0] = 0; $strn = '0'; } croak "Parameter '$strn' must be a positive integer" if $strn eq '' || ($strn =~ tr/0123456789//c && $strn !~ /^\+?\d+$/); if ($n <= INTMAX) { $_[0] = $strn if ref($n); } else { $_[0] = Math::BigInt->new($strn) } } $_[0]->upgrade(undef) if ref($_[0]) eq 'Math::BigInt' && $_[0]->upgrade(); croak "Parameter '$_[0]' must be >= $min" if defined $min && $_[0] < $min; croak "Parameter '$_[0]' must be <= $max" if defined $max && $_[0] > $max; 1; } sub _validate_integer { my($n) = @_; croak "Parameter must be defined" if !defined $n; if (ref($n) eq 'CODE') { $_[0] = $_[0]->(); $n = $_[0]; } my $poscmp = OLD_PERL_VERSION ? 562949953421312 : ''.~0; my $negcmp = OLD_PERL_VERSION ? -562949953421312 : -(~0 >> 1); if (ref($n) eq 'Math::BigInt') { croak "Parameter '$n' must be an integer" if !$n->is_int(); $_[0] = _bigint_to_int($_[0]) if $n <= $poscmp && $n >= $negcmp; } else { my $strn = "$n"; if ($strn eq '-0') { $_[0] = 0; $strn = '0'; } croak "Parameter '$strn' must be an integer" if $strn eq '' || ($strn =~ tr/-0123456789//c && $strn !~ /^[-+]?\d+$/); if ($n <= $poscmp && $n >= $negcmp) { $_[0] = $strn if ref($n); } else { $_[0] = Math::BigInt->new($strn) } } $_[0]->upgrade(undef) if ref($_[0]) && $_[0]->upgrade(); 1; } sub _binary_search { my($n, $lo, $hi, $sub, $exitsub) = @_; while ($lo < $hi) { my $mid = $lo + int(($hi-$lo) >> 1); return $mid if defined $exitsub && $exitsub->($n,$lo,$hi); if ($sub->($mid) < $n) { $lo = $mid+1; } else { $hi = $mid; } } return $lo-1; } my @_primes_small = (0,2); { my($n, $s, $sieveref) = (7-2, 3, _sieve_erat_string(5003)); push @_primes_small, 2*pos($$sieveref)-1 while $$sieveref =~ m/0/g; } my @_prime_next_small = ( 2,2,3,5,5,7,7,11,11,11,11,13,13,17,17,17,17,19,19,23,23,23,23, 29,29,29,29,29,29,31,31,37,37,37,37,37,37,41,41,41,41,43,43,47, 47,47,47,53,53,53,53,53,53,59,59,59,59,59,59,61,61,67,67,67,67,67,67,71); # For wheel-30 my @_prime_indices = (1, 7, 11, 13, 17, 19, 23, 29); my @_nextwheel30 = (1,7,7,7,7,7,7,11,11,11,11,13,13,17,17,17,17,19,19,23,23,23,23,29,29,29,29,29,29,1); my @_prevwheel30 = (29,29,1,1,1,1,1,1,7,7,7,7,11,11,13,13,13,13,17,17,19,19,19,19,23,23,23,23,23,23); my @_wheeladvance30 = (1,6,5,4,3,2,1,4,3,2,1,2,1,4,3,2,1,2,1,4,3,2,1,6,5,4,3,2,1,2); my @_wheelretreat30 = (1,2,1,2,3,4,5,6,1,2,3,4,1,2,1,2,3,4,1,2,1,2,3,4,1,2,3,4,5,6); sub _tiny_prime_count { my($n) = @_; return if $n >= $_primes_small[-1]; my $j = $#_primes_small; my $i = 1 + ($n >> 4); while ($i < $j) { my $mid = ($i+$j)>>1; if ($_primes_small[$mid] <= $n) { $i = $mid+1; } else { $j = $mid; } } return $i-1; } sub _is_prime7 { # n must not be divisible by 2, 3, or 5 my($n) = @_; $n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt' && $n <= BMAX; if (ref($n) eq 'Math::BigInt') { return 0 unless Math::BigInt::bgcd($n, B_PRIM767)->is_one; return 0 unless _miller_rabin_2($n); my $is_esl_prime = is_extra_strong_lucas_pseudoprime($n); return ($is_esl_prime) ? (($n <= "18446744073709551615") ? 2 : 1) : 0; } if ($n < 61*61) { foreach my $i (qw/7 11 13 17 19 23 29 31 37 41 43 47 53 59/) { return 2 if $i*$i > $n; return 0 if !($n % $i); } return 2; } return 0 if !($n % 7) || !($n % 11) || !($n % 13) || !($n % 17) || !($n % 19) || !($n % 23) || !($n % 29) || !($n % 31) || !($n % 37) || !($n % 41) || !($n % 43) || !($n % 47) || !($n % 53) || !($n % 59); # We could do: # return is_strong_pseudoprime($n, (2,299417)) if $n < 19471033; # or: # foreach my $p (@_primes_small[18..168]) { # last if $p > $limit; # return 0 unless $n % $p; # } # return 2; if ($n <= 1_500_000) { my $limit = int(sqrt($n)); my $i = 61; while (($i+30) <= $limit) { return 0 unless ($n% $i ) && ($n%($i+ 6)) && ($n%($i+10)) && ($n%($i+12)) && ($n%($i+16)) && ($n%($i+18)) && ($n%($i+22)) && ($n%($i+28)); $i += 30; } for my $inc (6,4,2,4,2,4,6,2) { last if $i > $limit; return 0 if !($n % $i); $i += $inc; } return 2; } if ($n < 47636622961201) { # BPSW seems to be faster after this # Deterministic set of Miller-Rabin tests. If the MR routines can handle # bases greater than n, then this can be simplified. my @bases; # n > 1_000_000 because of the previous block. if ($n < 19471033) { @bases = ( 2, 299417); } elsif ($n < 38010307) { @bases = ( 2, 9332593); } elsif ($n < 316349281) { @bases = ( 11000544, 31481107); } elsif ($n < 4759123141) { @bases = ( 2, 7, 61); } elsif ($n < 154639673381) { @bases = ( 15, 176006322, 4221622697); } elsif ($n < 47636622961201) { @bases = ( 2, 2570940, 211991001, 3749873356); } elsif ($n < 3770579582154547) { @bases = ( 2, 2570940, 880937, 610386380, 4130785767); } else { @bases = ( 2, 325, 9375, 28178, 450775, 9780504, 1795265022); } return is_strong_pseudoprime($n, @bases) ? 2 : 0; } # Inlined BPSW return 0 unless _miller_rabin_2($n); return is_almost_extra_strong_lucas_pseudoprime($n) ? 2 : 0; } sub is_prime { my($n) = @_; return 0 if defined($n) && int($n) < 0; _validate_positive_integer($n); if (ref($n) eq 'Math::BigInt') { return 0 unless Math::BigInt::bgcd($n, B_PRIM235)->is_one; } else { if ($n < 7) { return ($n == 2) || ($n == 3) || ($n == 5) ? 2 : 0; } return 0 if !($n % 2) || !($n % 3) || !($n % 5); } return _is_prime7($n); } # is_prob_prime is the same thing for us. *is_prob_prime = \&is_prime; # BPSW probable prime. No composites are known to have passed this test # since it was published in 1980, though we know infinitely many exist. # It has also been verified that no 64-bit composite will return true. # Slow since it's all in PP and uses bigints. sub is_bpsw_prime { my($n) = @_; return 0 if defined($n) && int($n) < 0; _validate_positive_integer($n); return 0 unless _miller_rabin_2($n); if ($n <= 18446744073709551615) { return is_almost_extra_strong_lucas_pseudoprime($n) ? 2 : 0; } return is_extra_strong_lucas_pseudoprime($n) ? 1 : 0; } sub is_provable_prime { my($n) = @_; return 0 if defined $n && $n < 2; _validate_positive_integer($n); if ($n <= 18446744073709551615) { return 0 unless _miller_rabin_2($n); return 0 unless is_almost_extra_strong_lucas_pseudoprime($n); return 2; } my($is_prime, $cert) = Math::Prime::Util::is_provable_prime_with_cert($n); $is_prime; } # Possible sieve storage: # 1) vec with mod-30 wheel: 8 bits / 30 # 2) vec with mod-2 wheel : 15 bits / 30 # 3) str with mod-30 wheel: 8 bytes / 30 # 4) str with mod-2 wheel : 15 bytes / 30 # # It looks like using vecs is about 2x slower than strs, and the strings also # let us do some fast operations on the results. E.g. # Count all primes: # $count += $$sieveref =~ tr/0//; # Loop over primes: # foreach my $s (split("0", $$sieveref, -1)) { # $n += 2 + 2 * length($s); # .. do something with the prime $n # } # # We're using method 4, though sadly it is memory intensive relative to the # other methods. I will point out that it is 30-60x less memory than sieves # using an array, and the performance of this function is over 10x that # of naive sieves. sub _sieve_erat_string { my($end) = @_; $end-- if ($end & 1) == 0; my $s_end = $end >> 1; my $whole = int( $s_end / 15); # Prefill with 3 and 5 already marked. croak "Sieve too large" if $whole > 1_145_324_612; # ~32 GB string my $sieve = '100010010010110' . '011010010010110' x $whole; substr($sieve, $s_end+1) = ''; # Ensure we don't make too many entries my ($n, $limit) = ( 7, int(sqrt($end)) ); while ( $n <= $limit ) { for (my $s = ($n*$n) >> 1; $s <= $s_end; $s += $n) { substr($sieve, $s, 1) = '1'; } do { $n += 2 } while substr($sieve, $n>>1, 1); } return \$sieve; } # TODO: this should be plugged into precalc, memfree, etc. just like the C code { my $primary_size_limit = 15000; my $primary_sieve_size = 0; my $primary_sieve_ref; sub _sieve_erat { my($end) = @_; return _sieve_erat_string($end) if $end > $primary_size_limit; if ($primary_sieve_size == 0) { $primary_sieve_size = $primary_size_limit; $primary_sieve_ref = _sieve_erat_string($primary_sieve_size); } my $sieve = substr($$primary_sieve_ref, 0, ($end+1)>>1); return \$sieve; } } sub _sieve_segment { my($beg,$end,$limit) = @_; ($beg, $end) = map { _bigint_to_int($_) } ($beg, $end) if ref($end) && $end <= BMAX; croak "Internal error: segment beg is even" if ($beg % 2) == 0; croak "Internal error: segment end is even" if ($end % 2) == 0; croak "Internal error: segment end < beg" if $end < $beg; croak "Internal error: segment beg should be >= 3" if $beg < 3; my $range = int( ($end - $beg) / 2 ) + 1; # Prefill with 3 and 5 already marked, and offset to the segment start. my $whole = int( ($range+14) / 15); my $startp = ($beg % 30) >> 1; my $sieve = substr('011010010010110', $startp) . '011010010010110' x $whole; # Set 3 and 5 to prime if we're sieving them. substr($sieve,0,2) = '00' if $beg == 3; substr($sieve,0,1) = '0' if $beg == 5; # Get rid of any extra we added. substr($sieve, $range) = ''; # If the end value is below 7^2, then the pre-sieve is all we needed. return \$sieve if $end < 49; my $sqlimit = ref($end) ? $end->copy->bsqrt() : int(sqrt($end)+0.0000001); $limit = $sqlimit if !defined $limit || $sqlimit < $limit; # For large value of end, it's a huge win to just walk primes. my($p, $s, $primesieveref) = (7-2, 3, _sieve_erat($limit)); while ( (my $nexts = 1 + index($$primesieveref, '0', $s)) > 0 ) { $p += 2 * ($nexts - $s); $s = $nexts; my $p2 = $p*$p; if ($p2 < $beg) { my $f = 1+int(($beg-1)/$p); $f++ unless $f % 2; $p2 = $p * $f; } # With large bases and small segments, it's common to find we don't hit # the segment at all. Skip all the setup if we find this now. if ($p2 <= $end) { # Inner loop marking multiples of p # (everything is divided by 2 to keep inner loop simpler) my $filter_end = ($end - $beg) >> 1; my $filter_p2 = ($p2 - $beg) >> 1; while ($filter_p2 <= $filter_end) { substr($sieve, $filter_p2, 1) = "1"; $filter_p2 += $p; } } } \$sieve; } sub trial_primes { my($low,$high) = @_; if (!defined $high) { $high = $low; $low = 2; } _validate_positive_integer($low); _validate_positive_integer($high); return if $low > $high; my @primes; # For a tiny range, just use next_prime calls if (($high-$low) < 1000) { $low-- if $low >= 2; my $curprime = next_prime($low); while ($curprime <= $high) { push @primes, $curprime; $curprime = next_prime($curprime); } return \@primes; } # Sieve to 10k then BPSW test push @primes, 2 if ($low <= 2) && ($high >= 2); push @primes, 3 if ($low <= 3) && ($high >= 3); push @primes, 5 if ($low <= 5) && ($high >= 5); $low = 7 if $low < 7; $low++ if ($low % 2) == 0; $high-- if ($high % 2) == 0; my $sieveref = _sieve_segment($low, $high, 10000); my $n = $low-2; while ($$sieveref =~ m/0/g) { my $p = $n+2*pos($$sieveref); push @primes, $p if _miller_rabin_2($p) && is_extra_strong_lucas_pseudoprime($p); } return \@primes; } sub primes { my($low,$high) = @_; if (scalar @_ > 1) { _validate_positive_integer($low); _validate_positive_integer($high); $low = 2 if $low < 2; } else { ($low,$high) = (2, $low); _validate_positive_integer($high); } my $sref = []; return $sref if ($low > $high) || ($high < 2); return [grep { $_ >= $low && $_ <= $high } @_primes_small] if $high <= $_primes_small[-1]; return [ Math::Prime::Util::GMP::sieve_primes($low, $high, 0) ] if $Math::Prime::Util::_GMPfunc{"sieve_primes"} && $Math::Prime::Util::GMP::VERSION >= 0.34; # At some point even the pretty-fast pure perl sieve is going to be a # dog, and we should move to trials. This is typical with a small range # on a large base. More thought on the switchover should be done. return trial_primes($low, $high) if ref($low) eq 'Math::BigInt' || ref($high) eq 'Math::BigInt' || ($low > 1_000_000_000_000 && ($high-$low) < int($low/1_000_000)); push @$sref, 2 if ($low <= 2) && ($high >= 2); push @$sref, 3 if ($low <= 3) && ($high >= 3); push @$sref, 5 if ($low <= 5) && ($high >= 5); $low = 7 if $low < 7; $low++ if ($low % 2) == 0; $high-- if ($high % 2) == 0; return $sref if $low > $high; my($n,$sieveref); if ($low == 7) { $n = 0; $sieveref = _sieve_erat($high); substr($$sieveref,0,3,'111'); } else { $n = $low-1; $sieveref = _sieve_segment($low,$high); } push @$sref, $n+2*pos($$sieveref)-1 while $$sieveref =~ m/0/g; $sref; } sub sieve_range { my($n, $width, $depth) = @_; _validate_positive_integer($n); _validate_positive_integer($width); _validate_positive_integer($depth); my @candidates; my $start = $n; if ($n < 5) { push @candidates, (2-$n) if $n <= 2 && $n+$width-1 >= 2; push @candidates, (3-$n) if $n <= 3 && $n+$width-1 >= 3; push @candidates, (4-$n) if $n <= 4 && $n+$width-1 >= 4 && $depth < 2; $start = 5; $width -= ($start - $n); } return @candidates, map {$start+$_-$n } 0 .. $width-1 if $depth < 2; return @candidates, map { $_ - $n } grep { ($_ & 1) && ($depth < 3 || ($_ % 3)) } map { $start+$_ } 0 .. $width-1 if $depth < 5; if (!($start & 1)) { $start++; $width--; } $width-- if !($width&1); return @candidates if $width < 1; my $sieveref = _sieve_segment($start, $start+$width-1, $depth); my $offset = $start - $n - 2; while ($$sieveref =~ m/0/g) { push @candidates, $offset + (pos($$sieveref) << 1); } return @candidates; } sub sieve_prime_cluster { my($lo,$hi,@cl) = @_; my $_verbose = Math::Prime::Util::prime_get_config()->{'verbose'}; _validate_positive_integer($lo); _validate_positive_integer($hi); if ($Math::Prime::Util::_GMPfunc{"sieve_prime_cluster"}) { return map { ($_ > ''.~0) ? Math::BigInt->new(''.$_) : $_ } Math::Prime::Util::GMP::sieve_prime_cluster($lo,$hi,@cl); } return @{primes($lo,$hi)} if scalar(@cl) == 0; unshift @cl, 0; for my $i (1 .. $#cl) { _validate_positive_integer($cl[$i]); croak "sieve_prime_cluster: values must be even" if $cl[$i] & 1; croak "sieve_prime_cluster: values must be increasing" if $cl[$i] <= $cl[$i-1]; } my($p,$sievelim,@p) = (17, 2000); $p = 13 if ($hi-$lo) < 50_000_000; $p = 11 if ($hi-$lo) < 1_000_000; $p = 7 if ($hi-$lo) < 20_000 && $lo < INTMAX; # Add any cases under our sieving point. if ($lo <= $sievelim) { $sievelim = $hi if $sievelim > $hi; for my $n (@{primes($lo,$sievelim)}) { my $ac = 1; for my $ci (1 .. $#cl) { if (!is_prime($n+$cl[$ci])) { $ac = 0; last; } } push @p, $n if $ac; } $lo = next_prime($sievelim); } return @p if $lo > $hi; # Compute acceptable residues. my $pr = primorial($p); my $startpr = _bigint_to_int($lo % $pr); my @acc = grep { ($_ & 1) && $_%3 } ($startpr .. $startpr + $pr - 1); for my $c (@cl) { if ($p >= 7) { @acc = grep { (($_+$c)%3) && (($_+$c)%5) && (($_+$c)%7) } @acc; } else { @acc = grep { (($_+$c)%3) && (($_+$c)%5) } @acc; } } for my $c (@cl) { @acc = grep { Math::Prime::Util::gcd($_+$c,$pr) == 1 } @acc; } @acc = map { $_-$startpr } @acc; print "cluster sieve using ",scalar(@acc)," residues mod $pr\n" if $_verbose; return @p if scalar(@acc) == 0; # Prepare table for more sieving. my @mprimes = @{primes( $p+1, $sievelim)}; my @vprem; for my $p (@mprimes) { for my $c (@cl) { $vprem[$p]->[ ($p-($c%$p)) % $p ] = 1; } } # Walk the range in primorial chunks, doing primality tests. my($nummr, $numlucas) = (0,0); while ($lo <= $hi) { my @racc = @acc; # Make sure we don't do anything past the limit if (($lo+$acc[-1]) > $hi) { my $max = _bigint_to_int($hi-$lo); @racc = grep { $_ <= $max } @racc; } # Sieve more values using native math foreach my $p (@mprimes) { my $rem = _bigint_to_int( $lo % $p ); @racc = grep { !$vprem[$p]->[ ($rem+$_) % $p ] } @racc; last unless scalar(@racc); } # Do final primality tests. if ($lo < 1e13) { for my $r (@racc) { my($good, $p) = (1, $lo + $r); for my $c (@cl) { $nummr++; if (!Math::Prime::Util::is_prime($p+$c)) { $good = 0; last; } } push @p, $p if $good; } } else { for my $r (@racc) { my($good, $p) = (1, $lo + $r); for my $c (@cl) { $nummr++; if (!Math::Prime::Util::is_strong_pseudoprime($p+$c,2)) { $good = 0; last; } } next unless $good; for my $c (@cl) { $numlucas++; if (!Math::Prime::Util::is_extra_strong_lucas_pseudoprime($p+$c)) { $good = 0; last; } } push @p, $p if $good; } } $lo += $pr; } print "cluster sieve ran $nummr MR and $numlucas Lucas tests\n" if $_verbose; @p; } sub _n_ramanujan_primes { my($n) = @_; return [] if $n <= 0; my $max = nth_prime_upper(int(48/19*$n)+1); my @L = (2, (0) x $n-1); my $s = 1; for (my $k = 7; $k <= $max; $k += 2) { $s++ if is_prime($k); $L[$s] = $k+1 if $s < $n; $s-- if ($k&3) == 1 && is_prime(($k+1)>>1); $L[$s] = $k+2 if $s < $n; } \@L; } sub _ramanujan_primes { my($low,$high) = @_; ($low,$high) = (2, $low) unless defined $high; return [] if ($low > $high) || ($high < 2); my $nn = prime_count_upper($high) >> 1; my $L = _n_ramanujan_primes($nn); shift @$L while @$L && $L->[0] < $low; pop @$L while @$L && $L->[-1] > $high; $L; } sub is_ramanujan_prime { my($n) = @_; return 1 if $n == 2; return 0 if $n < 11; my $L = _ramanujan_primes($n,$n); return (scalar(@$L) > 0) ? 1 : 0; } sub nth_ramanujan_prime { my($n) = @_; return undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) my $L = _n_ramanujan_primes($n); return $L->[$n-1]; } sub next_prime { my($n) = @_; _validate_positive_integer($n); return $_prime_next_small[$n] if $n <= $#_prime_next_small; # This turns out not to be faster. # return $_primes_small[1+_tiny_prime_count($n)] if $n < $_primes_small[-1]; return Math::BigInt->new(MPU_32BIT ? "4294967311" : "18446744073709551629") if ref($n) ne 'Math::BigInt' && $n >= MPU_MAXPRIME; # n is now either 1) not bigint and < maxprime, or (2) bigint and >= uvmax if ($n > 4294967295 && Math::Prime::Util::prime_get_config()->{'gmp'}) { return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::next_prime($n)); } if (ref($n) eq 'Math::BigInt') { do { $n += $_wheeladvance30[$n%30]; } while !Math::BigInt::bgcd($n, B_PRIM767)->is_one || !_miller_rabin_2($n) || !is_extra_strong_lucas_pseudoprime($n); } else { do { $n += $_wheeladvance30[$n%30]; } while !($n%7) || !_is_prime7($n); } $n; } sub prev_prime { my($n) = @_; _validate_positive_integer($n); return (undef,undef,undef,2,3,3,5,5,7,7,7,7)[$n] if $n <= 11; if ($n > 4294967295 && Math::Prime::Util::prime_get_config()->{'gmp'}) { return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::prev_prime($n)); } if (ref($n) eq 'Math::BigInt') { do { $n -= $_wheelretreat30[$n%30]; } while !Math::BigInt::bgcd($n, B_PRIM767)->is_one || !_miller_rabin_2($n) || !is_extra_strong_lucas_pseudoprime($n); } else { do { $n -= $_wheelretreat30[$n%30]; } while !($n%7) || !_is_prime7($n); } $n; } sub partitions { my $n = shift; my $d = int(sqrt($n+1)); my @pent = (1, map { (($_*(3*$_+1))>>1, (($_+1)*(3*$_+2))>>1) } 1 .. $d); my $ZERO = ($n >= ((~0 > 4294967295) ? 400 : 270)) ? BZERO : 0; my @part = ($ZERO+1); foreach my $j (scalar @part .. $n) { my ($psum1, $psum2, $k) = ($ZERO, $ZERO, 1); foreach my $p (@pent) { last if $p > $j; if ((++$k) & 2) { $psum1 += $part[ $j - $p ] } else { $psum2 += $part[ $j - $p ] } } $part[$j] = $psum1 - $psum2; } return $part[$n]; } sub primorial { my $n = shift; my @plist = @{primes($n)}; my $max = (MPU_32BIT) ? 29 : (OLD_PERL_VERSION) ? 43 : 53; # If small enough, multiply the small primes. if ($n < $max) { my $pn = 1; $pn *= $_ for @plist; return $pn; } # Otherwise, combine them as UVs, then combine using product tree. my $i = 0; while ($i < $#plist) { my $m = $plist[$i] * $plist[$i+1]; if ($m <= INTMAX) { splice(@plist, $i, 2, $m); } else { $i++; } } vecprod(@plist); } sub consecutive_integer_lcm { my $n = shift; my $max = (MPU_32BIT) ? 22 : (OLD_PERL_VERSION) ? 37 : 46; my $pn = ref($n) ? ref($n)->new(1) : ($n >= $max) ? Math::BigInt->bone() : 1; for (my $p = 2; $p <= $n; $p = next_prime($p)) { my($p_power, $pmin) = ($p, int($n/$p)); $p_power *= $p while $p_power <= $pmin; $pn *= $p_power; } $pn = _bigint_to_int($pn) if $pn <= BMAX; return $pn; } sub jordan_totient { my($k, $n) = @_; return ($n == 1) ? 1 : 0 if $k == 0; return euler_phi($n) if $k == 1; return ($n == 1) ? 1 : 0 if $n <= 1; return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::jordan_totient($k, $n)) if $Math::Prime::Util::_GMPfunc{"jordan_totient"}; my @pe = Math::Prime::Util::factor_exp($n); $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my $totient = BONE->copy; foreach my $f (@pe) { my ($p, $e) = @$f; $p = Math::BigInt->new("$p")->bpow($k); $totient->bmul($p->copy->bdec()); $totient->bmul($p) for 2 .. $e; } $totient = _bigint_to_int($totient) if $totient->bacmp(BMAX) <= 0; return $totient; } sub euler_phi { return euler_phi_range(@_) if scalar @_ > 1; my($n) = @_; return 0 if defined $n && $n < 0; return Math::Prime::Util::_reftyped($_[0],Math::Prime::Util::GMP::totient($n)) if $Math::Prime::Util::_GMPfunc{"totient"}; _validate_positive_integer($n); return $n if $n <= 1; my $totient = $n - $n + 1; # Fast reduction of multiples of 2, may also reduce n for factoring if (ref($n) eq 'Math::BigInt') { my $s = 0; if ($n->is_even) { do { $n->brsft(BONE); $s++; } while $n->is_even; $totient->blsft($s-1) if $s > 1; } } else { while (($n % 4) == 0) { $n >>= 1; $totient <<= 1; } if (($n % 2) == 0) { $n >>= 1; } } my @pe = Math::Prime::Util::factor_exp($n); if ($#pe == 0 && $pe[0]->[1] == 1) { if (ref($n) ne 'Math::BigInt') { $totient *= $n-1; } else { $totient->bmul($n->bdec()); } } elsif (ref($n) ne 'Math::BigInt') { foreach my $f (@pe) { my ($p, $e) = @$f; $totient *= $p - 1; $totient *= $p for 2 .. $e; } } else { my $zero = $n->copy->bzero; foreach my $f (@pe) { my ($p, $e) = @$f; $p = $zero->copy->badd("$p"); $totient->bmul($p->copy->bdec()); $totient->bmul($p) for 2 .. $e; } } $totient = _bigint_to_int($totient) if ref($totient) eq 'Math::BigInt' && $totient->bacmp(BMAX) <= 0; return $totient; } sub inverse_totient { my($n) = @_; _validate_positive_integer($n); return wantarray ? (1,2) : 2 if $n == 1; return wantarray ? () : 0 if $n < 1 || ($n & 1); $n = Math::Prime::Util::_to_bigint("$n") if !ref($n) && $n > 2**49; my $do_bigint = ref($n); if (is_prime($n >> 1)) { # Coleman Remark 3.3 (Thm 3.1) and Prop 6.2 return wantarray ? () : 0 if !is_prime($n+1); return wantarray ? ($n+1, 2*$n+2) : 2 if $n >= 10; } if (!wantarray) { my %r = ( 1 => 1 ); Math::Prime::Util::fordivisors(sub { my $d = $_; $d = $do_bigint->new("$d") if $do_bigint; my $p = $d+1; if (Math::Prime::Util::is_prime($p)) { my($dp,@sumi,@sumv) = ($d); for my $v (1 .. 1 + Math::Prime::Util::valuation($n, $p)) { Math::Prime::Util::fordivisors(sub { my $d2 = $_; if (defined $r{$d2}) { push @sumi, $d2*$dp; push @sumv, $r{$d2}; } }, $n / $dp); $dp *= $p; } $r{ $sumi[$_] } += $sumv[$_] for 0 .. $#sumi; } }, $n); return (defined $r{$n}) ? $r{$n} : 0; } else { my %r = ( 1 => [1] ); Math::Prime::Util::fordivisors(sub { my $d = $_; $d = $do_bigint->new("$d") if $do_bigint; my $p = $d+1; if (Math::Prime::Util::is_prime($p)) { my($dp,$pp,@T) = ($d,$p); for my $v (1 .. 1 + Math::Prime::Util::valuation($n, $p)) { Math::Prime::Util::fordivisors(sub { my $d2 = $_; push @T, [ $d2*$dp, [map { $_ * $pp } @{ $r{$d2} }] ] if defined $r{$d2}; }, $n / $dp); $dp *= $p; $pp *= $p; } push @{$r{$_->[0]}}, @{$_->[1]} for @T; } }, $n); return () unless defined $r{$n}; delete @r{ grep { $_ != $n } keys %r }; # Delete all intermediate results my @result = sort { $a <=> $b } @{$r{$n}}; return @result; } } sub euler_phi_range { my($lo, $hi) = @_; _validate_integer($lo); _validate_integer($hi); my @totients; while ($lo < 0 && $lo <= $hi) { push @totients, 0; $lo++; } return @totients if $hi < $lo; if ($hi > 2**30 || $hi-$lo < 100) { while ($lo <= $hi) { push @totients, euler_phi($lo++); } } else { my @tot = (0 .. $hi); foreach my $i (2 .. $hi) { next unless $tot[$i] == $i; $tot[$i] = $i-1; foreach my $j (2 .. int($hi / $i)) { $tot[$i*$j] -= $tot[$i*$j]/$i; } } splice(@tot, 0, $lo) if $lo > 0; push @totients, @tot; } @totients; } sub moebius { return moebius_range(@_) if scalar @_ > 1; my($n) = @_; $n = -$n if defined $n && $n < 0; _validate_num($n) || _validate_positive_integer($n); return ($n == 1) ? 1 : 0 if $n <= 1; return 0 if ($n >= 49) && (!($n % 4) || !($n % 9) || !($n % 25) || !($n%49) ); my @factors = Math::Prime::Util::factor($n); foreach my $i (1 .. $#factors) { return 0 if $factors[$i] == $factors[$i-1]; } return ((scalar @factors) % 2) ? -1 : 1; } sub is_square_free { return (Math::Prime::Util::moebius($_[0]) != 0) ? 1 : 0; } sub is_semiprime { my($n) = @_; _validate_positive_integer($n); return ($n == 4) if $n < 6; return (Math::Prime::Util::is_prob_prime($n>>1) ? 1 : 0) if ($n % 2) == 0; return (Math::Prime::Util::is_prob_prime($n/3) ? 1 : 0) if ($n % 3) == 0; return (Math::Prime::Util::is_prob_prime($n/5) ? 1 : 0) if ($n % 5) == 0; { my @f = trial_factor($n, 4999); return 0 if @f > 2; return (_is_prime7($f[1]) ? 1 : 0) if @f == 2; } return 0 if _is_prime7($n); { my @f = pminus1_factor ($n, 250_000); return 0 if @f > 2; return (_is_prime7($f[1]) ? 1 : 0) if @f == 2; } { my @f = pbrent_factor ($n, 128*1024, 3, 1); return 0 if @f > 2; return (_is_prime7($f[1]) ? 1 : 0) if @f == 2; } return (scalar(Math::Prime::Util::factor($n)) == 2) ? 1 : 0; } sub _totpred { my($n, $maxd) = @_; return 0 if $maxd <= 1 || (ref($n) ? $n->is_odd() : ($n & 1)); $n = Math::BigInt->new("$n") unless ref($n) || $n < INTMAX; $n >>= 1; return 1 if $n == 1 || ($n < $maxd && Math::Prime::Util::is_prime(2*$n+1)); for my $d (Math::Prime::Util::divisors($n)) { last if $d >= $maxd; my $p = ($d < (INTMAX >> 1)) ? ($d<<1)+1 : Math::Prime::Util::vecprod(2,$d)+1; next unless Math::Prime::Util::is_prime($p); my $r = int($n / $d); while (1) { return 1 if $r == $p || _totpred($r, $d); last if $r % $p; $r = int($r / $p); } } 0; } sub is_totient { my($n) = @_; _validate_positive_integer($n); return 1 if $n == 1; return 0 if $n <= 0; return _totpred($n,$n); } sub moebius_range { my($lo, $hi) = @_; _validate_integer($lo); _validate_integer($hi); return () if $hi < $lo; return moebius($lo) if $lo == $hi; if ($lo < 0) { if ($hi < 0) { return reverse(moebius_range(-$hi,-$lo)); } else { return (reverse(moebius_range(1,-$lo)), moebius_range(0,$hi)); } } if ($hi > 2**32) { my @mu; while ($lo <= $hi) { push @mu, moebius($lo++); } return @mu; } my @mu = map { 1 } $lo .. $hi; $mu[0] = 0 if $lo == 0; my($p, $sqrtn) = (2, int(sqrt($hi)+0.5)); while ($p <= $sqrtn) { my $i = $p * $p; $i = $i * int($lo/$i) + (($lo % $i) ? $i : 0) if $i < $lo; while ($i <= $hi) { $mu[$i-$lo] = 0; $i += $p * $p; } $i = $p; $i = $i * int($lo/$i) + (($lo % $i) ? $i : 0) if $i < $lo; while ($i <= $hi) { $mu[$i-$lo] *= -$p; $i += $p; } $p = next_prime($p); } foreach my $i ($lo .. $hi) { my $m = $mu[$i-$lo]; $m *= -1 if abs($m) != $i; $mu[$i-$lo] = ($m>0) - ($m<0); } return @mu; } sub mertens { my($n) = @_; # This is the most basic Deléglise and Rivat algorithm. u = n^1/2 # and no segmenting is done. Their algorithm uses u = n^1/3, breaks # the summation into two parts, and calculates those in segments. Their # computation time growth is half of this code. return $n if $n <= 1; my $u = int(sqrt($n)); my @mu = (0, Math::Prime::Util::moebius(1, $u)); # Hold values of mu for 0-u my $musum = 0; my @M = map { $musum += $_; } @mu; # Hold values of M for 0-u my $sum = $M[$u]; foreach my $m (1 .. $u) { next if $mu[$m] == 0; my $inner_sum = 0; my $lower = int($u/$m) + 1; my $last_nmk = int($n/($m*$lower)); my ($denom, $this_k, $next_k) = ($m, 0, int($n/($m*1))); for my $nmk (1 .. $last_nmk) { $denom += $m; $this_k = int($n/$denom); next if $this_k == $next_k; ($this_k, $next_k) = ($next_k, $this_k); $inner_sum += $M[$nmk] * ($this_k - $next_k); } $sum -= $mu[$m] * $inner_sum; } return $sum; } sub ramanujan_sum { my($k,$n) = @_; return 0 if $k < 1 || $n < 1; my $g = $k / Math::Prime::Util::gcd($k,$n); my $m = Math::Prime::Util::moebius($g); return $m if $m == 0 || $k == $g; $m * (Math::Prime::Util::euler_phi($k) / Math::Prime::Util::euler_phi($g)); } sub liouville { my($n) = @_; my $l = (-1) ** scalar Math::Prime::Util::factor($n); return $l; } # Exponential of Mangoldt function (A014963). # Return p if n = p^m [p prime, m >= 1], 1 otherwise. sub exp_mangoldt { my($n) = @_; my $p; return 1 unless Math::Prime::Util::is_prime_power($n,\$p); $p; } sub carmichael_lambda { my($n) = @_; return euler_phi($n) if $n < 8; # = phi(n) for n < 8 return $n >> 2 if ($n & ($n-1)) == 0; # = phi(n)/2 = n/4 for 2^k, k>2 my @pe = Math::Prime::Util::factor_exp($n); $pe[0]->[1]-- if $pe[0]->[0] == 2 && $pe[0]->[1] > 2; my $lcm; if (!ref($n)) { $lcm = Math::Prime::Util::lcm( map { ($_->[0] ** ($_->[1]-1)) * ($_->[0]-1) } @pe ); } else { $lcm = Math::BigInt::blcm( map { $_->[0]->copy->bpow($_->[1]->copy->bdec)->bmul($_->[0]->copy->bdec) } map { [ map { Math::BigInt->new("$_") } @$_ ] } @pe ); $lcm = _bigint_to_int($lcm) if $lcm->bacmp(BMAX) <= 0; } $lcm; } sub is_carmichael { my($n) = @_; _validate_positive_integer($n); # This works fine, but very slow # return !is_prime($n) && ($n % carmichael_lambda($n)) == 1; return 0 if $n < 561 || ($n % 2) == 0; return 0 if (!($n % 9) || !($n % 25) || !($n%49) || !($n%121)); # Check Korselt's criterion for small divisors my $fn = $n; for my $a (5,7,11,13,17,19,23,29,31,37,41,43) { if (($fn % $a) == 0) { return 0 if (($n-1) % ($a-1)) != 0; # Korselt $fn /= $a; return 0 unless $fn % $a; # not square free } } return 0 if Math::Prime::Util::powmod(2, $n-1, $n) != 1; # After pre-tests, it's reasonably likely $n is a Carmichael number or prime # Use probabilistic test if too large to reasonably factor. if (length($fn) > 50) { return 0 if Math::Prime::Util::is_prime($n); for my $t (13 .. 150) { my $a = $_primes_small[$t]; my $gcd = Math::Prime::Util::gcd($a, $fn); if ($gcd == 1) { return 0 if Math::Prime::Util::powmod($a, $n-1, $n) != 1; } else { return 0 if $gcd != $a; # Not square free return 0 if (($n-1) % ($a-1)) != 0; # factor doesn't divide $fn /= $a; } } return 1; } # Verify with factoring. my @pe = Math::Prime::Util::factor_exp($n); return 0 if scalar(@pe) < 3; for my $pe (@pe) { return 0 if $pe->[1] > 1 || (($n-1) % ($pe->[0]-1)) != 0; } 1; } sub is_quasi_carmichael { my($n) = @_; _validate_positive_integer($n); return 0 if $n < 35; return 0 if (!($n % 4) || !($n % 9) || !($n % 25) || !($n%49) || !($n%121)); my @pe = Math::Prime::Util::factor_exp($n); # Not quasi-Carmichael if prime return 0 if scalar(@pe) < 2; # Not quasi-Carmichael if not square free for my $pe (@pe) { return 0 if $pe->[1] > 1; } my @f = map { $_->[0] } @pe; my $nbases = 0; if ($n < 2000) { # In theory for performance, but mainly keeping to show direct method. my $lim = $f[-1]; $lim = (($n-$lim*$lim) + $lim - 1) / $lim; for my $b (1 .. $f[0]-1) { my $nb = $n - $b; $nbases++ if Math::Prime::Util::vecall(sub { $nb % ($_-$b) == 0 }, @f); } if (scalar(@f) > 2) { for my $b (1 .. $lim-1) { my $nb = $n + $b; $nbases++ if Math::Prime::Util::vecall(sub { $nb % ($_+$b) == 0 }, @f); } } } else { my($spf,$lpf) = ($f[0], $f[-1]); if (scalar(@f) == 2) { foreach my $d (Math::Prime::Util::divisors($n/$spf - 1)) { my $k = $spf - $d; my $p = $n - $k; last if $d >= $spf; $nbases++ if Math::Prime::Util::vecall(sub { my $j = $_-$k; $j && ($p % $j) == 0 }, @f); } } else { foreach my $d (Math::Prime::Util::divisors($lpf * ($n/$lpf - 1))) { my $k = $lpf - $d; my $p = $n - $k; next if $k == 0 || $k >= $spf; $nbases++ if Math::Prime::Util::vecall(sub { my $j = $_-$k; $j && ($p % $j) == 0 }, @f); } } } $nbases; } sub is_pillai { my($p) = @_; return 0 if defined($p) && int($p) < 0; _validate_positive_integer($p); return 0 if $p <= 2; my $pm1 = $p-1; my $nfac = 5040 % $p; for (my $n = 8; $n < $p; $n++) { $nfac = Math::Prime::Util::mulmod($nfac, $n, $p); return $n if $nfac == $pm1 && ($p % $n) != 1; } 0; } sub is_fundamental { my($n) = @_; _validate_integer($n); my $neg = ($n < 0); $n = -$n if $neg; my $r = $n & 15; if ($r) { my $r4 = $r & 3; if (!$neg) { return (($r == 4) ? 0 : is_square_free($n >> 2)) if $r4 == 0; return is_square_free($n) if $r4 == 1; } else { return (($r == 12) ? 0 : is_square_free($n >> 2)) if $r4 == 0; return is_square_free($n) if $r4 == 3; } } 0; } my @_ds_overflow = # We'll use BigInt math if the input is larger than this. (~0 > 4294967295) ? (124, 3000000000000000000, 3000000000, 2487240, 64260, 7026) : ( 50, 845404560, 52560, 1548, 252, 84); sub divisor_sum { my($n, $k) = @_; return ((defined $k && $k==0) ? 2 : 1) if $n == 0; return 1 if $n == 1; if (defined $k && ref($k) eq 'CODE') { my $sum = $n-$n; my $refn = ref($n); foreach my $d (Math::Prime::Util::divisors($n)) { $sum += $k->( $refn ? $refn->new("$d") : $d ); } return $sum; } croak "Second argument must be a code ref or number" unless !defined $k || _validate_num($k) || _validate_positive_integer($k); $k = 1 if !defined $k; return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::sigma($n, $k)) if $Math::Prime::Util::_GMPfunc{"sigma"}; my $will_overflow = ($k == 0) ? (length($n) >= $_ds_overflow[0]) : ($k <= 5) ? ($n >= $_ds_overflow[$k]) : 1; # The standard way is: # my $pk = $f ** $k; $product *= ($pk ** ($e+1) - 1) / ($pk - 1); # But we get less overflow using: # my $pk = $f ** $k; $product *= $pk**E for E in 0 .. e # Also separate BigInt and do fiddly bits for better performance. my @factors = Math::Prime::Util::factor_exp($n); my $product = 1; my @fm; if ($k == 0) { $product = Math::Prime::Util::vecprod(map { $_->[1]+1 } @factors); } elsif (!$will_overflow) { foreach my $f (@factors) { my ($p, $e) = @$f; my $pk = $p ** $k; my $fmult = $pk + 1; foreach my $E (2 .. $e) { $fmult += $pk**$E } $product *= $fmult; } } elsif (ref($n) && ref($n) ne 'Math::BigInt') { # This can help a lot for Math::GMP, etc. $product = ref($n)->new(1); foreach my $f (@factors) { my ($p, $e) = @$f; my $pk = ref($n)->new($p) ** $k; my $fmult = $pk; $fmult++; if ($e >= 2) { my $pke = $pk; for (2 .. $e) { $pke *= $pk; $fmult += $pke; } } $product *= $fmult; } } elsif ($k == 1) { foreach my $f (@factors) { my ($p, $e) = @$f; my $pk = Math::BigInt->new("$p"); if ($e == 1) { push @fm, $pk->binc; next; } my $fmult = $pk->copy->binc; my $pke = $pk->copy; for my $E (2 .. $e) { $pke->bmul($pk); $fmult->badd($pke); } push @fm, $fmult; } $product = Math::Prime::Util::vecprod(@fm); } else { my $bik = Math::BigInt->new("$k"); foreach my $f (@factors) { my ($p, $e) = @$f; my $pk = Math::BigInt->new("$p")->bpow($bik); if ($e == 1) { push @fm, $pk->binc; next; } my $fmult = $pk->copy->binc; my $pke = $pk->copy; for my $E (2 .. $e) { $pke->bmul($pk); $fmult->badd($pke); } push @fm, $fmult; } $product = Math::Prime::Util::vecprod(@fm); } $product; } ############################################################################# # Lehmer prime count # #my @_s0 = (0); #my @_s1 = (0,1); #my @_s2 = (0,1,1,1,1,2); my @_s3 = (0,1,1,1,1,1,1,2,2,2,2,3,3,4,4,4,4,5,5,6,6,6,6,7,7,7,7,7,7,8); my @_s4 = (0,1,1,1,1,1,1,1,1,1,1,2,2,3,3,3,3,4,4,5,5,5,5,6,6,6,6,6,6,7,7,8,8,8,8,8,8,9,9,9,9,10,10,11,11,11,11,12,12,12,12,12,12,13,13,13,13,13,13,14,14,15,15,15,15,15,15,16,16,16,16,17,17,18,18,18,18,18,18,19,19,19,19,20,20,20,20,20,20,21,21,21,21,21,21,21,21,22,22,22,22,23,23,24,24,24,24,25,25,26,26,26,26,27,27,27,27,27,27,27,27,28,28,28,28,28,28,29,29,29,29,30,30,30,30,30,30,31,31,32,32,32,32,33,33,33,33,33,33,34,34,35,35,35,35,35,35,36,36,36,36,36,36,37,37,37,37,38,38,39,39,39,39,40,40,40,40,40,40,41,41,42,42,42,42,42,42,43,43,43,43,44,44,45,45,45,45,46,46,47,47,47,47,47,47,47,47,47,47,48); sub _tablephi { my($x, $a) = @_; if ($a == 0) { return $x; } elsif ($a == 1) { return $x-int($x/2); } elsif ($a == 2) { return $x-int($x/2) - int($x/3) + int($x/6); } elsif ($a == 3) { return 8 * int($x / 30) + $_s3[$x % 30]; } elsif ($a == 4) { return 48 * int($x / 210) + $_s4[$x % 210]; } elsif ($a == 5) { my $xp = int($x/11); return ( (48 * int($x / 210) + $_s4[$x % 210]) - (48 * int($xp / 210) + $_s4[$xp % 210]) ); } else { my ($xp,$x2) = (int($x/11),int($x/13)); my $x2p = int($x2/11); return ( (48 * int($x / 210) + $_s4[$x % 210]) - (48 * int($xp / 210) + $_s4[$xp % 210]) - (48 * int($x2 / 210) + $_s4[$x2 % 210]) + (48 * int($x2p / 210) + $_s4[$x2p % 210]) ); } } sub legendre_phi { my ($x, $a, $primes) = @_; return _tablephi($x,$a) if $a <= 6; $primes = primes(Math::Prime::Util::nth_prime_upper($a+1)) unless defined $primes; return ($x > 0 ? 1 : 0) if $x < $primes->[$a]; my $sum = 0; my %vals = ( $x => 1 ); while ($a > 6) { my $primea = $primes->[$a-1]; my %newvals; while (my($v,$c) = each %vals) { my $sval = int($v / $primea); if ($sval < $primea) { $sum -= $c; } else { $newvals{$sval} -= $c; } } # merge newvals into vals while (my($v,$c) = each %newvals) { $vals{$v} += $c; delete $vals{$v} if $vals{$v} == 0; } $a--; } while (my($v,$c) = each %vals) { $sum += $c * _tablephi($v, $a); } return $sum; } sub _sieve_prime_count { my $high = shift; return (0,0,1,2,2,3,3)[$high] if $high < 7; $high-- unless ($high & 1); return 1 + ${_sieve_erat($high)} =~ tr/0//; } sub _count_with_sieve { my ($sref, $low, $high) = @_; ($low, $high) = (2, $low) if !defined $high; my $count = 0; if ($low < 3) { $low = 3; $count++; } else { $low |= 1; } $high-- unless ($high & 1); return $count if $low > $high; my $sbeg = $low >> 1; my $send = $high >> 1; if ( !defined $sref || $send >= length($$sref) ) { # outside our range, so call the segment siever. my $seg_ref = _sieve_segment($low, $high); return $count + $$seg_ref =~ tr/0//; } return $count + substr($$sref, $sbeg, $send-$sbeg+1) =~ tr/0//; } sub _lehmer_pi { my $x = shift; return _sieve_prime_count($x) if $x < 1_000; do { require Math::BigFloat; Math::BigFloat->import(); } if ref($x) eq 'Math::BigInt'; my $z = (ref($x) ne 'Math::BigInt') ? int(sqrt($x+0.5)) : int(Math::BigFloat->new($x)->badd(0.5)->bsqrt->bfloor->bstr); my $a = _lehmer_pi(int(sqrt($z)+0.5)); my $b = _lehmer_pi($z); my $c = _lehmer_pi(int( (ref($x) ne 'Math::BigInt') ? $x**(1/3)+0.5 : Math::BigFloat->new($x)->broot(3)->badd(0.5)->bfloor )); ($z, $a, $b, $c) = map { (ref($_) =~ /^Math::Big/) ? _bigint_to_int($_) : $_ } ($z, $a, $b, $c); # Generate at least b primes. my $bth_prime_upper = ($b <= 10) ? 29 : int($b*(log($b) + log(log($b)))) + 1; my $primes = primes( $bth_prime_upper ); my $sum = int(($b + $a - 2) * ($b - $a + 1) / 2); $sum += legendre_phi($x, $a, $primes); # Get a big sieve for our primecounts. The C code compromises with either # b*10 or x^3/5, as that cuts out all the inner loop sieves and about half # of the big outer loop counts. # Our sieve count isn't nearly as optimized here, so error on the side of # more primes. This uses a lot more memory but saves a lot of time. my $sref = _sieve_erat( int($x / $primes->[$a] / 5) ); my ($lastw, $lastwpc) = (0,0); foreach my $i (reverse $a+1 .. $b) { my $w = int($x / $primes->[$i-1]); $lastwpc += _count_with_sieve($sref,$lastw+1, $w); $lastw = $w; $sum -= $lastwpc; #$sum -= _count_with_sieve($sref,$w); if ($i <= $c) { my $bi = _count_with_sieve($sref,int(sqrt($w)+0.5)); foreach my $j ($i .. $bi) { $sum = $sum - _count_with_sieve($sref,int($w / $primes->[$j-1])) + $j - 1; } } } $sum; } ############################################################################# sub prime_count { my($low,$high) = @_; if (!defined $high) { $high = $low; $low = 2; } _validate_positive_integer($low); _validate_positive_integer($high); my $count = 0; $count++ if ($low <= 2) && ($high >= 2); # Count 2 $low = 3 if $low < 3; $low++ if ($low % 2) == 0; # Make low go to odd number. $high-- if ($high % 2) == 0; # Make high go to odd number. return $count if $low > $high; if ( ref($low) eq 'Math::BigInt' || ref($high) eq 'Math::BigInt' || ($high-$low) < 10 || ($high-$low) < int($low/100_000_000_000) ) { # Trial primes seems best. Needs some tuning. my $curprime = next_prime($low-1); while ($curprime <= $high) { $count++; $curprime = next_prime($curprime); } return $count; } # TODO: Needs tuning if ($high > 50_000) { if ( ($high / ($high-$low+1)) < 100 ) { $count += _lehmer_pi($high); $count -= ($low == 3) ? 1 : _lehmer_pi($low-1); return $count; } } return (_sieve_prime_count($high) - 1 + $count) if $low == 3; my $sieveref = _sieve_segment($low,$high); $count += $$sieveref =~ tr/0//; return $count; } sub nth_prime { my($n) = @_; _validate_positive_integer($n); return undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) return $_primes_small[$n] if $n <= $#_primes_small; if ($n > MPU_MAXPRIMEIDX && ref($n) ne 'Math::BigFloat') { do { require Math::BigFloat; Math::BigFloat->import(); } if !defined $Math::BigFloat::VERSION; $n = Math::BigFloat->new("$n") } my $prime = 0; my $count = 1; my $start = 3; my $logn = log($n); my $loglogn = log($logn); my $nth_prime_upper = ($n <= 10) ? 29 : int($n*($logn + $loglogn)) + 1; if ($nth_prime_upper > 100000) { # Use fast Lehmer prime count combined with lower bound to get close. my $nth_prime_lower = int($n * ($logn + $loglogn - 1.0 + (($loglogn-2.10)/$logn))); $nth_prime_lower-- unless $nth_prime_lower % 2; $count = _lehmer_pi($nth_prime_lower); $start = $nth_prime_lower + 2; } { # Make sure incr is an even number. my $incr = ($n < 1000) ? 1000 : ($n < 10000) ? 10000 : 100000; my $sieveref; while (1) { $sieveref = _sieve_segment($start, $start+$incr); my $segcount = $$sieveref =~ tr/0//; last if ($count + $segcount) >= $n; $count += $segcount; $start += $incr+2; } # Our count is somewhere in this segment. Need to look for it. $prime = $start - 2; while ($count < $n) { $prime += 2; $count++ if !substr($$sieveref, ($prime-$start)>>1, 1); } } $prime; } # The nth prime will be less or equal to this number sub nth_prime_upper { my($n) = @_; _validate_positive_integer($n); return undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) return $_primes_small[$n] if $n <= $#_primes_small; $n = _upgrade_to_float($n) if $n > MPU_MAXPRIMEIDX || $n > 2**45; my $flogn = log($n); my $flog2n = log($flogn); # Note distinction between log_2(n) and log^2(n) my $upper; if ($n >= 46254381) { # Axler 2017 Corollary 1.2 $upper = $n * ( $flogn + $flog2n-1.0 + (($flog2n-2.00)/$flogn) - (($flog2n*$flog2n - 6*$flog2n + 10.667)/(2*$flogn*$flogn)) ); } elsif ($n >= 8009824) { # Axler 2013 page viii Korollar G $upper = $n * ( $flogn + $flog2n-1.0 + (($flog2n-2.00)/$flogn) - (($flog2n*$flog2n - 6*$flog2n + 10.273)/(2*$flogn*$flogn)) ); } elsif ($n >= 688383) { # Dusart 2010 page 2 $upper = $n * ( $flogn + $flog2n - 1.0 + (($flog2n-2.00)/$flogn) ); } elsif ($n >= 178974) { # Dusart 2010 page 7 $upper = $n * ( $flogn + $flog2n - 1.0 + (($flog2n-1.95)/$flogn) ); } elsif ($n >= 39017) { # Dusart 1999 page 14 $upper = $n * ( $flogn + $flog2n - 0.9484 ); } elsif ($n >= 6) { # Modified Robin 1983, for 6-39016 only $upper = $n * ( $flogn + 0.6000 * $flog2n ); } else { $upper = $n * ( $flogn + $flog2n ); } return int($upper + 1.0); } # The nth prime will be greater than or equal to this number sub nth_prime_lower { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); return undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) return $_primes_small[$n] if $n <= $#_primes_small; $n = _upgrade_to_float($n) if $n > MPU_MAXPRIMEIDX || $n > 2**45; my $flogn = log($n); my $flog2n = log($flogn); # Note distinction between log_2(n) and log^2(n) # Dusart 1999 page 14, for all n >= 2 #my $lower = $n * ($flogn + $flog2n - 1.0 + (($flog2n-2.25)/$flogn)); # Dusart 2010 page 2, for all n >= 3 #my $lower = $n * ($flogn + $flog2n - 1.0 + (($flog2n-2.10)/$flogn)); # Axler 2013 page viii Korollar I, for all n >= 2 #my $lower = $n * ($flogn + $flog2n-1.0 + (($flog2n-2.00)/$flogn) - (($flog2n*$flog2n - 6*$flog2n + 11.847)/(2*$flogn*$flogn)) ); # Axler 2017 Corollary 1.4 my $lower = $n * ($flogn + $flog2n-1.0 + (($flog2n-2.00)/$flogn) - (($flog2n*$flog2n - 6*$flog2n + 11.508)/(2*$flogn*$flogn)) ); return int($lower + 0.999999999); } sub inverse_li { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); return (0,2,3,5,6,8)[$n] if $n <= 5; $n = _upgrade_to_float($n) if $n > MPU_MAXPRIMEIDX || $n > 2**45; my $t = $n * log($n); # Iterator Halley's method until error term grows my $old_term = MPU_INFINITY; for my $iter (1 .. 10000) { my $dn = Math::Prime::Util::LogarithmicIntegral($t) - $n; my $term = $dn * log($t) / (1.0 + $dn/(2*$t)); last if abs($term) >= abs($old_term); $old_term = $term; $t -= $term; last if abs($term) < 1e-6; } if (ref($t)) { $t = Math::BigInt->new($t->bceil->bstr); $t = _bigint_to_int($t) if $t->bacmp(BMAX) <= 0; } else { $t = int($t+0.999999); } $t; } sub _inverse_R { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); return (0,2,3,5,6,8)[$n] if $n <= 5; $n = _upgrade_to_float($n) if $n > MPU_MAXPRIMEIDX || $n > 2**45; my $t = $n * log($n); # Iterator Halley's method until error term grows my $old_term = MPU_INFINITY; for my $iter (1 .. 10000) { my $dn = Math::Prime::Util::RiemannR($t) - $n; my $term = $dn * log($t) / (1.0 + $dn/(2*$t)); last if abs($term) >= abs($old_term); $old_term = $term; $t -= $term; last if abs($term) < 1e-6; } if (ref($t)) { $t = Math::BigInt->new($t->bceil->bstr); $t = _bigint_to_int($t) if $t->bacmp(BMAX) <= 0; } else { $t = int($t+0.999999); } $t; } sub nth_prime_approx { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); return undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) return $_primes_small[$n] if $n <= $#_primes_small; # Once past 10^12 or so, inverse_li gives better results. return Math::Prime::Util::inverse_li($n) if $n > 1e12; $n = _upgrade_to_float($n) if ref($n) eq 'Math::BigInt' || $n >= MPU_MAXPRIMEIDX; my $flogn = log($n); my $flog2n = log($flogn); # Cipolla 1902: # m=0 fn * ( flogn + flog2n - 1 ); # m=1 + ((flog2n - 2)/flogn) ); # m=2 - (((flog2n*flog2n) - 6*flog2n + 11) / (2*flogn*flogn)) # + O((flog2n/flogn)^3) # # Shown in Dusart 1999 page 12, as well as other sources such as: # http://www.emis.de/journals/JIPAM/images/153_02_JIPAM/153_02.pdf # where the main issue you run into is that you're doing polynomial # interpolation, so it oscillates like crazy with many high-order terms. # Hence I'm leaving it at m=2. my $approx = $n * ( $flogn + $flog2n - 1 + (($flog2n - 2)/$flogn) - ((($flog2n*$flog2n) - 6*$flog2n + 11) / (2*$flogn*$flogn)) ); # Apply a correction to help keep values close. my $order = $flog2n/$flogn; $order = $order*$order*$order * $n; if ($n < 259) { $approx += 10.4 * $order; } elsif ($n < 775) { $approx += 6.3 * $order; } elsif ($n < 1271) { $approx += 5.3 * $order; } elsif ($n < 2000) { $approx += 4.7 * $order; } elsif ($n < 4000) { $approx += 3.9 * $order; } elsif ($n < 12000) { $approx += 2.8 * $order; } elsif ($n < 150000) { $approx += 1.2 * $order; } elsif ($n < 20000000) { $approx += 0.11 * $order; } elsif ($n < 100000000) { $approx += 0.008 * $order; } elsif ($n < 500000000) { $approx += -0.038 * $order; } elsif ($n < 2000000000) { $approx += -0.054 * $order; } else { $approx += -0.058 * $order; } # If we want the asymptotic approximation to be >= actual, use -0.010. return int($approx + 0.5); } ############################################################################# sub prime_count_approx { my($x) = @_; _validate_num($x) || _validate_positive_integer($x); # Turn on high precision FP if they gave us a big number. $x = _upgrade_to_float($x) if ref($_[0]) eq 'Math::BigInt' && $x > 1e16; # Method 10^10 %error 10^19 %error # ----------------- ------------ ------------ # n/(log(n)-1) .22% .058% # n/(ln(n)-1-1/ln(n)) .032% .0041% # average bounds .0005% .0000002% # asymp .0006% .00000004% # li(n) .0007% .00000004% # li(n)-li(n^.5)/2 .0004% .00000001% # R(n) .0004% .00000001% # # Also consider: http://trac.sagemath.org/sage_trac/ticket/8135 # Asymp: # my $l1 = log($x); my $l2 = $l1*$l1; my $l4 = $l2*$l2; # my $result = int( $x/$l1 + $x/$l2 + 2*$x/($l2*$l1) + 6*$x/($l4) + 24*$x/($l4*$l1) + 120*$x/($l4*$l2) + 720*$x/($l4*$l2*$l1) + 5040*$x/($l4*$l4) + 40320*$x/($l4*$l4*$l1) + 0.5 ); # my $result = int( (prime_count_upper($x) + prime_count_lower($x)) / 2); # my $result = int( LogarithmicIntegral($x) ); # my $result = int(LogarithmicIntegral($x) - LogarithmicIntegral(sqrt($x))/2); # my $result = RiemannR($x) + 0.5; # Make sure we get enough accuracy, and also not too much more than needed $x->accuracy(length($x->copy->as_int->bstr())+2) if ref($x) =~ /^Math::Big/; my $result; if ($Math::Prime::Util::_GMPfunc{"riemannr"} || !ref($x)) { # Fast if we have our GMP backend, and ok for native. $result = Math::Prime::Util::PP::RiemannR($x); } else { $x = _upgrade_to_float($x) unless ref($x) eq 'Math::BigFloat'; $result = Math::BigFloat->new(0); $result->accuracy($x->accuracy) if ref($x) && $x->accuracy; $result += Math::BigFloat->new(LogarithmicIntegral($x)); $result -= Math::BigFloat->new(LogarithmicIntegral(sqrt($x))/2); my $intx = ref($x) ? Math::BigInt->new($x->bfround(0)) : $x; for my $k (3 .. 1000) { my $m = moebius($k); next unless $m != 0; # With Math::BigFloat and the Calc backend, FP root is ungodly slow. # Use integer root instead. For more accuracy (not useful here): # my $v = Math::BigFloat->new( "" . rootint($x->as_int,$k) ); # $v->accuracy(length($v)+5); # $v = $v - Math::BigFloat->new(($v**$k - $x))->bdiv($k * $v**($k-1)); # my $term = LogarithmicIntegral($v)/$k; my $term = LogarithmicIntegral(rootint($intx,$k)) / $k; last if $term < .25; if ($m == 1) { $result->badd(Math::BigFloat->new($term)) } else { $result->bsub(Math::BigFloat->new($term)) } } } if (ref($result)) { return $result unless ref($result) eq 'Math::BigFloat'; # Math::BigInt::FastCalc 0.19 implements as_int incorrectly. return Math::BigInt->new($result->bfround(0)->bstr); } int($result+0.5); } sub prime_count_lower { my($x) = @_; _validate_num($x) || _validate_positive_integer($x); return _tiny_prime_count($x) if $x < $_primes_small[-1]; return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::prime_count_lower($x)) if $Math::Prime::Util::_GMPfunc{"prime_count_lower"}; $x = _upgrade_to_float($x) if ref($x) eq 'Math::BigInt' || ref($_[0]) eq 'Math::BigInt'; my($result,$a); my $fl1 = log($x); my $fl2 = $fl1*$fl1; my $one = (ref($x) eq 'Math::BigFloat') ? $x->copy->bone : $x-$x+1.0; # Chebyshev 1*x/logx x >= 17 # Rosser & Schoenfeld x/(logx-1/2) x >= 67 # Dusart 1999 x/logx*(1+1/logx+1.8/logxlogx) x >= 32299 # Dusart 2010 x/logx*(1+1/logx+2.0/logxlogx) x >= 88783 # Axler 2014 (1.2) ""+... x >= 1332450001 # Axler 2014 (1.2) x/(logx-1-1/logx-...) x >= 1332479531 # Büthe 2015 (1.9) li(x)-(sqrtx/logx)*(...) x <= 10^19 # Büthe 2014 Th 2 li(x)-logx*sqrtx/8Pi x > 2657, x <= 1.4*10^25 if ($x < 599) { # Decent for small numbers $result = $x / ($fl1 - 0.7); } elsif ($x < 52600000) { # Dusart 2010 tweaked if ($x < 2700) { $a = 0.30; } elsif ($x < 5500) { $a = 0.90; } elsif ($x < 19400) { $a = 1.30; } elsif ($x < 32299) { $a = 1.60; } elsif ($x < 88783) { $a = 1.83; } elsif ($x < 176000) { $a = 1.99; } elsif ($x < 315000) { $a = 2.11; } elsif ($x < 1100000) { $a = 2.19; } elsif ($x < 4500000) { $a = 2.31; } else { $a = 2.35; } $result = ($x/$fl1) * ($one + $one/$fl1 + $a/$fl2); } elsif ($x < 1.4e25 || Math::Prime::Util::prime_get_config()->{'assume_rh'}){ # Büthe 2014/2015 my $lix = LogarithmicIntegral($x); my $sqx = sqrt($x); if ($x < 1e19) { $result = $lix - ($sqx/$fl1) * (1.94 + 3.88/$fl1 + 27.57/$fl2); } else { if (ref($x) eq 'Math::BigFloat') { my $xdigits = _find_big_acc($x); $result = $lix - ($fl1*$sqx / (Math::BigFloat->bpi($xdigits)*8)); } else { $result = $lix - ($fl1*$sqx / PI_TIMES_8); } } } else { # Axler 2014 1.4 my($fl3,$fl4) = ($fl2*$fl1,$fl2*$fl2); my($fl5,$fl6) = ($fl4*$fl1,$fl4*$fl2); $result = $x / ($fl1 - $one - $one/$fl1 - 2.65/$fl2 - 13.35/$fl3 - 70.3/$fl4 - 455.6275/$fl5 - 3404.4225/$fl6); } return Math::BigInt->new($result->bfloor->bstr()) if ref($result) eq 'Math::BigFloat'; return int($result); } sub prime_count_upper { my($x) = @_; _validate_num($x) || _validate_positive_integer($x); # Give an exact answer for what we have in our little table. return _tiny_prime_count($x) if $x < $_primes_small[-1]; return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::prime_count_upper($x)) if $Math::Prime::Util::_GMPfunc{"prime_count_upper"}; $x = _upgrade_to_float($x) if ref($x) eq 'Math::BigInt' || ref($_[0]) eq 'Math::BigInt'; # Chebyshev: 1.25506*x/logx x >= 17 # Rosser & Schoenfeld: x/(logx-3/2) x >= 67 # Panaitopol 1999: x/(logx-1.112) x >= 4 # Dusart 1999: x/logx*(1+1/logx+2.51/logxlogx) x >= 355991 # Dusart 2010: x/logx*(1+1/logx+2.334/logxlogx) x >= 2_953_652_287 # Axler 2014: x/(logx-1-1/logx-3.35/logxlogx...) x >= e^3.804 # Büthe 2014 7.4 Schoenfeld bounds hold to x <= 1.4e25 # Axler 2017 Prop 2.2 Schoenfeld bounds hold to x <= 5.5e25 # Skewes li(x) x < 1e14 my($result,$a); my $fl1 = log($x); my $fl2 = $fl1 * $fl1; my $one = (ref($x) eq 'Math::BigFloat') ? $x->copy->bone : $x-$x+1.0; if ($x < 15900) { # Tweaked Rosser-type $a = ($x < 1621) ? 1.048 : ($x < 5000) ? 1.071 : 1.098; $result = ($x / ($fl1 - $a)) + 1.0; } elsif ($x < 821800000) { # Tweaked Dusart 2010 if ($x < 24000) { $a = 2.30; } elsif ($x < 59000) { $a = 2.48; } elsif ($x < 350000) { $a = 2.52; } elsif ($x < 355991) { $a = 2.54; } elsif ($x < 356000) { $a = 2.51; } elsif ($x < 3550000) { $a = 2.50; } elsif ($x < 3560000) { $a = 2.49; } elsif ($x < 5000000) { $a = 2.48; } elsif ($x < 8000000) { $a = 2.47; } elsif ($x < 13000000) { $a = 2.46; } elsif ($x < 18000000) { $a = 2.45; } elsif ($x < 31000000) { $a = 2.44; } elsif ($x < 41000000) { $a = 2.43; } elsif ($x < 48000000) { $a = 2.42; } elsif ($x < 119000000) { $a = 2.41; } elsif ($x < 182000000) { $a = 2.40; } elsif ($x < 192000000) { $a = 2.395; } elsif ($x < 213000000) { $a = 2.390; } elsif ($x < 271000000) { $a = 2.385; } elsif ($x < 322000000) { $a = 2.380; } elsif ($x < 400000000) { $a = 2.375; } elsif ($x < 510000000) { $a = 2.370; } elsif ($x < 682000000) { $a = 2.367; } elsif ($x < 2953652287) { $a = 2.362; } else { $a = 2.334; } # Dusart 2010, page 2 $result = ($x/$fl1) * ($one + $one/$fl1 + $a/$fl2) + $one; } elsif ($x < 1e19) { # Skewes number lower limit $a = ($x < 110e7) ? 0.032 : ($x < 1001e7) ? 0.027 : ($x < 10126e7) ? 0.021 : 0.0; $result = LogarithmicIntegral($x) - $a * $fl1*sqrt($x)/PI_TIMES_8; } elsif ($x < 5.5e25 || Math::Prime::Util::prime_get_config()->{'assume_rh'}) { # Schoenfeld / Büthe 2014 Th 7.4 my $lix = LogarithmicIntegral($x); my $sqx = sqrt($x); if (ref($x) eq 'Math::BigFloat') { my $xdigits = _find_big_acc($x); $result = $lix + ($fl1*$sqx / (Math::BigFloat->bpi($xdigits)*8)); } else { $result = $lix + ($fl1*$sqx / PI_TIMES_8); } } else { # Axler 2014 1.3 my($fl3,$fl4) = ($fl2*$fl1,$fl2*$fl2); my($fl5,$fl6) = ($fl4*$fl1,$fl4*$fl2); $result = $x / ($fl1 - $one - $one/$fl1 - 3.35/$fl2 - 12.65/$fl3 - 71.7/$fl4 - 466.1275/$fl5 - 3489.8225/$fl6); } return Math::BigInt->new($result->bfloor->bstr()) if ref($result) eq 'Math::BigFloat'; return int($result); } sub twin_prime_count { my($low,$high) = @_; if (defined $high) { _validate_positive_integer($low); } else { ($low,$high) = (2, $low); } _validate_positive_integer($high); my $sum = 0; while ($low <= $high) { my $seghigh = ($high-$high) + $low + 1e7 - 1; $seghigh = $high if $seghigh > $high; $sum += scalar(@{Math::Prime::Util::twin_primes($low,$seghigh)}); $low = $seghigh + 1; } $sum; } sub _semiprime_count { my $n = shift; my($sum,$pc) = (0,0); Math::Prime::Util::forprimes( sub { $sum += Math::Prime::Util::prime_count(int($n/$_))-$pc++; }, sqrtint($n)); $sum; } sub semiprime_count { my($low,$high) = @_; if (defined $high) { _validate_positive_integer($low); } else { ($low,$high) = (2, $low); } _validate_positive_integer($high); # todo: threshold of fast count vs. walk my $sum = _semiprime_count($high) - (($low < 4) ? 0 : semiprime_count($low-1)); $sum; } sub ramanujan_prime_count { my($low,$high) = @_; if (defined $high) { _validate_positive_integer($low); } else { ($low,$high) = (2, $low); } _validate_positive_integer($high); my $sum = 0; while ($low <= $high) { my $seghigh = ($high-$high) + $low + 1e9 - 1; $seghigh = $high if $seghigh > $high; $sum += scalar(@{Math::Prime::Util::ramanujan_primes($low,$seghigh)}); $low = $seghigh + 1; } $sum; } sub twin_prime_count_approx { my($n) = @_; return twin_prime_count(3,$n) if $n < 2000; $n = _upgrade_to_float($n) if ref($n); my $logn = log($n); # The loss of full Ei precision is a few orders of magnitude less than the # accuracy of the estimate, so save huge time and don't bother. my $li2 = Math::Prime::Util::ExponentialIntegral("$logn") + 2.8853900817779268147198494 - ($n/$logn); # Empirical correction factor my $fm; if ($n < 4000) { $fm = 0.2952; } elsif ($n < 8000) { $fm = 0.3151; } elsif ($n < 16000) { $fm = 0.3090; } elsif ($n < 32000) { $fm = 0.3096; } elsif ($n < 64000) { $fm = 0.3100; } elsif ($n < 128000) { $fm = 0.3089; } elsif ($n < 256000) { $fm = 0.3099; } elsif ($n < 600000) { my($x0, $x1, $y0, $y1) = (1e6, 6e5, .3091, .3059); $fm = $y0 + ($n - $x0) * ($y1-$y0) / ($x1 - $x0); } elsif ($n < 1000000) { my($x0, $x1, $y0, $y1) = (6e5, 1e6, .3062, .3042); $fm = $y0 + ($n - $x0) * ($y1-$y0) / ($x1 - $x0); } elsif ($n < 4000000) { my($x0, $x1, $y0, $y1) = (1e6, 4e6, .3067, .3041); $fm = $y0 + ($n - $x0) * ($y1-$y0) / ($x1 - $x0); } elsif ($n < 16000000) { my($x0, $x1, $y0, $y1) = (4e6, 16e6, .3033, .2983); $fm = $y0 + ($n - $x0) * ($y1-$y0) / ($x1 - $x0); } elsif ($n < 32000000) { my($x0, $x1, $y0, $y1) = (16e6, 32e6, .2980, .2965); $fm = $y0 + ($n - $x0) * ($y1-$y0) / ($x1 - $x0); } $li2 *= $fm * log(12+$logn) if defined $fm; return int(1.32032363169373914785562422 * $li2 + 0.5); } sub semiprime_count_approx { my($n) = @_; return 0 if $n < 4; _validate_positive_integer($n); $n = "$n" + 0.00000001; my $l1 = log($n); my $l2 = log($l1); #my $est = $n * $l2 / $l1; my $est = $n * ($l2 + 0.302) / $l1; int(0.5+$est); } sub nth_twin_prime { my($n) = @_; return undef if $n < 0; ## no critic qw(ProhibitExplicitReturnUndef) return (undef,3,5,11,17,29,41)[$n] if $n <= 6; my $p = Math::Prime::Util::nth_twin_prime_approx($n+200); my $tp = Math::Prime::Util::twin_primes($p); while ($n > scalar(@$tp)) { $n -= scalar(@$tp); $tp = Math::Prime::Util::twin_primes($p+1,$p+1e5); $p += 1e5; } return $tp->[$n-1]; } sub nth_twin_prime_approx { my($n) = @_; _validate_positive_integer($n); return nth_twin_prime($n) if $n < 6; $n = _upgrade_to_float($n) if ref($n) || $n > 127e14; # TODO lower for 32-bit my $logn = log($n); my $nlogn2 = $n * $logn * $logn; return int(5.158 * $nlogn2/log(9+log($n*$n))) if $n > 59 && $n <= 1092; my $lo = int(0.7 * $nlogn2); my $hi = int( ($n > 1e16) ? 1.1 * $nlogn2 : ($n > 480) ? 1.7 * $nlogn2 : 2.3 * $nlogn2 + 3 ); _binary_search($n, $lo, $hi, sub{Math::Prime::Util::twin_prime_count_approx(shift)}, sub{ ($_[2]-$_[1])/$_[1] < 1e-15 } ); } sub nth_semiprime { my $n = shift; return undef if $n < 0; ## no critic qw(ProhibitExplicitReturnUndef) return (undef,4,6,9,10,14,15,21,22)[$n] if $n <= 8; my $logn = log($n); my $est = 0.966 * $n * $logn / log($logn); 1+_binary_search($n, int(0.9*$est)-1, int(1.15*$est)+1, sub{Math::Prime::Util::semiprime_count(shift)}); } sub nth_semiprime_approx { my $n = shift; return undef if $n < 0; ## no critic qw(ProhibitExplicitReturnUndef) _validate_positive_integer($n); return (undef,4,6,9,10,14,15,21,22)[$n] if $n <= 8; $n = "$n" + 0.00000001; my $l1 = log($n); my $l2 = log($l1); my $est = 0.966 * $n * $l1 / $l2; int(0.5+$est); } sub nth_ramanujan_prime_upper { my $n = shift; return (0,2,11)[$n] if $n <= 2; $n = Math::BigInt->new("$n") if $n > (~0/3); my $nth = nth_prime_upper(3*$n); return $nth if $n < 10000; $nth = Math::BigInt->new("$nth") if $nth > (~0/177); if ($n < 1000000) { $nth = (177 * $nth) >> 8; } elsif ($n < 1e10) { $nth = (175 * $nth) >> 8; } else { $nth = (133 * $nth) >> 8; } $nth = _bigint_to_int($nth) if ref($nth) && $nth->bacmp(BMAX) <= 0; $nth; } sub nth_ramanujan_prime_lower { my $n = shift; return (0,2,11)[$n] if $n <= 2; $n = Math::BigInt->new("$n") if $n > (~0/2); my $nth = nth_prime_lower(2*$n); $nth = Math::BigInt->new("$nth") if $nth > (~0/275); if ($n < 10000) { $nth = (275 * $nth) >> 8; } elsif ($n < 1e10) { $nth = (262 * $nth) >> 8; } $nth = _bigint_to_int($nth) if ref($nth) && $nth->bacmp(BMAX) <= 0; $nth; } sub nth_ramanujan_prime_approx { my $n = shift; return (0,2,11)[$n] if $n <= 2; my($lo,$hi) = (nth_ramanujan_prime_lower($n),nth_ramanujan_prime_upper($n)); $lo + (($hi-$lo)>>1); } sub ramanujan_prime_count_upper { my $n = shift; return (($n < 2) ? 0 : 1) if $n < 11; my $lo = int(prime_count_lower($n) / 3); my $hi = prime_count_upper($n) >> 1; 1+_binary_search($n, $lo, $hi, sub{Math::Prime::Util::nth_ramanujan_prime_lower(shift)}); } sub ramanujan_prime_count_lower { my $n = shift; return (($n < 2) ? 0 : 1) if $n < 11; my $lo = int(prime_count_lower($n) / 3); my $hi = prime_count_upper($n) >> 1; _binary_search($n, $lo, $hi, sub{Math::Prime::Util::nth_ramanujan_prime_upper(shift)}); } sub ramanujan_prime_count_approx { my $n = shift; return (($n < 2) ? 0 : 1) if $n < 11; #$n = _upgrade_to_float($n) if ref($n) || $n > 2e16; my $lo = ramanujan_prime_count_lower($n); my $hi = ramanujan_prime_count_upper($n); _binary_search($n, $lo, $hi, sub{Math::Prime::Util::nth_ramanujan_prime_approx(shift)}, sub{ ($_[2]-$_[1])/$_[1] < 1e-15 } ); } sub _sum_primes_n { my $n = shift; return (0,0,2,5,5)[$n] if $n < 5; my $r = Math::Prime::Util::sqrtint($n); my $r2 = $r + int($n/($r+1)); my(@V,@S); for my $k (0 .. $r2) { my $v = ($k <= $r) ? $k : int($n/($r2-$k+1)); $V[$k] = $v; $S[$k] = (($v*($v+1)) >> 1) - 1; } Math::Prime::Util::forprimes( sub { my $p = $_; my $sp = $S[$p-1]; my $p2 = $p*$p; for my $v (reverse @V) { last if $v < $p2; my($a,$b) = ($v,int($v/$p)); $a = $r2 - int($n/$a) + 1 if $a > $r; $b = $r2 - int($n/$b) + 1 if $b > $r; $S[$a] -= $p * ($S[$b] - $sp); } }, 2, $r); $S[$r2]; } sub sum_primes { my($low,$high) = @_; if (defined $high) { _validate_positive_integer($low); } else { ($low,$high) = (2, $low); } _validate_positive_integer($high); my $sum = 0; $sum = BZERO->copy if ( (MPU_32BIT && $high > 323_380) || (MPU_64BIT && $high > 29_505_444_490) ); # It's very possible we're here because they've counted too high. Skip fwd. if ($low <= 2 && $high >= 29505444491) { $low = 29505444503; $sum = Math::BigInt->new("18446744087046669523"); } return $sum if $low > $high; # We have to make some decision about whether to use our PP prime sum or loop # doing the XS sieve. TODO: Be smarter here? if (!Math::Prime::Util::prime_get_config()->{'xs'} && !ref($sum) && !MPU_32BIT && ($high-$low) > 1000000) { # Unfortunately with bigints this is horrifically slow, but we have to do it. $high = BZERO->copy + $high if $high >= (1 << (MPU_MAXBITS/2))-1; $sum = _sum_primes_n($high); $sum -= _sum_primes_n($low-1) if $low > 2; return $sum; } my $xssum = (MPU_64BIT && $high < 6e14 && Math::Prime::Util::prime_get_config()->{'xs'}); my $step = ($xssum && $high > 5e13) ? 1_000_000 : 11_000_000; Math::Prime::Util::prime_precalc(sqrtint($high)); while ($low <= $high) { my $next = $low + $step - 1; $next = $high if $next > $high; $sum += ($xssum) ? Math::Prime::Util::sum_primes($low,$next) : Math::Prime::Util::vecsum( @{Math::Prime::Util::primes($low,$next)} ); last if $next == $high; $low = $next+1; } $sum; } sub print_primes { my($low,$high,$fd) = @_; if (defined $high) { _validate_positive_integer($low); } else { ($low,$high) = (2, $low); } _validate_positive_integer($high); $fd = fileno(STDOUT) unless defined $fd; open(my $fh, ">>&=", $fd); # TODO .... or die if ($high >= $low) { my $p1 = $low; while ($p1 <= $high) { my $p2 = $p1 + 15_000_000 - 1; $p2 = $high if $p2 > $high; if ($Math::Prime::Util::_GMPfunc{"sieve_primes"}) { print $fh "$_\n" for Math::Prime::Util::GMP::sieve_primes($p1,$p2,0); } else { print $fh "$_\n" for @{primes($p1,$p2)}; } $p1 = $p2+1; } } close($fh); } ############################################################################# sub _mulmod { my($x, $y, $n) = @_; return (($x * $y) % $n) if ($x|$y) < MPU_HALFWORD; #return (($x * $y) % $n) if ($x|$y) < MPU_HALFWORD || $y == 0 || $x < int(~0/$y); my $r = 0; $x %= $n if $x >= $n; $y %= $n if $y >= $n; ($x,$y) = ($y,$x) if $x < $y; if ($n <= (~0 >> 1)) { while ($y > 1) { if ($y & 1) { $r += $x; $r -= $n if $r >= $n; } $y >>= 1; $x += $x; $x -= $n if $x >= $n; } if ($y & 1) { $r += $x; $r -= $n if $r >= $n; } } else { while ($y > 1) { if ($y & 1) { $r = $n-$r; $r = ($x >= $r) ? $x-$r : $n-$r+$x; } $y >>= 1; $x = ($x > ($n - $x)) ? ($x - $n) + $x : $x + $x; } if ($y & 1) { $r = $n-$r; $r = ($x >= $r) ? $x-$r : $n-$r+$x; } } $r; } sub _addmod { my($x, $y, $n) = @_; $x %= $n if $x >= $n; $y %= $n if $y >= $n; if (($n-$x) <= $y) { ($x,$y) = ($y,$x) if $y > $x; $x -= $n; } $x + $y; } # Note that Perl 5.6.2 with largish 64-bit numbers will break. As usual. sub _native_powmod { my($n, $power, $m) = @_; my $t = 1; $n = $n % $m; while ($power) { $t = ($t * $n) % $m if ($power & 1); $power >>= 1; $n = ($n * $n) % $m if $power; } $t; } sub _powmod { my($n, $power, $m) = @_; my $t = 1; $n %= $m if $n >= $m; if ($m < MPU_HALFWORD) { while ($power) { $t = ($t * $n) % $m if ($power & 1); $power >>= 1; $n = ($n * $n) % $m if $power; } } else { while ($power) { $t = _mulmod($t, $n, $m) if ($power & 1); $power >>= 1; $n = _mulmod($n, $n, $m) if $power; } } $t; } # Make sure to work around RT71548, Math::BigInt::Lite, # and use correct lcm semantics. sub gcd { # First see if all inputs are non-bigints 5-10x faster if so. if (0 == scalar(grep { ref($_) } @_)) { my($x,$y) = (shift || 0, 0); while (@_) { $y = shift; while ($y) { ($x,$y) = ($y, $x % $y); } $x = -$x if $x < 0; } return $x; } my $gcd = Math::BigInt::bgcd( map { my $v = (($_ < 2147483647 && !ref($_)) || ref($_) eq 'Math::BigInt') ? $_ : "$_"; $v; } @_ ); $gcd = _bigint_to_int($gcd) if $gcd->bacmp(BMAX) <= 0; return $gcd; } sub lcm { return 0 unless @_; my $lcm = Math::BigInt::blcm( map { my $v = (($_ < 2147483647 && !ref($_)) || ref($_) eq 'Math::BigInt') ? $_ : "$_"; return 0 if $v == 0; $v = -$v if $v < 0; $v; } @_ ); $lcm = _bigint_to_int($lcm) if $lcm->bacmp(BMAX) <= 0; return $lcm; } sub gcdext { my($x,$y) = @_; if ($x == 0) { return (0, (-1,0,1)[($y>=0)+($y>0)], abs($y)); } if ($y == 0) { return ((-1,0,1)[($x>=0)+($x>0)], 0, abs($x)); } if ($Math::Prime::Util::_GMPfunc{"gcdext"}) { my($a,$b,$g) = Math::Prime::Util::GMP::gcdext($x,$y); $a = Math::Prime::Util::_reftyped($_[0], $a); $b = Math::Prime::Util::_reftyped($_[0], $b); $g = Math::Prime::Util::_reftyped($_[0], $g); return ($a,$b,$g); } my($a,$b,$g,$u,$v,$w); if (abs($x) < (~0>>1) && abs($y) < (~0>>1)) { $x = _bigint_to_int($x) if ref($x) eq 'Math::BigInt'; $y = _bigint_to_int($y) if ref($y) eq 'Math::BigInt'; ($a,$b,$g,$u,$v,$w) = (1,0,$x,0,1,$y); while ($w != 0) { my $r = $g % $w; my $q = int(($g-$r)/$w); ($a,$b,$g,$u,$v,$w) = ($u,$v,$w,$a-$q*$u,$b-$q*$v,$r); } } else { ($a,$b,$g,$u,$v,$w) = (BONE->copy,BZERO->copy,Math::BigInt->new("$x"), BZERO->copy,BONE->copy,Math::BigInt->new("$y")); while ($w != 0) { # Using the array bdiv is logical, but is the wrong sign. my $r = $g->copy->bmod($w); my $q = $g->copy->bsub($r)->bdiv($w); ($a,$b,$g,$u,$v,$w) = ($u,$v,$w,$a-$q*$u,$b-$q*$v,$r); } $a = _bigint_to_int($a) if $a->bacmp(BMAX) <= 0; $b = _bigint_to_int($b) if $b->bacmp(BMAX) <= 0; $g = _bigint_to_int($g) if $g->bacmp(BMAX) <= 0; } if ($g < 0) { ($a,$b,$g) = (-$a,-$b,-$g); } return ($a,$b,$g); } sub chinese { return 0 unless scalar @_; return $_[0]->[0] % $_[0]->[1] if scalar @_ == 1; my($lcm, $sum); if ($Math::Prime::Util::_GMPfunc{"chinese"} && $Math::Prime::Util::GMP::VERSION >= 0.42) { $sum = Math::Prime::Util::GMP::chinese(@_); if (defined $sum) { $sum = Math::BigInt->new("$sum"); $sum = _bigint_to_int($sum) if ref($sum) && $sum->bacmp(BMAX) <= 0; } return $sum; } foreach my $aref (sort { $b->[1] <=> $a->[1] } @_) { my($ai, $ni) = @$aref; $ai = Math::BigInt->new("$ai") if !ref($ai) && (abs($ai) > (~0>>1) || OLD_PERL_VERSION); $ni = Math::BigInt->new("$ni") if !ref($ni) && (abs($ni) > (~0>>1) || OLD_PERL_VERSION); if (!defined $lcm) { ($sum,$lcm) = ($ai % $ni, $ni); next; } # gcdext my($u,$v,$g,$s,$t,$w) = (1,0,$lcm,0,1,$ni); while ($w != 0) { my $r = $g % $w; my $q = ref($g) ? $g->copy->bsub($r)->bdiv($w) : int(($g-$r)/$w); ($u,$v,$g,$s,$t,$w) = ($s,$t,$w,$u-$q*$s,$v-$q*$t,$r); } ($u,$v,$g) = (-$u,-$v,-$g) if $g < 0; return if $g != 1 && ($sum % $g) != ($ai % $g); # Not co-prime $s = -$s if $s < 0; $t = -$t if $t < 0; # Convert to bigint if necessary. Performance goes to hell. if (!ref($lcm) && ($lcm*$s) > ~0) { $lcm = Math::BigInt->new("$lcm"); } if (ref($lcm)) { $lcm->bmul("$s"); my $m1 = Math::BigInt->new("$v")->bmul("$s")->bmod($lcm); my $m2 = Math::BigInt->new("$u")->bmul("$t")->bmod($lcm); $m1->bmul("$sum")->bmod($lcm); $m2->bmul("$ai")->bmod($lcm); $sum = $m1->badd($m2)->bmod($lcm); } else { $lcm *= $s; $u += $lcm if $u < 0; $v += $lcm if $v < 0; my $vs = _mulmod($v,$s,$lcm); my $ut = _mulmod($u,$t,$lcm); my $m1 = _mulmod($sum,$vs,$lcm); my $m2 = _mulmod($ut,$ai % $lcm,$lcm); $sum = _addmod($m1, $m2, $lcm); } } $sum = _bigint_to_int($sum) if ref($sum) && $sum->bacmp(BMAX) <= 0; $sum; } sub _from_128 { my($hi, $lo) = @_; return 0 unless defined $hi && defined $lo; #print "hi $hi lo $lo\n"; (Math::BigInt->new("$hi") << MPU_MAXBITS) + $lo; } sub vecsum { return Math::Prime::Util::_reftyped($_[0], @_ ? $_[0] : 0) if @_ <= 1; return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::vecsum(@_)) if $Math::Prime::Util::_GMPfunc{"vecsum"}; my $sum = 0; my $neglim = -(INTMAX >> 1) - 1; foreach my $v (@_) { $sum += $v; if ($sum > (INTMAX-250) || $sum < $neglim) { $sum = BZERO->copy; $sum->badd("$_") for @_; return $sum; } } $sum; } sub vecprod { return 1 unless @_; return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::vecprod(@_)) if $Math::Prime::Util::_GMPfunc{"vecprod"}; # Product tree: my $prod = _product(0, $#_, [map { Math::BigInt->new("$_") } @_]); # Linear: # my $prod = BONE->copy; $prod *= "$_" for @_; $prod = _bigint_to_int($prod) if $prod->bacmp(BMAX) <= 0 && $prod->bcmp(-(BMAX>>1)) > 0; $prod; } sub vecmin { return unless @_; my $min = shift; for (@_) { $min = $_ if $_ < $min; } $min; } sub vecmax { return unless @_; my $max = shift; for (@_) { $max = $_ if $_ > $max; } $max; } sub vecextract { my($aref, $mask) = @_; return @$aref[@$mask] if ref($mask) eq 'ARRAY'; # This is concise but very slow. # map { $aref->[$_] } grep { $mask & (1 << $_) } 0 .. $#$aref; my($i, @v) = (0); while ($mask) { push @v, $i if $mask & 1; $mask >>= 1; $i++; } @$aref[@v]; } sub sumdigits { my($n,$base) = @_; my $sum = 0; $base = 2 if !defined $base && $n =~ s/^0b//; $base = 16 if !defined $base && $n =~ s/^0x//; if (!defined $base || $base == 10) { $n =~ tr/0123456789//cd; $sum += $_ for (split(//,$n)); } else { croak "sumdigits: invalid base $base" if $base < 2; my $cmap = substr("0123456789abcdefghijklmnopqrstuvwxyz",0,$base); for my $c (split(//,lc($n))) { my $p = index($cmap,$c); $sum += $p if $p > 0; } } $sum; } sub invmod { my($a,$n) = @_; return if $n == 0 || $a == 0; return 0 if $n == 1; $n = -$n if $n < 0; # Pari semantics if ($n > ~0) { my $invmod = Math::BigInt->new("$a")->bmodinv("$n"); return if !defined $invmod || $invmod->is_nan; $invmod = _bigint_to_int($invmod) if $invmod->bacmp(BMAX) <= 0; return $invmod; } my($t,$nt,$r,$nr) = (0, 1, $n, $a % $n); while ($nr != 0) { # Use mod before divide to force correct behavior with high bit set my $quot = int( ($r-($r % $nr))/$nr ); ($nt,$t) = ($t-$quot*$nt,$nt); ($nr,$r) = ($r-$quot*$nr,$nr); } return if $r > 1; $t += $n if $t < 0; $t; } sub _verify_sqrtmod { my($r,$a,$n) = @_; if (ref($r)) { return if $r->copy->bmul($r)->bmod($n)->bcmp($a); $r = _bigint_to_int($r) if $r->bacmp(BMAX) <= 0; } else { return unless (($r*$r) % $n) == $a; } $r = $n-$r if $n-$r < $r; $r; } sub sqrtmod { my($a,$n) = @_; return if $n == 0; if ($n <= 2 || $a <= 1) { $a %= $n; return ((($a*$a) % $n) == $a) ? $a : undef; } if ($n < 10000000) { # Horrible trial search $a = _bigint_to_int($a); $n = _bigint_to_int($n); $a %= $n; return 1 if $a == 1; my $lim = ($n+1) >> 1; for my $r (2 .. $lim) { return $r if (($r*$r) % $n) == $a; } undef; } $a = Math::BigInt->new("$a") unless ref($a) eq 'Math::BigInt'; $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; $a->bmod($n); my $r; if (($n % 4) == 3) { $r = $a->copy->bmodpow(($n+1)>>2, $n); return _verify_sqrtmod($r, $a, $n); } if (($n % 8) == 5) { my $q = $a->copy->bmodpow(($n-1)>>2, $n); if ($q->is_one) { $r = $a->copy->bmodpow(($n+3)>>3, $n); } else { my $v = $a->copy->bmul(4)->bmodpow(($n-5)>>3, $n); $r = $a->copy->bmul(2)->bmul($v)->bmod($n); } return _verify_sqrtmod($r, $a, $n); } return if $n->is_odd && !$a->copy->bmodpow(($n-1)>>1,$n)->is_one(); # Horrible trial search. Need to use Tonelli-Shanks here. $r = Math::BigInt->new(2); my $lim = int( ($n+1) / 2 ); while ($r < $lim) { return $r if $r->copy->bmul($r)->bmod($n) == $a; $r++; } undef; } sub addmod { my($a, $b, $n) = @_; return 0 if $n <= 1; return _addmod($a,$b,$n) if $n < INTMAX && $a>=0 && $a<INTMAX && $b>=0 && $b<INTMAX; my $ret = Math::BigInt->new("$a")->badd("$b")->bmod("$n"); $ret = _bigint_to_int($ret) if $ret->bacmp(BMAX) <= 0; $ret; } sub mulmod { my($a, $b, $n) = @_; return 0 if $n <= 1; return _mulmod($a,$b,$n) if $n < INTMAX && $a>0 && $a<INTMAX && $b>0 && $b<INTMAX; return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::mulmod($a,$b,$n)) if $Math::Prime::Util::_GMPfunc{"mulmod"}; my $ret = Math::BigInt->new("$a")->bmod("$n")->bmul("$b")->bmod("$n"); $ret = _bigint_to_int($ret) if $ret->bacmp(BMAX) <= 0; $ret; } sub divmod { my($a, $b, $n) = @_; return 0 if $n <= 1; my $ret = Math::BigInt->new("$b")->bmodinv("$n")->bmul("$a")->bmod("$n"); if ($ret->is_nan) { $ret = undef; } else { $ret = _bigint_to_int($ret) if $ret->bacmp(BMAX) <= 0; } $ret; } sub powmod { my($a, $b, $n) = @_; return 0 if $n <= 1; if ($Math::Prime::Util::_GMPfunc{"powmod"}) { my $r = Math::Prime::Util::GMP::powmod($a,$b,$n); return (defined $r) ? Math::Prime::Util::_reftyped($_[0], $r) : undef; } my $ret = Math::BigInt->new("$a")->bmod("$n")->bmodpow("$b","$n"); if ($ret->is_nan) { $ret = undef; } else { $ret = _bigint_to_int($ret) if $ret->bacmp(BMAX) <= 0; } $ret; } # no validation, x is allowed to be negative, y must be >= 0 sub _gcd_ui { my($x, $y) = @_; if ($y < $x) { ($x, $y) = ($y, $x); } elsif ($x < 0) { $x = -$x; } while ($y > 0) { ($x, $y) = ($y, $x % $y); } $x; } sub is_power { my ($n, $a, $refp) = @_; croak("is_power third argument not a scalar reference") if defined($refp) && !ref($refp); _validate_integer($n); return 0 if abs($n) <= 3 && !$a; if ($Math::Prime::Util::_GMPfunc{"is_power"} && ($Math::Prime::Util::GMP::VERSION >= 0.42 || ($Math::Prime::Util::GMP::VERSION >= 0.28 && $n > 0))) { $a = 0 unless defined $a; my $k = Math::Prime::Util::GMP::is_power($n,$a); return 0 unless $k > 0; if (defined $refp) { $a = $k unless $a; my $isneg = ($n < 0); $n =~ s/^-// if $isneg; $$refp = Math::Prime::Util::rootint($n, $a); $$refp = Math::Prime::Util::_reftyped($_[0], $$refp) if $$refp > INTMAX; $$refp = -$$refp if $isneg; } return $k; } if (defined $a && $a != 0) { return 1 if $a == 1; # Everything is a 1st power return 0 if $n < 0 && $a % 2 == 0; # Negative n never an even power if ($a == 2) { if (_is_perfect_square($n)) { $$refp = int(sqrt($n)) if defined $refp; return 1; } } else { $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my $root = $n->copy->babs->broot($a)->bfloor; $root->bneg if $n->is_neg; if ($root->copy->bpow($a) == $n) { $$refp = $root if defined $refp; return 1; } } } else { $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; if ($n < 0) { my $absn = $n->copy->babs; my $root = is_power($absn, 0, $refp); return 0 unless $root; if ($root % 2 == 0) { my $power = valuation($root, 2); $root >>= $power; return 0 if $root == 1; $power = BTWO->copy->bpow($power); $$refp = $$refp ** $power if defined $refp; } $$refp = -$$refp if defined $refp; return $root; } my $e = 2; while (1) { my $root = $n->copy()->broot($e)->bfloor; last if $root->is_one(); if ($root->copy->bpow($e) == $n) { my $next = is_power($root, 0, $refp); $$refp = $root if !$next && defined $refp; $e *= $next if $next != 0; return $e; } $e = next_prime($e); } } 0; } sub is_square { my($n) = @_; return 0 if $n < 0; #is_power($n,2); _validate_integer($n); _is_perfect_square($n); } sub is_prime_power { my ($n, $refp) = @_; croak("is_prime_power second argument not a scalar reference") if defined($refp) && !ref($refp); return 0 if $n <= 1; if (Math::Prime::Util::is_prime($n)) { $$refp = $n if defined $refp; return 1; } my $r; my $k = Math::Prime::Util::is_power($n,0,\$r); if ($k) { $r = _bigint_to_int($r) if ref($r) && $r->bacmp(BMAX) <= 0; return 0 unless Math::Prime::Util::is_prime($r); $$refp = $r if defined $refp; } $k; } sub is_polygonal { my ($n, $k, $refp) = @_; croak("is_polygonal third argument not a scalar reference") if defined($refp) && !ref($refp); croak("is_polygonal: k must be >= 3") if $k < 3; return 0 if $n <= 0; if ($n == 1) { $$refp = 1 if defined $refp; return 1; } if ($Math::Prime::Util::_GMPfunc{"polygonal_nth"}) { my $nth = Math::Prime::Util::GMP::polygonal_nth($n, $k); return 0 unless $nth; $nth = Math::Prime::Util::_reftyped($_[0], $nth); $$refp = $nth if defined $refp; return 1; } my($D,$R); if ($k == 4) { return 0 unless _is_perfect_square($n); $$refp = sqrtint($n) if defined $refp; return 1; } if ($n <= MPU_HALFWORD && $k <= MPU_HALFWORD) { $D = ($k==3) ? 1+($n<<3) : (8*$k-16)*$n + ($k-4)*($k-4); return 0 unless _is_perfect_square($D); $D = $k-4 + Math::Prime::Util::sqrtint($D); $R = 2*$k-4; } else { if ($k == 3) { $D = vecsum(1, vecprod($n, 8)); } else { $D = vecsum(vecprod($n, vecprod(8, $k) - 16), vecprod($k-4,$k-4));; } return 0 unless _is_perfect_square($D); $D = vecsum( sqrtint($D), $k-4 ); $R = vecprod(2, $k) - 4; } return 0 if ($D % $R) != 0; $$refp = $D / $R if defined $refp; 1; } sub valuation { my($n, $k) = @_; $n = -$n if defined $n && $n < 0; _validate_num($n) || _validate_positive_integer($n); return 0 if $n < 2 || $k < 2; my $v = 0; if ($k == 2) { # Accelerate power of 2 if (ref($n) eq 'Math::BigInt') { # This can pay off for big inputs return 0 unless $n->is_even; my $s = $n->as_bin; # We could do same for k=10 return length($s) - rindex($s,'1') - 1; } while (!($n & 0xFFFF) ) { $n >>=16; $v +=16; } while (!($n & 0x000F) ) { $n >>= 4; $v += 4; } } while ( !($n % $k) ) { $n /= $k; $v++; } $v; } sub hammingweight { my $n = shift; return 0 + (Math::BigInt->new("$n")->as_bin() =~ tr/1//); } my @_digitmap = (0..9, 'a'..'z'); my %_mapdigit = map { $_digitmap[$_] => $_ } 0 .. $#_digitmap; sub _splitdigits { my($n, $base, $len) = @_; # n is num or bigint, base is in range my @d; if ($base == 10) { @d = split(//,"$n"); } elsif ($base == 2) { @d = split(//,substr(Math::BigInt->new("$n")->as_bin,2)); } elsif ($base == 16) { @d = map { $_mapdigit{$_} } split(//,substr(Math::BigInt->new("$n")->as_hex,2)); } else { while ($n >= 1) { my $rem = $n % $base; unshift @d, $rem; $n = ($n-$rem)/$base; # Always an exact division } } if ($len >= 0 && $len != scalar(@d)) { while (@d < $len) { unshift @d, 0; } while (@d > $len) { shift @d; } } @d; } sub todigits { my($n,$base,$len) = @_; $base = 10 unless defined $base; $len = -1 unless defined $len; die "Invalid base: $base" if $base < 2; return if $n == 0; $n = -$n if $n < 0; _validate_num($n) || _validate_positive_integer($n); _splitdigits($n, $base, $len); } sub todigitstring { my($n,$base,$len) = @_; $base = 10 unless defined $base; $len = -1 unless defined $len; $n =~ s/^-//; return substr(Math::BigInt->new("$n")->as_bin,2) if $base == 2 && $len < 0; return substr(Math::BigInt->new("$n")->as_oct,1) if $base == 8 && $len < 0; return substr(Math::BigInt->new("$n")->as_hex,2) if $base == 16 && $len < 0; my @d = ($n == 0) ? () : _splitdigits($n, $base, $len); return join("", @d) if $base <= 10; die "Invalid base for string: $base" if $base > 36; join("", map { $_digitmap[$_] } @d); } sub fromdigits { my($r, $base) = @_; $base = 10 unless defined $base; return $r if $base == 10 && ref($r) =~ /^Math::/; my $n; if (ref($r) && ref($r) !~ /^Math::/) { croak "fromdigits first argument must be a string or array reference" unless ref($r) eq 'ARRAY'; ($n,$base) = (BZERO->copy, BZERO + $base); for my $d (@$r) { $n = $n * $base + $d; } } elsif ($base == 2) { $n = Math::BigInt->from_bin("0b$r"); } elsif ($base == 8) { $n = Math::BigInt->from_oct("0$r"); } elsif ($base == 16) { $n = Math::BigInt->from_hex("0x$r"); } else { $r =~ s/^0*//; ($n,$base) = (BZERO->copy, BZERO + $base); #for my $d (map { $_mapdigit{$_} } split(//,$r)) { # croak "Invalid digit for base $base" unless defined $d && $d < $base; # $n = $n * $base + $d; #} for my $c (split(//, lc($r))) { $n->bmul($base); if ($c ne '0') { my $d = index("0123456789abcdefghijklmnopqrstuvwxyz", $c); croak "Invalid digit for base $base" unless $d >= 0; $n->badd($d); } } } $n = _bigint_to_int($n) if $n->bacmp(BMAX) <= 0; $n; } sub sqrtint { my($n) = @_; my $sqrt = Math::BigInt->new("$n")->bsqrt; return Math::Prime::Util::_reftyped($_[0], "$sqrt"); } sub rootint { my ($n, $k, $refp) = @_; croak "rootint: k must be > 0" unless $k > 0; # Math::BigInt returns NaN for any root of a negative n. my $root = Math::BigInt->new("$n")->babs->broot("$k"); if (defined $refp) { croak("logint third argument not a scalar reference") unless ref($refp); $$refp = $root->copy->bpow($k); } return Math::Prime::Util::_reftyped($_[0], "$root"); } sub logint { my ($n, $b, $refp) = @_; croak("logint third argument not a scalar reference") if defined($refp) && !ref($refp); if ($Math::Prime::Util::_GMPfunc{"logint"}) { my $e = Math::Prime::Util::GMP::logint($n, $b); if (defined $refp) { my $r = Math::Prime::Util::GMP::powmod($b, $e, $n); $r = $n if $r == 0; $$refp = Math::Prime::Util::_reftyped($_[0], $r); } return Math::Prime::Util::_reftyped($_[0], $e); } croak "logint: n must be > 0" unless $n > 0; croak "logint: missing base" unless defined $b; if ($b == 10) { my $e = length($n)-1; $$refp = Math::BigInt->new("1" . "0"x$e) if defined $refp; return $e; } if ($b == 2) { my $e = length(Math::BigInt->new("$n")->as_bin)-2-1; $$refp = Math::BigInt->from_bin("1" . "0"x$e) if defined $refp; return $e; } croak "logint: base must be > 1" unless $b > 1; my $e = Math::BigInt->new("$n")->blog("$b"); $$refp = Math::BigInt->new("$b")->bpow($e) if defined $refp; return Math::Prime::Util::_reftyped($_[0], "$e"); } # Seidel (Luschny), core using Trizen's simplications from Math::BigNum. # http://oeis.org/wiki/User:Peter_Luschny/ComputationAndAsymptoticsOfBernoulliNumbers#Bernoulli_numbers__after_Seidel sub _bernoulli_seidel { my($n) = @_; return (1,1) if $n == 0; return (0,1) if $n > 1 && $n % 2; my $oacc = Math::BigInt->accuracy(); Math::BigInt->accuracy(undef); my @D = (BZERO->copy, BONE->copy, map { BZERO->copy } 1 .. ($n>>1)-1); my ($h, $w) = (1, 1); foreach my $i (0 .. $n-1) { if ($w ^= 1) { $D[$_]->badd($D[$_-1]) for 1 .. $h-1; } else { $w = $h++; $D[$w]->badd($D[$w+1]) while --$w; } } my $num = $D[$h-1]; my $den = BONE->copy->blsft($n+1)->bsub(BTWO); my $gcd = Math::BigInt::bgcd($num, $den); $num /= $gcd; $den /= $gcd; $num->bneg() if ($n % 4) == 0; Math::BigInt->accuracy($oacc); ($num,$den); } sub bernfrac { my $n = shift; return (BONE,BONE) if $n == 0; return (BONE,BTWO) if $n == 1; # We're choosing 1/2 instead of -1/2 return (BZERO,BONE) if $n < 0 || $n & 1; # We should have used one of the GMP functions before coming here. _bernoulli_seidel($n); } sub stirling { my($n, $m, $type) = @_; return 1 if $m == $n; return 0 if $n == 0 || $m == 0 || $m > $n; $type = 1 unless defined $type; croak "stirling type must be 1, 2, or 3" unless $type == 1 || $type == 2 || $type == 3; if ($m == 1) { return 1 if $type == 2; return factorial($n) if $type == 3; return factorial($n-1) if $n&1; return vecprod(-1, factorial($n-1)); } return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::stirling($n,$m,$type)) if $Math::Prime::Util::_GMPfunc{"stirling"}; # Go through vecsum with quoted negatives to make sure we don't overflow. my $s; if ($type == 3) { $s = Math::Prime::Util::vecprod( Math::Prime::Util::binomial($n,$m), Math::Prime::Util::binomial($n-1,$m-1), Math::Prime::Util::factorial($n-$m) ); } elsif ($type == 2) { my @terms; for my $j (1 .. $m) { my $t = Math::Prime::Util::vecprod( Math::BigInt->new($j) ** $n, Math::Prime::Util::binomial($m,$j) ); push @terms, (($m-$j) & 1) ? "-$t" : $t; } $s = Math::Prime::Util::vecsum(@terms) / factorial($m); } else { my @terms; for my $k (1 .. $n-$m) { my $t = Math::Prime::Util::vecprod( Math::Prime::Util::binomial($k + $n - 1, $k + $n - $m), Math::Prime::Util::binomial(2 * $n - $m, $n - $k - $m), Math::Prime::Util::stirling($k - $m + $n, $k, 2), ); push @terms, ($k & 1) ? "-$t" : $t; } $s = Math::Prime::Util::vecsum(@terms); } $s; } sub _harmonic_split { # From Fredrik Johansson my($a,$b) = @_; return (BONE, $a) if $b - $a == BONE; return ($a+$a+BONE, $a*$a+$a) if $b - $a == BTWO; # Cut down recursion my $m = $a->copy->badd($b)->brsft(BONE); my ($p,$q) = _harmonic_split($a, $m); my ($r,$s) = _harmonic_split($m, $b); ($p*$s+$q*$r, $q*$s); } sub harmfrac { my($n) = @_; return (BZERO,BONE) if $n <= 0; $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my($p,$q) = _harmonic_split($n-$n+1, $n+1); my $gcd = Math::BigInt::bgcd($p,$q); ( scalar $p->bdiv($gcd), scalar $q->bdiv($gcd) ); } sub harmreal { my($n, $precision) = @_; do { require Math::BigFloat; Math::BigFloat->import(); } unless defined $Math::BigFloat::VERSION; return Math::BigFloat->bzero if $n <= 0; # Use asymptotic formula for larger $n if possible. Saves lots of time if # the default Calc backend is being used. { my $sprec = $precision; $sprec = Math::BigFloat->precision unless defined $sprec; $sprec = 40 unless defined $sprec; if ( ($sprec <= 23 && $n > 54) || ($sprec <= 30 && $n > 348) || ($sprec <= 40 && $n > 2002) || ($sprec <= 50 && $n > 12644) ) { $n = Math::BigFloat->new($n, $sprec+5); my($n2, $one, $h) = ($n*$n, Math::BigFloat->bone, Math::BigFloat->bzero); my $nt = $n2; my $eps = Math::BigFloat->new(10)->bpow(-$sprec-4); foreach my $d (-12, 120, -252, 240, -132, 32760, -12, 8160, -14364, 6600, -276, 65520, -12) { # OEIS A006593 my $term = $one/($d * $nt); last if $term->bacmp($eps) < 0; $h += $term; $nt *= $n2; } $h->badd(scalar $one->copy->bdiv(2*$n)); $h->badd(_Euler($sprec)); $h->badd($n->copy->blog); $h->round($sprec); return $h; } } my($num,$den) = Math::Prime::Util::harmfrac($n); # Note, with Calc backend this can be very, very slow scalar Math::BigFloat->new($num)->bdiv($den, $precision); } sub is_pseudoprime { my($n, @bases) = @_; return 0 if int($n) < 0; _validate_positive_integer($n); croak("No bases given to is_pseudoprime") unless scalar(@bases) > 0; return 0+($n >= 2) if $n < 4; foreach my $base (@bases) { croak "Base $base is invalid" if $base < 2; $base = $base % $n if $base >= $n; if ($base > 1 && $base != $n-1) { my $x = (ref($n) eq 'Math::BigInt') ? $n->copy->bzero->badd($base)->bmodpow($n-1,$n)->is_one : _powmod($base, $n-1, $n); return 0 unless $x == 1; } } 1; } sub is_euler_pseudoprime { my($n, @bases) = @_; return 0 if int($n) < 0; _validate_positive_integer($n); croak("No bases given to is_euler_pseudoprime") unless scalar(@bases) > 0; return 0+($n >= 2) if $n < 4; foreach my $base (@bases) { croak "Base $base is invalid" if $base < 2; $base = $base % $n if $base >= $n; if ($base > 1 && $base != $n-1) { my $j = kronecker($base, $n); return 0 if $j == 0; $j = ($j > 0) ? 1 : $n-1; my $x = (ref($n) eq 'Math::BigInt') ? $n->copy->bzero->badd($base)->bmodpow(($n-1)/2,$n) : _powmod($base, ($n-1)>>1, $n); return 0 unless $x == $j; } } 1; } sub is_euler_plumb_pseudoprime { my($n) = @_; return 0 if int($n) < 0; _validate_positive_integer($n); return 0+($n >= 2) if $n < 4; return 0 if ($n % 2) == 0; my $nmod8 = $n % 8; my $exp = 1 + ($nmod8 == 1); my $ap = Math::Prime::Util::powmod(2, ($n-1) >> $exp, $n); if ($ap == 1) { return ($nmod8 == 1 || $nmod8 == 7); } if ($ap == $n-1) { return ($nmod8 == 1 || $nmod8 == 3 || $nmod8 == 5); } 0; } sub _miller_rabin_2 { my($n, $nm1, $s, $d) = @_; if ( ref($n) eq 'Math::BigInt' ) { if (!defined $nm1) { $nm1 = $n->copy->bdec(); $s = 0; $d = $nm1->copy; do { $s++; $d->brsft(BONE); } while $d->is_even; } my $x = BTWO->copy->bmodpow($d,$n); return 1 if $x->is_one || $x->bcmp($nm1) == 0; foreach my $r (1 .. $s-1) { $x->bmul($x)->bmod($n); last if $x->is_one; return 1 if $x->bcmp($nm1) == 0; } } else { if (!defined $nm1) { $nm1 = $n-1; $s = 0; $d = $nm1; while ( ($d & 1) == 0 ) { $s++; $d >>= 1; } } if ($n < MPU_HALFWORD) { my $x = _native_powmod(2, $d, $n); return 1 if $x == 1 || $x == $nm1; foreach my $r (1 .. $s-1) { $x = ($x*$x) % $n; last if $x == 1; return 1 if $x == $n-1; } } else { my $x = _powmod(2, $d, $n); return 1 if $x == 1 || $x == $nm1; foreach my $r (1 .. $s-1) { $x = ($x < MPU_HALFWORD) ? ($x*$x) % $n : _mulmod($x, $x, $n); last if $x == 1; return 1 if $x == $n-1; } } } 0; } sub is_strong_pseudoprime { my($n, @bases) = @_; return 0 if int($n) < 0; _validate_positive_integer($n); croak("No bases given to is_strong_pseudoprime") unless scalar(@bases) > 0; return 0+($n >= 2) if $n < 4; return 0 if ($n % 2) == 0; if ($bases[0] == 2) { return 0 unless _miller_rabin_2($n); shift @bases; return 1 unless @bases; } my @newbases; for my $base (@bases) { croak "Base $base is invalid" if $base < 2; $base %= $n if $base >= $n; return 0 if $base == 0 || ($base == $n-1 && ($base % 2) == 1); push @newbases, $base; } @bases = @newbases; if ( ref($n) eq 'Math::BigInt' ) { my $nminus1 = $n->copy->bdec(); my $s = 0; my $d = $nminus1->copy; do { # n is > 3 and odd, so n-1 must be even $s++; $d->brsft(BONE); } while $d->is_even; # Different way of doing the above. Fewer function calls, slower on ave. #my $dbin = $nminus1->as_bin; #my $last1 = rindex($dbin, '1'); #my $s = length($dbin)-2-$last1+1; #my $d = $nminus1->copy->brsft($s); foreach my $ma (@bases) { my $x = $n->copy->bzero->badd($ma)->bmodpow($d,$n); next if $x->is_one || $x->bcmp($nminus1) == 0; foreach my $r (1 .. $s-1) { $x->bmul($x); $x->bmod($n); return 0 if $x->is_one; do { $ma = 0; last; } if $x->bcmp($nminus1) == 0; } return 0 if $ma != 0; } } else { my $s = 0; my $d = $n - 1; while ( ($d & 1) == 0 ) { $s++; $d >>= 1; } if ($n < MPU_HALFWORD) { foreach my $ma (@bases) { my $x = _native_powmod($ma, $d, $n); next if ($x == 1) || ($x == ($n-1)); foreach my $r (1 .. $s-1) { $x = ($x*$x) % $n; return 0 if $x == 1; last if $x == $n-1; } return 0 if $x != $n-1; } } else { foreach my $ma (@bases) { my $x = _powmod($ma, $d, $n); next if ($x == 1) || ($x == ($n-1)); foreach my $r (1 .. $s-1) { $x = ($x < MPU_HALFWORD) ? ($x*$x) % $n : _mulmod($x, $x, $n); return 0 if $x == 1; last if $x == $n-1; } return 0 if $x != $n-1; } } } 1; } # Calculate Kronecker symbol (a|b). Cohen Algorithm 1.4.10. # Extension of the Jacobi symbol, itself an extension of the Legendre symbol. sub kronecker { my($a, $b) = @_; return (abs($a) == 1) ? 1 : 0 if $b == 0; my $k = 1; if ($b % 2 == 0) { return 0 if $a % 2 == 0; my $v = 0; do { $v++; $b /= 2; } while $b % 2 == 0; $k = -$k if $v % 2 == 1 && ($a % 8 == 3 || $a % 8 == 5); } if ($b < 0) { $b = -$b; $k = -$k if $a < 0; } if ($a < 0) { $a = -$a; $k = -$k if $b % 4 == 3; } $b = _bigint_to_int($b) if ref($b) eq 'Math::BigInt' && $b <= BMAX; $a = _bigint_to_int($a) if ref($a) eq 'Math::BigInt' && $a <= BMAX; # Now: b > 0, b odd, a >= 0 while ($a != 0) { if ($a % 2 == 0) { my $v = 0; do { $v++; $a /= 2; } while $a % 2 == 0; $k = -$k if $v % 2 == 1 && ($b % 8 == 3 || $b % 8 == 5); } $k = -$k if $a % 4 == 3 && $b % 4 == 3; ($a, $b) = ($b % $a, $a); # If a,b are bigints and now small enough, finish as native. if ( ref($a) eq 'Math::BigInt' && $a <= BMAX && ref($b) eq 'Math::BigInt' && $b <= BMAX) { return $k * kronecker(_bigint_to_int($a),_bigint_to_int($b)); } } return ($b == 1) ? $k : 0; } sub _binomialu { my($r, $n, $k) = (1, @_); return ($k == $n) ? 1 : 0 if $k >= $n; $k = $n - $k if $k > ($n >> 1); foreach my $d (1 .. $k) { if ($r >= int(~0/$n)) { my($g, $nr, $dr); $g = _gcd_ui($n, $d); $nr = int($n/$g); $dr = int($d/$g); $g = _gcd_ui($r, $dr); $r = int($r/$g); $dr = int($dr/$g); return 0 if $r >= int(~0/$nr); $r *= $nr; $r = int($r/$dr); } else { $r *= $n; $r = int($r/$d); } $n--; } $r; } sub binomial { my($n, $k) = @_; # 1. Try GMP return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::binomial($n,$k)) if $Math::Prime::Util::_GMPfunc{"binomial"}; # 2. Exit early for known 0 cases, and adjust k to be positive. if ($n >= 0) { return 0 if $k < 0 || $k > $n; } else { return 0 if $k < 0 && $k > $n; } $k = $n - $k if $k < 0; # 3. Try to do in integer Perl my $r; if ($n >= 0) { $r = _binomialu($n, $k); return $r if $r > 0; } else { $r = _binomialu(-$n+$k-1, $k); return $r if $r > 0 && !($k & 1); return -$r if $r > 0 && $r <= (~0>>1); } # 4. Overflow. Solve using Math::BigInt return 1 if $k == 0; # Work around bug in old return $n if $k == $n-1; # Math::BigInt (fixed in 1.90) if ($n >= 0) { $r = Math::BigInt->new(''.$n)->bnok($k); $r = _bigint_to_int($r) if $r->bacmp(BMAX) <= 0; } else { # Math::BigInt is incorrect for negative n $r = Math::BigInt->new(''.(-$n+$k-1))->bnok($k); if ($k & 1) { $r->bneg; $r = _bigint_to_int($r) if $r->bacmp(''.(~0>>1)) <= 0; } else { $r = _bigint_to_int($r) if $r->bacmp(BMAX) <= 0; } } $r; } sub _product { my($a, $b, $r) = @_; if ($b <= $a) { $r->[$a]; } elsif ($b == $a+1) { $r->[$a] -> bmul( $r->[$b] ); } elsif ($b == $a+2) { $r->[$a] -> bmul( $r->[$a+1] ) -> bmul( $r->[$a+2] ); } else { my $c = $a + (($b-$a+1)>>1); _product($a, $c-1, $r); _product($c, $b, $r); $r->[$a] -> bmul( $r->[$c] ); } } sub factorial { my($n) = @_; return (1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800,479001600)[$n] if $n <= 12; return Math::GMP::bfac($n) if ref($n) eq 'Math::GMP'; do { my $r = Math::GMPz->new(); Math::GMPz::Rmpz_fac_ui($r,$n); return $r; } if ref($n) eq 'Math::GMPz'; if (Math::BigInt->config()->{lib} !~ /GMP|Pari/) { # It's not a GMP or GMPz object, and we have a slow bigint library. my $r; if (defined $Math::GMPz::VERSION) { $r = Math::GMPz->new(); Math::GMPz::Rmpz_fac_ui($r,$n); } elsif (defined $Math::GMP::VERSION) { $r = Math::GMP::bfac($n); } elsif (defined &Math::Prime::Util::GMP::factorial && Math::Prime::Util::prime_get_config()->{'gmp'}) { $r = Math::Prime::Util::GMP::factorial($n); } return Math::Prime::Util::_reftyped($_[0], $r) if defined $r; } my $r = Math::BigInt->new($n)->bfac(); $r = _bigint_to_int($r) if $r->bacmp(BMAX) <= 0; $r; } sub factorialmod { my($n,$m) = @_; return Math::Prime::Util::GMP::factorialmod($n,$m) if $Math::Prime::Util::_GMPfunc{"factorialmod"}; return 0 if $n >= $m || $m == 1; if ($n > 10) { my($s,$t,$e) = (1); Math::Prime::Util::forprimes( sub { ($t,$e) = ($n,0); while ($t > 0) { $t = int($t/$_); $e += $t; } $s = Math::Prime::Util::mulmod($s, Math::Prime::Util::powmod($_,$e,$m), $m); }, 2, $n >> 1); Math::Prime::Util::forprimes( sub { $s = Math::Prime::Util::mulmod($s, $_, $m); }, ($n >> 1)+1, $n); return $s; } return factorial($n) % $m; } sub _is_perfect_square { my($n) = @_; return (1,1,0,0,1)[$n] if $n <= 4; if (ref($n) eq 'Math::BigInt') { my $mc = _bigint_to_int($n & 31); if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) { my $sq = $n->copy->bsqrt->bfloor; $sq->bmul($sq); return 1 if $sq == $n; } } else { my $mc = $n & 31; if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) { my $sq = int(sqrt($n)); return 1 if ($sq*$sq) == $n; } } 0; } sub is_primitive_root { my($a, $n) = @_; $n = -$n if $n < 0; # Ignore sign of n return ($n==1) ? 1 : 0 if $n <= 1; $a %= $n if $a < 0 || $a >= $n; return Math::Prime::Util::GMP::is_primitive_root($a,$n) if $Math::Prime::Util::_GMPfunc{"is_primitive_root"}; if ($Math::Prime::Util::_GMPfunc{"znorder"} && $Math::Prime::Util::_GMPfunc{"totient"}) { my $order = Math::Prime::Util::GMP::znorder($a,$n); return 0 unless defined $order; my $totient = Math::Prime::Util::GMP::totient($n); return ($order eq $totient) ? 1 : 0; } return 0 if Math::Prime::Util::gcd($a, $n) != 1; my $s = Math::Prime::Util::euler_phi($n); return 0 if ($s % 2) == 0 && Math::Prime::Util::powmod($a, $s/2, $n) == 1; return 0 if ($s % 3) == 0 && Math::Prime::Util::powmod($a, $s/3, $n) == 1; return 0 if ($s % 5) == 0 && Math::Prime::Util::powmod($a, $s/5, $n) == 1; foreach my $f (Math::Prime::Util::factor_exp($s)) { my $fp = $f->[0]; return 0 if $fp > 5 && Math::Prime::Util::powmod($a, $s/$fp, $n) == 1; } 1; } sub znorder { my($a, $n) = @_; return if $n <= 0; return 1 if $n == 1; return if $a <= 0; return 1 if $a == 1; return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::znorder($a,$n)) if $Math::Prime::Util::_GMPfunc{"znorder"}; # Sadly, Calc/FastCalc are horrendously slow for this function. return if Math::Prime::Util::gcd($a, $n) > 1; # The answer is one of the divisors of phi(n) and lambda(n). my $lambda = Math::Prime::Util::carmichael_lambda($n); $a = Math::BigInt->new("$a") unless ref($a) eq 'Math::BigInt'; # This is easy and usually fast, but can bog down with too many divisors. if ($lambda <= 2**64) { foreach my $k (Math::Prime::Util::divisors($lambda)) { return $k if Math::Prime::Util::powmod($a,$k,$n) == 1; } return; } # Algorithm 1.7 from A. Das applied to Carmichael Lambda. $lambda = Math::BigInt->new("$lambda") unless ref($lambda) eq 'Math::BigInt'; my $k = Math::BigInt->bone; foreach my $f (Math::Prime::Util::factor_exp($lambda)) { my($pi, $ei, $enum) = (Math::BigInt->new("$f->[0]"), $f->[1], 0); my $phidiv = $lambda / ($pi**$ei); my $b = Math::Prime::Util::powmod($a,$phidiv,$n); while ($b != 1) { return if $enum++ >= $ei; $b = Math::Prime::Util::powmod($b,$pi,$n); $k *= $pi; } } $k = _bigint_to_int($k) if $k->bacmp(BMAX) <= 0; return $k; } sub _dlp_trial { my ($a,$g,$p,$limit) = @_; $limit = $p if !defined $limit || $limit > $p; my $t = $g->copy; if ($limit < 1_000_000_000) { for my $k (1 .. $limit) { return $k if $t == $a; $t = Math::Prime::Util::mulmod($t, $g, $p); } return 0; } for (my $k = BONE->copy; $k < $limit; $k->binc) { if ($t == $a) { $k = _bigint_to_int($k) if $k->bacmp(BMAX) <= 0; return $k; } $t->bmul($g)->bmod($p); } 0; } sub _dlp_bsgs { my ($a,$g,$p,$n,$_verbose) = @_; my $invg = invmod($g, $p); return unless defined $invg; my $maxm = Math::Prime::Util::sqrtint($n)+1; my $b = ($p + $maxm - 1) / $maxm; # Limit for time and space. $b = ($b > 4_000_000) ? 4_000_000 : int("$b"); $maxm = ($maxm > $b) ? $b : int("$maxm"); my %hash; my $am = BONE->copy; my $gm = Math::Prime::Util::powmod($invg, $maxm, $p); my $key = $a->copy; my $r; foreach my $m (0 .. $b) { # Baby Step if ($m <= $maxm) { $r = $hash{"$am"}; if (defined $r) { print " bsgs found in stage 1 after $m tries\n" if $_verbose; $r = Math::Prime::Util::addmod($m, Math::Prime::Util::mulmod($r,$maxm,$p), $p); return $r; } $hash{"$am"} = $m; $am = Math::Prime::Util::mulmod($am,$g,$p); if ($am == $a) { print " bsgs found during bs\n" if $_verbose; return $m+1; } } # Giant Step $r = $hash{"$key"}; if (defined $r) { print " bsgs found in stage 2 after $m tries\n" if $_verbose; $r = Math::Prime::Util::addmod($r, Math::Prime::Util::mulmod($m,$maxm,$p), $p); return $r; } $hash{"$key"} = $m if $m <= $maxm; $key = Math::Prime::Util::mulmod($key,$gm,$p); } 0; } sub znlog { my ($a,$g,$p) = map { ref($_) eq 'Math::BigInt' ? $_ : Math::BigInt->new("$_") } @_; $a->bmod($p); $g->bmod($p); return 0 if $a == 1 || $g == 0 || $p < 2; my $_verbose = Math::Prime::Util::prime_get_config()->{'verbose'}; # For large p, znorder can be very slow. Do trial test first. my $x = _dlp_trial($a, $g, $p, 200); if ($x == 0) { my $n = znorder($g, $p); if (defined $n && $n > 1000) { $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; $x = _dlp_bsgs($a, $g, $p, $n, $_verbose); $x = _bigint_to_int($x) if ref($x) && $x->bacmp(BMAX) <= 0; return $x if $x > 0 && $g->copy->bmodpow($x, $p) == $a; print " BSGS giving up\n" if $x == 0 && $_verbose; print " BSGS incorrect answer $x\n" if $x > 0 && $_verbose > 1; } $x = _dlp_trial($a,$g,$p); } $x = _bigint_to_int($x) if ref($x) && $x->bacmp(BMAX) <= 0; return ($x == 0) ? undef : $x; } sub znprimroot { my($n) = @_; $n = -$n if $n < 0; if ($n <= 4) { return if $n == 0; return $n-1; } return if $n % 4 == 0; my $a = 1; my $phi = $n-1; if (!is_prob_prime($n)) { $phi = euler_phi($n); # Check that a primitive root exists. return if $phi != Math::Prime::Util::carmichael_lambda($n); } my @exp = map { Math::BigInt->new("$_") } map { int($phi/$_->[0]) } Math::Prime::Util::factor_exp($phi); #print "phi: $phi factors: ", join(",",factor($phi)), "\n"; #print " exponents: ", join(",", @exp), "\n"; while (1) { my $fail = 0; do { $a++ } while Math::Prime::Util::kronecker($a,$n) == 0; return if $a >= $n; foreach my $f (@exp) { if (Math::Prime::Util::powmod($a,$f,$n) == 1) { $fail = 1; last; } } return $a if !$fail; } } # Find first D in sequence (5,-7,9,-11,13,-15,...) where (D|N) == -1 sub _lucas_selfridge_params { my($n) = @_; # D is typically quite small: 67 max for N < 10^19. However, it is # theoretically possible D could grow unreasonably. I'm giving up at 4000M. my $d = 5; my $sign = 1; while (1) { my $gcd = (ref($n) eq 'Math::BigInt') ? Math::BigInt::bgcd($d, $n) : _gcd_ui($d, $n); return (0,0,0) if $gcd > 1 && $gcd != $n; # Found divisor $d my $j = kronecker($d * $sign, $n); last if $j == -1; $d += 2; croak "Could not find Jacobi sequence for $n" if $d > 4_000_000_000; $sign = -$sign; } my $D = $sign * $d; my $P = 1; my $Q = int( (1 - $D) / 4 ); ($P, $Q, $D) } sub _lucas_extrastrong_params { my($n, $increment) = @_; $increment = 1 unless defined $increment; my ($P, $Q, $D) = (3, 1, 5); while (1) { my $gcd = (ref($n) eq 'Math::BigInt') ? Math::BigInt::bgcd($D, $n) : _gcd_ui($D, $n); return (0,0,0) if $gcd > 1 && $gcd != $n; # Found divisor $d last if kronecker($D, $n) == -1; $P += $increment; croak "Could not find Jacobi sequence for $n" if $P > 65535; $D = $P*$P - 4; } ($P, $Q, $D); } # returns U_k, V_k, Q_k all mod n sub lucas_sequence { my($n, $P, $Q, $k) = @_; croak "lucas_sequence: n must be >= 2" if $n < 2; croak "lucas_sequence: k must be >= 0" if $k < 0; croak "lucas_sequence: P out of range" if abs($P) >= $n; croak "lucas_sequence: Q out of range" if abs($Q) >= $n; if ($Math::Prime::Util::_GMPfunc{"lucas_sequence"} && $Math::Prime::Util::GMP::VERSION >= 0.30) { return map { ($_ > ''.~0) ? Math::BigInt->new(''.$_) : $_ } Math::Prime::Util::GMP::lucas_sequence($n, $P, $Q, $k); } $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my $ZERO = $n->copy->bzero; $P = $ZERO+$P unless ref($P) eq 'Math::BigInt'; $Q = $ZERO+$Q unless ref($Q) eq 'Math::BigInt'; my $D = $P*$P - BTWO*BTWO*$Q; if ($D->is_zero) { my $S = ($ZERO+$P) >> 1; my $U = $S->copy->bmodpow($k-1,$n)->bmul($k)->bmod($n); my $V = $S->copy->bmodpow($k,$n)->bmul(BTWO)->bmod($n); my $Qk = ($ZERO+$Q)->bmodpow($k, $n); return ($U, $V, $Qk); } my $U = BONE->copy; my $V = $P->copy; my $Qk = $Q->copy; return (BZERO->copy, BTWO->copy, $Qk) if $k == 0; $k = Math::BigInt->new("$k") unless ref($k) eq 'Math::BigInt'; my $kstr = substr($k->as_bin, 2); my $bpos = 0; if (($n % 2)==0) { $P->bmod($n); $Q->bmod($n); my($Uh,$Vl, $Vh, $Ql, $Qh) = (BONE->copy, BTWO->copy, $P->copy, BONE->copy, BONE->copy); my ($b,$s) = (length($kstr)-1, 0); if ($kstr =~ /(0+)$/) { $s = length($1); } for my $bpos (0 .. $b-$s-1) { $Ql->bmul($Qh)->bmod($n); if (substr($kstr,$bpos,1)) { $Qh = $Ql * $Q; $Uh->bmul($Vh)->bmod($n); $Vl->bmul($Vh)->bsub($P * $Ql)->bmod($n); $Vh->bmul($Vh)->bsub(BTWO * $Qh)->bmod($n); } else { $Qh = $Ql->copy; $Uh->bmul($Vl)->bsub($Ql)->bmod($n); $Vh->bmul($Vl)->bsub($P * $Ql)->bmod($n); $Vl->bmul($Vl)->bsub(BTWO * $Ql)->bmod($n); } } $Ql->bmul($Qh); $Qh = $Ql * $Q; $Uh->bmul($Vl)->bsub($Ql)->bmod($n); $Vl->bmul($Vh)->bsub($P * $Ql)->bmod($n); $Ql->bmul($Qh)->bmod($n); for (1 .. $s) { $Uh->bmul($Vl)->bmod($n); $Vl->bmul($Vl)->bsub(BTWO * $Ql)->bmod($n); $Ql->bmul($Ql)->bmod($n); } ($U, $V, $Qk) = ($Uh, $Vl, $Ql); } elsif ($Q->is_one) { my $Dinverse = $D->copy->bmodinv($n); if ($P > BTWO && !$Dinverse->is_nan) { # Calculate V_k with U=V_{k+1} $U = $P->copy->bmul($P)->bsub(BTWO)->bmod($n); while (++$bpos < length($kstr)) { if (substr($kstr,$bpos,1)) { $V->bmul($U)->bsub($P )->bmod($n); $U->bmul($U)->bsub(BTWO)->bmod($n); } else { $U->bmul($V)->bsub($P )->bmod($n); $V->bmul($V)->bsub(BTWO)->bmod($n); } } # Crandall and Pomerance eq 3.13: U_n = D^-1 (2V_{n+1} - PV_n) $U = $Dinverse * (BTWO*$U - $P*$V); } else { while (++$bpos < length($kstr)) { $U->bmul($V)->bmod($n); $V->bmul($V)->bsub(BTWO)->bmod($n); if (substr($kstr,$bpos,1)) { my $T1 = $U->copy->bmul($D); $U->bmul($P)->badd( $V); $U->badd($n) if $U->is_odd; $U->brsft(BONE); $V->bmul($P)->badd($T1); $V->badd($n) if $V->is_odd; $V->brsft(BONE); } } } } else { my $qsign = ($Q == -1) ? -1 : 0; while (++$bpos < length($kstr)) { $U->bmul($V)->bmod($n); if ($qsign == 1) { $V->bmul($V)->bsub(BTWO)->bmod($n); } elsif ($qsign == -1) { $V->bmul($V)->badd(BTWO)->bmod($n); } else { $V->bmul($V)->bsub($Qk->copy->blsft(BONE))->bmod($n); } if (substr($kstr,$bpos,1)) { my $T1 = $U->copy->bmul($D); $U->bmul($P)->badd( $V); $U->badd($n) if $U->is_odd; $U->brsft(BONE); $V->bmul($P)->badd($T1); $V->badd($n) if $V->is_odd; $V->brsft(BONE); if ($qsign != 0) { $qsign = -1; } else { $Qk->bmul($Qk)->bmul($Q)->bmod($n); } } else { if ($qsign != 0) { $qsign = 1; } else { $Qk->bmul($Qk)->bmod($n); } } } if ($qsign == 1) { $Qk->bneg; } elsif ($qsign == -1) { $Qk = $n->copy->bdec; } } $U->bmod($n); $V->bmod($n); return ($U, $V, $Qk); } sub _lucasuv { my($P, $Q, $k) = @_; croak "lucas_sequence: k must be >= 0" if $k < 0; return (0,2) if $k == 0; $P = Math::BigInt->new("$P") unless ref($P) eq 'Math::BigInt'; $Q = Math::BigInt->new("$Q") unless ref($Q) eq 'Math::BigInt'; # Simple way, very slow as k increases: #my($U0, $U1) = (BZERO->copy, BONE->copy); #my($V0, $V1) = (BTWO->copy, Math::BigInt->new("$P")); #for (2 .. $k) { # ($U0,$U1) = ($U1, $P*$U1 - $Q*$U0); # ($V0,$V1) = ($V1, $P*$V1 - $Q*$V0); #} #return ($U1, $V1); my($Uh,$Vl, $Vh, $Ql, $Qh) = (BONE->copy, BTWO->copy, $P->copy, BONE->copy, BONE->copy); $k = Math::BigInt->new("$k") unless ref($k) eq 'Math::BigInt'; my $kstr = substr($k->as_bin, 2); my ($n,$s) = (length($kstr)-1, 0); if ($kstr =~ /(0+)$/) { $s = length($1); } if ($Q == -1) { # This could be simplified, and it's running 10x slower than it should. my ($ql,$qh) = (1,1); for my $bpos (0 .. $n-$s-1) { $ql *= $qh; if (substr($kstr,$bpos,1)) { $qh = -$ql; $Uh->bmul($Vh); if ($ql == 1) { $Vl->bmul($Vh)->bsub( $P ); $Vh->bmul($Vh)->badd( BTWO ); } else { $Vl->bmul($Vh)->badd( $P ); $Vh->bmul($Vh)->bsub( BTWO ); } } else { $qh = $ql; if ($ql == 1) { $Uh->bmul($Vl)->bdec; $Vh->bmul($Vl)->bsub($P); $Vl->bmul($Vl)->bsub(BTWO); } else { $Uh->bmul($Vl)->binc; $Vh->bmul($Vl)->badd($P); $Vl->bmul($Vl)->badd(BTWO); } } } $ql *= $qh; $qh = -$ql; if ($ql == 1) { $Uh->bmul($Vl)->bdec; $Vl->bmul($Vh)->bsub($P); } else { $Uh->bmul($Vl)->binc; $Vl->bmul($Vh)->badd($P); } $ql *= $qh; for (1 .. $s) { $Uh->bmul($Vl); if ($ql == 1) { $Vl->bmul($Vl)->bsub(BTWO); $ql *= $ql; } else { $Vl->bmul($Vl)->badd(BTWO); $ql *= $ql; } } return map { ($_ > ''.~0) ? Math::BigInt->new(''.$_) : $_ } ($Uh, $Vl); } for my $bpos (0 .. $n-$s-1) { $Ql->bmul($Qh); if (substr($kstr,$bpos,1)) { $Qh = $Ql * $Q; #$Uh = $Uh * $Vh; #$Vl = $Vh * $Vl - $P * $Ql; #$Vh = $Vh * $Vh - BTWO * $Qh; $Uh->bmul($Vh); $Vl->bmul($Vh)->bsub($P * $Ql); $Vh->bmul($Vh)->bsub(BTWO * $Qh); } else { $Qh = $Ql->copy; #$Uh = $Uh * $Vl - $Ql; #$Vh = $Vh * $Vl - $P * $Ql; #$Vl = $Vl * $Vl - BTWO * $Ql; $Uh->bmul($Vl)->bsub($Ql); $Vh->bmul($Vl)->bsub($P * $Ql); $Vl->bmul($Vl)->bsub(BTWO * $Ql); } } $Ql->bmul($Qh); $Qh = $Ql * $Q; $Uh->bmul($Vl)->bsub($Ql); $Vl->bmul($Vh)->bsub($P * $Ql); $Ql->bmul($Qh); for (1 .. $s) { $Uh->bmul($Vl); $Vl->bmul($Vl)->bsub(BTWO * $Ql); $Ql->bmul($Ql); } return map { ($_ > ''.~0) ? Math::BigInt->new(''.$_) : $_ } ($Uh, $Vl, $Ql); } sub lucasu { (_lucasuv(@_))[0] } sub lucasv { (_lucasuv(@_))[1] } sub is_lucas_pseudoprime { my($n) = @_; return 0+($n >= 2) if $n < 4; return 0 if ($n % 2) == 0 || _is_perfect_square($n); my ($P, $Q, $D) = _lucas_selfridge_params($n); return 0 if $D == 0; # We found a divisor in the sequence die "Lucas parameter error: $D, $P, $Q\n" if ($D != $P*$P - 4*$Q); my($U, $V, $Qk) = lucas_sequence($n, $P, $Q, $n+1); return ($U == 0) ? 1 : 0; } sub is_strong_lucas_pseudoprime { my($n) = @_; return 0+($n >= 2) if $n < 4; return 0 if ($n % 2) == 0 || _is_perfect_square($n); my ($P, $Q, $D) = _lucas_selfridge_params($n); return 0 if $D == 0; # We found a divisor in the sequence die "Lucas parameter error: $D, $P, $Q\n" if ($D != $P*$P - 4*$Q); my $m = $n+1; my($s, $k) = (0, $m); while ( $k > 0 && !($k % 2) ) { $s++; $k >>= 1; } my($U, $V, $Qk) = lucas_sequence($n, $P, $Q, $k); return 1 if $U == 0; $V = Math::BigInt->new("$V") unless ref($V) eq 'Math::BigInt'; $Qk = Math::BigInt->new("$Qk") unless ref($Qk) eq 'Math::BigInt'; foreach my $r (0 .. $s-1) { return 1 if $V->is_zero; if ($r < ($s-1)) { $V->bmul($V)->bsub(BTWO*$Qk)->bmod($n); $Qk->bmul($Qk)->bmod($n); } } return 0; } sub is_extra_strong_lucas_pseudoprime { my($n) = @_; return 0+($n >= 2) if $n < 4; return 0 if ($n % 2) == 0 || _is_perfect_square($n); my ($P, $Q, $D) = _lucas_extrastrong_params($n); return 0 if $D == 0; # We found a divisor in the sequence die "Lucas parameter error: $D, $P, $Q\n" if ($D != $P*$P - 4*$Q); # We have to convert n to a bigint or Math::BigInt::GMP's stupid set_si bug # (RT 71548) will hit us and make the test $V == $n-2 always return false. $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my($s, $k) = (0, $n->copy->binc); while ($k->is_even && !$k->is_zero) { $s++; $k->brsft(BONE); } my($U, $V, $Qk) = lucas_sequence($n, $P, $Q, $k); $V = Math::BigInt->new("$V") unless ref($V) eq 'Math::BigInt'; return 1 if $U == 0 && ($V == BTWO || $V == ($n - BTWO)); foreach my $r (0 .. $s-2) { return 1 if $V->is_zero; $V->bmul($V)->bsub(BTWO)->bmod($n); } return 0; } sub is_almost_extra_strong_lucas_pseudoprime { my($n, $increment) = @_; $increment = 1 unless defined $increment; return 0+($n >= 2) if $n < 4; return 0 if ($n % 2) == 0 || _is_perfect_square($n); my ($P, $Q, $D) = _lucas_extrastrong_params($n, $increment); return 0 if $D == 0; # We found a divisor in the sequence die "Lucas parameter error: $D, $P, $Q\n" if ($D != $P*$P - 4*$Q); $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my $ZERO = $n->copy->bzero; my $TWO = $ZERO->copy->binc->binc; my $V = $ZERO + $P; # V_{k} my $W = $ZERO + $P*$P-$TWO; # V_{k+1} my $kstr = substr($n->copy->binc()->as_bin, 2); $kstr =~ s/(0*)$//; my $s = length($1); my $bpos = 0; while (++$bpos < length($kstr)) { if (substr($kstr,$bpos,1)) { $V->bmul($W)->bsub($P )->bmod($n); $W->bmul($W)->bsub($TWO)->bmod($n); } else { $W->bmul($V)->bsub($P )->bmod($n); $V->bmul($V)->bsub($TWO)->bmod($n); } } return 1 if $V == 2 || $V == ($n-$TWO); foreach my $r (0 .. $s-2) { return 1 if $V->is_zero; $V->bmul($V)->bsub($TWO)->bmod($n); } return 0; } sub is_frobenius_khashin_pseudoprime { my($n) = @_; return 0+($n >= 2) if $n < 4; return 0 unless $n % 2; return 0 if _is_perfect_square($n); $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my($k,$c) = (2,1); if ($n % 4 == 3) { $c = $n-1; } elsif ($n % 8 == 5) { $c = 2; } else { do { $c += 2; $k = kronecker($c, $n); } while $k == 1; } return 0 if $k == 0 || ($k == 2 && !($n % 3));; my $ea = ($k == 2) ? 2 : 1; my($ra,$rb,$a,$b,$d) = ($ea,1,$ea,1,$n-1); while (!$d->is_zero) { if ($d->is_odd()) { ($ra, $rb) = ( (($ra*$a)%$n + ((($rb*$b)%$n)*$c)%$n) % $n, (($rb*$a)%$n + ($ra*$b)%$n) % $n ); } $d >>= 1; if (!$d->is_zero) { ($a, $b) = ( (($a*$a)%$n + ((($b*$b)%$n)*$c)%$n) % $n, (($b*$a)%$n + ($a*$b)%$n) % $n ); } } return ($ra == $ea && $rb == $n-1) ? 1 : 0; } sub is_frobenius_underwood_pseudoprime { my($n) = @_; return 0+($n >= 2) if $n < 4; return 0 unless $n % 2; my($a, $temp1, $temp2); if ($n % 4 == 3) { $a = 0; } else { for ($a = 1; $a < 1000000; $a++) { next if $a==2 || $a==4 || $a==7 || $a==8 || $a==10 || $a==14 || $a==16 || $a==18; my $j = kronecker($a*$a - 4, $n); last if $j == -1; return 0 if $j == 0 || ($a == 20 && _is_perfect_square($n)); } } $temp1 = Math::Prime::Util::gcd(($a+4)*(2*$a+5), $n); return 0 if $temp1 != 1 && $temp1 != $n; $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my $ZERO = $n->copy->bzero; my $ONE = $ZERO->copy->binc; my $TWO = $ONE->copy->binc; my($s, $t) = ($ONE->copy, $TWO->copy); my $ap2 = $TWO + $a; my $np1string = substr( $n->copy->binc->as_bin, 2); my $np1len = length($np1string); foreach my $bit (1 .. $np1len-1) { $temp2 = $t+$t; $temp2 += ($s * $a) if $a != 0; $temp1 = $temp2 * $s; $temp2 = $t - $s; $s += $t; $t = ($s * $temp2) % $n; $s = $temp1 % $n; if ( substr( $np1string, $bit, 1 ) ) { if ($a == 0) { $temp1 = $s + $s; } else { $temp1 = $s * $ap2; } $temp1 += $t; $t->badd($t)->bsub($s); # $t = ($t+$t) - $s; $s = $temp1; } } $temp1 = (2*$a+5) % $n; return ($s == 0 && $t == $temp1) ? 1 : 0; } sub _perrin_signature { my($n) = @_; my @S = (1,$n-1,3, 3,0,2); return @S if $n <= 1; my @nbin = todigits($n,2); shift @nbin; while (@nbin) { my @T = map { addmod(addmod(Math::Prime::Util::mulmod($S[$_],$S[$_],$n), $n-$S[5-$_],$n), $n-$S[5-$_],$n); } 0..5; my $T01 = addmod($T[2], $n-$T[1], $n); my $T34 = addmod($T[5], $n-$T[4], $n); my $T45 = addmod($T34, $T[3], $n); if (shift @nbin) { @S = ($T[0], $T01, $T[1], $T[4], $T45, $T[5]); } else { @S = ($T01, $T[1], addmod($T01,$T[0],$n), $T34, $T[4], $T45); } } @S; } sub is_perrin_pseudoprime { my($n, $restrict) = @_; $restrict = 0 unless defined $restrict; return 0+($n >= 2) if $n < 4; return 0 if $restrict > 2 && ($n % 2) == 0; $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my @S = _perrin_signature($n); return 0 unless $S[4] == 0; return 1 if $restrict == 0; return 0 unless $S[1] == $n-1; return 1 if $restrict == 1; my $j = kronecker(-23,$n); if ($j == -1) { my $B = $S[2]; my $B2 = mulmod($B,$B,$n); my $A = addmod(addmod(1,mulmod(3,$B,$n),$n),$n-$B2,$n); my $C = addmod(mulmod(3,$B2,$n),$n-2,$n); return 1 if $S[0] == $A && $S[2] == $B && $S[3] == $B && $S[5] == $C && $B != 3 && addmod(mulmod($B2,$B,$n),$n-$B,$n) == 1; } else { return 0 if $j == 0 && $n != 23 && $restrict > 2; return 1 if $S[0] == 1 && $S[2] == 3 && $S[3] == 3 && $S[5] == 2; return 1 if $S[0] == 0 && $S[5] == $n-1 && $S[2] != $S[3] && addmod($S[2],$S[3],$n) == $n-3 && mulmod(addmod($S[2],$n-$S[3],$n),addmod($S[2],$n-$S[3],$n),$n) == $n-(23%$n); } 0; } sub is_catalan_pseudoprime { my($n) = @_; return 0+($n >= 2) if $n < 4; my $m = ($n-1)>>1; return (binomial($m<<1,$m) % $n) == (($m&1) ? $n-1 : 1) ? 1 : 0; } sub is_frobenius_pseudoprime { my($n, $P, $Q) = @_; ($P,$Q) = (0,0) unless defined $P && defined $Q; return 0+($n >= 2) if $n < 4; $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; return 0 if $n->is_even; my($k, $Vcomp, $D, $Du) = (0, 4); if ($P == 0 && $Q == 0) { ($P,$Q) = (-1,2); while ($k != -1) { $P += 2; $P = 5 if $P == 3; # Skip 3 $D = $P*$P-4*$Q; $Du = ($D >= 0) ? $D : -$D; last if $P >= $n || $Du >= $n; # TODO: remove? $k = kronecker($D, $n); return 0 if $k == 0; return 0 if $P == 10001 && _is_perfect_square($n); } } else { $D = $P*$P-4*$Q; $Du = ($D >= 0) ? $D : -$D; croak "Frobenius invalid P,Q: ($P,$Q)" if _is_perfect_square($Du); } return (is_prime($n) ? 1 : 0) if $n <= $Du || $n <= abs($Q) || $n <= abs($P); return 0 if Math::Prime::Util::gcd(abs($P*$Q*$D), $n) > 1; if ($k == 0) { $k = kronecker($D, $n); return 0 if $k == 0; my $Q2 = (2*abs($Q)) % $n; $Vcomp = ($k == 1) ? 2 : ($Q >= 0) ? $Q2 : $n-$Q2; } my($U, $V, $Qk) = lucas_sequence($n, $P, $Q, $n-$k); return 1 if $U == 0 && $V == $Vcomp; 0; } # Since people have graciously donated millions of CPU years to doing these # tests, it would be rude of us not to use the results. This means we don't # actually use the pretest and Lucas-Lehmer test coded below for any reasonable # size number. # See: http://www.mersenne.org/report_milestones/ my %_mersenne_primes; undef @_mersenne_primes{2,3,5,7,13,17,19,31,61,89,107,127,521,607,1279,2203,2281,3217,4253,4423,9689,9941,11213,19937,21701,23209,44497,86243,110503,132049,216091,756839,859433,1257787,1398269,2976221,3021377,6972593,13466917,20996011,24036583,25964951,30402457,32582657,37156667,42643801,43112609,57885161,74207281}; sub is_mersenne_prime { my $p = shift; # Use the known Mersenne primes return 1 if exists $_mersenne_primes{$p}; return 0 if $p < 34007399; # GIMPS has checked all below # Past this we do a generic Mersenne prime test return 1 if $p == 2; return 0 unless is_prob_prime($p); return 0 if $p > 3 && $p % 4 == 3 && $p < ((~0)>>1) && is_prob_prime($p*2+1); my $mp = BONE->copy->blsft($p)->bdec; # Definitely faster than using Math::BigInt that doesn't have GMP. return (0 == (Math::Prime::Util::GMP::lucas_sequence($mp, 4, 1, $mp+1))[0]) if $Math::Prime::Util::_GMPfunc{"lucas_sequence"}; my $V = Math::BigInt->new(4); for my $k (3 .. $p) { $V->bmul($V)->bsub(BTWO)->bmod($mp); } return $V->is_zero; } my $_poly_bignum; sub _poly_new { my @poly = @_; push @poly, 0 unless scalar @poly; if ($_poly_bignum) { @poly = map { (ref $_ eq 'Math::BigInt') ? $_->copy : Math::BigInt->new("$_"); } @poly; } return \@poly; } #sub _poly_print { # my($poly) = @_; # carp "poly has null top degree" if $#$poly > 0 && !$poly->[-1]; # foreach my $d (reverse 1 .. $#$poly) { # my $coef = $poly->[$d]; # print "", ($coef != 1) ? $coef : "", ($d > 1) ? "x^$d" : "x", " + " # if $coef; # } # my $p0 = $poly->[0] || 0; # print "$p0\n"; #} sub _poly_mod_mul { my($px, $py, $r, $n) = @_; my $px_degree = $#$px; my $py_degree = $#$py; my @res = map { $_poly_bignum ? Math::BigInt->bzero : 0 } 0 .. $r-1; # convolve(px, py) mod (X^r-1,n) my @indices_y = grep { $py->[$_] } (0 .. $py_degree); foreach my $ix (0 .. $px_degree) { my $px_at_ix = $px->[$ix]; next unless $px_at_ix; if ($_poly_bignum) { foreach my $iy (@indices_y) { my $rindex = ($ix + $iy) % $r; # reduce mod X^r-1 $res[$rindex]->badd($px_at_ix->copy->bmul($py->[$iy]))->bmod($n); } } else { foreach my $iy (@indices_y) { my $rindex = ($ix + $iy) % $r; # reduce mod X^r-1 $res[$rindex] = ($res[$rindex] + $px_at_ix * $py->[$iy]) % $n; } } } # In case we had upper terms go to zero after modulo, reduce the degree. pop @res while !$res[-1]; return \@res; } sub _poly_mod_pow { my($pn, $power, $r, $mod) = @_; my $res = _poly_new(1); my $p = $power; while ($p) { $res = _poly_mod_mul($res, $pn, $r, $mod) if ($p & 1); $p >>= 1; $pn = _poly_mod_mul($pn, $pn, $r, $mod) if $p; } return $res; } sub _test_anr { my($a, $n, $r) = @_; my $pp = _poly_mod_pow(_poly_new($a, 1), $n, $r, $n); $pp->[$n % $r] = (($pp->[$n % $r] || 0) - 1) % $n; # subtract X^(n%r) $pp->[ 0] = (($pp->[ 0] || 0) - $a) % $n; # subtract a return 0 if scalar grep { $_ } @$pp; 1; } sub is_aks_prime { my $n = shift; return 0 if $n < 2 || is_power($n); my($log2n, $limit); if ($n > 2**48) { do { require Math::BigFloat; Math::BigFloat->import(); } if !defined $Math::BigFloat::VERSION; # limit = floor( log2(n) * log2(n) ). o_r(n) must be larger than this my $floatn = Math::BigFloat->new("$n"); #my $sqrtn = _bigint_to_int($floatn->copy->bsqrt->bfloor); # The following line seems to trigger a memory leak in Math::BigFloat::blog # (the part where $MBI is copied to $int) if $n is a Math::BigInt::GMP. $log2n = $floatn->copy->blog(2); $limit = _bigint_to_int( ($log2n * $log2n)->bfloor ); } else { $log2n = log($n)/log(2) + 0.0001; # Error on large side. $limit = int( $log2n*$log2n + 0.0001 ); } my $r = next_prime($limit); foreach my $f (@{primes(0,$r-1)}) { return 1 if $f == $n; return 0 if !($n % $f); } while ($r < $n) { return 0 if !($n % $r); #return 1 if $r >= $sqrtn; last if znorder($n, $r) > $limit; # Note the arguments! $r = next_prime($r); } return 1 if $r >= $n; # Since r is a prime, phi(r) = r-1 my $rlimit = (ref($log2n) eq 'Math::BigFloat') ? _bigint_to_int( Math::BigFloat->new("$r")->bdec() ->bsqrt->bmul($log2n)->bfloor) : int( (sqrt(($r-1)) * $log2n) + 0.001 ); $_poly_bignum = 1; if ( $n < (MPU_HALFWORD-1) ) { $_poly_bignum = 0; #$n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt'; } else { $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; } my $_verbose = Math::Prime::Util::prime_get_config()->{'verbose'}; print "# aks r = $r s = $rlimit\n" if $_verbose; local $| = 1 if $_verbose > 1; for (my $a = 1; $a <= $rlimit; $a++) { return 0 unless _test_anr($a, $n, $r); print "." if $_verbose > 1; } print "\n" if $_verbose > 1; return 1; } sub _basic_factor { # MODIFIES INPUT SCALAR return ($_[0] == 1) ? () : ($_[0]) if $_[0] < 4; my @factors; if (ref($_[0]) ne 'Math::BigInt') { while ( !($_[0] % 2) ) { push @factors, 2; $_[0] = int($_[0] / 2); } while ( !($_[0] % 3) ) { push @factors, 3; $_[0] = int($_[0] / 3); } while ( !($_[0] % 5) ) { push @factors, 5; $_[0] = int($_[0] / 5); } } else { # Without this, the bdivs will try to convert the results to BigFloat # and lose precision. $_[0]->upgrade(undef) if ref($_[0]) && $_[0]->upgrade(); if (!Math::BigInt::bgcd($_[0], B_PRIM235)->is_one) { while ( $_[0]->is_even) { push @factors, 2; $_[0]->brsft(BONE); } foreach my $div (3, 5) { my ($q, $r) = $_[0]->copy->bdiv($div); while ($r->is_zero) { push @factors, $div; $_[0] = $q; ($q, $r) = $_[0]->copy->bdiv($div); } } } $_[0] = _bigint_to_int($_[0]) if $] >= 5.008 && $_[0] <= BMAX; } if ( ($_[0] > 1) && _is_prime7($_[0]) ) { push @factors, $_[0]; $_[0] = 1; } @factors; } sub trial_factor { my($n, $limit) = @_; # Don't use _basic_factor here -- they want a trial forced. my @factors; if ($n < 4) { @factors = ($n == 1) ? () : ($n); return @factors; } my $start_idx = 1; # Expand small primes if it would help. push @_primes_small, @{primes($_primes_small[-1]+1, 100_003)} if $n > 400_000_000 && $_primes_small[-1] < 99_000 && (!defined $limit || $limit > $_primes_small[-1]); # Do initial bigint reduction. Hopefully reducing it to native int. if (ref($n) eq 'Math::BigInt') { $n = $n->copy; # Don't modify their original input! my $newlim = $n->copy->bsqrt; $limit = $newlim if !defined $limit || $limit > $newlim; while ($start_idx <= $#_primes_small) { my $f = $_primes_small[$start_idx++]; last if $f > $limit; if ($n->copy->bmod($f)->is_zero) { do { push @factors, $f; $n->bdiv($f)->bfloor(); } while $n->copy->bmod($f)->is_zero; last if $n < BMAX; my $newlim = $n->copy->bsqrt; $limit = $newlim if $limit > $newlim; } } return @factors if $n->is_one; $n = _bigint_to_int($n) if $n <= BMAX; return (@factors,$n) if $start_idx <= $#_primes_small && $_primes_small[$start_idx] > $limit; } { my $newlim = (ref($n) eq 'Math::BigInt') ? $n->copy->bsqrt : int(sqrt($n) + 0.001); $limit = $newlim if !defined $limit || $limit > $newlim; } if (ref($n) ne 'Math::BigInt') { for my $i ($start_idx .. $#_primes_small) { my $p = $_primes_small[$i]; last if $p > $limit; if (($n % $p) == 0) { do { push @factors, $p; $n = int($n/$p); } while ($n % $p) == 0; last if $n == 1; my $newlim = int( sqrt($n) + 0.001); $limit = $newlim if $newlim < $limit; } } if ($_primes_small[-1] < $limit) { my $inc = (($_primes_small[-1] % 6) == 1) ? 4 : 2; my $p = $_primes_small[-1] + $inc; while ($p <= $limit) { if (($n % $p) == 0) { do { push @factors, $p; $n = int($n/$p); } while ($n % $p) == 0; last if $n == 1; my $newlim = int( sqrt($n) + 0.001); $limit = $newlim if $newlim < $limit; } $p += ($inc ^= 6); } } } else { # n is a bigint. Use mod-210 wheel trial division. # Generating a wheel mod $w starting at $s: # mpu 'my($s,$w,$t)=(11,2*3*5); say join ",",map { ($t,$s)=($_-$s,$_); $t; } grep { gcd($_,$w)==1 } $s+1..$s+$w;' # Should start at $_primes_small[$start_idx], do 11 + next multiple of 210. my @incs = map { Math::BigInt->new($_) } (2,4,2,4,6,2,6,4,2,4,6,6,2,6,4,2,6,4,6,8,4,2,4,2,4,8,6,4,6,2,4,6,2,6,6,4,2,4,6,2,6,4,2,4,2,10,2,10); my $f = 11; while ($f <= $_primes_small[$start_idx-1]-210) { $f += 210; } ($f, $limit) = map { Math::BigInt->new("$_") } ($f, $limit); SEARCH: while ($f <= $limit) { foreach my $finc (@incs) { if ($n->copy->bmod($f)->is_zero && $f->bacmp($limit) <= 0) { my $sf = ($f <= BMAX) ? _bigint_to_int($f) : $f->copy; do { push @factors, $sf; $n->bdiv($f)->bfloor(); } while $n->copy->bmod($f)->is_zero; last SEARCH if $n->is_one; my $newlim = $n->copy->bsqrt; $limit = $newlim if $limit > $newlim; } $f->badd($finc); } } } push @factors, $n if $n > 1; @factors; } my $_holf_r; my @_fsublist = ( [ "pbrent 32k", sub { pbrent_factor (shift, 32*1024, 1, 1) } ], [ "p-1 1M", sub { pminus1_factor(shift, 1_000_000, undef, 1); } ], [ "ECM 1k", sub { ecm_factor (shift, 1_000, 5_000, 15) } ], [ "pbrent 512k",sub { pbrent_factor (shift, 512*1024, 7, 1) } ], [ "p-1 4M", sub { pminus1_factor(shift, 4_000_000, undef, 1); } ], [ "ECM 10k", sub { ecm_factor (shift, 10_000, 50_000, 10) } ], [ "pbrent 512k",sub { pbrent_factor (shift, 512*1024, 11, 1) } ], [ "HOLF 256k", sub { holf_factor (shift, 256*1024, $_holf_r); $_holf_r += 256*1024; } ], [ "p-1 20M", sub { pminus1_factor(shift,20_000_000); } ], [ "ECM 100k", sub { ecm_factor (shift, 100_000, 800_000, 10) } ], [ "HOLF 512k", sub { holf_factor (shift, 512*1024, $_holf_r); $_holf_r += 512*1024; } ], [ "pbrent 2M", sub { pbrent_factor (shift, 2048*1024, 13, 1) } ], [ "HOLF 2M", sub { holf_factor (shift, 2048*1024, $_holf_r); $_holf_r += 2048*1024; } ], [ "ECM 1M", sub { ecm_factor (shift, 1_000_000, 1_000_000, 10) } ], [ "p-1 100M", sub { pminus1_factor(shift, 100_000_000, 500_000_000); } ], ); sub factor { my($n) = @_; _validate_positive_integer($n); my @factors; if ($n < 4) { @factors = ($n == 1) ? () : ($n); return @factors; } $n = $n->copy if ref($n) eq 'Math::BigInt'; my $lim = 4999; # How much trial factoring to do # For native integers, we could save a little time by doing hardcoded trials # by 2-29 here. Skipping it. push @factors, trial_factor($n, $lim); return @factors if $factors[-1] < $lim*$lim; $n = pop(@factors); my @nstack = ($n); while (@nstack) { $n = pop @nstack; # Don't use bignum on $n if it has gotten small enough. $n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt' && $n <= BMAX; #print "Looking at $n with stack ", join(",",@nstack), "\n"; while ( ($n >= ($lim*$lim)) && !_is_prime7($n) ) { my @ftry; $_holf_r = 1; foreach my $sub (@_fsublist) { last if scalar @ftry >= 2; print " starting $sub->[0]\n" if Math::Prime::Util::prime_get_config()->{'verbose'} > 1; @ftry = $sub->[1]->($n); } if (scalar @ftry > 1) { #print " split into ", join(",",@ftry), "\n"; $n = shift @ftry; $n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt' && $n <= BMAX; push @nstack, @ftry; } else { #warn "trial factor $n\n"; push @factors, trial_factor($n); #print " trial into ", join(",",@factors), "\n"; $n = 1; last; } } push @factors, $n if $n != 1; } @factors = sort {$a<=>$b} @factors; return @factors; } sub _found_factor { my($f, $n, $what, @factors) = @_; if ($f == 1 || $f == $n) { push @factors, $n; } else { # Perl 5.6.2 needs things spelled out for it. my $f2 = (ref($n) eq 'Math::BigInt') ? $n->copy->bdiv($f)->as_int : int($n/$f); push @factors, $f; push @factors, $f2; croak "internal error in $what" unless $f * $f2 == $n; # MPU::GMP prints this type of message if verbose, so do the same. print "$what found factor $f\n" if Math::Prime::Util::prime_get_config()->{'verbose'} > 0; } @factors; } # TODO: sub squfof_factor { trial_factor(@_) } sub prho_factor { my($n, $rounds, $pa, $skipbasic) = @_; $rounds = 4*1024*1024 unless defined $rounds; $pa = 3 unless defined $pa; my @factors; if (!$skipbasic) { @factors = _basic_factor($n); return @factors if $n < 4; } my $inloop = 0; my $U = 7; my $V = 7; if ( ref($n) eq 'Math::BigInt' ) { my $zero = $n->copy->bzero; $pa = $zero->badd("$pa"); $U = $zero->copy->badd($U); $V = $zero->copy->badd($V); for my $i (1 .. $rounds) { # Would use bmuladd here, but old Math::BigInt's barf with scalar $pa. $U->bmul($U)->badd($pa)->bmod($n); $V->bmul($V)->badd($pa); $V->bmul($V)->badd($pa)->bmod($n); my $f = Math::BigInt::bgcd($U-$V, $n); if ($f->bacmp($n) == 0) { last if $inloop++; # We've been here before } elsif (!$f->is_one) { return _found_factor($f, $n, "prho", @factors); } } } elsif ($n < MPU_HALFWORD) { my $inner = 32; $rounds = int( ($rounds + $inner-1) / $inner ); while ($rounds-- > 0) { my($m, $oldU, $oldV, $f) = (1, $U, $V); for my $i (1 .. $inner) { $U = ($U * $U + $pa) % $n; $V = ($V * $V + $pa) % $n; $V = ($V * $V + $pa) % $n; $f = ($U > $V) ? $U-$V : $V-$U; $m = ($m * $f) % $n; } $f = _gcd_ui( $m, $n ); next if $f == 1; if ($f == $n) { ($U, $V) = ($oldU, $oldV); for my $i (1 .. $inner) { $U = ($U * $U + $pa) % $n; $V = ($V * $V + $pa) % $n; $V = ($V * $V + $pa) % $n; $f = ($U > $V) ? $U-$V : $V-$U; $f = _gcd_ui( $f, $n); last if $f != 1; } last if $f == 1 || $f == $n; } return _found_factor($f, $n, "prho", @factors); } } else { for my $i (1 .. $rounds) { if ($n <= (~0 >> 1)) { $U = _mulmod($U, $U, $n); $U += $pa; $U -= $n if $U >= $n; $V = _mulmod($V, $V, $n); $V += $pa; # Let the mulmod handle it $V = _mulmod($V, $V, $n); $V += $pa; $V -= $n if $V >= $n; } else { #$U = _mulmod($U, $U, $n); $U=$n-$U; $U = ($pa>=$U) ? $pa-$U : $n-$U+$pa; #$V = _mulmod($V, $V, $n); $V=$n-$V; $V = ($pa>=$V) ? $pa-$V : $n-$V+$pa; #$V = _mulmod($V, $V, $n); $V=$n-$V; $V = ($pa>=$V) ? $pa-$V : $n-$V+$pa; $U = _mulmod($U, $U, $n); $U = _addmod($U, $pa, $n); $V = _mulmod($V, $V, $n); $V = _addmod($V, $pa, $n); $V = _mulmod($V, $V, $n); $V = _addmod($V, $pa, $n); } my $f = _gcd_ui( $U-$V, $n ); if ($f == $n) { last if $inloop++; # We've been here before } elsif ($f != 1) { return _found_factor($f, $n, "prho", @factors); } } } push @factors, $n; @factors; } sub pbrent_factor { my($n, $rounds, $pa, $skipbasic) = @_; $rounds = 4*1024*1024 unless defined $rounds; $pa = 3 unless defined $pa; my @factors; if (!$skipbasic) { @factors = _basic_factor($n); return @factors if $n < 4; } my $Xi = 2; my $Xm = 2; if ( ref($n) eq 'Math::BigInt' ) { # Same code as the GMP version, but runs *much* slower. Even with # Math::BigInt::GMP it's >200x slower. With the default Calc backend # it's thousands of times slower. my $inner = 32; my $zero = $n->copy->bzero; my $saveXi; my $f; $Xi = $zero->copy->badd($Xi); $Xm = $zero->copy->badd($Xm); $pa = $zero->copy->badd($pa); my $r = 1; while ($rounds > 0) { my $rleft = ($r > $rounds) ? $rounds : $r; while ($rleft > 0) { my $dorounds = ($rleft > $inner) ? $inner : $rleft; my $m = $zero->copy->bone; $saveXi = $Xi->copy; foreach my $i (1 .. $dorounds) { $Xi->bmul($Xi)->badd($pa)->bmod($n); $m->bmul($Xi->copy->bsub($Xm)); } $rleft -= $dorounds; $rounds -= $dorounds; $m->bmod($n); $f = Math::BigInt::bgcd($m, $n); last unless $f->is_one; } if ($f->is_one) { $r *= 2; $Xm = $Xi->copy; next; } if ($f == $n) { # back up to determine the factor $Xi = $saveXi->copy; do { $Xi->bmul($Xi)->badd($pa)->bmod($n); $f = Math::BigInt::bgcd($Xm-$Xi, $n); } while ($f != 1 && $r-- != 0); last if $f == 1 || $f == $n; } return _found_factor($f, $n, "pbrent", @factors); } } elsif ($n < MPU_HALFWORD) { # Doing the gcd batching as above works pretty well here, but it's a lot # of code for not much gain for general users. for my $i (1 .. $rounds) { $Xi = ($Xi * $Xi + $pa) % $n; my $f = _gcd_ui( ($Xi>$Xm) ? $Xi-$Xm : $Xm-$Xi, $n); return _found_factor($f, $n, "pbrent", @factors) if $f != 1 && $f != $n; $Xm = $Xi if ($i & ($i-1)) == 0; # i is a power of 2 } } else { for my $i (1 .. $rounds) { $Xi = _addmod( _mulmod($Xi, $Xi, $n), $pa, $n); my $f = _gcd_ui( ($Xi>$Xm) ? $Xi-$Xm : $Xm-$Xi, $n); return _found_factor($f, $n, "pbrent", @factors) if $f != 1 && $f != $n; $Xm = $Xi if ($i & ($i-1)) == 0; # i is a power of 2 } } push @factors, $n; @factors; } sub pminus1_factor { my($n, $B1, $B2, $skipbasic) = @_; my @factors; if (!$skipbasic) { @factors = _basic_factor($n); return @factors if $n < 4; } if ( ref($n) ne 'Math::BigInt' ) { # Stage 1 only $B1 = 10_000_000 unless defined $B1; my $pa = 2; my $f = 1; my($pc_beg, $pc_end, @bprimes); $pc_beg = 2; $pc_end = $pc_beg + 100_000; my $sqrtb1 = int(sqrt($B1)); while (1) { $pc_end = $B1 if $pc_end > $B1; @bprimes = @{ primes($pc_beg, $pc_end) }; foreach my $q (@bprimes) { my $k = $q; if ($q <= $sqrtb1) { my $kmin = int($B1 / $q); while ($k <= $kmin) { $k *= $q; } } $pa = _powmod($pa, $k, $n); if ($pa == 0) { push @factors, $n; return @factors; } my $f = _gcd_ui( $pa-1, $n ); return _found_factor($f, $n, "pminus1", @factors) if $f != 1; } last if $pc_end >= $B1; $pc_beg = $pc_end+1; $pc_end += 500_000; } push @factors, $n; return @factors; } # Stage 2 isn't really any faster than stage 1 for the examples I've tried. # Perl's overhead is greater than the savings of multiply vs. powmod if (!defined $B1) { for my $mul (1, 100, 1000, 10_000, 100_000, 1_000_000) { $B1 = 1000 * $mul; $B2 = 1*$B1; #warn "Trying p-1 with $B1 / $B2\n"; my @nf = pminus1_factor($n, $B1, $B2); if (scalar @nf > 1) { push @factors, @nf; return @factors; } } push @factors, $n; return @factors; } $B2 = 1*$B1 unless defined $B2; my $one = $n->copy->bone; my ($j, $q, $saveq) = (32, 2, 2); my $t = $one->copy; my $pa = $one->copy->binc(); my $savea = $pa->copy; my $f = $one->copy; my($pc_beg, $pc_end, @bprimes); $pc_beg = 2; $pc_end = $pc_beg + 100_000; while (1) { $pc_end = $B1 if $pc_end > $B1; @bprimes = @{ primes($pc_beg, $pc_end) }; foreach my $q (@bprimes) { my($k, $kmin) = ($q, int($B1 / $q)); while ($k <= $kmin) { $k *= $q; } $t *= $k; # accumulate powers for a if ( ($j++ % 64) == 0) { next if $pc_beg > 2 && ($j-1) % 256; $pa->bmodpow($t, $n); $t = $one->copy; if ($pa == 0) { push @factors, $n; return @factors; } $f = Math::BigInt::bgcd( $pa->copy->bdec, $n ); last if $f == $n; return _found_factor($f, $n, "pminus1", @factors) unless $f->is_one; $saveq = $q; $savea = $pa->copy; } } $q = $bprimes[-1]; last if !$f->is_one || $pc_end >= $B1; $pc_beg = $pc_end+1; $pc_end += 500_000; } undef @bprimes; $pa->bmodpow($t, $n); if ($pa == 0) { push @factors, $n; return @factors; } $f = Math::BigInt::bgcd( $pa-1, $n ); if ($f == $n) { $q = $saveq; $pa = $savea->copy; while ($q <= $B1) { my ($k, $kmin) = ($q, int($B1 / $q)); while ($k <= $kmin) { $k *= $q; } $pa->bmodpow($k, $n); my $f = Math::BigInt::bgcd( $pa-1, $n ); if ($f == $n) { push @factors, $n; return @factors; } last if !$f->is_one; $q = next_prime($q); } } # STAGE 2 if ($f->is_one && $B2 > $B1) { my $bm = $pa->copy; my $b = $one->copy; my @precomp_bm; $precomp_bm[0] = ($bm * $bm) % $n; foreach my $j (1..19) { $precomp_bm[$j] = ($precomp_bm[$j-1] * $bm * $bm) % $n; } $pa->bmodpow($q, $n); my $j = 1; $pc_beg = $q+1; $pc_end = $pc_beg + 100_000; while (1) { $pc_end = $B2 if $pc_end > $B2; @bprimes = @{ primes($pc_beg, $pc_end) }; foreach my $i (0 .. $#bprimes) { my $diff = $bprimes[$i] - $q; $q = $bprimes[$i]; my $qdiff = ($diff >> 1) - 1; if (!defined $precomp_bm[$qdiff]) { $precomp_bm[$qdiff] = $bm->copy->bmodpow($diff, $n); } $pa->bmul($precomp_bm[$qdiff])->bmod($n); if ($pa == 0) { push @factors, $n; return @factors; } $b->bmul($pa-1); if (($j++ % 128) == 0) { $b->bmod($n); $f = Math::BigInt::bgcd( $b, $n ); last if !$f->is_one; } } last if !$f->is_one || $pc_end >= $B2; $pc_beg = $pc_end+1; $pc_end += 500_000; } $f = Math::BigInt::bgcd( $b, $n ); } return _found_factor($f, $n, "pminus1", @factors); } sub holf_factor { my($n, $rounds, $startrounds) = @_; $rounds = 64*1024*1024 unless defined $rounds; $startrounds = 1 unless defined $startrounds; $startrounds = 1 if $startrounds < 1; my @factors = _basic_factor($n); return @factors if $n < 4; if ( ref($n) eq 'Math::BigInt' ) { for my $i ($startrounds .. $rounds) { my $ni = $n->copy->bmul($i); my $s = $ni->copy->bsqrt->bfloor->as_int; if ($s * $s == $ni) { # s^2 = n*i, so m = s^2 mod n = 0. Hence f = GCD(n, s) = GCD(n, n*i) my $f = Math::BigInt::bgcd($ni, $n); return _found_factor($f, $n, "HOLF", @factors); } $s->binc; my $m = ($s * $s) - $ni; # Check for perfect square my $mc = _bigint_to_int($m & 31); next unless $mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25; my $f = $m->copy->bsqrt->bfloor->as_int; next unless ($f*$f) == $m; $f = Math::BigInt::bgcd( ($s > $f) ? $s-$f : $f-$s, $n); return _found_factor($f, $n, "HOLF ($i rounds)", @factors); } } else { for my $i ($startrounds .. $rounds) { my $s = int(sqrt($n * $i)); $s++ if ($s * $s) != ($n * $i); my $m = ($s < MPU_HALFWORD) ? ($s*$s) % $n : _mulmod($s, $s, $n); # Check for perfect square my $mc = $m & 31; next unless $mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25; my $f = int(sqrt($m)); next unless $f*$f == $m; $f = _gcd_ui($s - $f, $n); return _found_factor($f, $n, "HOLF ($i rounds)", @factors); } } push @factors, $n; @factors; } sub fermat_factor { my($n, $rounds) = @_; $rounds = 64*1024*1024 unless defined $rounds; my @factors = _basic_factor($n); return @factors if $n < 4; if ( ref($n) eq 'Math::BigInt' ) { my $pa = $n->copy->bsqrt->bfloor->as_int; return _found_factor($pa, $n, "Fermat", @factors) if $pa*$pa == $n; $pa++; my $b2 = $pa*$pa - $n; my $lasta = $pa + $rounds; while ($pa <= $lasta) { my $mc = _bigint_to_int($b2 & 31); if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) { my $s = $b2->copy->bsqrt->bfloor->as_int; if ($s*$s == $b2) { my $i = $pa-($lasta-$rounds)+1; return _found_factor($pa - $s, $n, "Fermat ($i rounds)", @factors); } } $pa++; $b2 = $pa*$pa-$n; } } else { my $pa = int(sqrt($n)); return _found_factor($pa, $n, "Fermat", @factors) if $pa*$pa == $n; $pa++; my $b2 = $pa*$pa - $n; my $lasta = $pa + $rounds; while ($pa <= $lasta) { my $mc = $b2 & 31; if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) { my $s = int(sqrt($b2)); if ($s*$s == $b2) { my $i = $pa-($lasta-$rounds)+1; return _found_factor($pa - $s, $n, "Fermat ($i rounds)", @factors); } } $pa++; $b2 = $pa*$pa-$n; } } push @factors, $n; @factors; } sub ecm_factor { my($n, $B1, $B2, $ncurves) = @_; _validate_positive_integer($n); my @factors = _basic_factor($n); return @factors if $n < 4; if ($Math::Prime::Util::_GMPfunc{"ecm_factor"}) { $B1 = 0 if !defined $B1; $ncurves = 0 if !defined $ncurves; my @ef = Math::Prime::Util::GMP::ecm_factor($n, $B1, $ncurves); if (@ef > 1) { my $ecmfac = Math::Prime::Util::_reftyped($n, $ef[-1]); return _found_factor($ecmfac, $n, "ECM (GMP) B1=$B1 curves $ncurves", @factors); } push @factors, $n; return @factors; } $ncurves = 10 unless defined $ncurves; if (!defined $B1) { for my $mul (1, 10, 100, 1000, 10_000, 100_000, 1_000_000) { $B1 = 100 * $mul; $B2 = 10*$B1; #warn "Trying ecm with $B1 / $B2\n"; my @nf = ecm_factor($n, $B1, $B2, $ncurves); if (scalar @nf > 1) { push @factors, @nf; return @factors; } } push @factors, $n; return @factors; } $B2 = 10*$B1 unless defined $B2; my $sqrt_b1 = int(sqrt($B1)+1); # Affine code. About 3x slower than the projective, and no stage 2. # #if (!defined $Math::Prime::Util::ECAffinePoint::VERSION) { # eval { require Math::Prime::Util::ECAffinePoint; 1; } # or do { croak "Cannot load Math::Prime::Util::ECAffinePoint"; }; #} #my @bprimes = @{ primes(2, $B1) }; #my $irandf = Math::Prime::Util::_get_rand_func(); #foreach my $curve (1 .. $ncurves) { # my $a = $irandf->($n-1); # my $b = 1; # my $ECP = Math::Prime::Util::ECAffinePoint->new($a, $b, $n, 0, 1); # foreach my $q (@bprimes) { # my $k = $q; # if ($k < $sqrt_b1) { # my $kmin = int($B1 / $q); # while ($k <= $kmin) { $k *= $q; } # } # $ECP->mul($k); # my $f = $ECP->f; # if ($f != 1) { # last if $f == $n; # warn "ECM found factors with B1 = $B1 in curve $curve\n"; # return _found_factor($f, $n, "ECM B1=$B1 curve $curve", @factors); # } # last if $ECP->is_infinity; # } #} require Math::Prime::Util::ECProjectivePoint; require Math::Prime::Util::RandomPrimes; # With multiple curves, it's better to get all the primes at once. # The downside is this can kill memory with a very large B1. my @bprimes = @{ primes(3, $B1) }; foreach my $q (@bprimes) { last if $q > $sqrt_b1; my($k,$kmin) = ($q, int($B1/$q)); while ($k <= $kmin) { $k *= $q; } $q = $k; } my @b2primes = ($B2 > $B1) ? @{primes($B1+1, $B2)} : (); foreach my $curve (1 .. $ncurves) { my $sigma = Math::Prime::Util::urandomm($n-6) + 6; my ($u, $v) = ( ($sigma*$sigma - 5) % $n, (4 * $sigma) % $n ); my ($x, $z) = ( ($u*$u*$u) % $n, ($v*$v*$v) % $n ); my $cb = (4 * $x * $v) % $n; my $ca = ( (($v-$u)**3) * (3*$u + $v) ) % $n; my $f = Math::BigInt::bgcd( $cb, $n ); $f = Math::BigInt::bgcd( $z, $n ) if $f == 1; next if $f == $n; return _found_factor($f,$n, "ECM B1=$B1 curve $curve", @factors) if $f != 1; $cb = Math::BigInt->new("$cb") unless ref($cb) eq 'Math::BigInt'; $u = $cb->copy->bmodinv($n); $ca = (($ca*$u) - 2) % $n; my $ECP = Math::Prime::Util::ECProjectivePoint->new($ca, $n, $x, $z); my $fm = $n-$n+1; my $i = 15; for (my $q = 2; $q < $B1; $q *= 2) { $ECP->double(); } foreach my $k (@bprimes) { $ECP->mul($k); $fm = ($fm * $ECP->x() ) % $n; if ($i++ % 32 == 0) { $f = Math::BigInt::bgcd($fm, $n); last if $f != 1; } } $f = Math::BigInt::bgcd($fm, $n); next if $f == $n; if ($f == 1 && $B2 > $B1) { # BEGIN STAGE 2 my $D = int(sqrt($B2/2)); $D++ if $D % 2; my $one = $n - $n + 1; my $g = $one; my $S2P = $ECP->copy->normalize; $f = $S2P->f; if ($f != 1) { next if $f == $n; #warn "ECM S2 normalize f=$f\n" if $f != 1; return _found_factor($f, $n, "ECM S2 B1=$B1 curve $curve"); } my $S2x = $S2P->x; my $S2d = $S2P->d; my @nqx = ($n-$n, $S2x); foreach my $i (2 .. 2*$D) { my($x2, $z2); if ($i % 2) { ($x2, $z2) = Math::Prime::Util::ECProjectivePoint::_addx($nqx[($i-1)/2], $nqx[($i+1)/2], $S2x, $n); } else { ($x2, $z2) = Math::Prime::Util::ECProjectivePoint::_double($nqx[$i/2], $one, $n, $S2d); } $nqx[$i] = $x2; #($f, $u, undef) = _extended_gcd($z2, $n); $f = Math::BigInt::bgcd( $z2, $n ); last if $f != 1; $u = $z2->copy->bmodinv($n); $nqx[$i] = ($x2 * $u) % $n; } if ($f != 1) { next if $f == $n; #warn "ECM S2 1: B1 $B1 B2 $B2 curve $curve f=$f\n"; return _found_factor($f, $n, "ECM S2 B1=$B1 curve $curve", @factors); } $x = $nqx[2*$D-1]; my $m = 1; while ($m < ($B2+$D)) { if ($m != 1) { my $oldx = $S2x; my ($x1, $z1) = Math::Prime::Util::ECProjectivePoint::_addx($nqx[2*$D], $S2x, $x, $n); $f = Math::BigInt::bgcd( $z1, $n ); last if $f != 1; $u = $z1->copy->bmodinv($n); $S2x = ($x1 * $u) % $n; $x = $oldx; last if $f != 1; } if ($m+$D > $B1) { my @p = grep { $_ >= $m-$D && $_ <= $m+$D } @b2primes; foreach my $i (@p) { last if $i >= $m; $g = ($g * ($S2x - $nqx[$m+$D-$i])) % $n; } foreach my $i (@p) { next unless $i > $m; next if $i > ($m+$m) || is_prime($m+$m-$i); $g = ($g * ($S2x - $nqx[$i-$m])) % $n; } $f = Math::BigInt::bgcd($g, $n); #warn "ECM S2 3: found $f in stage 2\n" if $f != 1; last if $f != 1; } $m += 2*$D; } } # END STAGE 2 next if $f == $n; if ($f != 1) { #warn "ECM found factors with B1 = $B1 in curve $curve\n"; return _found_factor($f, $n, "ECM B1=$B1 curve $curve", @factors); } # end of curve loop } push @factors, $n; @factors; } sub divisors { my($n) = @_; _validate_positive_integer($n); my(@factors, @d, @t); # In scalar context, returns sigma_0(n). Very fast. return Math::Prime::Util::divisor_sum($n,0) unless wantarray; return ($n == 0) ? (0,1) : (1) if $n <= 1; if ($Math::Prime::Util::_GMPfunc{"divisors"}) { # This trips an erroneous compile time error without the eval. eval ' @d = Math::Prime::Util::GMP::divisors($n); '; ## no critic qw(ProhibitStringyEval) @d = map { $_ <= ~0 ? $_ : ref($n)->new($_) } @d if ref($n); return @d; } @factors = Math::Prime::Util::factor($n); return (1,$n) if scalar @factors == 1; my $bigint = ref($n); @factors = map { $bigint->new("$_") } @factors if $bigint; @d = $bigint ? ($bigint->new(1)) : (1); while (my $p = shift @factors) { my $e = 1; while (@factors && $p == $factors[0]) { $e++; shift(@factors); } push @d, @t = map { $_ * $p } @d; # multiply through once push @d, @t = map { $_ * $p } @t for 2 .. $e; # repeat } @d = map { $_ <= INTMAX ? _bigint_to_int($_) : $_ } @d if $bigint; @d = sort { $a <=> $b } @d; @d; } sub chebyshev_theta { my($n,$low) = @_; $low = 2 unless defined $low; my($sum,$high) = (0.0, 0); while ($low <= $n) { $high = $low + 1e6; $high = $n if $high > $n; $sum += log($_) for @{primes($low,$high)}; $low = $high+1; } $sum; } sub chebyshev_psi { my($n) = @_; return 0 if $n <= 1; my ($sum, $logn, $sqrtn) = (0.0, log($n), int(sqrt($n))); # Sum the log of prime powers first for my $p (@{primes($sqrtn)}) { my $logp = log($p); $sum += $logp * int($logn/$logp+1e-15); } # The rest all have exponent 1: add them in using the segmenting theta code $sum += chebyshev_theta($n, $sqrtn+1); $sum; } sub hclassno { my $n = shift; return -1 if $n == 0; return 0 if $n < 0 || ($n % 4) == 1 || ($n % 4) == 2; return 2 * (2,3,6,6,6,8,12,9,6,12,18,12,8,12,18,18,12,15,24,12,6,24,30,20,12,12,24,24,18,24)[($n>>1)-1] if $n <= 60; my ($h, $square, $b, $b2) = (0, 0, $n & 1, ($n+1) >> 2); if ($b == 0) { my $lim = int(sqrt($b2)); if (_is_perfect_square($b2)) { $square = 1; $lim--; } #$h += scalar(grep { $_ <= $lim } divisors($b2)); for my $i (1 .. $lim) { $h++ unless $b2 % $i; } ($b,$b2) = (2, ($n+4) >> 2); } while ($b2 * 3 < $n) { $h++ unless $b2 % $b; my $lim = int(sqrt($b2)); if (_is_perfect_square($b2)) { $h++; $lim--; } #$h += 2 * scalar(grep { $_ > $b && $_ <= $lim } divisors($b2)); for my $i ($b+1 .. $lim) { $h += 2 unless $b2 % $i; } $b += 2; $b2 = ($n+$b*$b) >> 2; } return (($b2*3 == $n) ? 2*(3*$h+1) : $square ? 3*(2*$h+1) : 6*$h) << 1; } # Sigma method for prime powers sub _taup { my($p, $e, $n) = @_; my($bp) = Math::BigInt->new("".$p); if ($e == 1) { return (0,1,-24,252,-1472,4830,-6048,-16744,84480)[$p] if $p <= 8; my $ds5 = $bp->copy->bpow( 5)->binc(); # divisor_sum(p,5) my $ds11 = $bp->copy->bpow(11)->binc(); # divisor_sum(p,11) my $s = Math::BigInt->new("".vecsum(map { vecprod(BTWO,Math::Prime::Util::divisor_sum($_,5), Math::Prime::Util::divisor_sum($p-$_,5)) } 1..($p-1)>>1)); $n = ( 65*$ds11 + 691*$ds5 - (691*252)*$s ) / 756; } else { my $t = Math::BigInt->new(""._taup($p,1)); $n = $t->copy->bpow($e); if ($e == 2) { $n -= $bp->copy->bpow(11); } elsif ($e == 3) { $n -= BTWO * $t * $bp->copy->bpow(11); } else { $n += vecsum( map { vecprod( ($_&1) ? - BONE : BONE, $bp->copy->bpow(11*$_), binomial($e-$_, $e-2*$_), $t ** ($e-2*$_) ) } 1 .. ($e>>1) ); } } $n = _bigint_to_int($n) if ref($n) && $n->bacmp(BMAX) <= 0; $n; } # Cohen's method using Hurwitz class numbers # The two hclassno calls could be collapsed with some work sub _tauprime { my $p = shift; return -24 if $p == 2; my $sum = Math::BigInt->new(0); if ($p < (MPU_32BIT ? 300 : 1600)) { my($p9,$pp7) = (9*$p, 7*$p*$p); for my $t (1 .. Math::Prime::Util::sqrtint($p)) { my $t2 = $t * $t; my $v = $p - $t2; $sum += $t2**3 * (4*$t2*$t2 - $p9*$t2 + $pp7) * (Math::Prime::Util::hclassno(4*$v) + 2 * Math::Prime::Util::hclassno($v)); } $p = Math::BigInt->new("$p"); } else { $p = Math::BigInt->new("$p"); my($p9,$pp7) = (9*$p, 7*$p*$p); for my $t (1 .. Math::Prime::Util::sqrtint($p)) { my $t2 = Math::BigInt->new("$t") ** 2; my $v = $p - $t2; $sum += $t2**3 * (4*$t2*$t2 - $p9*$t2 + $pp7) * (Math::Prime::Util::hclassno(4*$v) + 2 * Math::Prime::Util::hclassno($v)); } } 28*$p**6 - 28*$p**5 - 90*$p**4 - 35*$p**3 - 1 - 32 * ($sum/3); } # Recursive method for handling prime powers sub _taupower { my($p, $e) = @_; return 1 if $e <= 0; return _tauprime($p) if $e == 1; $p = Math::BigInt->new("$p"); my($tp, $p11) = ( _tauprime($p), $p**11 ); return $tp ** 2 - $p11 if $e == 2; return $tp ** 3 - 2 * $tp * $p11 if $e == 3; return $tp ** 4 - 3 * $tp**2 * $p11 + $p11**2 if $e == 4; # Recurse -3 ($tp**3 - 2*$tp*$p11) * _taupower($p,$e-3) + ($p11*$p11 - $tp*$tp*$p11) * _taupower($p,$e-4); } sub ramanujan_tau { my $n = shift; return 0 if $n <= 0; # Use GMP if we have no XS or if size is small if ($n < 100000 || !Math::Prime::Util::prime_get_config()->{'xs'}) { if ($Math::Prime::Util::_GMPfunc{"ramanujan_tau"}) { return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::ramanujan_tau($n)); } } # _taup is faster for small numbers, but gets very slow. It's not a huge # deal, and the GMP code will probably get run for small inputs anyway. vecprod(map { _taupower($_->[0],$_->[1]) } Math::Prime::Util::factor_exp($n)); } sub _Euler { my($dig) = @_; return Math::Prime::Util::GMP::Euler($dig) if $dig > 70 && $Math::Prime::Util::_GMPfunc{"Euler"}; '0.57721566490153286060651209008240243104215933593992359880576723488486772677766467'; } sub _Li2 { my($dig) = @_; return Math::Prime::Util::GMP::li(2,$dig) if $dig > 70 && $Math::Prime::Util::_GMPfunc{"li"}; '1.04516378011749278484458888919461313652261557815120157583290914407501320521'; } sub ExponentialIntegral { my($x) = @_; return - MPU_INFINITY if $x == 0; return 0 if $x == - MPU_INFINITY; return MPU_INFINITY if $x == MPU_INFINITY; if ($Math::Prime::Util::_GMPfunc{"ei"}) { $x = Math::BigFloat->new("$x") if defined $bignum::VERSION && ref($x) ne 'Math::BigFloat'; return 0.0 + Math::Prime::Util::GMP::ei($x,40) if !ref($x); my $str = Math::Prime::Util::GMP::ei($x, _find_big_acc($x)); return $x->copy->bzero->badd($str); } $x = Math::BigFloat->new("$x") if defined $bignum::VERSION && ref($x) ne 'Math::BigFloat'; my $tol = 1e-16; my $sum = 0.0; my($y, $t); my $c = 0.0; my $val; # The result from one of the four methods if ($x < -1) { # Continued fraction my $lc = 0; my $ld = 1 / (1 - $x); $val = $ld * (-exp($x)); for my $n (1 .. 100000) { $lc = 1 / (2*$n + 1 - $x - $n*$n*$lc); $ld = 1 / (2*$n + 1 - $x - $n*$n*$ld); my $old = $val; $val *= $ld/$lc; last if abs($val - $old) <= ($tol * abs($val)); } } elsif ($x < 0) { # Rational Chebyshev approximation my @C6p = ( -148151.02102575750838086, 150260.59476436982420737, 89904.972007457256553251, 15924.175980637303639884, 2150.0672908092918123209, 116.69552669734461083368, 5.0196785185439843791020); my @C6q = ( 256664.93484897117319268, 184340.70063353677359298, 52440.529172056355429883, 8125.8035174768735759866, 750.43163907103936624165, 40.205465640027706061433, 1.0000000000000000000000); my $sumn = $C6p[0]-$x*($C6p[1]-$x*($C6p[2]-$x*($C6p[3]-$x*($C6p[4]-$x*($C6p[5]-$x*$C6p[6]))))); my $sumd = $C6q[0]-$x*($C6q[1]-$x*($C6q[2]-$x*($C6q[3]-$x*($C6q[4]-$x*($C6q[5]-$x*$C6q[6]))))); $val = log(-$x) - ($sumn / $sumd); } elsif ($x < -log($tol)) { # Convergent series my $fact_n = 1; $y = _Euler(18)-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; $y = log($x)-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; for my $n (1 .. 200) { $fact_n *= $x/$n; my $term = $fact_n / $n; $y = $term-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; last if $term < $tol; } $val = $sum; } else { # Asymptotic divergent series my $invx = 1.0 / $x; my $term = $invx; $sum = 1.0 + $term; for my $n (2 .. 200) { my $last_term = $term; $term *= $n * $invx; last if $term < $tol; if ($term < $last_term) { $y = $term-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; } else { $y = (-$last_term/3)-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; last; } } $val = exp($x) * $invx * $sum; } $val; } sub LogarithmicIntegral { my($x,$opt) = @_; return 0 if $x == 0; return - MPU_INFINITY if $x == 1; return MPU_INFINITY if $x == MPU_INFINITY; croak "Invalid input to LogarithmicIntegral: x must be > 0" if $x <= 0; $opt = 0 unless defined $opt; if ($Math::Prime::Util::_GMPfunc{"li"}) { $x = Math::BigFloat->new("$x") if defined $bignum::VERSION && ref($x) ne 'Math::BigFloat'; return 0.0 + Math::Prime::Util::GMP::li($x,40) if !ref($x); my $str = Math::Prime::Util::GMP::li($x, _find_big_acc($x)); return $x->copy->bzero->badd($str); } if ($x == 2) { my $li2const = (ref($x) eq 'Math::BigFloat') ? Math::BigFloat->new(_Li2(_find_big_acc($x))) : 0.0+_Li2(30); return $li2const; } if (defined $bignum::VERSION) { # If bignum is on, always use Math::BigFloat. $x = Math::BigFloat->new("$x") if ref($x) ne 'Math::BigFloat'; } elsif (ref($x)) { # bignum is off, use native if small, BigFloat otherwise. if ($x <= 1e16) { $x = _bigint_to_int($x); } else { $x = _upgrade_to_float($x) if ref($x) ne 'Math::BigFloat'; } } # Make sure we preserve whatever accuracy setting the input was using. $x->accuracy($_[0]->accuracy) if ref($x) && ref($_[0]) =~ /^Math::Big/ && $_[0]->accuracy; # Do divergent series here for big inputs. Common for big pc approximations. # Why is this here? # 1) exp(log(x)) results in a lot of lost precision # 2) exp(x) with lots of precision turns out to be really slow, and in # this case it was unnecessary. my $tol = 1e-16; my $xdigits = 0; my $finalacc = 0; if (ref($x) =~ /^Math::Big/) { $xdigits = _find_big_acc($x); my $xlen = length($x->copy->bfloor->bstr()); $xdigits = $xlen if $xdigits < $xlen; $finalacc = $xdigits; $xdigits += length(int(log(0.0+"$x"))) + 1; $tol = Math::BigFloat->new(10)->bpow(-$xdigits); $x->accuracy($xdigits); } my $logx = $xdigits ? $x->copy->blog(undef,$xdigits) : log($x); # TODO: See if we can tune this if (0 && $x >= 1) { _upgrade_to_float(); my $sum = Math::BigFloat->new(0); my $inner_sum = Math::BigFloat->new(0); my $p = Math::BigFloat->new(-1); my $factorial = 1; my $power2 = 1; my $q; my $k = 0; my $neglogx = -$logx; for my $n (1 .. 1000) { $factorial = vecprod($factorial, $n); $q = vecprod($factorial, $power2); $power2 = vecprod(2, $power2); while ($k <= ($n-1)>>1) { $inner_sum += Math::BigFloat->new(1) / (2*$k+1); $k++; } $p *= $neglogx; my $term = ($p / $q) * $inner_sum; $sum += $term; last if abs($term) < $tol; } $sum *= sqrt($x); return 0.0+_Euler(18) + log($logx) + $sum unless ref($x)=~/^Math::Big/; my $val = Math::BigFloat->new(_Euler(40))->badd("".log($logx))->badd("$sum"); $val->accuracy($finalacc) if $xdigits; return $val; } if ($x > 1e16) { my $invx = ref($logx) ? Math::BigFloat->bone / $logx : 1.0/$logx; # n = 0 => 0!/(logx)^0 = 1/1 = 1 # n = 1 => 1!/(logx)^1 = 1/logx my $term = $invx; my $sum = 1.0 + $term; for my $n (2 .. 1000) { my $last_term = $term; $term *= $n * $invx; last if $term < $tol; if ($term < $last_term) { $sum += $term; } else { $sum -= ($last_term/3); last; } $term->bround($xdigits) if $xdigits; } $invx *= $sum; $invx *= $x; $invx->accuracy($finalacc) if ref($invx) && $xdigits; return $invx; } # Convergent series. if ($x >= 1) { my $fact_n = 1.0; my $nfac = 1.0; my $sum = 0.0; for my $n (1 .. 200) { $fact_n *= $logx/$n; my $term = $fact_n / $n; $sum += $term; last if $term < $tol; $term->bround($xdigits) if $xdigits; } return 0.0+_Euler(18) + log($logx) + $sum unless ref($x) =~ /^Math::Big/; my $val = Math::BigFloat->new(_Euler(40))->badd("".log($logx))->badd("$sum"); $val->accuracy($finalacc) if $xdigits; return $val; } ExponentialIntegral($logx); } # Riemann Zeta function for native integers. my @_Riemann_Zeta_Table = ( 0.6449340668482264364724151666460251892, # zeta(2) - 1 0.2020569031595942853997381615114499908, 0.0823232337111381915160036965411679028, 0.0369277551433699263313654864570341681, 0.0173430619844491397145179297909205279, 0.0083492773819228268397975498497967596, 0.0040773561979443393786852385086524653, 0.0020083928260822144178527692324120605, 0.0009945751278180853371459589003190170, 0.0004941886041194645587022825264699365, 0.0002460865533080482986379980477396710, 0.0001227133475784891467518365263573957, 0.0000612481350587048292585451051353337, 0.0000305882363070204935517285106450626, 0.0000152822594086518717325714876367220, 0.0000076371976378997622736002935630292, 0.0000038172932649998398564616446219397, 0.0000019082127165539389256569577951013, 0.0000009539620338727961131520386834493, 0.0000004769329867878064631167196043730, 0.0000002384505027277329900036481867530, 0.0000001192199259653110730677887188823, 0.0000000596081890512594796124402079358, 0.0000000298035035146522801860637050694, 0.0000000149015548283650412346585066307, 0.0000000074507117898354294919810041706, 0.0000000037253340247884570548192040184, 0.0000000018626597235130490064039099454, 0.0000000009313274324196681828717647350, 0.0000000004656629065033784072989233251, 0.0000000002328311833676505492001455976, 0.0000000001164155017270051977592973835, 0.0000000000582077208790270088924368599, 0.0000000000291038504449709968692942523, 0.0000000000145519218910419842359296322, 0.0000000000072759598350574810145208690, 0.0000000000036379795473786511902372363, 0.0000000000018189896503070659475848321, 0.0000000000009094947840263889282533118, ); sub RiemannZeta { my($x) = @_; my $ix = ($x == int($x)) ? "" . Math::BigInt->new($x) : 0; # Try our GMP code if possible. if ($Math::Prime::Util::_GMPfunc{"zeta"}) { my($wantbf,$xdigits) = _bfdigits($x); # If we knew the *exact* number of zero digits, we could let GMP zeta # handle the correct rounding. But we don't, so we have to go over. my $zero_dig = "".int($x / 3) - 1; my $strval = Math::Prime::Util::GMP::zeta($x, $xdigits + 8 + $zero_dig); if ($strval =~ s/^(1\.0*)/./) { $strval .= "e-".(length($1)-2) if length($1) > 2; } else { $strval =~ s/^(\d+)/$1-1/e; } return ($wantbf) ? Math::BigFloat->new($strval,$wantbf) : 0.0 + $strval; } # If we need a bigfloat result, then call our PP routine. if (defined $bignum::VERSION || ref($x) =~ /^Math::Big/) { require Math::Prime::Util::ZetaBigFloat; return Math::Prime::Util::ZetaBigFloat::RiemannZeta($x); } # Native float results return 0.0 + $_Riemann_Zeta_Table[int($x)-2] if $x == int($x) && defined $_Riemann_Zeta_Table[int($x)-2]; my $tol = 1.11e-16; # Series based on (2n)! / B_2n. # This is a simplification of the Cephes zeta function. my @A = ( 12.0, -720.0, 30240.0, -1209600.0, 47900160.0, -1892437580.3183791606367583212735166426, 74724249600.0, -2950130727918.1642244954382084600497650, 116467828143500.67248729113000661089202, -4597978722407472.6105457273596737891657, 181521054019435467.73425331153534235290, -7166165256175667011.3346447367083352776, 282908877253042996618.18640556532523927, ); my $s = 0.0; my $rb = 0.0; foreach my $i (2 .. 10) { $rb = $i ** -$x; $s += $rb; return $s if abs($rb/$s) < $tol; } my $w = 10.0; $s = $s + $rb*$w/($x-1.0) - 0.5*$rb; my $ra = 1.0; foreach my $i (0 .. 12) { my $k = 2*$i; $ra *= $x + $k; $rb /= $w; my $t = $ra*$rb/$A[$i]; $s += $t; $t = abs($t/$s); last if $t < $tol; $ra *= $x + $k + 1.0; $rb /= $w; } return $s; } # Riemann R function sub RiemannR { my($x) = @_; croak "Invalid input to ReimannR: x must be > 0" if $x <= 0; # With MPU::GMP v0.49 this is fast. if ($Math::Prime::Util::_GMPfunc{"riemannr"}) { my($wantbf,$xdigits) = _bfdigits($x); my $strval = Math::Prime::Util::GMP::riemannr($x, $xdigits); return ($wantbf) ? Math::BigFloat->new($strval,$wantbf) : 0.0 + $strval; } # TODO: look into this as a generic solution if (0 && $Math::Prime::Util::_GMPfunc{"zeta"}) { my($wantbf,$xdigits) = _bfdigits($x); $x = _upgrade_to_float($x); my $extra_acc = 4; $xdigits += $extra_acc; $x->accuracy($xdigits); my $logx = log($x); my $part_term = $x->copy->bone; my $sum = $x->copy->bone; my $tol = $x->copy->bone->brsft($xdigits-1, 10); my $bigk = $x->copy->bone; my $term; for my $k (1 .. 10000) { $part_term *= $logx / $bigk; my $zarg = $bigk->copy->binc; my $zeta = (RiemannZeta($zarg) * $bigk) + $bigk; #my $strval = Math::Prime::Util::GMP::zeta($k+1, $xdigits + int(($k+1) / 3)); #my $zeta = Math::BigFloat->new($strval)->bdec->bmul($bigk)->badd($bigk); $term = $part_term / $zeta; $sum += $term; last if $term < ($tol * $sum); $bigk->binc; } $sum->bround($xdigits-$extra_acc); my $strval = "$sum"; return ($wantbf) ? Math::BigFloat->new($strval,$wantbf) : 0.0 + $strval; } if (defined $bignum::VERSION || ref($x) =~ /^Math::Big/) { require Math::Prime::Util::ZetaBigFloat; return Math::Prime::Util::ZetaBigFloat::RiemannR($x); } my $sum = 0.0; my $tol = 1e-18; my($c, $y, $t) = (0.0); if ($x > 10**17) { my @mob = Math::Prime::Util::moebius(0,300); for my $k (1 .. 300) { next if $mob[$k] == 0; my $term = $mob[$k] / $k * Math::Prime::Util::LogarithmicIntegral($x**(1.0/$k)); $y = $term-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; last if abs($term) < ($tol * abs($sum)); } } else { $y = 1.0-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; my $flogx = log($x); my $part_term = 1.0; for my $k (1 .. 10000) { my $zeta = ($k <= $#_Riemann_Zeta_Table) ? $_Riemann_Zeta_Table[$k+1-2] # Small k from table : RiemannZeta($k+1); # Large k from function $part_term *= $flogx / $k; my $term = $part_term / ($k + $k * $zeta); $y = $term-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; last if $term < ($tol * $sum); } } return $sum; } sub LambertW { my $x = shift; croak "Invalid input to LambertW: x must be >= -1/e" if $x < -0.36787944118; $x = _upgrade_to_float($x) if ref($x) eq 'Math::BigInt'; my $xacc = ref($x) ? _find_big_acc($x) : 0; my $w; if ($Math::Prime::Util::_GMPfunc{"lambertw"}) { my $w = (!$xacc) ? 0.0 + Math::Prime::Util::GMP::lambertw($x) : $x->copy->bzero->badd(Math::Prime::Util::GMP::lambertw($x, $xacc)); return $w; } # Approximation if ($x < -0.06) { my $ti = $x * 2 * exp($x-$x+1) + 2; return -1 if $ti <= 0; my $t = sqrt($ti); $w = (-1 + 1/6*$t + (257/720)*$t*$t + (13/720)*$t*$t*$t) / (1 + (5/6)*$t + (103/720)*$t*$t); } elsif ($x < 1.363) { my $l1 = log($x + 1); $w = $l1 * (1 - log(1+$l1) / (2+$l1)); } elsif ($x < 3.7) { my $l1 = log($x); my $l2 = log($l1); $w = $l1 - $l2 - log(1 - $l2/$l1)/2.0; } else { my $l1 = log($x); my $l2 = log($l1); my $d1 = 2 * $l1 * $l1; my $d2 = 3 * $l1 * $d1; my $d3 = 2 * $l1 * $d2; my $d4 = 5 * $l1 * $d3; $w = $l1 - $l2 + $l2/$l1 + $l2*($l2-2)/$d1 + $l2*(6+$l2*(-9+2*$l2))/$d2 + $l2*(-12+$l2*(36+$l2*(-22+3*$l2)))/$d3 + $l2*(60+$l2*(-300+$l2*(350+$l2*(-125+12*$l2))))/$d4; } # Now iterate to get the answer # # Newton: # $w = $w*(log($x) - log($w) + 1) / ($w+1); # Halley: # my $e = exp($w); # my $f = $w * $e - $x; # $w -= $f / ($w*$e+$e - ($w+2)*$f/(2*$w+2)); # Fritsch converges quadratically, so tolerance could be 4x smaller. Use 2x. my $tol = ($xacc) ? 10**(-int(1+$xacc/2)) : 1e-16; $w->accuracy($xacc+10) if $xacc; for (1 .. 200) { last if $w == 0; my $w1 = $w + 1; my $zn = log($x/$w) - $w; my $qn = $w1 * 2 * ($w1+(2*$zn/3)); my $en = ($zn/$w1) * ($qn-$zn)/($qn-$zn*2); my $wen = $w * $en; $w += $wen; last if abs($wen) < $tol; } $w->accuracy($xacc) if $xacc; $w; } my $_Pi = "3.141592653589793238462643383279503"; sub Pi { my $digits = shift; return 0.0+$_Pi unless $digits; return 0.0+sprintf("%.*lf", $digits-1, $_Pi) if $digits < 15; return _upgrade_to_float($_Pi, $digits) if $digits < 30; # Performance ranking: # MPU::GMP Uses AGM or Ramanujan/Chudnosky with binary splitting # MPFR Uses AGM, from 1x to 1/4x the above # Perl AGM w/GMP also AGM, nice growth rate, but slower than above # C pidigits much worse than above, but faster than the others # Perl AGM without Math::BigInt::GMP, it's sluggish # Math::BigFloat new versions use AGM, old ones are *very* slow # # With a few thousand digits, any of the top 4 are fine. # At 10k digits, the first two are pulling away. # At 50k digits, the first three are 5-20x faster than C pidigits, and # pray you're not having to the Perl BigFloat methods without GMP. # At 100k digits, the first two are 15x faster than the third, C pidigits # is 200x slower, and the rest thousands of times slower. # At 1M digits, the first is under 1 second, MPFR under 2 seconds, # Perl AGM (Math::BigInt::GMP) is over a minute, and C piigits at 1.5 hours. # # Interestingly, Math::BigInt::Pari, while greatly faster than Calc, is # *much* slower than GMP for these operations (both AGM and Machin). While # Perl AGM with the Math::BigInt::GMP backend will pull away from C pidigits, # using it with the other backends doesn't do so. # # The GMP program at https://gmplib.org/download/misc/gmp-chudnovsky.c # will run ~4x faster than MPFR and ~1.5x faster than MPU::GMP. my $have_bigint_gmp = Math::BigInt->config()->{lib} =~ /GMP/; my $have_xdigits = Math::Prime::Util::prime_get_config()->{'xs'}; my $_verbose = Math::Prime::Util::prime_get_config()->{'verbose'}; if ($Math::Prime::Util::_GMPfunc{"Pi"}) { print " using MPUGMP for Pi($digits)\n" if $_verbose; return _upgrade_to_float( Math::Prime::Util::GMP::Pi($digits) ); } # We could consider looking for Math::MPFR or Math::Pari # This has a *much* better growth rate than the later solutions. if ( !$have_xdigits || ($have_bigint_gmp && $digits > 100) ) { print " using Perl AGM for Pi($digits)\n" if $_verbose; # Brent-Salamin (aka AGM or Gauss-Legendre) $digits += 8; my $HALF = _upgrade_to_float(0.5); my ($an, $bn, $tn, $pn) = ($HALF->copy->bone, $HALF->copy->bsqrt($digits), $HALF->copy->bmul($HALF), $HALF->copy->bone); while ($pn < $digits) { my $prev_an = $an->copy; $an->badd($bn)->bmul($HALF, $digits); $bn->bmul($prev_an)->bsqrt($digits); $prev_an->bsub($an); $tn->bsub($pn * $prev_an * $prev_an); $pn->badd($pn); } $an->badd($bn); $an->bmul($an,$digits)->bdiv(4*$tn, $digits-8); return $an; } # Spigot method in C. Low overhead but not good growth rate. if ($have_xdigits) { print " using XS spigot for Pi($digits)\n" if $_verbose; return _upgrade_to_float(Math::Prime::Util::_pidigits($digits)); } # We're going to have to use the Math::BigFloat code. # 1) it rounds incorrectly (e.g. 761, 1372, 1509,...). # Fix by adding some digits and rounding. # 2) AGM is *much* faster once past ~2000 digits # 3) It is very slow without the GMP backend. The Pari backend helps # but it still pretty bad. With Calc it's glacial for large inputs. # Math::BigFloat AGM spigot AGM # Size GMP Pari Calc GMP Pari Calc C C+GMP # 500 0.04 0.60 0.30 0.08 0.10 0.47 0.09 0.06 # 1000 0.04 0.11 1.82 0.09 0.14 1.82 0.09 0.06 # 2000 0.07 0.37 13.5 0.09 0.34 9.16 0.10 0.06 # 4000 0.14 2.17 107.8 0.12 1.14 39.7 0.20 0.06 # 8000 0.52 15.7 0.22 4.63 186.2 0.56 0.08 # 16000 2.73 121.8 0.52 19.2 2.00 0.08 # 32000 15.4 1.42 7.78 0.12 # ^ ^ ^ # | use this THIRD ---+ | # use this SECOND ---+ | # use this FIRST ---+ # approx # growth 5.6x 7.6x 8.0x 2.7x 4.1x 4.7x 3.9x 2.0x print " using BigFloat for Pi($digits)\n" if $_verbose; _upgrade_to_float(0); return Math::BigFloat::bpi($digits+10)->round($digits); } sub forpart { my($sub, $n, $rhash) = @_; _forcompositions(1, $sub, $n, $rhash); } sub forcomp { my($sub, $n, $rhash) = @_; _forcompositions(0, $sub, $n, $rhash); } sub _forcompositions { my($ispart, $sub, $n, $rhash) = @_; _validate_positive_integer($n); my($mina, $maxa, $minn, $maxn, $primeq) = (1,$n,1,$n,-1); if (defined $rhash) { croak "forpart second argument must be a hash reference" unless ref($rhash) eq 'HASH'; if (defined $rhash->{amin}) { $mina = $rhash->{amin}; _validate_positive_integer($mina); } if (defined $rhash->{amax}) { $maxa = $rhash->{amax}; _validate_positive_integer($maxa); } $minn = $maxn = $rhash->{n} if defined $rhash->{n}; $minn = $rhash->{nmin} if defined $rhash->{nmin}; $maxn = $rhash->{nmax} if defined $rhash->{nmax}; _validate_positive_integer($minn); _validate_positive_integer($maxn); if (defined $rhash->{prime}) { $primeq = $rhash->{prime}; _validate_positive_integer($primeq); } $mina = 1 if $mina < 1; $maxa = $n if $maxa > $n; $minn = 1 if $minn < 1; $maxn = $n if $maxn > $n; $primeq = 2 if $primeq != -1 && $primeq != 0; } $sub->() if $n == 0 && $minn <= 1; return if $n < $minn || $minn > $maxn || $mina > $maxa || $maxn <= 0 || $maxa <= 0; my $oldforexit = Math::Prime::Util::_start_for_loop(); my ($x, $y, $r, $k); my @a = (0) x ($n); $k = 1; $a[0] = $mina - 1; $a[1] = $n - $mina + 1; while ($k != 0) { $x = $a[$k-1]+1; $y = $a[$k]-1; $k--; $r = $ispart ? $x : 1; while ($r <= $y) { $a[$k] = $x; $x = $r; $y -= $x; $k++; } $a[$k] = $x + $y; # Restrict size while ($k+1 > $maxn) { $a[$k-1] += $a[$k]; $k--; } next if $k+1 < $minn; # Restrict values if ($mina > 1 || $maxa < $n) { last if $a[0] > $maxa; if ($ispart) { next if $a[$k] > $maxa; } else { next if Math::Prime::Util::vecany(sub{ $_ < $mina || $_ > $maxa }, @a[0..$k]); } } next if $primeq == 0 && Math::Prime::Util::vecany(sub{ is_prime($_) }, @a[0..$k]); next if $primeq == 2 && Math::Prime::Util::vecany(sub{ !is_prime($_) }, @a[0..$k]); last if Math::Prime::Util::_get_forexit(); $sub->(@a[0 .. $k]); } Math::Prime::Util::_end_for_loop($oldforexit); } sub forcomb { my($sub, $n, $k) = @_; _validate_positive_integer($n); my($begk, $endk); if (defined $k) { _validate_positive_integer($k); return if $k > $n; $begk = $endk = $k; } else { $begk = 0; $endk = $n; } my $oldforexit = Math::Prime::Util::_start_for_loop(); for my $k ($begk .. $endk) { if ($k == 0) { $sub->(); } else { my @c = 0 .. $k-1; while (1) { $sub->(@c); last if Math::Prime::Util::_get_forexit(); next if $c[-1]++ < $n-1; my $i = $k-2; $i-- while $i >= 0 && $c[$i] >= $n-($k-$i); last if $i < 0; $c[$i]++; while (++$i < $k) { $c[$i] = $c[$i-1] + 1; } } } last if Math::Prime::Util::_get_forexit(); } Math::Prime::Util::_end_for_loop($oldforexit); } sub _forperm { my($sub, $n, $all_perm) = @_; my $k = $n; my @c = reverse 0 .. $k-1; my $inc = 0; my $send = 1; my $oldforexit = Math::Prime::Util::_start_for_loop(); while (1) { if (!$all_perm) { # Derangements via simple filtering. $send = 1; for my $p (0 .. $#c) { if ($c[$p] == $k-$p-1) { $send = 0; last; } } } if ($send) { $sub->(reverse @c); last if Math::Prime::Util::_get_forexit(); } if (++$inc & 1) { @c[0,1] = @c[1,0]; next; } my $j = 2; $j++ while $j < $k && $c[$j] > $c[$j-1]; last if $j >= $k; my $m = 0; $m++ while $c[$j] > $c[$m]; @c[$j,$m] = @c[$m,$j]; @c[0..$j-1] = reverse @c[0..$j-1]; } Math::Prime::Util::_end_for_loop($oldforexit); } sub forperm { my($sub, $n, $k) = @_; _validate_positive_integer($n); croak "Too many arguments for forperm" if defined $k; return $sub->() if $n == 0; return $sub->(0) if $n == 1; _forperm($sub, $n, 1); } sub forderange { my($sub, $n, $k) = @_; _validate_positive_integer($n); croak "Too many arguments for forderange" if defined $k; return $sub->() if $n == 0; return if $n == 1; _forperm($sub, $n, 0); } sub _multiset_permutations { my($sub, $prefix, $ar, $sum) = @_; return if $sum == 0; # Remove any values with 0 occurances my @n = grep { $_->[1] > 0 } @$ar; if ($sum == 1) { # A single value $sub->(@$prefix, $n[0]->[0]); } elsif ($sum == 2) { # Optimize the leaf case my($n0,$n1) = map { $_->[0] } @n; if (@n == 1) { $sub->(@$prefix, $n0, $n0); } else { $sub->(@$prefix, $n0, $n1); $sub->(@$prefix, $n1, $n0) unless Math::Prime::Util::_get_forexit(); } } elsif (0 && $sum == scalar(@n)) { # All entries have 1 occurance # TODO: Figure out a way to use this safely. We need to capture any # lastfor that was seen in the forperm. my @i = map { $_->[0] } @n; Math::Prime::Util::forperm(sub { $sub->(@$prefix, @i[@_]) }, 1+$#i); } else { # Recurse over each leading value for my $v (@n) { $v->[1]--; push @$prefix, $v->[0]; no warnings 'recursion'; _multiset_permutations($sub, $prefix, \@n, $sum-1); pop @$prefix; $v->[1]++; last if Math::Prime::Util::_get_forexit(); } } } sub numtoperm { my($n,$k) = @_; _validate_positive_integer($n); _validate_integer($k); return () if $n == 0; return (0) if $n == 1; my $f = factorial($n-1); $k %= vecprod($f,$n) if $k < 0 || int($k/$f) >= $n; my @S = map { $_ } 0 .. $n-1; my @V; while ($n-- > 0) { my $i = int($k/$f); push @V, splice(@S,$i,1); last if $n == 0; $k -= $i*$f; $f /= $n; } @V; } sub permtonum { my $A = shift; croak "permtonum argument must be an array reference" unless ref($A) eq 'ARRAY'; my $n = scalar(@$A); return 0 if $n == 0; { my %S; for my $v (@$A) { croak "permtonum invalid permutation array" if !defined $v || $v < 0 || $v >= $n || $S{$v}++; } } my $f = factorial($n-1); my $rank = 0; for my $i (0 .. $n-2) { my $k = 0; for my $j ($i+1 .. $n-1) { $k++ if $A->[$j] < $A->[$i]; } $rank = Math::Prime::Util::vecsum($rank, Math::Prime::Util::vecprod($k,$f)); $f /= $n-$i-1; } $rank; } sub randperm { my($n,$k) = @_; _validate_positive_integer($n); if (defined $k) { _validate_positive_integer($k); } $k = $n if !defined($k) || $k > $n; return () if $k == 0; my @S; if ("$k"/"$n" <= 0.30) { my %seen; my $v; for my $i (1 .. $k) { do { $v = Math::Prime::Util::urandomm($n); } while $seen{$v}++; push @S,$v; } } else { @S = map { $_ } 0..$n-1; for my $i (0 .. $n-2) { last if $i >= $k; my $j = Math::Prime::Util::urandomm($n-$i); @S[$i,$i+$j] = @S[$i+$j,$i]; } $#S = $k-1; } return @S; } sub shuffle { my @S=@_; # Note: almost all the time is spent in urandomm. for (my $i = $#S; $i >= 1; $i--) { my $j = Math::Prime::Util::urandomm($i+1); @S[$i,$j] = @S[$j,$i]; } @S; } ############################################################################### # Random numbers ############################################################################### # PPFE: irand irand64 drand random_bytes csrand srand _is_csprng_well_seeded sub urandomb { my($n) = @_; return 0 if $n <= 0; return ( Math::Prime::Util::irand() >> (32-$n) ) if $n <= 32; return ( Math::Prime::Util::irand64() >> (64-$n) ) if MPU_MAXBITS >= 64 && $n <= 64; my $bytes = Math::Prime::Util::random_bytes(($n+7)>>3); my $binary = substr(unpack("B*",$bytes),0,$n); return Math::BigInt->new("0b$binary"); } sub urandomm { my($n) = @_; # _validate_positive_integer($n); return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::urandomm($n)) if $Math::Prime::Util::_GMPfunc{"urandomm"}; return 0 if $n <= 1; my $r; if ($n <= 4294967295) { my $rmax = int(4294967295 / $n) * $n; do { $r = Math::Prime::Util::irand() } while $r >= $rmax; } elsif (!ref($n)) { my $rmax = int(~0 / $n) * $n; do { $r = Math::Prime::Util::irand64() } while $r >= $rmax; } else { # TODO: verify and try to optimize this my $bits = length($n->as_bin) - 2; my $bytes = 1 + (($bits+7)>>3); my $rmax = Math::BigInt->bone->blsft($bytes*8)->bdec; my $overflow = $rmax - ($rmax % $n); do { $r = Math::Prime::Util::urandomb($bytes*8); } while $r >= $overflow; } return $r % $n; } sub random_prime { my($low, $high) = @_; if (scalar(@_) == 1) { ($low,$high) = (2,$low); } else { _validate_positive_integer($low); } _validate_positive_integer($high); return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_prime($low, $high)) if $Math::Prime::Util::_GMPfunc{"random_prime"}; require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_prime($low,$high); } sub random_ndigit_prime { my($digits) = @_; _validate_positive_integer($digits, 1); return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_ndigit_prime($digits)) if $Math::Prime::Util::_GMPfunc{"random_ndigit_prime"}; require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_ndigit_prime($digits); } sub random_nbit_prime { my($bits) = @_; _validate_positive_integer($bits, 2); return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_nbit_prime($bits)) if $Math::Prime::Util::_GMPfunc{"random_nbit_prime"}; require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_nbit_prime($bits); } sub random_strong_prime { my($bits) = @_; _validate_positive_integer($bits, 128); return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_strong_prime($bits)) if $Math::Prime::Util::_GMPfunc{"random_strong_prime"}; require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_strong_prime($bits); } sub random_maurer_prime { my($bits) = @_; _validate_positive_integer($bits, 2); return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_maurer_prime($bits)) if $Math::Prime::Util::_GMPfunc{"random_maurer_prime"}; require Math::Prime::Util::RandomPrimes; my ($n, $cert) = Math::Prime::Util::RandomPrimes::random_maurer_prime_with_cert($bits); croak "maurer prime $n failed certificate verification!" unless Math::Prime::Util::verify_prime($cert); return $n; } sub random_shawe_taylor_prime { my($bits) = @_; _validate_positive_integer($bits, 2); return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_shawe_taylor_prime($bits)) if $Math::Prime::Util::_GMPfunc{"random_shawe_taylor_prime"}; require Math::Prime::Util::RandomPrimes; my ($n, $cert) = Math::Prime::Util::RandomPrimes::random_shawe_taylor_prime_with_cert($bits); croak "shawe-taylor prime $n failed certificate verification!" unless Math::Prime::Util::verify_prime($cert); return $n; } sub miller_rabin_random { my($n, $k, $seed) = @_; _validate_positive_integer($n); if (scalar(@_) == 1 ) { $k = 1; } else { _validate_positive_integer($k); } return 1 if $k <= 0; if ($Math::Prime::Util::_GMPfunc{"miller_rabin_random"}) { return Math::Prime::Util::GMP::miller_rabin_random($n, $k, $seed) if defined $seed; return Math::Prime::Util::GMP::miller_rabin_random($n, $k); } # Math::Prime::Util::prime_get_config()->{'assume_rh'}) ==> 2*log(n)^2 if ($k >= int(3*$n/4) ) { for (2 .. int(3*$n/4)+2) { return 0 unless Math::Prime::Util::is_strong_pseudoprime($n, $_); } return 1; } my $brange = $n-2; return 0 unless Math::Prime::Util::is_strong_pseudoprime($n, Math::Prime::Util::urandomm($brange)+2 ); $k--; while ($k > 0) { my $nbases = ($k >= 20) ? 20 : $k; return 0 unless is_strong_pseudoprime($n, map { urandomm($brange)+2 } 1 .. $nbases); $k -= $nbases; } 1; } sub random_semiprime { my($b) = @_; return 0 if defined $b && int($b) < 0; _validate_positive_integer($b,4); my $n; my $min = ($b <= MPU_MAXBITS) ? (1 << ($b-1)) : BTWO->copy->bpow($b-1); my $max = $min + ($min - 1); my $L = $b >> 1; my $N = $b - $L; my $one = ($b <= MPU_MAXBITS) ? 1 : BONE; do { $n = $one * random_nbit_prime($L) * random_nbit_prime($N); } while $n < $min || $n > $max; $n = _bigint_to_int($n) if ref($n) && $n->bacmp(BMAX) <= 0; $n; } sub random_unrestricted_semiprime { my($b) = @_; return 0 if defined $b && int($b) < 0; _validate_positive_integer($b,3); my $n; my $min = ($b <= MPU_MAXBITS) ? (1 << ($b-1)) : BTWO->copy->bpow($b-1); my $max = $min + ($min - 1); if ($b <= 64) { do { $n = $min + urandomb($b-1); } while !Math::Prime::Util::is_semiprime($n); } else { # Try to get probabilities right for small divisors my %M = ( 2 => 1.91218397452243, 3 => 1.33954826555021, 5 => 0.854756717114822, 7 => 0.635492301836862, 11 => 0.426616792046787, 13 => 0.368193843118344, 17 => 0.290512701603111, 19 => 0.263359264658156, 23 => 0.222406328935102, 29 => 0.181229250520242, 31 => 0.170874199059434, 37 => 0.146112155735473, 41 => 0.133427839963585, 43 => 0.127929010905662, 47 => 0.118254609086782, 53 => 0.106316418106489, 59 => 0.0966989675438643, 61 => 0.0938833658008547, 67 => 0.0864151823151671, 71 => 0.0820822953188297, 73 => 0.0800964416340746, 79 => 0.0747060914833344, 83 => 0.0714973706654851, 89 => 0.0672115468436284, 97 => 0.0622818892486191, 101 => 0.0600855891549939, 103 => 0.0590613570015407, 107 => 0.0570921135626976, 109 => 0.0561691667641485, 113 => 0.0544330141081874, 127 => 0.0490620204315701, ); my ($p,$r); $r = Math::Prime::Util::drand(); for my $prime (2..127) { next unless defined $M{$prime}; my $PR = $M{$prime} / $b + 0.19556 / $prime; if ($r <= $PR) { $p = $prime; last; } $r -= $PR; } if (!defined $p) { # Idea from Charles Greathouse IV, 2010. The distribution is right # at the high level (small primes weighted more and not far off what # we get with the uniform selection), but there is a noticeable skew # toward primes with a large gap after them. For instance 3 ends up # being weighted as much as 2, and 7 more than 5. # # Since we handled small divisors earlier, this is less bothersome. my $M = 0.26149721284764278375542683860869585905; my $weight = $M + log($b * log(2)/2); my $minr = log(log(131)); do { $r = Math::Prime::Util::drand($weight) - $M; } while $r < $minr; # Using Math::BigFloat::bexp is ungodly slow, so avoid at all costs. my $re = exp($r); my $a = ($re < log(~0)) ? int(exp($re)+0.5) : _upgrade_to_float($re)->bexp->bround->as_int; $p = $a < 2 ? 2 : Math::Prime::Util::prev_prime($a+1); } my $ranmin = ref($min) ? $min->badd($p-1)->bdiv($p)->as_int : int(($min+$p-1)/$p); my $ranmax = ref($max) ? $max->bdiv($p)->as_int : int($max/$p); my $q = random_prime($ranmin, $ranmax); $n = Math::Prime::Util::vecprod($p,$q); } $n = _bigint_to_int($n) if ref($n) && $n->bacmp(BMAX) <= 0; $n; } sub random_factored_integer { my($n) = @_; return (0,[]) if defined $n && int($n) < 0; _validate_positive_integer($n,1); while (1) { my @S = ($n); # make s_i chain push @S, 1 + Math::Prime::Util::urandomm($S[-1]) while $S[-1] > 1; # first is n, last is 1 @S = grep { is_prime($_) } @S[1 .. $#S-1]; my $r = Math::Prime::Util::vecprod(@S); return ($r, [@S]) if $r <= $n && (1+urandomm($n)) <= $r; } } 1; __END__ # ABSTRACT: Pure Perl version of Math::Prime::Util =pod =encoding utf8 =head1 NAME Math::Prime::Util::PP - Pure Perl version of Math::Prime::Util =head1 VERSION Version 0.73 =head1 SYNOPSIS The functionality is basically identical to L<Math::Prime::Util>, as this module is just the Pure Perl implementation. This documentation will only note differences. # Normally you would just import the functions you are using. # Nothing is exported by default. use Math::Prime::Util ':all'; =head1 DESCRIPTION Pure Perl implementations of prime number utilities that are normally handled with XS or GMP. Having the Perl implementations (1) provides examples, (2) allows the functions to run even if XS isn't available, and (3) gives big number support if L<Math::Prime::Util::GMP> isn't available. This is a subset of L<Math::Prime::Util>'s functionality. All routines should work with native integers or multi-precision numbers. To enable big numbers, use bigint or bignum: use bigint; say prime_count_approx(1000000000000000000000000)' # says 18435599767347543283712 This is still experimental, and some functions will be very slow. The L<Math::Prime::Util::GMP> module has much faster versions of many of these functions. Alternately, L<Math::Pari> has a lot of these types of functions. =head1 FUNCTIONS =head2 euler_phi Takes a I<single> integer input and returns the Euler totient. =head2 euler_phi_range Takes two values defining a range C<low> to C<high> and returns an array with the totient of each value in the range, inclusive. =head2 moebius Takes a I<single> integer input and returns the Moebius function. =head2 moebius_range Takes two values defining a range C<low> to C<high> and returns an array with the Moebius function of each value in the range, inclusive. =head1 LIMITATIONS The SQUFOF and Fermat factoring algorithms are not implemented yet. Some of the prime methods use more memory than they should, as the segmented sieve is not properly used in C<primes> and C<prime_count>. =head1 PERFORMANCE Performance compared to the XS/C code is quite poor for many operations. Some operations that are relatively close for small and medium-size values: next_prime / prev_prime is_prime / is_prob_prime is_strong_pseudoprime ExponentialIntegral / LogarithmicIntegral / RiemannR primearray Operations that are slower include: primes random_prime / random_ndigit_prime factor / factor_exp / divisors nth_prime prime_count is_aks_prime Performance improvement in this code is still possible. The prime sieve is over 2x faster than anything I was able to find online, but it is still has room for improvement. L<Math::Prime::Util::GMP> offers C<C+XS+GMP> support for most of the important functions, and will be vastly faster for most operations. If you install that module, L<Math::Prime::Util> will load it automatically, meaning you should not have to think about what code is actually being used (C, GMP, or Perl). Memory use will generally be higher for the PP code, and in some cases B<much> higher. Some of this may be addressed in a later release. For small values (e.g. primes and prime counts under 10M) most of this will not matter. =head1 SEE ALSO L<Math::Prime::Util> L<Math::Prime::Util::GMP> =head1 AUTHORS Dana Jacobsen E<lt>dana@acm.orgE<gt> =head1 COPYRIGHT Copyright 2012-2016 by Dana Jacobsen E<lt>dana@acm.orgE<gt> This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut
Close