1package Math::Prime::Util::PP; 2use strict; 3use warnings; 4use Carp qw/carp croak confess/; 5 6BEGIN { 7 $Math::Prime::Util::PP::AUTHORITY = 'cpan:DANAJ'; 8 $Math::Prime::Util::PP::VERSION = '0.73'; 9} 10 11BEGIN { 12 do { require Math::BigInt; Math::BigInt->import(try=>"GMP,Pari"); } 13 unless defined $Math::BigInt::VERSION; 14} 15 16# The Pure Perl versions of all the Math::Prime::Util routines. 17# 18# Some of these will be relatively similar in performance, some will be 19# very slow in comparison. 20# 21# Most of these are pretty simple. Also, you really should look at the C 22# code for more detailed comments, including references to papers. 23 24BEGIN { 25 use constant OLD_PERL_VERSION=> $] < 5.008; 26 use constant MPU_MAXBITS => (~0 == 4294967295) ? 32 : 64; 27 use constant MPU_64BIT => MPU_MAXBITS == 64; 28 use constant MPU_32BIT => MPU_MAXBITS == 32; 29 #use constant MPU_MAXPARAM => MPU_32BIT ? 4294967295 : 18446744073709551615; 30 #use constant MPU_MAXDIGITS => MPU_32BIT ? 10 : 20; 31 use constant MPU_MAXPRIME => MPU_32BIT ? 4294967291 : 18446744073709551557; 32 use constant MPU_MAXPRIMEIDX => MPU_32BIT ? 203280221 : 425656284035217743; 33 use constant MPU_HALFWORD => MPU_32BIT ? 65536 : OLD_PERL_VERSION ? 33554432 : 4294967296; 34 use constant UVPACKLET => MPU_32BIT ? 'L' : 'Q'; 35 use constant MPU_INFINITY => (65535 > 0+'inf') ? 20**20**20 : 0+'inf'; 36 use constant BZERO => Math::BigInt->bzero; 37 use constant BONE => Math::BigInt->bone; 38 use constant BTWO => Math::BigInt->new(2); 39 use constant INTMAX => (!OLD_PERL_VERSION || MPU_32BIT) ? ~0 : 562949953421312; 40 use constant BMAX => Math::BigInt->new('' . INTMAX); 41 use constant B_PRIM767 => Math::BigInt->new("261944051702675568529303"); 42 use constant B_PRIM235 => Math::BigInt->new("30"); 43 use constant PI_TIMES_8 => 25.13274122871834590770114707; 44} 45 46my $_precalc_size = 0; 47sub prime_precalc { 48 my($n) = @_; 49 croak "Parameter '$n' must be a positive integer" unless _is_positive_int($n); 50 $_precalc_size = $n if $n > $_precalc_size; 51} 52sub prime_memfree { 53 $_precalc_size = 0; 54 eval { Math::Prime::Util::GMP::_GMP_memfree(); } 55 if defined $Math::Prime::Util::GMP::VERSION && $Math::Prime::Util::GMP::VERSION >= 0.49; 56} 57sub _get_prime_cache_size { $_precalc_size } 58sub _prime_memfreeall { prime_memfree; } 59 60 61sub _is_positive_int { 62 ((defined $_[0]) && $_[0] ne '' && ($_[0] !~ tr/0123456789//c)); 63} 64 65sub _bigint_to_int { 66 #if (OLD_PERL_VERSION) { 67 # my $pack = ($_[0] < 0) ? lc(UVPACKLET) : UVPACKLET; 68 # return unpack($pack,pack($pack,"$_[0]")); 69 #} 70 int("$_[0]"); 71} 72 73sub _upgrade_to_float { 74 do { require Math::BigFloat; Math::BigFloat->import(); } 75 if !defined $Math::BigFloat::VERSION; 76 Math::BigFloat->new(@_); 77} 78 79# Get the accuracy of variable x, or the max default from BigInt/BigFloat 80# One might think to use ref($x)->accuracy() but numbers get upgraded and 81# downgraded willy-nilly, and it will do the wrong thing from the user's 82# perspective. 83sub _find_big_acc { 84 my($x) = @_; 85 my $b; 86 87 $b = $x->accuracy() if ref($x) =~ /^Math::Big/; 88 return $b if defined $b; 89 90 my ($i,$f) = (Math::BigInt->accuracy(), Math::BigFloat->accuracy()); 91 return (($i > $f) ? $i : $f) if defined $i && defined $f; 92 return $i if defined $i; 93 return $f if defined $f; 94 95 ($i,$f) = (Math::BigInt->div_scale(), Math::BigFloat->div_scale()); 96 return (($i > $f) ? $i : $f) if defined $i && defined $f; 97 return $i if defined $i; 98 return $f if defined $f; 99 return 18; 100} 101 102sub _bfdigits { 103 my($wantbf, $xdigits) = (0, 17); 104 if (defined $bignum::VERSION || ref($_[0]) =~ /^Math::Big/) { 105 do { require Math::BigFloat; Math::BigFloat->import(); } 106 if !defined $Math::BigFloat::VERSION; 107 if (ref($_[0]) eq 'Math::BigInt') { 108 my $xacc = ($_[0])->accuracy(); 109 $_[0] = Math::BigFloat->new($_[0]); 110 ($_[0])->accuracy($xacc) if $xacc; 111 } 112 $_[0] = Math::BigFloat->new("$_[0]") if ref($_[0]) ne 'Math::BigFloat'; 113 $wantbf = _find_big_acc($_[0]); 114 $xdigits = $wantbf; 115 } 116 ($wantbf, $xdigits); 117} 118 119 120sub _validate_num { 121 my($n, $min, $max) = @_; 122 croak "Parameter must be defined" if !defined $n; 123 return 0 if ref($n); 124 croak "Parameter '$n' must be a positive integer" 125 if $n eq '' || ($n =~ tr/0123456789//c && $n !~ /^\+\d+$/); 126 croak "Parameter '$n' must be >= $min" if defined $min && $n < $min; 127 croak "Parameter '$n' must be <= $max" if defined $max && $n > $max; 128 substr($_[0],0,1,'') if substr($n,0,1) eq '+'; 129 return 0 unless $n < ~0 || int($n) eq ''.~0; 130 1; 131} 132 133sub _validate_positive_integer { 134 my($n, $min, $max) = @_; 135 croak "Parameter must be defined" if !defined $n; 136 if (ref($n) eq 'CODE') { 137 $_[0] = $_[0]->(); 138 $n = $_[0]; 139 } 140 if (ref($n) eq 'Math::BigInt') { 141 croak "Parameter '$n' must be a positive integer" 142 if $n->sign() ne '+' || !$n->is_int(); 143 $_[0] = _bigint_to_int($_[0]) if $n <= BMAX; 144 } elsif (ref($n) eq 'Math::GMPz') { 145 croak "Parameter '$n' must be a positive integer" if Math::GMPz::Rmpz_sgn($n) < 0; 146 $_[0] = _bigint_to_int($_[0]) if $n <= INTMAX; 147 } else { 148 my $strn = "$n"; 149 if ($strn eq '-0') { $_[0] = 0; $strn = '0'; } 150 croak "Parameter '$strn' must be a positive integer" 151 if $strn eq '' || ($strn =~ tr/0123456789//c && $strn !~ /^\+?\d+$/); 152 if ($n <= INTMAX) { 153 $_[0] = $strn if ref($n); 154 } else { 155 $_[0] = Math::BigInt->new($strn) 156 } 157 } 158 $_[0]->upgrade(undef) if ref($_[0]) eq 'Math::BigInt' && $_[0]->upgrade(); 159 croak "Parameter '$_[0]' must be >= $min" if defined $min && $_[0] < $min; 160 croak "Parameter '$_[0]' must be <= $max" if defined $max && $_[0] > $max; 161 1; 162} 163 164sub _validate_integer { 165 my($n) = @_; 166 croak "Parameter must be defined" if !defined $n; 167 if (ref($n) eq 'CODE') { 168 $_[0] = $_[0]->(); 169 $n = $_[0]; 170 } 171 my $poscmp = OLD_PERL_VERSION ? 562949953421312 : ''.~0; 172 my $negcmp = OLD_PERL_VERSION ? -562949953421312 : -(~0 >> 1); 173 if (ref($n) eq 'Math::BigInt') { 174 croak "Parameter '$n' must be an integer" if !$n->is_int(); 175 $_[0] = _bigint_to_int($_[0]) if $n <= $poscmp && $n >= $negcmp; 176 } else { 177 my $strn = "$n"; 178 if ($strn eq '-0') { $_[0] = 0; $strn = '0'; } 179 croak "Parameter '$strn' must be an integer" 180 if $strn eq '' || ($strn =~ tr/-0123456789//c && $strn !~ /^[-+]?\d+$/); 181 if ($n <= $poscmp && $n >= $negcmp) { 182 $_[0] = $strn if ref($n); 183 } else { 184 $_[0] = Math::BigInt->new($strn) 185 } 186 } 187 $_[0]->upgrade(undef) if ref($_[0]) && $_[0]->upgrade(); 188 1; 189} 190 191sub _binary_search { 192 my($n, $lo, $hi, $sub, $exitsub) = @_; 193 while ($lo < $hi) { 194 my $mid = $lo + int(($hi-$lo) >> 1); 195 return $mid if defined $exitsub && $exitsub->($n,$lo,$hi); 196 if ($sub->($mid) < $n) { $lo = $mid+1; } 197 else { $hi = $mid; } 198 } 199 return $lo-1; 200} 201 202my @_primes_small = (0,2); 203{ 204 my($n, $s, $sieveref) = (7-2, 3, _sieve_erat_string(5003)); 205 push @_primes_small, 2*pos($$sieveref)-1 while $$sieveref =~ m/0/g; 206} 207my @_prime_next_small = ( 208 2,2,3,5,5,7,7,11,11,11,11,13,13,17,17,17,17,19,19,23,23,23,23, 209 29,29,29,29,29,29,31,31,37,37,37,37,37,37,41,41,41,41,43,43,47, 210 47,47,47,53,53,53,53,53,53,59,59,59,59,59,59,61,61,67,67,67,67,67,67,71); 211 212# For wheel-30 213my @_prime_indices = (1, 7, 11, 13, 17, 19, 23, 29); 214my @_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); 215my @_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); 216my @_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); 217my @_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); 218 219sub _tiny_prime_count { 220 my($n) = @_; 221 return if $n >= $_primes_small[-1]; 222 my $j = $#_primes_small; 223 my $i = 1 + ($n >> 4); 224 while ($i < $j) { 225 my $mid = ($i+$j)>>1; 226 if ($_primes_small[$mid] <= $n) { $i = $mid+1; } 227 else { $j = $mid; } 228 } 229 return $i-1; 230} 231 232sub _is_prime7 { # n must not be divisible by 2, 3, or 5 233 my($n) = @_; 234 235 $n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt' && $n <= BMAX; 236 if (ref($n) eq 'Math::BigInt') { 237 return 0 unless Math::BigInt::bgcd($n, B_PRIM767)->is_one; 238 return 0 unless _miller_rabin_2($n); 239 my $is_esl_prime = is_extra_strong_lucas_pseudoprime($n); 240 return ($is_esl_prime) ? (($n <= "18446744073709551615") ? 2 : 1) : 0; 241 } 242 243 if ($n < 61*61) { 244 foreach my $i (qw/7 11 13 17 19 23 29 31 37 41 43 47 53 59/) { 245 return 2 if $i*$i > $n; 246 return 0 if !($n % $i); 247 } 248 return 2; 249 } 250 251 return 0 if !($n % 7) || !($n % 11) || !($n % 13) || !($n % 17) || 252 !($n % 19) || !($n % 23) || !($n % 29) || !($n % 31) || 253 !($n % 37) || !($n % 41) || !($n % 43) || !($n % 47) || 254 !($n % 53) || !($n % 59); 255 256 # We could do: 257 # return is_strong_pseudoprime($n, (2,299417)) if $n < 19471033; 258 # or: 259 # foreach my $p (@_primes_small[18..168]) { 260 # last if $p > $limit; 261 # return 0 unless $n % $p; 262 # } 263 # return 2; 264 265 if ($n <= 1_500_000) { 266 my $limit = int(sqrt($n)); 267 my $i = 61; 268 while (($i+30) <= $limit) { 269 return 0 unless ($n% $i ) && ($n%($i+ 6)) && 270 ($n%($i+10)) && ($n%($i+12)) && 271 ($n%($i+16)) && ($n%($i+18)) && 272 ($n%($i+22)) && ($n%($i+28)); 273 $i += 30; 274 } 275 for my $inc (6,4,2,4,2,4,6,2) { 276 last if $i > $limit; 277 return 0 if !($n % $i); 278 $i += $inc; 279 } 280 return 2; 281 } 282 283 if ($n < 47636622961201) { # BPSW seems to be faster after this 284 # Deterministic set of Miller-Rabin tests. If the MR routines can handle 285 # bases greater than n, then this can be simplified. 286 my @bases; 287 # n > 1_000_000 because of the previous block. 288 if ($n < 19471033) { @bases = ( 2, 299417); } 289 elsif ($n < 38010307) { @bases = ( 2, 9332593); } 290 elsif ($n < 316349281) { @bases = ( 11000544, 31481107); } 291 elsif ($n < 4759123141) { @bases = ( 2, 7, 61); } 292 elsif ($n < 154639673381) { @bases = ( 15, 176006322, 4221622697); } 293 elsif ($n < 47636622961201) { @bases = ( 2, 2570940, 211991001, 3749873356); } 294 elsif ($n < 3770579582154547) { @bases = ( 2, 2570940, 880937, 610386380, 4130785767); } 295 else { @bases = ( 2, 325, 9375, 28178, 450775, 9780504, 1795265022); } 296 return is_strong_pseudoprime($n, @bases) ? 2 : 0; 297 } 298 299 # Inlined BPSW 300 return 0 unless _miller_rabin_2($n); 301 return is_almost_extra_strong_lucas_pseudoprime($n) ? 2 : 0; 302} 303 304sub is_prime { 305 my($n) = @_; 306 return 0 if defined($n) && int($n) < 0; 307 _validate_positive_integer($n); 308 309 if (ref($n) eq 'Math::BigInt') { 310 return 0 unless Math::BigInt::bgcd($n, B_PRIM235)->is_one; 311 } else { 312 if ($n < 7) { return ($n == 2) || ($n == 3) || ($n == 5) ? 2 : 0; } 313 return 0 if !($n % 2) || !($n % 3) || !($n % 5); 314 } 315 return _is_prime7($n); 316} 317 318# is_prob_prime is the same thing for us. 319*is_prob_prime = \&is_prime; 320 321# BPSW probable prime. No composites are known to have passed this test 322# since it was published in 1980, though we know infinitely many exist. 323# It has also been verified that no 64-bit composite will return true. 324# Slow since it's all in PP and uses bigints. 325sub is_bpsw_prime { 326 my($n) = @_; 327 return 0 if defined($n) && int($n) < 0; 328 _validate_positive_integer($n); 329 return 0 unless _miller_rabin_2($n); 330 if ($n <= 18446744073709551615) { 331 return is_almost_extra_strong_lucas_pseudoprime($n) ? 2 : 0; 332 } 333 return is_extra_strong_lucas_pseudoprime($n) ? 1 : 0; 334} 335 336sub is_provable_prime { 337 my($n) = @_; 338 return 0 if defined $n && $n < 2; 339 _validate_positive_integer($n); 340 if ($n <= 18446744073709551615) { 341 return 0 unless _miller_rabin_2($n); 342 return 0 unless is_almost_extra_strong_lucas_pseudoprime($n); 343 return 2; 344 } 345 my($is_prime, $cert) = Math::Prime::Util::is_provable_prime_with_cert($n); 346 $is_prime; 347} 348 349# Possible sieve storage: 350# 1) vec with mod-30 wheel: 8 bits / 30 351# 2) vec with mod-2 wheel : 15 bits / 30 352# 3) str with mod-30 wheel: 8 bytes / 30 353# 4) str with mod-2 wheel : 15 bytes / 30 354# 355# It looks like using vecs is about 2x slower than strs, and the strings also 356# let us do some fast operations on the results. E.g. 357# Count all primes: 358# $count += $$sieveref =~ tr/0//; 359# Loop over primes: 360# foreach my $s (split("0", $$sieveref, -1)) { 361# $n += 2 + 2 * length($s); 362# .. do something with the prime $n 363# } 364# 365# We're using method 4, though sadly it is memory intensive relative to the 366# other methods. I will point out that it is 30-60x less memory than sieves 367# using an array, and the performance of this function is over 10x that 368# of naive sieves. 369 370sub _sieve_erat_string { 371 my($end) = @_; 372 $end-- if ($end & 1) == 0; 373 my $s_end = $end >> 1; 374 375 my $whole = int( $s_end / 15); # Prefill with 3 and 5 already marked. 376 croak "Sieve too large" if $whole > 1_145_324_612; # ~32 GB string 377 my $sieve = '100010010010110' . '011010010010110' x $whole; 378 substr($sieve, $s_end+1) = ''; # Ensure we don't make too many entries 379 my ($n, $limit) = ( 7, int(sqrt($end)) ); 380 while ( $n <= $limit ) { 381 for (my $s = ($n*$n) >> 1; $s <= $s_end; $s += $n) { 382 substr($sieve, $s, 1) = '1'; 383 } 384 do { $n += 2 } while substr($sieve, $n>>1, 1); 385 } 386 return \$sieve; 387} 388 389# TODO: this should be plugged into precalc, memfree, etc. just like the C code 390{ 391 my $primary_size_limit = 15000; 392 my $primary_sieve_size = 0; 393 my $primary_sieve_ref; 394 sub _sieve_erat { 395 my($end) = @_; 396 397 return _sieve_erat_string($end) if $end > $primary_size_limit; 398 399 if ($primary_sieve_size == 0) { 400 $primary_sieve_size = $primary_size_limit; 401 $primary_sieve_ref = _sieve_erat_string($primary_sieve_size); 402 } 403 my $sieve = substr($$primary_sieve_ref, 0, ($end+1)>>1); 404 return \$sieve; 405 } 406} 407 408 409sub _sieve_segment { 410 my($beg,$end,$limit) = @_; 411 ($beg, $end) = map { _bigint_to_int($_) } ($beg, $end) 412 if ref($end) && $end <= BMAX; 413 croak "Internal error: segment beg is even" if ($beg % 2) == 0; 414 croak "Internal error: segment end is even" if ($end % 2) == 0; 415 croak "Internal error: segment end < beg" if $end < $beg; 416 croak "Internal error: segment beg should be >= 3" if $beg < 3; 417 my $range = int( ($end - $beg) / 2 ) + 1; 418 419 # Prefill with 3 and 5 already marked, and offset to the segment start. 420 my $whole = int( ($range+14) / 15); 421 my $startp = ($beg % 30) >> 1; 422 my $sieve = substr('011010010010110', $startp) . '011010010010110' x $whole; 423 # Set 3 and 5 to prime if we're sieving them. 424 substr($sieve,0,2) = '00' if $beg == 3; 425 substr($sieve,0,1) = '0' if $beg == 5; 426 # Get rid of any extra we added. 427 substr($sieve, $range) = ''; 428 429 # If the end value is below 7^2, then the pre-sieve is all we needed. 430 return \$sieve if $end < 49; 431 432 my $sqlimit = ref($end) ? $end->copy->bsqrt() : int(sqrt($end)+0.0000001); 433 $limit = $sqlimit if !defined $limit || $sqlimit < $limit; 434 # For large value of end, it's a huge win to just walk primes. 435 436 my($p, $s, $primesieveref) = (7-2, 3, _sieve_erat($limit)); 437 while ( (my $nexts = 1 + index($$primesieveref, '0', $s)) > 0 ) { 438 $p += 2 * ($nexts - $s); 439 $s = $nexts; 440 my $p2 = $p*$p; 441 if ($p2 < $beg) { 442 my $f = 1+int(($beg-1)/$p); 443 $f++ unless $f % 2; 444 $p2 = $p * $f; 445 } 446 # With large bases and small segments, it's common to find we don't hit 447 # the segment at all. Skip all the setup if we find this now. 448 if ($p2 <= $end) { 449 # Inner loop marking multiples of p 450 # (everything is divided by 2 to keep inner loop simpler) 451 my $filter_end = ($end - $beg) >> 1; 452 my $filter_p2 = ($p2 - $beg) >> 1; 453 while ($filter_p2 <= $filter_end) { 454 substr($sieve, $filter_p2, 1) = "1"; 455 $filter_p2 += $p; 456 } 457 } 458 } 459 \$sieve; 460} 461 462sub trial_primes { 463 my($low,$high) = @_; 464 if (!defined $high) { 465 $high = $low; 466 $low = 2; 467 } 468 _validate_positive_integer($low); 469 _validate_positive_integer($high); 470 return if $low > $high; 471 my @primes; 472 473 # For a tiny range, just use next_prime calls 474 if (($high-$low) < 1000) { 475 $low-- if $low >= 2; 476 my $curprime = next_prime($low); 477 while ($curprime <= $high) { 478 push @primes, $curprime; 479 $curprime = next_prime($curprime); 480 } 481 return \@primes; 482 } 483 484 # Sieve to 10k then BPSW test 485 push @primes, 2 if ($low <= 2) && ($high >= 2); 486 push @primes, 3 if ($low <= 3) && ($high >= 3); 487 push @primes, 5 if ($low <= 5) && ($high >= 5); 488 $low = 7 if $low < 7; 489 $low++ if ($low % 2) == 0; 490 $high-- if ($high % 2) == 0; 491 my $sieveref = _sieve_segment($low, $high, 10000); 492 my $n = $low-2; 493 while ($$sieveref =~ m/0/g) { 494 my $p = $n+2*pos($$sieveref); 495 push @primes, $p if _miller_rabin_2($p) && is_extra_strong_lucas_pseudoprime($p); 496 } 497 return \@primes; 498} 499 500sub primes { 501 my($low,$high) = @_; 502 if (scalar @_ > 1) { 503 _validate_positive_integer($low); 504 _validate_positive_integer($high); 505 $low = 2 if $low < 2; 506 } else { 507 ($low,$high) = (2, $low); 508 _validate_positive_integer($high); 509 } 510 my $sref = []; 511 return $sref if ($low > $high) || ($high < 2); 512 return [grep { $_ >= $low && $_ <= $high } @_primes_small] 513 if $high <= $_primes_small[-1]; 514 515 return [ Math::Prime::Util::GMP::sieve_primes($low, $high, 0) ] 516 if $Math::Prime::Util::_GMPfunc{"sieve_primes"} && $Math::Prime::Util::GMP::VERSION >= 0.34; 517 518 # At some point even the pretty-fast pure perl sieve is going to be a 519 # dog, and we should move to trials. This is typical with a small range 520 # on a large base. More thought on the switchover should be done. 521 return trial_primes($low, $high) if ref($low) eq 'Math::BigInt' 522 || ref($high) eq 'Math::BigInt' 523 || ($low > 1_000_000_000_000 && ($high-$low) < int($low/1_000_000)); 524 525 push @$sref, 2 if ($low <= 2) && ($high >= 2); 526 push @$sref, 3 if ($low <= 3) && ($high >= 3); 527 push @$sref, 5 if ($low <= 5) && ($high >= 5); 528 $low = 7 if $low < 7; 529 $low++ if ($low % 2) == 0; 530 $high-- if ($high % 2) == 0; 531 return $sref if $low > $high; 532 533 my($n,$sieveref); 534 if ($low == 7) { 535 $n = 0; 536 $sieveref = _sieve_erat($high); 537 substr($$sieveref,0,3,'111'); 538 } else { 539 $n = $low-1; 540 $sieveref = _sieve_segment($low,$high); 541 } 542 push @$sref, $n+2*pos($$sieveref)-1 while $$sieveref =~ m/0/g; 543 $sref; 544} 545 546sub sieve_range { 547 my($n, $width, $depth) = @_; 548 _validate_positive_integer($n); 549 _validate_positive_integer($width); 550 _validate_positive_integer($depth); 551 552 my @candidates; 553 my $start = $n; 554 555 if ($n < 5) { 556 push @candidates, (2-$n) if $n <= 2 && $n+$width-1 >= 2; 557 push @candidates, (3-$n) if $n <= 3 && $n+$width-1 >= 3; 558 push @candidates, (4-$n) if $n <= 4 && $n+$width-1 >= 4 && $depth < 2; 559 $start = 5; 560 $width -= ($start - $n); 561 } 562 563 return @candidates, map {$start+$_-$n } 0 .. $width-1 if $depth < 2; 564 return @candidates, map { $_ - $n } 565 grep { ($_ & 1) && ($depth < 3 || ($_ % 3)) } 566 map { $start+$_ } 567 0 .. $width-1 if $depth < 5; 568 569 if (!($start & 1)) { $start++; $width--; } 570 $width-- if !($width&1); 571 return @candidates if $width < 1; 572 573 my $sieveref = _sieve_segment($start, $start+$width-1, $depth); 574 my $offset = $start - $n - 2; 575 while ($$sieveref =~ m/0/g) { 576 push @candidates, $offset + (pos($$sieveref) << 1); 577 } 578 return @candidates; 579} 580 581sub sieve_prime_cluster { 582 my($lo,$hi,@cl) = @_; 583 my $_verbose = Math::Prime::Util::prime_get_config()->{'verbose'}; 584 _validate_positive_integer($lo); 585 _validate_positive_integer($hi); 586 587 if ($Math::Prime::Util::_GMPfunc{"sieve_prime_cluster"}) { 588 return map { ($_ > ''.~0) ? Math::BigInt->new(''.$_) : $_ } 589 Math::Prime::Util::GMP::sieve_prime_cluster($lo,$hi,@cl); 590 } 591 592 return @{primes($lo,$hi)} if scalar(@cl) == 0; 593 594 unshift @cl, 0; 595 for my $i (1 .. $#cl) { 596 _validate_positive_integer($cl[$i]); 597 croak "sieve_prime_cluster: values must be even" if $cl[$i] & 1; 598 croak "sieve_prime_cluster: values must be increasing" if $cl[$i] <= $cl[$i-1]; 599 } 600 my($p,$sievelim,@p) = (17, 2000); 601 $p = 13 if ($hi-$lo) < 50_000_000; 602 $p = 11 if ($hi-$lo) < 1_000_000; 603 $p = 7 if ($hi-$lo) < 20_000 && $lo < INTMAX; 604 605 # Add any cases under our sieving point. 606 if ($lo <= $sievelim) { 607 $sievelim = $hi if $sievelim > $hi; 608 for my $n (@{primes($lo,$sievelim)}) { 609 my $ac = 1; 610 for my $ci (1 .. $#cl) { 611 if (!is_prime($n+$cl[$ci])) { $ac = 0; last; } 612 } 613 push @p, $n if $ac; 614 } 615 $lo = next_prime($sievelim); 616 } 617 return @p if $lo > $hi; 618 619 # Compute acceptable residues. 620 my $pr = primorial($p); 621 my $startpr = _bigint_to_int($lo % $pr); 622 623 my @acc = grep { ($_ & 1) && $_%3 } ($startpr .. $startpr + $pr - 1); 624 for my $c (@cl) { 625 if ($p >= 7) { 626 @acc = grep { (($_+$c)%3) && (($_+$c)%5) && (($_+$c)%7) } @acc; 627 } else { 628 @acc = grep { (($_+$c)%3) && (($_+$c)%5) } @acc; 629 } 630 } 631 for my $c (@cl) { 632 @acc = grep { Math::Prime::Util::gcd($_+$c,$pr) == 1 } @acc; 633 } 634 @acc = map { $_-$startpr } @acc; 635 636 print "cluster sieve using ",scalar(@acc)," residues mod $pr\n" if $_verbose; 637 return @p if scalar(@acc) == 0; 638 639 # Prepare table for more sieving. 640 my @mprimes = @{primes( $p+1, $sievelim)}; 641 my @vprem; 642 for my $p (@mprimes) { 643 for my $c (@cl) { 644 $vprem[$p]->[ ($p-($c%$p)) % $p ] = 1; 645 } 646 } 647 648 # Walk the range in primorial chunks, doing primality tests. 649 my($nummr, $numlucas) = (0,0); 650 while ($lo <= $hi) { 651 652 my @racc = @acc; 653 654 # Make sure we don't do anything past the limit 655 if (($lo+$acc[-1]) > $hi) { 656 my $max = _bigint_to_int($hi-$lo); 657 @racc = grep { $_ <= $max } @racc; 658 } 659 660 # Sieve more values using native math 661 foreach my $p (@mprimes) { 662 my $rem = _bigint_to_int( $lo % $p ); 663 @racc = grep { !$vprem[$p]->[ ($rem+$_) % $p ] } @racc; 664 last unless scalar(@racc); 665 } 666 667 # Do final primality tests. 668 if ($lo < 1e13) { 669 for my $r (@racc) { 670 my($good, $p) = (1, $lo + $r); 671 for my $c (@cl) { 672 $nummr++; 673 if (!Math::Prime::Util::is_prime($p+$c)) { $good = 0; last; } 674 } 675 push @p, $p if $good; 676 } 677 } else { 678 for my $r (@racc) { 679 my($good, $p) = (1, $lo + $r); 680 for my $c (@cl) { 681 $nummr++; 682 if (!Math::Prime::Util::is_strong_pseudoprime($p+$c,2)) { $good = 0; last; } 683 } 684 next unless $good; 685 for my $c (@cl) { 686 $numlucas++; 687 if (!Math::Prime::Util::is_extra_strong_lucas_pseudoprime($p+$c)) { $good = 0; last; } 688 } 689 push @p, $p if $good; 690 } 691 } 692 693 $lo += $pr; 694 } 695 print "cluster sieve ran $nummr MR and $numlucas Lucas tests\n" if $_verbose; 696 @p; 697} 698 699 700sub _n_ramanujan_primes { 701 my($n) = @_; 702 return [] if $n <= 0; 703 my $max = nth_prime_upper(int(48/19*$n)+1); 704 my @L = (2, (0) x $n-1); 705 my $s = 1; 706 for (my $k = 7; $k <= $max; $k += 2) { 707 $s++ if is_prime($k); 708 $L[$s] = $k+1 if $s < $n; 709 $s-- if ($k&3) == 1 && is_prime(($k+1)>>1); 710 $L[$s] = $k+2 if $s < $n; 711 } 712 \@L; 713} 714 715sub _ramanujan_primes { 716 my($low,$high) = @_; 717 ($low,$high) = (2, $low) unless defined $high; 718 return [] if ($low > $high) || ($high < 2); 719 my $nn = prime_count_upper($high) >> 1; 720 my $L = _n_ramanujan_primes($nn); 721 shift @$L while @$L && $L->[0] < $low; 722 pop @$L while @$L && $L->[-1] > $high; 723 $L; 724} 725 726sub is_ramanujan_prime { 727 my($n) = @_; 728 return 1 if $n == 2; 729 return 0 if $n < 11; 730 my $L = _ramanujan_primes($n,$n); 731 return (scalar(@$L) > 0) ? 1 : 0; 732} 733 734sub nth_ramanujan_prime { 735 my($n) = @_; 736 return undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) 737 my $L = _n_ramanujan_primes($n); 738 return $L->[$n-1]; 739} 740 741sub next_prime { 742 my($n) = @_; 743 _validate_positive_integer($n); 744 return $_prime_next_small[$n] if $n <= $#_prime_next_small; 745 # This turns out not to be faster. 746 # return $_primes_small[1+_tiny_prime_count($n)] if $n < $_primes_small[-1]; 747 748 return Math::BigInt->new(MPU_32BIT ? "4294967311" : "18446744073709551629") 749 if ref($n) ne 'Math::BigInt' && $n >= MPU_MAXPRIME; 750 # n is now either 1) not bigint and < maxprime, or (2) bigint and >= uvmax 751 752 if ($n > 4294967295 && Math::Prime::Util::prime_get_config()->{'gmp'}) { 753 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::next_prime($n)); 754 } 755 756 if (ref($n) eq 'Math::BigInt') { 757 do { 758 $n += $_wheeladvance30[$n%30]; 759 } while !Math::BigInt::bgcd($n, B_PRIM767)->is_one || 760 !_miller_rabin_2($n) || !is_extra_strong_lucas_pseudoprime($n); 761 } else { 762 do { 763 $n += $_wheeladvance30[$n%30]; 764 } while !($n%7) || !_is_prime7($n); 765 } 766 $n; 767} 768 769sub prev_prime { 770 my($n) = @_; 771 _validate_positive_integer($n); 772 return (undef,undef,undef,2,3,3,5,5,7,7,7,7)[$n] if $n <= 11; 773 if ($n > 4294967295 && Math::Prime::Util::prime_get_config()->{'gmp'}) { 774 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::prev_prime($n)); 775 } 776 777 if (ref($n) eq 'Math::BigInt') { 778 do { 779 $n -= $_wheelretreat30[$n%30]; 780 } while !Math::BigInt::bgcd($n, B_PRIM767)->is_one || 781 !_miller_rabin_2($n) || !is_extra_strong_lucas_pseudoprime($n); 782 } else { 783 do { 784 $n -= $_wheelretreat30[$n%30]; 785 } while !($n%7) || !_is_prime7($n); 786 } 787 $n; 788} 789 790sub partitions { 791 my $n = shift; 792 793 my $d = int(sqrt($n+1)); 794 my @pent = (1, map { (($_*(3*$_+1))>>1, (($_+1)*(3*$_+2))>>1) } 1 .. $d); 795 my $ZERO = ($n >= ((~0 > 4294967295) ? 400 : 270)) ? BZERO : 0; 796 my @part = ($ZERO+1); 797 foreach my $j (scalar @part .. $n) { 798 my ($psum1, $psum2, $k) = ($ZERO, $ZERO, 1); 799 foreach my $p (@pent) { 800 last if $p > $j; 801 if ((++$k) & 2) { $psum1 += $part[ $j - $p ] } 802 else { $psum2 += $part[ $j - $p ] } 803 } 804 $part[$j] = $psum1 - $psum2; 805 } 806 return $part[$n]; 807} 808 809sub primorial { 810 my $n = shift; 811 812 my @plist = @{primes($n)}; 813 my $max = (MPU_32BIT) ? 29 : (OLD_PERL_VERSION) ? 43 : 53; 814 815 # If small enough, multiply the small primes. 816 if ($n < $max) { 817 my $pn = 1; 818 $pn *= $_ for @plist; 819 return $pn; 820 } 821 822 # Otherwise, combine them as UVs, then combine using product tree. 823 my $i = 0; 824 while ($i < $#plist) { 825 my $m = $plist[$i] * $plist[$i+1]; 826 if ($m <= INTMAX) { splice(@plist, $i, 2, $m); } 827 else { $i++; } 828 } 829 vecprod(@plist); 830} 831 832sub consecutive_integer_lcm { 833 my $n = shift; 834 835 my $max = (MPU_32BIT) ? 22 : (OLD_PERL_VERSION) ? 37 : 46; 836 my $pn = ref($n) ? ref($n)->new(1) : ($n >= $max) ? Math::BigInt->bone() : 1; 837 for (my $p = 2; $p <= $n; $p = next_prime($p)) { 838 my($p_power, $pmin) = ($p, int($n/$p)); 839 $p_power *= $p while $p_power <= $pmin; 840 $pn *= $p_power; 841 } 842 $pn = _bigint_to_int($pn) if $pn <= BMAX; 843 return $pn; 844} 845 846sub jordan_totient { 847 my($k, $n) = @_; 848 return ($n == 1) ? 1 : 0 if $k == 0; 849 return euler_phi($n) if $k == 1; 850 return ($n == 1) ? 1 : 0 if $n <= 1; 851 852 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::jordan_totient($k, $n)) 853 if $Math::Prime::Util::_GMPfunc{"jordan_totient"}; 854 855 856 my @pe = Math::Prime::Util::factor_exp($n); 857 $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; 858 my $totient = BONE->copy; 859 foreach my $f (@pe) { 860 my ($p, $e) = @$f; 861 $p = Math::BigInt->new("$p")->bpow($k); 862 $totient->bmul($p->copy->bdec()); 863 $totient->bmul($p) for 2 .. $e; 864 } 865 $totient = _bigint_to_int($totient) if $totient->bacmp(BMAX) <= 0; 866 return $totient; 867} 868 869sub euler_phi { 870 return euler_phi_range(@_) if scalar @_ > 1; 871 my($n) = @_; 872 return 0 if defined $n && $n < 0; 873 874 return Math::Prime::Util::_reftyped($_[0],Math::Prime::Util::GMP::totient($n)) 875 if $Math::Prime::Util::_GMPfunc{"totient"}; 876 877 _validate_positive_integer($n); 878 return $n if $n <= 1; 879 880 my $totient = $n - $n + 1; 881 882 # Fast reduction of multiples of 2, may also reduce n for factoring 883 if (ref($n) eq 'Math::BigInt') { 884 my $s = 0; 885 if ($n->is_even) { 886 do { $n->brsft(BONE); $s++; } while $n->is_even; 887 $totient->blsft($s-1) if $s > 1; 888 } 889 } else { 890 while (($n % 4) == 0) { $n >>= 1; $totient <<= 1; } 891 if (($n % 2) == 0) { $n >>= 1; } 892 } 893 894 my @pe = Math::Prime::Util::factor_exp($n); 895 896 if ($#pe == 0 && $pe[0]->[1] == 1) { 897 if (ref($n) ne 'Math::BigInt') { $totient *= $n-1; } 898 else { $totient->bmul($n->bdec()); } 899 } elsif (ref($n) ne 'Math::BigInt') { 900 foreach my $f (@pe) { 901 my ($p, $e) = @$f; 902 $totient *= $p - 1; 903 $totient *= $p for 2 .. $e; 904 } 905 } else { 906 my $zero = $n->copy->bzero; 907 foreach my $f (@pe) { 908 my ($p, $e) = @$f; 909 $p = $zero->copy->badd("$p"); 910 $totient->bmul($p->copy->bdec()); 911 $totient->bmul($p) for 2 .. $e; 912 } 913 } 914 $totient = _bigint_to_int($totient) if ref($totient) eq 'Math::BigInt' 915 && $totient->bacmp(BMAX) <= 0; 916 return $totient; 917} 918 919sub inverse_totient { 920 my($n) = @_; 921 _validate_positive_integer($n); 922 923 return wantarray ? (1,2) : 2 if $n == 1; 924 return wantarray ? () : 0 if $n < 1 || ($n & 1); 925 926 $n = Math::Prime::Util::_to_bigint("$n") if !ref($n) && $n > 2**49; 927 my $do_bigint = ref($n); 928 929 if (is_prime($n >> 1)) { # Coleman Remark 3.3 (Thm 3.1) and Prop 6.2 930 return wantarray ? () : 0 if !is_prime($n+1); 931 return wantarray ? ($n+1, 2*$n+2) : 2 if $n >= 10; 932 } 933 934 if (!wantarray) { 935 my %r = ( 1 => 1 ); 936 Math::Prime::Util::fordivisors(sub { my $d = $_; 937 $d = $do_bigint->new("$d") if $do_bigint; 938 my $p = $d+1; 939 if (Math::Prime::Util::is_prime($p)) { 940 my($dp,@sumi,@sumv) = ($d); 941 for my $v (1 .. 1 + Math::Prime::Util::valuation($n, $p)) { 942 Math::Prime::Util::fordivisors(sub { my $d2 = $_; 943 if (defined $r{$d2}) { push @sumi, $d2*$dp; push @sumv, $r{$d2}; } 944 }, $n / $dp); 945 $dp *= $p; 946 } 947 $r{ $sumi[$_] } += $sumv[$_] for 0 .. $#sumi; 948 } 949 }, $n); 950 return (defined $r{$n}) ? $r{$n} : 0; 951 } else { 952 my %r = ( 1 => [1] ); 953 Math::Prime::Util::fordivisors(sub { my $d = $_; 954 $d = $do_bigint->new("$d") if $do_bigint; 955 my $p = $d+1; 956 if (Math::Prime::Util::is_prime($p)) { 957 my($dp,$pp,@T) = ($d,$p); 958 for my $v (1 .. 1 + Math::Prime::Util::valuation($n, $p)) { 959 Math::Prime::Util::fordivisors(sub { my $d2 = $_; 960 push @T, [ $d2*$dp, [map { $_ * $pp } @{ $r{$d2} }] ] if defined $r{$d2}; 961 }, $n / $dp); 962 $dp *= $p; 963 $pp *= $p; 964 } 965 push @{$r{$_->[0]}}, @{$_->[1]} for @T; 966 } 967 }, $n); 968 return () unless defined $r{$n}; 969 delete @r{ grep { $_ != $n } keys %r }; # Delete all intermediate results 970 my @result = sort { $a <=> $b } @{$r{$n}}; 971 return @result; 972 } 973} 974 975sub euler_phi_range { 976 my($lo, $hi) = @_; 977 _validate_integer($lo); 978 _validate_integer($hi); 979 980 my @totients; 981 while ($lo < 0 && $lo <= $hi) { 982 push @totients, 0; 983 $lo++; 984 } 985 return @totients if $hi < $lo; 986 987 if ($hi > 2**30 || $hi-$lo < 100) { 988 while ($lo <= $hi) { 989 push @totients, euler_phi($lo++); 990 } 991 } else { 992 my @tot = (0 .. $hi); 993 foreach my $i (2 .. $hi) { 994 next unless $tot[$i] == $i; 995 $tot[$i] = $i-1; 996 foreach my $j (2 .. int($hi / $i)) { 997 $tot[$i*$j] -= $tot[$i*$j]/$i; 998 } 999 } 1000 splice(@tot, 0, $lo) if $lo > 0; 1001 push @totients, @tot; 1002 } 1003 @totients; 1004} 1005 1006sub moebius { 1007 return moebius_range(@_) if scalar @_ > 1; 1008 my($n) = @_; 1009 $n = -$n if defined $n && $n < 0; 1010 _validate_num($n) || _validate_positive_integer($n); 1011 return ($n == 1) ? 1 : 0 if $n <= 1; 1012 return 0 if ($n >= 49) && (!($n % 4) || !($n % 9) || !($n % 25) || !($n%49) ); 1013 my @factors = Math::Prime::Util::factor($n); 1014 foreach my $i (1 .. $#factors) { 1015 return 0 if $factors[$i] == $factors[$i-1]; 1016 } 1017 return ((scalar @factors) % 2) ? -1 : 1; 1018} 1019sub is_square_free { 1020 return (Math::Prime::Util::moebius($_[0]) != 0) ? 1 : 0; 1021} 1022sub is_semiprime { 1023 my($n) = @_; 1024 _validate_positive_integer($n); 1025 return ($n == 4) if $n < 6; 1026 return (Math::Prime::Util::is_prob_prime($n>>1) ? 1 : 0) if ($n % 2) == 0; 1027 return (Math::Prime::Util::is_prob_prime($n/3) ? 1 : 0) if ($n % 3) == 0; 1028 return (Math::Prime::Util::is_prob_prime($n/5) ? 1 : 0) if ($n % 5) == 0; 1029 { 1030 my @f = trial_factor($n, 4999); 1031 return 0 if @f > 2; 1032 return (_is_prime7($f[1]) ? 1 : 0) if @f == 2; 1033 } 1034 return 0 if _is_prime7($n); 1035 { 1036 my @f = pminus1_factor ($n, 250_000); 1037 return 0 if @f > 2; 1038 return (_is_prime7($f[1]) ? 1 : 0) if @f == 2; 1039 } 1040 { 1041 my @f = pbrent_factor ($n, 128*1024, 3, 1); 1042 return 0 if @f > 2; 1043 return (_is_prime7($f[1]) ? 1 : 0) if @f == 2; 1044 } 1045 return (scalar(Math::Prime::Util::factor($n)) == 2) ? 1 : 0; 1046} 1047 1048sub _totpred { 1049 my($n, $maxd) = @_; 1050 return 0 if $maxd <= 1 || (ref($n) ? $n->is_odd() : ($n & 1)); 1051 $n = Math::BigInt->new("$n") unless ref($n) || $n < INTMAX; 1052 $n >>= 1; 1053 return 1 if $n == 1 || ($n < $maxd && Math::Prime::Util::is_prime(2*$n+1)); 1054 for my $d (Math::Prime::Util::divisors($n)) { 1055 last if $d >= $maxd; 1056 my $p = ($d < (INTMAX >> 1)) ? ($d<<1)+1 : Math::Prime::Util::vecprod(2,$d)+1; 1057 next unless Math::Prime::Util::is_prime($p); 1058 my $r = int($n / $d); 1059 while (1) { 1060 return 1 if $r == $p || _totpred($r, $d); 1061 last if $r % $p; 1062 $r = int($r / $p); 1063 } 1064 } 1065 0; 1066} 1067sub is_totient { 1068 my($n) = @_; 1069 _validate_positive_integer($n); 1070 return 1 if $n == 1; 1071 return 0 if $n <= 0; 1072 return _totpred($n,$n); 1073} 1074 1075 1076sub moebius_range { 1077 my($lo, $hi) = @_; 1078 _validate_integer($lo); 1079 _validate_integer($hi); 1080 return () if $hi < $lo; 1081 return moebius($lo) if $lo == $hi; 1082 if ($lo < 0) { 1083 if ($hi < 0) { 1084 return reverse(moebius_range(-$hi,-$lo)); 1085 } else { 1086 return (reverse(moebius_range(1,-$lo)), moebius_range(0,$hi)); 1087 } 1088 } 1089 if ($hi > 2**32) { 1090 my @mu; 1091 while ($lo <= $hi) { 1092 push @mu, moebius($lo++); 1093 } 1094 return @mu; 1095 } 1096 my @mu = map { 1 } $lo .. $hi; 1097 $mu[0] = 0 if $lo == 0; 1098 my($p, $sqrtn) = (2, int(sqrt($hi)+0.5)); 1099 while ($p <= $sqrtn) { 1100 my $i = $p * $p; 1101 $i = $i * int($lo/$i) + (($lo % $i) ? $i : 0) if $i < $lo; 1102 while ($i <= $hi) { 1103 $mu[$i-$lo] = 0; 1104 $i += $p * $p; 1105 } 1106 $i = $p; 1107 $i = $i * int($lo/$i) + (($lo % $i) ? $i : 0) if $i < $lo; 1108 while ($i <= $hi) { 1109 $mu[$i-$lo] *= -$p; 1110 $i += $p; 1111 } 1112 $p = next_prime($p); 1113 } 1114 foreach my $i ($lo .. $hi) { 1115 my $m = $mu[$i-$lo]; 1116 $m *= -1 if abs($m) != $i; 1117 $mu[$i-$lo] = ($m>0) - ($m<0); 1118 } 1119 return @mu; 1120} 1121 1122sub mertens { 1123 my($n) = @_; 1124 # This is the most basic Deléglise and Rivat algorithm. u = n^1/2 1125 # and no segmenting is done. Their algorithm uses u = n^1/3, breaks 1126 # the summation into two parts, and calculates those in segments. Their 1127 # computation time growth is half of this code. 1128 return $n if $n <= 1; 1129 my $u = int(sqrt($n)); 1130 my @mu = (0, Math::Prime::Util::moebius(1, $u)); # Hold values of mu for 0-u 1131 my $musum = 0; 1132 my @M = map { $musum += $_; } @mu; # Hold values of M for 0-u 1133 my $sum = $M[$u]; 1134 foreach my $m (1 .. $u) { 1135 next if $mu[$m] == 0; 1136 my $inner_sum = 0; 1137 my $lower = int($u/$m) + 1; 1138 my $last_nmk = int($n/($m*$lower)); 1139 my ($denom, $this_k, $next_k) = ($m, 0, int($n/($m*1))); 1140 for my $nmk (1 .. $last_nmk) { 1141 $denom += $m; 1142 $this_k = int($n/$denom); 1143 next if $this_k == $next_k; 1144 ($this_k, $next_k) = ($next_k, $this_k); 1145 $inner_sum += $M[$nmk] * ($this_k - $next_k); 1146 } 1147 $sum -= $mu[$m] * $inner_sum; 1148 } 1149 return $sum; 1150} 1151 1152sub ramanujan_sum { 1153 my($k,$n) = @_; 1154 return 0 if $k < 1 || $n < 1; 1155 my $g = $k / Math::Prime::Util::gcd($k,$n); 1156 my $m = Math::Prime::Util::moebius($g); 1157 return $m if $m == 0 || $k == $g; 1158 $m * (Math::Prime::Util::euler_phi($k) / Math::Prime::Util::euler_phi($g)); 1159} 1160 1161sub liouville { 1162 my($n) = @_; 1163 my $l = (-1) ** scalar Math::Prime::Util::factor($n); 1164 return $l; 1165} 1166 1167# Exponential of Mangoldt function (A014963). 1168# Return p if n = p^m [p prime, m >= 1], 1 otherwise. 1169sub exp_mangoldt { 1170 my($n) = @_; 1171 my $p; 1172 return 1 unless Math::Prime::Util::is_prime_power($n,\$p); 1173 $p; 1174} 1175 1176sub carmichael_lambda { 1177 my($n) = @_; 1178 return euler_phi($n) if $n < 8; # = phi(n) for n < 8 1179 return $n >> 2 if ($n & ($n-1)) == 0; # = phi(n)/2 = n/4 for 2^k, k>2 1180 1181 my @pe = Math::Prime::Util::factor_exp($n); 1182 $pe[0]->[1]-- if $pe[0]->[0] == 2 && $pe[0]->[1] > 2; 1183 1184 my $lcm; 1185 if (!ref($n)) { 1186 $lcm = Math::Prime::Util::lcm( 1187 map { ($_->[0] ** ($_->[1]-1)) * ($_->[0]-1) } @pe 1188 ); 1189 } else { 1190 $lcm = Math::BigInt::blcm( 1191 map { $_->[0]->copy->bpow($_->[1]->copy->bdec)->bmul($_->[0]->copy->bdec) } 1192 map { [ map { Math::BigInt->new("$_") } @$_ ] } 1193 @pe 1194 ); 1195 $lcm = _bigint_to_int($lcm) if $lcm->bacmp(BMAX) <= 0; 1196 } 1197 $lcm; 1198} 1199 1200sub is_carmichael { 1201 my($n) = @_; 1202 _validate_positive_integer($n); 1203 1204 # This works fine, but very slow 1205 # return !is_prime($n) && ($n % carmichael_lambda($n)) == 1; 1206 1207 return 0 if $n < 561 || ($n % 2) == 0; 1208 return 0 if (!($n % 9) || !($n % 25) || !($n%49) || !($n%121)); 1209 1210 # Check Korselt's criterion for small divisors 1211 my $fn = $n; 1212 for my $a (5,7,11,13,17,19,23,29,31,37,41,43) { 1213 if (($fn % $a) == 0) { 1214 return 0 if (($n-1) % ($a-1)) != 0; # Korselt 1215 $fn /= $a; 1216 return 0 unless $fn % $a; # not square free 1217 } 1218 } 1219 return 0 if Math::Prime::Util::powmod(2, $n-1, $n) != 1; 1220 1221 # After pre-tests, it's reasonably likely $n is a Carmichael number or prime 1222 1223 # Use probabilistic test if too large to reasonably factor. 1224 if (length($fn) > 50) { 1225 return 0 if Math::Prime::Util::is_prime($n); 1226 for my $t (13 .. 150) { 1227 my $a = $_primes_small[$t]; 1228 my $gcd = Math::Prime::Util::gcd($a, $fn); 1229 if ($gcd == 1) { 1230 return 0 if Math::Prime::Util::powmod($a, $n-1, $n) != 1; 1231 } else { 1232 return 0 if $gcd != $a; # Not square free 1233 return 0 if (($n-1) % ($a-1)) != 0; # factor doesn't divide 1234 $fn /= $a; 1235 } 1236 } 1237 return 1; 1238 } 1239 1240 # Verify with factoring. 1241 my @pe = Math::Prime::Util::factor_exp($n); 1242 return 0 if scalar(@pe) < 3; 1243 for my $pe (@pe) { 1244 return 0 if $pe->[1] > 1 || (($n-1) % ($pe->[0]-1)) != 0; 1245 } 1246 1; 1247} 1248 1249sub is_quasi_carmichael { 1250 my($n) = @_; 1251 _validate_positive_integer($n); 1252 1253 return 0 if $n < 35; 1254 return 0 if (!($n % 4) || !($n % 9) || !($n % 25) || !($n%49) || !($n%121)); 1255 1256 my @pe = Math::Prime::Util::factor_exp($n); 1257 # Not quasi-Carmichael if prime 1258 return 0 if scalar(@pe) < 2; 1259 # Not quasi-Carmichael if not square free 1260 for my $pe (@pe) { 1261 return 0 if $pe->[1] > 1; 1262 } 1263 my @f = map { $_->[0] } @pe; 1264 my $nbases = 0; 1265 if ($n < 2000) { 1266 # In theory for performance, but mainly keeping to show direct method. 1267 my $lim = $f[-1]; 1268 $lim = (($n-$lim*$lim) + $lim - 1) / $lim; 1269 for my $b (1 .. $f[0]-1) { 1270 my $nb = $n - $b; 1271 $nbases++ if Math::Prime::Util::vecall(sub { $nb % ($_-$b) == 0 }, @f); 1272 } 1273 if (scalar(@f) > 2) { 1274 for my $b (1 .. $lim-1) { 1275 my $nb = $n + $b; 1276 $nbases++ if Math::Prime::Util::vecall(sub { $nb % ($_+$b) == 0 }, @f); 1277 } 1278 } 1279 } else { 1280 my($spf,$lpf) = ($f[0], $f[-1]); 1281 if (scalar(@f) == 2) { 1282 foreach my $d (Math::Prime::Util::divisors($n/$spf - 1)) { 1283 my $k = $spf - $d; 1284 my $p = $n - $k; 1285 last if $d >= $spf; 1286 $nbases++ if Math::Prime::Util::vecall(sub { my $j = $_-$k; $j && ($p % $j) == 0 }, @f); 1287 } 1288 } else { 1289 foreach my $d (Math::Prime::Util::divisors($lpf * ($n/$lpf - 1))) { 1290 my $k = $lpf - $d; 1291 my $p = $n - $k; 1292 next if $k == 0 || $k >= $spf; 1293 $nbases++ if Math::Prime::Util::vecall(sub { my $j = $_-$k; $j && ($p % $j) == 0 }, @f); 1294 } 1295 } 1296 } 1297 $nbases; 1298} 1299 1300sub is_pillai { 1301 my($p) = @_; 1302 return 0 if defined($p) && int($p) < 0; 1303 _validate_positive_integer($p); 1304 return 0 if $p <= 2; 1305 1306 my $pm1 = $p-1; 1307 my $nfac = 5040 % $p; 1308 for (my $n = 8; $n < $p; $n++) { 1309 $nfac = Math::Prime::Util::mulmod($nfac, $n, $p); 1310 return $n if $nfac == $pm1 && ($p % $n) != 1; 1311 } 1312 0; 1313} 1314 1315sub is_fundamental { 1316 my($n) = @_; 1317 _validate_integer($n); 1318 my $neg = ($n < 0); 1319 $n = -$n if $neg; 1320 my $r = $n & 15; 1321 if ($r) { 1322 my $r4 = $r & 3; 1323 if (!$neg) { 1324 return (($r == 4) ? 0 : is_square_free($n >> 2)) if $r4 == 0; 1325 return is_square_free($n) if $r4 == 1; 1326 } else { 1327 return (($r == 12) ? 0 : is_square_free($n >> 2)) if $r4 == 0; 1328 return is_square_free($n) if $r4 == 3; 1329 } 1330 } 1331 0; 1332} 1333 1334my @_ds_overflow = # We'll use BigInt math if the input is larger than this. 1335 (~0 > 4294967295) 1336 ? (124, 3000000000000000000, 3000000000, 2487240, 64260, 7026) 1337 : ( 50, 845404560, 52560, 1548, 252, 84); 1338sub divisor_sum { 1339 my($n, $k) = @_; 1340 return ((defined $k && $k==0) ? 2 : 1) if $n == 0; 1341 return 1 if $n == 1; 1342 1343 if (defined $k && ref($k) eq 'CODE') { 1344 my $sum = $n-$n; 1345 my $refn = ref($n); 1346 foreach my $d (Math::Prime::Util::divisors($n)) { 1347 $sum += $k->( $refn ? $refn->new("$d") : $d ); 1348 } 1349 return $sum; 1350 } 1351 1352 croak "Second argument must be a code ref or number" 1353 unless !defined $k || _validate_num($k) || _validate_positive_integer($k); 1354 $k = 1 if !defined $k; 1355 1356 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::sigma($n, $k)) 1357 if $Math::Prime::Util::_GMPfunc{"sigma"}; 1358 1359 my $will_overflow = ($k == 0) ? (length($n) >= $_ds_overflow[0]) 1360 : ($k <= 5) ? ($n >= $_ds_overflow[$k]) 1361 : 1; 1362 1363 # The standard way is: 1364 # my $pk = $f ** $k; $product *= ($pk ** ($e+1) - 1) / ($pk - 1); 1365 # But we get less overflow using: 1366 # my $pk = $f ** $k; $product *= $pk**E for E in 0 .. e 1367 # Also separate BigInt and do fiddly bits for better performance. 1368 1369 my @factors = Math::Prime::Util::factor_exp($n); 1370 my $product = 1; 1371 my @fm; 1372 if ($k == 0) { 1373 $product = Math::Prime::Util::vecprod(map { $_->[1]+1 } @factors); 1374 } elsif (!$will_overflow) { 1375 foreach my $f (@factors) { 1376 my ($p, $e) = @$f; 1377 my $pk = $p ** $k; 1378 my $fmult = $pk + 1; 1379 foreach my $E (2 .. $e) { $fmult += $pk**$E } 1380 $product *= $fmult; 1381 } 1382 } elsif (ref($n) && ref($n) ne 'Math::BigInt') { 1383 # This can help a lot for Math::GMP, etc. 1384 $product = ref($n)->new(1); 1385 foreach my $f (@factors) { 1386 my ($p, $e) = @$f; 1387 my $pk = ref($n)->new($p) ** $k; 1388 my $fmult = $pk; $fmult++; 1389 if ($e >= 2) { 1390 my $pke = $pk; 1391 for (2 .. $e) { $pke *= $pk; $fmult += $pke; } 1392 } 1393 $product *= $fmult; 1394 } 1395 } elsif ($k == 1) { 1396 foreach my $f (@factors) { 1397 my ($p, $e) = @$f; 1398 my $pk = Math::BigInt->new("$p"); 1399 if ($e == 1) { push @fm, $pk->binc; next; } 1400 my $fmult = $pk->copy->binc; 1401 my $pke = $pk->copy; 1402 for my $E (2 .. $e) { 1403 $pke->bmul($pk); 1404 $fmult->badd($pke); 1405 } 1406 push @fm, $fmult; 1407 } 1408 $product = Math::Prime::Util::vecprod(@fm); 1409 } else { 1410 my $bik = Math::BigInt->new("$k"); 1411 foreach my $f (@factors) { 1412 my ($p, $e) = @$f; 1413 my $pk = Math::BigInt->new("$p")->bpow($bik); 1414 if ($e == 1) { push @fm, $pk->binc; next; } 1415 my $fmult = $pk->copy->binc; 1416 my $pke = $pk->copy; 1417 for my $E (2 .. $e) { 1418 $pke->bmul($pk); 1419 $fmult->badd($pke); 1420 } 1421 push @fm, $fmult; 1422 } 1423 $product = Math::Prime::Util::vecprod(@fm); 1424 } 1425 $product; 1426} 1427 1428############################################################################# 1429# Lehmer prime count 1430# 1431#my @_s0 = (0); 1432#my @_s1 = (0,1); 1433#my @_s2 = (0,1,1,1,1,2); 1434my @_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); 1435my @_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); 1436sub _tablephi { 1437 my($x, $a) = @_; 1438 if ($a == 0) { return $x; } 1439 elsif ($a == 1) { return $x-int($x/2); } 1440 elsif ($a == 2) { return $x-int($x/2) - int($x/3) + int($x/6); } 1441 elsif ($a == 3) { return 8 * int($x / 30) + $_s3[$x % 30]; } 1442 elsif ($a == 4) { return 48 * int($x / 210) + $_s4[$x % 210]; } 1443 elsif ($a == 5) { my $xp = int($x/11); 1444 return ( (48 * int($x / 210) + $_s4[$x % 210]) - 1445 (48 * int($xp / 210) + $_s4[$xp % 210]) ); } 1446 else { my ($xp,$x2) = (int($x/11),int($x/13)); 1447 my $x2p = int($x2/11); 1448 return ( (48 * int($x / 210) + $_s4[$x % 210]) - 1449 (48 * int($xp / 210) + $_s4[$xp % 210]) - 1450 (48 * int($x2 / 210) + $_s4[$x2 % 210]) + 1451 (48 * int($x2p / 210) + $_s4[$x2p % 210]) ); } 1452} 1453 1454sub legendre_phi { 1455 my ($x, $a, $primes) = @_; 1456 return _tablephi($x,$a) if $a <= 6; 1457 $primes = primes(Math::Prime::Util::nth_prime_upper($a+1)) unless defined $primes; 1458 return ($x > 0 ? 1 : 0) if $x < $primes->[$a]; 1459 1460 my $sum = 0; 1461 my %vals = ( $x => 1 ); 1462 while ($a > 6) { 1463 my $primea = $primes->[$a-1]; 1464 my %newvals; 1465 while (my($v,$c) = each %vals) { 1466 my $sval = int($v / $primea); 1467 if ($sval < $primea) { 1468 $sum -= $c; 1469 } else { 1470 $newvals{$sval} -= $c; 1471 } 1472 } 1473 # merge newvals into vals 1474 while (my($v,$c) = each %newvals) { 1475 $vals{$v} += $c; 1476 delete $vals{$v} if $vals{$v} == 0; 1477 } 1478 $a--; 1479 } 1480 while (my($v,$c) = each %vals) { 1481 $sum += $c * _tablephi($v, $a); 1482 } 1483 return $sum; 1484} 1485 1486sub _sieve_prime_count { 1487 my $high = shift; 1488 return (0,0,1,2,2,3,3)[$high] if $high < 7; 1489 $high-- unless ($high & 1); 1490 return 1 + ${_sieve_erat($high)} =~ tr/0//; 1491} 1492 1493sub _count_with_sieve { 1494 my ($sref, $low, $high) = @_; 1495 ($low, $high) = (2, $low) if !defined $high; 1496 my $count = 0; 1497 if ($low < 3) { $low = 3; $count++; } 1498 else { $low |= 1; } 1499 $high-- unless ($high & 1); 1500 return $count if $low > $high; 1501 my $sbeg = $low >> 1; 1502 my $send = $high >> 1; 1503 1504 if ( !defined $sref || $send >= length($$sref) ) { 1505 # outside our range, so call the segment siever. 1506 my $seg_ref = _sieve_segment($low, $high); 1507 return $count + $$seg_ref =~ tr/0//; 1508 } 1509 return $count + substr($$sref, $sbeg, $send-$sbeg+1) =~ tr/0//; 1510} 1511 1512sub _lehmer_pi { 1513 my $x = shift; 1514 return _sieve_prime_count($x) if $x < 1_000; 1515 do { require Math::BigFloat; Math::BigFloat->import(); } 1516 if ref($x) eq 'Math::BigInt'; 1517 my $z = (ref($x) ne 'Math::BigInt') 1518 ? int(sqrt($x+0.5)) 1519 : int(Math::BigFloat->new($x)->badd(0.5)->bsqrt->bfloor->bstr); 1520 my $a = _lehmer_pi(int(sqrt($z)+0.5)); 1521 my $b = _lehmer_pi($z); 1522 my $c = _lehmer_pi(int( (ref($x) ne 'Math::BigInt') 1523 ? $x**(1/3)+0.5 1524 : Math::BigFloat->new($x)->broot(3)->badd(0.5)->bfloor 1525 )); 1526 ($z, $a, $b, $c) = map { (ref($_) =~ /^Math::Big/) ? _bigint_to_int($_) : $_ } 1527 ($z, $a, $b, $c); 1528 1529 # Generate at least b primes. 1530 my $bth_prime_upper = ($b <= 10) ? 29 : int($b*(log($b) + log(log($b)))) + 1; 1531 my $primes = primes( $bth_prime_upper ); 1532 1533 my $sum = int(($b + $a - 2) * ($b - $a + 1) / 2); 1534 $sum += legendre_phi($x, $a, $primes); 1535 1536 # Get a big sieve for our primecounts. The C code compromises with either 1537 # b*10 or x^3/5, as that cuts out all the inner loop sieves and about half 1538 # of the big outer loop counts. 1539 # Our sieve count isn't nearly as optimized here, so error on the side of 1540 # more primes. This uses a lot more memory but saves a lot of time. 1541 my $sref = _sieve_erat( int($x / $primes->[$a] / 5) ); 1542 1543 my ($lastw, $lastwpc) = (0,0); 1544 foreach my $i (reverse $a+1 .. $b) { 1545 my $w = int($x / $primes->[$i-1]); 1546 $lastwpc += _count_with_sieve($sref,$lastw+1, $w); 1547 $lastw = $w; 1548 $sum -= $lastwpc; 1549 #$sum -= _count_with_sieve($sref,$w); 1550 if ($i <= $c) { 1551 my $bi = _count_with_sieve($sref,int(sqrt($w)+0.5)); 1552 foreach my $j ($i .. $bi) { 1553 $sum = $sum - _count_with_sieve($sref,int($w / $primes->[$j-1])) + $j - 1; 1554 } 1555 } 1556 } 1557 $sum; 1558} 1559############################################################################# 1560 1561 1562sub prime_count { 1563 my($low,$high) = @_; 1564 if (!defined $high) { 1565 $high = $low; 1566 $low = 2; 1567 } 1568 _validate_positive_integer($low); 1569 _validate_positive_integer($high); 1570 1571 my $count = 0; 1572 1573 $count++ if ($low <= 2) && ($high >= 2); # Count 2 1574 $low = 3 if $low < 3; 1575 1576 $low++ if ($low % 2) == 0; # Make low go to odd number. 1577 $high-- if ($high % 2) == 0; # Make high go to odd number. 1578 return $count if $low > $high; 1579 1580 if ( ref($low) eq 'Math::BigInt' || ref($high) eq 'Math::BigInt' 1581 || ($high-$low) < 10 1582 || ($high-$low) < int($low/100_000_000_000) ) { 1583 # Trial primes seems best. Needs some tuning. 1584 my $curprime = next_prime($low-1); 1585 while ($curprime <= $high) { 1586 $count++; 1587 $curprime = next_prime($curprime); 1588 } 1589 return $count; 1590 } 1591 1592 # TODO: Needs tuning 1593 if ($high > 50_000) { 1594 if ( ($high / ($high-$low+1)) < 100 ) { 1595 $count += _lehmer_pi($high); 1596 $count -= ($low == 3) ? 1 : _lehmer_pi($low-1); 1597 return $count; 1598 } 1599 } 1600 1601 return (_sieve_prime_count($high) - 1 + $count) if $low == 3; 1602 1603 my $sieveref = _sieve_segment($low,$high); 1604 $count += $$sieveref =~ tr/0//; 1605 return $count; 1606} 1607 1608 1609sub nth_prime { 1610 my($n) = @_; 1611 _validate_positive_integer($n); 1612 1613 return undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) 1614 return $_primes_small[$n] if $n <= $#_primes_small; 1615 1616 if ($n > MPU_MAXPRIMEIDX && ref($n) ne 'Math::BigFloat') { 1617 do { require Math::BigFloat; Math::BigFloat->import(); } 1618 if !defined $Math::BigFloat::VERSION; 1619 $n = Math::BigFloat->new("$n") 1620 } 1621 1622 my $prime = 0; 1623 my $count = 1; 1624 my $start = 3; 1625 1626 my $logn = log($n); 1627 my $loglogn = log($logn); 1628 my $nth_prime_upper = ($n <= 10) ? 29 : int($n*($logn + $loglogn)) + 1; 1629 if ($nth_prime_upper > 100000) { 1630 # Use fast Lehmer prime count combined with lower bound to get close. 1631 my $nth_prime_lower = int($n * ($logn + $loglogn - 1.0 + (($loglogn-2.10)/$logn))); 1632 $nth_prime_lower-- unless $nth_prime_lower % 2; 1633 $count = _lehmer_pi($nth_prime_lower); 1634 $start = $nth_prime_lower + 2; 1635 } 1636 1637 { 1638 # Make sure incr is an even number. 1639 my $incr = ($n < 1000) ? 1000 : ($n < 10000) ? 10000 : 100000; 1640 my $sieveref; 1641 while (1) { 1642 $sieveref = _sieve_segment($start, $start+$incr); 1643 my $segcount = $$sieveref =~ tr/0//; 1644 last if ($count + $segcount) >= $n; 1645 $count += $segcount; 1646 $start += $incr+2; 1647 } 1648 # Our count is somewhere in this segment. Need to look for it. 1649 $prime = $start - 2; 1650 while ($count < $n) { 1651 $prime += 2; 1652 $count++ if !substr($$sieveref, ($prime-$start)>>1, 1); 1653 } 1654 } 1655 $prime; 1656} 1657 1658# The nth prime will be less or equal to this number 1659sub nth_prime_upper { 1660 my($n) = @_; 1661 _validate_positive_integer($n); 1662 1663 return undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) 1664 return $_primes_small[$n] if $n <= $#_primes_small; 1665 1666 $n = _upgrade_to_float($n) if $n > MPU_MAXPRIMEIDX || $n > 2**45; 1667 1668 my $flogn = log($n); 1669 my $flog2n = log($flogn); # Note distinction between log_2(n) and log^2(n) 1670 1671 my $upper; 1672 if ($n >= 46254381) { # Axler 2017 Corollary 1.2 1673 $upper = $n * ( $flogn + $flog2n-1.0 + (($flog2n-2.00)/$flogn) - (($flog2n*$flog2n - 6*$flog2n + 10.667)/(2*$flogn*$flogn)) ); 1674 } elsif ($n >= 8009824) { # Axler 2013 page viii Korollar G 1675 $upper = $n * ( $flogn + $flog2n-1.0 + (($flog2n-2.00)/$flogn) - (($flog2n*$flog2n - 6*$flog2n + 10.273)/(2*$flogn*$flogn)) ); 1676 } elsif ($n >= 688383) { # Dusart 2010 page 2 1677 $upper = $n * ( $flogn + $flog2n - 1.0 + (($flog2n-2.00)/$flogn) ); 1678 } elsif ($n >= 178974) { # Dusart 2010 page 7 1679 $upper = $n * ( $flogn + $flog2n - 1.0 + (($flog2n-1.95)/$flogn) ); 1680 } elsif ($n >= 39017) { # Dusart 1999 page 14 1681 $upper = $n * ( $flogn + $flog2n - 0.9484 ); 1682 } elsif ($n >= 6) { # Modified Robin 1983, for 6-39016 only 1683 $upper = $n * ( $flogn + 0.6000 * $flog2n ); 1684 } else { 1685 $upper = $n * ( $flogn + $flog2n ); 1686 } 1687 1688 return int($upper + 1.0); 1689} 1690 1691# The nth prime will be greater than or equal to this number 1692sub nth_prime_lower { 1693 my($n) = @_; 1694 _validate_num($n) || _validate_positive_integer($n); 1695 1696 return undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) 1697 return $_primes_small[$n] if $n <= $#_primes_small; 1698 1699 $n = _upgrade_to_float($n) if $n > MPU_MAXPRIMEIDX || $n > 2**45; 1700 1701 my $flogn = log($n); 1702 my $flog2n = log($flogn); # Note distinction between log_2(n) and log^2(n) 1703 1704 # Dusart 1999 page 14, for all n >= 2 1705 #my $lower = $n * ($flogn + $flog2n - 1.0 + (($flog2n-2.25)/$flogn)); 1706 # Dusart 2010 page 2, for all n >= 3 1707 #my $lower = $n * ($flogn + $flog2n - 1.0 + (($flog2n-2.10)/$flogn)); 1708 # Axler 2013 page viii Korollar I, for all n >= 2 1709 #my $lower = $n * ($flogn + $flog2n-1.0 + (($flog2n-2.00)/$flogn) - (($flog2n*$flog2n - 6*$flog2n + 11.847)/(2*$flogn*$flogn)) ); 1710 # Axler 2017 Corollary 1.4 1711 my $lower = $n * ($flogn + $flog2n-1.0 + (($flog2n-2.00)/$flogn) - (($flog2n*$flog2n - 6*$flog2n + 11.508)/(2*$flogn*$flogn)) ); 1712 1713 return int($lower + 0.999999999); 1714} 1715 1716sub inverse_li { 1717 my($n) = @_; 1718 _validate_num($n) || _validate_positive_integer($n); 1719 1720 return (0,2,3,5,6,8)[$n] if $n <= 5; 1721 $n = _upgrade_to_float($n) if $n > MPU_MAXPRIMEIDX || $n > 2**45; 1722 my $t = $n * log($n); 1723 1724 # Iterator Halley's method until error term grows 1725 my $old_term = MPU_INFINITY; 1726 for my $iter (1 .. 10000) { 1727 my $dn = Math::Prime::Util::LogarithmicIntegral($t) - $n; 1728 my $term = $dn * log($t) / (1.0 + $dn/(2*$t)); 1729 last if abs($term) >= abs($old_term); 1730 $old_term = $term; 1731 $t -= $term; 1732 last if abs($term) < 1e-6; 1733 } 1734 if (ref($t)) { 1735 $t = Math::BigInt->new($t->bceil->bstr); 1736 $t = _bigint_to_int($t) if $t->bacmp(BMAX) <= 0; 1737 } else { 1738 $t = int($t+0.999999); 1739 } 1740 $t; 1741} 1742sub _inverse_R { 1743 my($n) = @_; 1744 _validate_num($n) || _validate_positive_integer($n); 1745 1746 return (0,2,3,5,6,8)[$n] if $n <= 5; 1747 $n = _upgrade_to_float($n) if $n > MPU_MAXPRIMEIDX || $n > 2**45; 1748 my $t = $n * log($n); 1749 1750 # Iterator Halley's method until error term grows 1751 my $old_term = MPU_INFINITY; 1752 for my $iter (1 .. 10000) { 1753 my $dn = Math::Prime::Util::RiemannR($t) - $n; 1754 my $term = $dn * log($t) / (1.0 + $dn/(2*$t)); 1755 last if abs($term) >= abs($old_term); 1756 $old_term = $term; 1757 $t -= $term; 1758 last if abs($term) < 1e-6; 1759 } 1760 if (ref($t)) { 1761 $t = Math::BigInt->new($t->bceil->bstr); 1762 $t = _bigint_to_int($t) if $t->bacmp(BMAX) <= 0; 1763 } else { 1764 $t = int($t+0.999999); 1765 } 1766 $t; 1767} 1768 1769sub nth_prime_approx { 1770 my($n) = @_; 1771 _validate_num($n) || _validate_positive_integer($n); 1772 1773 return undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) 1774 return $_primes_small[$n] if $n <= $#_primes_small; 1775 1776 # Once past 10^12 or so, inverse_li gives better results. 1777 return Math::Prime::Util::inverse_li($n) if $n > 1e12; 1778 1779 $n = _upgrade_to_float($n) 1780 if ref($n) eq 'Math::BigInt' || $n >= MPU_MAXPRIMEIDX; 1781 1782 my $flogn = log($n); 1783 my $flog2n = log($flogn); 1784 1785 # Cipolla 1902: 1786 # m=0 fn * ( flogn + flog2n - 1 ); 1787 # m=1 + ((flog2n - 2)/flogn) ); 1788 # m=2 - (((flog2n*flog2n) - 6*flog2n + 11) / (2*flogn*flogn)) 1789 # + O((flog2n/flogn)^3) 1790 # 1791 # Shown in Dusart 1999 page 12, as well as other sources such as: 1792 # http://www.emis.de/journals/JIPAM/images/153_02_JIPAM/153_02.pdf 1793 # where the main issue you run into is that you're doing polynomial 1794 # interpolation, so it oscillates like crazy with many high-order terms. 1795 # Hence I'm leaving it at m=2. 1796 1797 my $approx = $n * ( $flogn + $flog2n - 1 1798 + (($flog2n - 2)/$flogn) 1799 - ((($flog2n*$flog2n) - 6*$flog2n + 11) / (2*$flogn*$flogn)) 1800 ); 1801 1802 # Apply a correction to help keep values close. 1803 my $order = $flog2n/$flogn; 1804 $order = $order*$order*$order * $n; 1805 1806 if ($n < 259) { $approx += 10.4 * $order; } 1807 elsif ($n < 775) { $approx += 6.3 * $order; } 1808 elsif ($n < 1271) { $approx += 5.3 * $order; } 1809 elsif ($n < 2000) { $approx += 4.7 * $order; } 1810 elsif ($n < 4000) { $approx += 3.9 * $order; } 1811 elsif ($n < 12000) { $approx += 2.8 * $order; } 1812 elsif ($n < 150000) { $approx += 1.2 * $order; } 1813 elsif ($n < 20000000) { $approx += 0.11 * $order; } 1814 elsif ($n < 100000000) { $approx += 0.008 * $order; } 1815 elsif ($n < 500000000) { $approx += -0.038 * $order; } 1816 elsif ($n < 2000000000) { $approx += -0.054 * $order; } 1817 else { $approx += -0.058 * $order; } 1818 # If we want the asymptotic approximation to be >= actual, use -0.010. 1819 1820 return int($approx + 0.5); 1821} 1822 1823############################################################################# 1824 1825sub prime_count_approx { 1826 my($x) = @_; 1827 _validate_num($x) || _validate_positive_integer($x); 1828 1829 # Turn on high precision FP if they gave us a big number. 1830 $x = _upgrade_to_float($x) if ref($_[0]) eq 'Math::BigInt' && $x > 1e16; 1831 # Method 10^10 %error 10^19 %error 1832 # ----------------- ------------ ------------ 1833 # n/(log(n)-1) .22% .058% 1834 # n/(ln(n)-1-1/ln(n)) .032% .0041% 1835 # average bounds .0005% .0000002% 1836 # asymp .0006% .00000004% 1837 # li(n) .0007% .00000004% 1838 # li(n)-li(n^.5)/2 .0004% .00000001% 1839 # R(n) .0004% .00000001% 1840 # 1841 # Also consider: http://trac.sagemath.org/sage_trac/ticket/8135 1842 1843 # Asymp: 1844 # my $l1 = log($x); my $l2 = $l1*$l1; my $l4 = $l2*$l2; 1845 # 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 ); 1846 # my $result = int( (prime_count_upper($x) + prime_count_lower($x)) / 2); 1847 # my $result = int( LogarithmicIntegral($x) ); 1848 # my $result = int(LogarithmicIntegral($x) - LogarithmicIntegral(sqrt($x))/2); 1849 # my $result = RiemannR($x) + 0.5; 1850 1851 # Make sure we get enough accuracy, and also not too much more than needed 1852 $x->accuracy(length($x->copy->as_int->bstr())+2) if ref($x) =~ /^Math::Big/; 1853 1854 my $result; 1855 if ($Math::Prime::Util::_GMPfunc{"riemannr"} || !ref($x)) { 1856 # Fast if we have our GMP backend, and ok for native. 1857 $result = Math::Prime::Util::PP::RiemannR($x); 1858 } else { 1859 $x = _upgrade_to_float($x) unless ref($x) eq 'Math::BigFloat'; 1860 $result = Math::BigFloat->new(0); 1861 $result->accuracy($x->accuracy) if ref($x) && $x->accuracy; 1862 $result += Math::BigFloat->new(LogarithmicIntegral($x)); 1863 $result -= Math::BigFloat->new(LogarithmicIntegral(sqrt($x))/2); 1864 my $intx = ref($x) ? Math::BigInt->new($x->bfround(0)) : $x; 1865 for my $k (3 .. 1000) { 1866 my $m = moebius($k); 1867 next unless $m != 0; 1868 # With Math::BigFloat and the Calc backend, FP root is ungodly slow. 1869 # Use integer root instead. For more accuracy (not useful here): 1870 # my $v = Math::BigFloat->new( "" . rootint($x->as_int,$k) ); 1871 # $v->accuracy(length($v)+5); 1872 # $v = $v - Math::BigFloat->new(($v**$k - $x))->bdiv($k * $v**($k-1)); 1873 # my $term = LogarithmicIntegral($v)/$k; 1874 my $term = LogarithmicIntegral(rootint($intx,$k)) / $k; 1875 last if $term < .25; 1876 if ($m == 1) { $result->badd(Math::BigFloat->new($term)) } 1877 else { $result->bsub(Math::BigFloat->new($term)) } 1878 } 1879 } 1880 1881 if (ref($result)) { 1882 return $result unless ref($result) eq 'Math::BigFloat'; 1883 # Math::BigInt::FastCalc 0.19 implements as_int incorrectly. 1884 return Math::BigInt->new($result->bfround(0)->bstr); 1885 } 1886 int($result+0.5); 1887} 1888 1889sub prime_count_lower { 1890 my($x) = @_; 1891 _validate_num($x) || _validate_positive_integer($x); 1892 1893 return _tiny_prime_count($x) if $x < $_primes_small[-1]; 1894 1895 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::prime_count_lower($x)) 1896 if $Math::Prime::Util::_GMPfunc{"prime_count_lower"}; 1897 1898 $x = _upgrade_to_float($x) 1899 if ref($x) eq 'Math::BigInt' || ref($_[0]) eq 'Math::BigInt'; 1900 1901 my($result,$a); 1902 my $fl1 = log($x); 1903 my $fl2 = $fl1*$fl1; 1904 my $one = (ref($x) eq 'Math::BigFloat') ? $x->copy->bone : $x-$x+1.0; 1905 1906 # Chebyshev 1*x/logx x >= 17 1907 # Rosser & Schoenfeld x/(logx-1/2) x >= 67 1908 # Dusart 1999 x/logx*(1+1/logx+1.8/logxlogx) x >= 32299 1909 # Dusart 2010 x/logx*(1+1/logx+2.0/logxlogx) x >= 88783 1910 # Axler 2014 (1.2) ""+... x >= 1332450001 1911 # Axler 2014 (1.2) x/(logx-1-1/logx-...) x >= 1332479531 1912 # Büthe 2015 (1.9) li(x)-(sqrtx/logx)*(...) x <= 10^19 1913 # Büthe 2014 Th 2 li(x)-logx*sqrtx/8Pi x > 2657, x <= 1.4*10^25 1914 1915 if ($x < 599) { # Decent for small numbers 1916 $result = $x / ($fl1 - 0.7); 1917 } elsif ($x < 52600000) { # Dusart 2010 tweaked 1918 if ($x < 2700) { $a = 0.30; } 1919 elsif ($x < 5500) { $a = 0.90; } 1920 elsif ($x < 19400) { $a = 1.30; } 1921 elsif ($x < 32299) { $a = 1.60; } 1922 elsif ($x < 88783) { $a = 1.83; } 1923 elsif ($x < 176000) { $a = 1.99; } 1924 elsif ($x < 315000) { $a = 2.11; } 1925 elsif ($x < 1100000) { $a = 2.19; } 1926 elsif ($x < 4500000) { $a = 2.31; } 1927 else { $a = 2.35; } 1928 $result = ($x/$fl1) * ($one + $one/$fl1 + $a/$fl2); 1929 } elsif ($x < 1.4e25 || Math::Prime::Util::prime_get_config()->{'assume_rh'}){ 1930 # Büthe 2014/2015 1931 my $lix = LogarithmicIntegral($x); 1932 my $sqx = sqrt($x); 1933 if ($x < 1e19) { 1934 $result = $lix - ($sqx/$fl1) * (1.94 + 3.88/$fl1 + 27.57/$fl2); 1935 } else { 1936 if (ref($x) eq 'Math::BigFloat') { 1937 my $xdigits = _find_big_acc($x); 1938 $result = $lix - ($fl1*$sqx / (Math::BigFloat->bpi($xdigits)*8)); 1939 } else { 1940 $result = $lix - ($fl1*$sqx / PI_TIMES_8); 1941 } 1942 } 1943 } else { # Axler 2014 1.4 1944 my($fl3,$fl4) = ($fl2*$fl1,$fl2*$fl2); 1945 my($fl5,$fl6) = ($fl4*$fl1,$fl4*$fl2); 1946 $result = $x / ($fl1 - $one - $one/$fl1 - 2.65/$fl2 - 13.35/$fl3 - 70.3/$fl4 - 455.6275/$fl5 - 3404.4225/$fl6); 1947 } 1948 1949 return Math::BigInt->new($result->bfloor->bstr()) if ref($result) eq 'Math::BigFloat'; 1950 return int($result); 1951} 1952 1953sub prime_count_upper { 1954 my($x) = @_; 1955 _validate_num($x) || _validate_positive_integer($x); 1956 1957 # Give an exact answer for what we have in our little table. 1958 return _tiny_prime_count($x) if $x < $_primes_small[-1]; 1959 1960 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::prime_count_upper($x)) 1961 if $Math::Prime::Util::_GMPfunc{"prime_count_upper"}; 1962 1963 $x = _upgrade_to_float($x) 1964 if ref($x) eq 'Math::BigInt' || ref($_[0]) eq 'Math::BigInt'; 1965 1966 # Chebyshev: 1.25506*x/logx x >= 17 1967 # Rosser & Schoenfeld: x/(logx-3/2) x >= 67 1968 # Panaitopol 1999: x/(logx-1.112) x >= 4 1969 # Dusart 1999: x/logx*(1+1/logx+2.51/logxlogx) x >= 355991 1970 # Dusart 2010: x/logx*(1+1/logx+2.334/logxlogx) x >= 2_953_652_287 1971 # Axler 2014: x/(logx-1-1/logx-3.35/logxlogx...) x >= e^3.804 1972 # Büthe 2014 7.4 Schoenfeld bounds hold to x <= 1.4e25 1973 # Axler 2017 Prop 2.2 Schoenfeld bounds hold to x <= 5.5e25 1974 # Skewes li(x) x < 1e14 1975 1976 my($result,$a); 1977 my $fl1 = log($x); 1978 my $fl2 = $fl1 * $fl1; 1979 my $one = (ref($x) eq 'Math::BigFloat') ? $x->copy->bone : $x-$x+1.0; 1980 1981 if ($x < 15900) { # Tweaked Rosser-type 1982 $a = ($x < 1621) ? 1.048 : ($x < 5000) ? 1.071 : 1.098; 1983 $result = ($x / ($fl1 - $a)) + 1.0; 1984 } elsif ($x < 821800000) { # Tweaked Dusart 2010 1985 if ($x < 24000) { $a = 2.30; } 1986 elsif ($x < 59000) { $a = 2.48; } 1987 elsif ($x < 350000) { $a = 2.52; } 1988 elsif ($x < 355991) { $a = 2.54; } 1989 elsif ($x < 356000) { $a = 2.51; } 1990 elsif ($x < 3550000) { $a = 2.50; } 1991 elsif ($x < 3560000) { $a = 2.49; } 1992 elsif ($x < 5000000) { $a = 2.48; } 1993 elsif ($x < 8000000) { $a = 2.47; } 1994 elsif ($x < 13000000) { $a = 2.46; } 1995 elsif ($x < 18000000) { $a = 2.45; } 1996 elsif ($x < 31000000) { $a = 2.44; } 1997 elsif ($x < 41000000) { $a = 2.43; } 1998 elsif ($x < 48000000) { $a = 2.42; } 1999 elsif ($x < 119000000) { $a = 2.41; } 2000 elsif ($x < 182000000) { $a = 2.40; } 2001 elsif ($x < 192000000) { $a = 2.395; } 2002 elsif ($x < 213000000) { $a = 2.390; } 2003 elsif ($x < 271000000) { $a = 2.385; } 2004 elsif ($x < 322000000) { $a = 2.380; } 2005 elsif ($x < 400000000) { $a = 2.375; } 2006 elsif ($x < 510000000) { $a = 2.370; } 2007 elsif ($x < 682000000) { $a = 2.367; } 2008 elsif ($x < 2953652287) { $a = 2.362; } 2009 else { $a = 2.334; } # Dusart 2010, page 2 2010 $result = ($x/$fl1) * ($one + $one/$fl1 + $a/$fl2) + $one; 2011 } elsif ($x < 1e19) { # Skewes number lower limit 2012 $a = ($x < 110e7) ? 0.032 : ($x < 1001e7) ? 0.027 : ($x < 10126e7) ? 0.021 : 0.0; 2013 $result = LogarithmicIntegral($x) - $a * $fl1*sqrt($x)/PI_TIMES_8; 2014 } elsif ($x < 5.5e25 || Math::Prime::Util::prime_get_config()->{'assume_rh'}) { 2015 # Schoenfeld / Büthe 2014 Th 7.4 2016 my $lix = LogarithmicIntegral($x); 2017 my $sqx = sqrt($x); 2018 if (ref($x) eq 'Math::BigFloat') { 2019 my $xdigits = _find_big_acc($x); 2020 $result = $lix + ($fl1*$sqx / (Math::BigFloat->bpi($xdigits)*8)); 2021 } else { 2022 $result = $lix + ($fl1*$sqx / PI_TIMES_8); 2023 } 2024 } else { # Axler 2014 1.3 2025 my($fl3,$fl4) = ($fl2*$fl1,$fl2*$fl2); 2026 my($fl5,$fl6) = ($fl4*$fl1,$fl4*$fl2); 2027 $result = $x / ($fl1 - $one - $one/$fl1 - 3.35/$fl2 - 12.65/$fl3 - 71.7/$fl4 - 466.1275/$fl5 - 3489.8225/$fl6); 2028 } 2029 2030 return Math::BigInt->new($result->bfloor->bstr()) if ref($result) eq 'Math::BigFloat'; 2031 return int($result); 2032} 2033 2034sub twin_prime_count { 2035 my($low,$high) = @_; 2036 if (defined $high) { _validate_positive_integer($low); } 2037 else { ($low,$high) = (2, $low); } 2038 _validate_positive_integer($high); 2039 my $sum = 0; 2040 while ($low <= $high) { 2041 my $seghigh = ($high-$high) + $low + 1e7 - 1; 2042 $seghigh = $high if $seghigh > $high; 2043 $sum += scalar(@{Math::Prime::Util::twin_primes($low,$seghigh)}); 2044 $low = $seghigh + 1; 2045 } 2046 $sum; 2047} 2048sub _semiprime_count { 2049 my $n = shift; 2050 my($sum,$pc) = (0,0); 2051 Math::Prime::Util::forprimes( sub { 2052 $sum += Math::Prime::Util::prime_count(int($n/$_))-$pc++; 2053 }, sqrtint($n)); 2054 $sum; 2055} 2056sub semiprime_count { 2057 my($low,$high) = @_; 2058 if (defined $high) { _validate_positive_integer($low); } 2059 else { ($low,$high) = (2, $low); } 2060 _validate_positive_integer($high); 2061 # todo: threshold of fast count vs. walk 2062 my $sum = _semiprime_count($high) - (($low < 4) ? 0 : semiprime_count($low-1)); 2063 $sum; 2064} 2065sub ramanujan_prime_count { 2066 my($low,$high) = @_; 2067 if (defined $high) { _validate_positive_integer($low); } 2068 else { ($low,$high) = (2, $low); } 2069 _validate_positive_integer($high); 2070 my $sum = 0; 2071 while ($low <= $high) { 2072 my $seghigh = ($high-$high) + $low + 1e9 - 1; 2073 $seghigh = $high if $seghigh > $high; 2074 $sum += scalar(@{Math::Prime::Util::ramanujan_primes($low,$seghigh)}); 2075 $low = $seghigh + 1; 2076 } 2077 $sum; 2078} 2079 2080sub twin_prime_count_approx { 2081 my($n) = @_; 2082 return twin_prime_count(3,$n) if $n < 2000; 2083 $n = _upgrade_to_float($n) if ref($n); 2084 my $logn = log($n); 2085 # The loss of full Ei precision is a few orders of magnitude less than the 2086 # accuracy of the estimate, so save huge time and don't bother. 2087 my $li2 = Math::Prime::Util::ExponentialIntegral("$logn") + 2.8853900817779268147198494 - ($n/$logn); 2088 2089 # Empirical correction factor 2090 my $fm; 2091 if ($n < 4000) { $fm = 0.2952; } 2092 elsif ($n < 8000) { $fm = 0.3151; } 2093 elsif ($n < 16000) { $fm = 0.3090; } 2094 elsif ($n < 32000) { $fm = 0.3096; } 2095 elsif ($n < 64000) { $fm = 0.3100; } 2096 elsif ($n < 128000) { $fm = 0.3089; } 2097 elsif ($n < 256000) { $fm = 0.3099; } 2098 elsif ($n < 600000) { my($x0, $x1, $y0, $y1) = (1e6, 6e5, .3091, .3059); 2099 $fm = $y0 + ($n - $x0) * ($y1-$y0) / ($x1 - $x0); } 2100 elsif ($n < 1000000) { my($x0, $x1, $y0, $y1) = (6e5, 1e6, .3062, .3042); 2101 $fm = $y0 + ($n - $x0) * ($y1-$y0) / ($x1 - $x0); } 2102 elsif ($n < 4000000) { my($x0, $x1, $y0, $y1) = (1e6, 4e6, .3067, .3041); 2103 $fm = $y0 + ($n - $x0) * ($y1-$y0) / ($x1 - $x0); } 2104 elsif ($n < 16000000) { my($x0, $x1, $y0, $y1) = (4e6, 16e6, .3033, .2983); 2105 $fm = $y0 + ($n - $x0) * ($y1-$y0) / ($x1 - $x0); } 2106 elsif ($n < 32000000) { my($x0, $x1, $y0, $y1) = (16e6, 32e6, .2980, .2965); 2107 $fm = $y0 + ($n - $x0) * ($y1-$y0) / ($x1 - $x0); } 2108 $li2 *= $fm * log(12+$logn) if defined $fm; 2109 2110 return int(1.32032363169373914785562422 * $li2 + 0.5); 2111} 2112 2113sub semiprime_count_approx { 2114 my($n) = @_; 2115 return 0 if $n < 4; 2116 _validate_positive_integer($n); 2117 $n = "$n" + 0.00000001; 2118 my $l1 = log($n); 2119 my $l2 = log($l1); 2120 #my $est = $n * $l2 / $l1; 2121 my $est = $n * ($l2 + 0.302) / $l1; 2122 int(0.5+$est); 2123} 2124 2125sub nth_twin_prime { 2126 my($n) = @_; 2127 return undef if $n < 0; ## no critic qw(ProhibitExplicitReturnUndef) 2128 return (undef,3,5,11,17,29,41)[$n] if $n <= 6; 2129 2130 my $p = Math::Prime::Util::nth_twin_prime_approx($n+200); 2131 my $tp = Math::Prime::Util::twin_primes($p); 2132 while ($n > scalar(@$tp)) { 2133 $n -= scalar(@$tp); 2134 $tp = Math::Prime::Util::twin_primes($p+1,$p+1e5); 2135 $p += 1e5; 2136 } 2137 return $tp->[$n-1]; 2138} 2139 2140sub nth_twin_prime_approx { 2141 my($n) = @_; 2142 _validate_positive_integer($n); 2143 return nth_twin_prime($n) if $n < 6; 2144 $n = _upgrade_to_float($n) if ref($n) || $n > 127e14; # TODO lower for 32-bit 2145 my $logn = log($n); 2146 my $nlogn2 = $n * $logn * $logn; 2147 2148 return int(5.158 * $nlogn2/log(9+log($n*$n))) if $n > 59 && $n <= 1092; 2149 2150 my $lo = int(0.7 * $nlogn2); 2151 my $hi = int( ($n > 1e16) ? 1.1 * $nlogn2 2152 : ($n > 480) ? 1.7 * $nlogn2 2153 : 2.3 * $nlogn2 + 3 ); 2154 2155 _binary_search($n, $lo, $hi, 2156 sub{Math::Prime::Util::twin_prime_count_approx(shift)}, 2157 sub{ ($_[2]-$_[1])/$_[1] < 1e-15 } ); 2158} 2159 2160sub nth_semiprime { 2161 my $n = shift; 2162 return undef if $n < 0; ## no critic qw(ProhibitExplicitReturnUndef) 2163 return (undef,4,6,9,10,14,15,21,22)[$n] if $n <= 8; 2164 my $logn = log($n); 2165 my $est = 0.966 * $n * $logn / log($logn); 2166 1+_binary_search($n, int(0.9*$est)-1, int(1.15*$est)+1, 2167 sub{Math::Prime::Util::semiprime_count(shift)}); 2168} 2169 2170sub nth_semiprime_approx { 2171 my $n = shift; 2172 return undef if $n < 0; ## no critic qw(ProhibitExplicitReturnUndef) 2173 _validate_positive_integer($n); 2174 return (undef,4,6,9,10,14,15,21,22)[$n] if $n <= 8; 2175 $n = "$n" + 0.00000001; 2176 my $l1 = log($n); 2177 my $l2 = log($l1); 2178 my $est = 0.966 * $n * $l1 / $l2; 2179 int(0.5+$est); 2180} 2181 2182sub nth_ramanujan_prime_upper { 2183 my $n = shift; 2184 return (0,2,11)[$n] if $n <= 2; 2185 $n = Math::BigInt->new("$n") if $n > (~0/3); 2186 my $nth = nth_prime_upper(3*$n); 2187 return $nth if $n < 10000; 2188 $nth = Math::BigInt->new("$nth") if $nth > (~0/177); 2189 if ($n < 1000000) { $nth = (177 * $nth) >> 8; } 2190 elsif ($n < 1e10) { $nth = (175 * $nth) >> 8; } 2191 else { $nth = (133 * $nth) >> 8; } 2192 $nth = _bigint_to_int($nth) if ref($nth) && $nth->bacmp(BMAX) <= 0; 2193 $nth; 2194} 2195sub nth_ramanujan_prime_lower { 2196 my $n = shift; 2197 return (0,2,11)[$n] if $n <= 2; 2198 $n = Math::BigInt->new("$n") if $n > (~0/2); 2199 my $nth = nth_prime_lower(2*$n); 2200 $nth = Math::BigInt->new("$nth") if $nth > (~0/275); 2201 if ($n < 10000) { $nth = (275 * $nth) >> 8; } 2202 elsif ($n < 1e10) { $nth = (262 * $nth) >> 8; } 2203 $nth = _bigint_to_int($nth) if ref($nth) && $nth->bacmp(BMAX) <= 0; 2204 $nth; 2205} 2206sub nth_ramanujan_prime_approx { 2207 my $n = shift; 2208 return (0,2,11)[$n] if $n <= 2; 2209 my($lo,$hi) = (nth_ramanujan_prime_lower($n),nth_ramanujan_prime_upper($n)); 2210 $lo + (($hi-$lo)>>1); 2211} 2212sub ramanujan_prime_count_upper { 2213 my $n = shift; 2214 return (($n < 2) ? 0 : 1) if $n < 11; 2215 my $lo = int(prime_count_lower($n) / 3); 2216 my $hi = prime_count_upper($n) >> 1; 2217 1+_binary_search($n, $lo, $hi, 2218 sub{Math::Prime::Util::nth_ramanujan_prime_lower(shift)}); 2219} 2220sub ramanujan_prime_count_lower { 2221 my $n = shift; 2222 return (($n < 2) ? 0 : 1) if $n < 11; 2223 my $lo = int(prime_count_lower($n) / 3); 2224 my $hi = prime_count_upper($n) >> 1; 2225 _binary_search($n, $lo, $hi, 2226 sub{Math::Prime::Util::nth_ramanujan_prime_upper(shift)}); 2227} 2228sub ramanujan_prime_count_approx { 2229 my $n = shift; 2230 return (($n < 2) ? 0 : 1) if $n < 11; 2231 #$n = _upgrade_to_float($n) if ref($n) || $n > 2e16; 2232 my $lo = ramanujan_prime_count_lower($n); 2233 my $hi = ramanujan_prime_count_upper($n); 2234 _binary_search($n, $lo, $hi, 2235 sub{Math::Prime::Util::nth_ramanujan_prime_approx(shift)}, 2236 sub{ ($_[2]-$_[1])/$_[1] < 1e-15 } ); 2237} 2238 2239sub _sum_primes_n { 2240 my $n = shift; 2241 return (0,0,2,5,5)[$n] if $n < 5; 2242 my $r = Math::Prime::Util::sqrtint($n); 2243 my $r2 = $r + int($n/($r+1)); 2244 my(@V,@S); 2245 for my $k (0 .. $r2) { 2246 my $v = ($k <= $r) ? $k : int($n/($r2-$k+1)); 2247 $V[$k] = $v; 2248 $S[$k] = (($v*($v+1)) >> 1) - 1; 2249 } 2250 Math::Prime::Util::forprimes( sub { my $p = $_; 2251 my $sp = $S[$p-1]; 2252 my $p2 = $p*$p; 2253 for my $v (reverse @V) { 2254 last if $v < $p2; 2255 my($a,$b) = ($v,int($v/$p)); 2256 $a = $r2 - int($n/$a) + 1 if $a > $r; 2257 $b = $r2 - int($n/$b) + 1 if $b > $r; 2258 $S[$a] -= $p * ($S[$b] - $sp); 2259 } 2260 }, 2, $r); 2261 $S[$r2]; 2262} 2263 2264sub sum_primes { 2265 my($low,$high) = @_; 2266 if (defined $high) { _validate_positive_integer($low); } 2267 else { ($low,$high) = (2, $low); } 2268 _validate_positive_integer($high); 2269 my $sum = 0; 2270 $sum = BZERO->copy if ( (MPU_32BIT && $high > 323_380) || 2271 (MPU_64BIT && $high > 29_505_444_490) ); 2272 2273 # It's very possible we're here because they've counted too high. Skip fwd. 2274 if ($low <= 2 && $high >= 29505444491) { 2275 $low = 29505444503; 2276 $sum = Math::BigInt->new("18446744087046669523"); 2277 } 2278 2279 return $sum if $low > $high; 2280 2281 # We have to make some decision about whether to use our PP prime sum or loop 2282 # doing the XS sieve. TODO: Be smarter here? 2283 if (!Math::Prime::Util::prime_get_config()->{'xs'} && !ref($sum) && !MPU_32BIT && ($high-$low) > 1000000) { 2284 # Unfortunately with bigints this is horrifically slow, but we have to do it. 2285 $high = BZERO->copy + $high if $high >= (1 << (MPU_MAXBITS/2))-1; 2286 $sum = _sum_primes_n($high); 2287 $sum -= _sum_primes_n($low-1) if $low > 2; 2288 return $sum; 2289 } 2290 2291 my $xssum = (MPU_64BIT && $high < 6e14 && Math::Prime::Util::prime_get_config()->{'xs'}); 2292 my $step = ($xssum && $high > 5e13) ? 1_000_000 : 11_000_000; 2293 Math::Prime::Util::prime_precalc(sqrtint($high)); 2294 while ($low <= $high) { 2295 my $next = $low + $step - 1; 2296 $next = $high if $next > $high; 2297 $sum += ($xssum) ? Math::Prime::Util::sum_primes($low,$next) 2298 : Math::Prime::Util::vecsum( @{Math::Prime::Util::primes($low,$next)} ); 2299 last if $next == $high; 2300 $low = $next+1; 2301 } 2302 $sum; 2303} 2304sub print_primes { 2305 my($low,$high,$fd) = @_; 2306 if (defined $high) { _validate_positive_integer($low); } 2307 else { ($low,$high) = (2, $low); } 2308 _validate_positive_integer($high); 2309 2310 $fd = fileno(STDOUT) unless defined $fd; 2311 open(my $fh, ">>&=", $fd); # TODO .... or die 2312 2313 if ($high >= $low) { 2314 my $p1 = $low; 2315 while ($p1 <= $high) { 2316 my $p2 = $p1 + 15_000_000 - 1; 2317 $p2 = $high if $p2 > $high; 2318 if ($Math::Prime::Util::_GMPfunc{"sieve_primes"}) { 2319 print $fh "$_\n" for Math::Prime::Util::GMP::sieve_primes($p1,$p2,0); 2320 } else { 2321 print $fh "$_\n" for @{primes($p1,$p2)}; 2322 } 2323 $p1 = $p2+1; 2324 } 2325 } 2326 close($fh); 2327} 2328 2329 2330############################################################################# 2331 2332sub _mulmod { 2333 my($x, $y, $n) = @_; 2334 return (($x * $y) % $n) if ($x|$y) < MPU_HALFWORD; 2335 #return (($x * $y) % $n) if ($x|$y) < MPU_HALFWORD || $y == 0 || $x < int(~0/$y); 2336 my $r = 0; 2337 $x %= $n if $x >= $n; 2338 $y %= $n if $y >= $n; 2339 ($x,$y) = ($y,$x) if $x < $y; 2340 if ($n <= (~0 >> 1)) { 2341 while ($y > 1) { 2342 if ($y & 1) { $r += $x; $r -= $n if $r >= $n; } 2343 $y >>= 1; 2344 $x += $x; $x -= $n if $x >= $n; 2345 } 2346 if ($y & 1) { $r += $x; $r -= $n if $r >= $n; } 2347 } else { 2348 while ($y > 1) { 2349 if ($y & 1) { $r = $n-$r; $r = ($x >= $r) ? $x-$r : $n-$r+$x; } 2350 $y >>= 1; 2351 $x = ($x > ($n - $x)) ? ($x - $n) + $x : $x + $x; 2352 } 2353 if ($y & 1) { $r = $n-$r; $r = ($x >= $r) ? $x-$r : $n-$r+$x; } 2354 } 2355 $r; 2356} 2357sub _addmod { 2358 my($x, $y, $n) = @_; 2359 $x %= $n if $x >= $n; 2360 $y %= $n if $y >= $n; 2361 if (($n-$x) <= $y) { 2362 ($x,$y) = ($y,$x) if $y > $x; 2363 $x -= $n; 2364 } 2365 $x + $y; 2366} 2367 2368# Note that Perl 5.6.2 with largish 64-bit numbers will break. As usual. 2369sub _native_powmod { 2370 my($n, $power, $m) = @_; 2371 my $t = 1; 2372 $n = $n % $m; 2373 while ($power) { 2374 $t = ($t * $n) % $m if ($power & 1); 2375 $power >>= 1; 2376 $n = ($n * $n) % $m if $power; 2377 } 2378 $t; 2379} 2380 2381sub _powmod { 2382 my($n, $power, $m) = @_; 2383 my $t = 1; 2384 2385 $n %= $m if $n >= $m; 2386 if ($m < MPU_HALFWORD) { 2387 while ($power) { 2388 $t = ($t * $n) % $m if ($power & 1); 2389 $power >>= 1; 2390 $n = ($n * $n) % $m if $power; 2391 } 2392 } else { 2393 while ($power) { 2394 $t = _mulmod($t, $n, $m) if ($power & 1); 2395 $power >>= 1; 2396 $n = _mulmod($n, $n, $m) if $power; 2397 } 2398 } 2399 $t; 2400} 2401 2402# Make sure to work around RT71548, Math::BigInt::Lite, 2403# and use correct lcm semantics. 2404sub gcd { 2405 # First see if all inputs are non-bigints 5-10x faster if so. 2406 if (0 == scalar(grep { ref($_) } @_)) { 2407 my($x,$y) = (shift || 0, 0); 2408 while (@_) { 2409 $y = shift; 2410 while ($y) { ($x,$y) = ($y, $x % $y); } 2411 $x = -$x if $x < 0; 2412 } 2413 return $x; 2414 } 2415 my $gcd = Math::BigInt::bgcd( map { 2416 my $v = (($_ < 2147483647 && !ref($_)) || ref($_) eq 'Math::BigInt') ? $_ : "$_"; 2417 $v; 2418 } @_ ); 2419 $gcd = _bigint_to_int($gcd) if $gcd->bacmp(BMAX) <= 0; 2420 return $gcd; 2421} 2422sub lcm { 2423 return 0 unless @_; 2424 my $lcm = Math::BigInt::blcm( map { 2425 my $v = (($_ < 2147483647 && !ref($_)) || ref($_) eq 'Math::BigInt') ? $_ : "$_"; 2426 return 0 if $v == 0; 2427 $v = -$v if $v < 0; 2428 $v; 2429 } @_ ); 2430 $lcm = _bigint_to_int($lcm) if $lcm->bacmp(BMAX) <= 0; 2431 return $lcm; 2432} 2433sub gcdext { 2434 my($x,$y) = @_; 2435 if ($x == 0) { return (0, (-1,0,1)[($y>=0)+($y>0)], abs($y)); } 2436 if ($y == 0) { return ((-1,0,1)[($x>=0)+($x>0)], 0, abs($x)); } 2437 2438 if ($Math::Prime::Util::_GMPfunc{"gcdext"}) { 2439 my($a,$b,$g) = Math::Prime::Util::GMP::gcdext($x,$y); 2440 $a = Math::Prime::Util::_reftyped($_[0], $a); 2441 $b = Math::Prime::Util::_reftyped($_[0], $b); 2442 $g = Math::Prime::Util::_reftyped($_[0], $g); 2443 return ($a,$b,$g); 2444 } 2445 2446 my($a,$b,$g,$u,$v,$w); 2447 if (abs($x) < (~0>>1) && abs($y) < (~0>>1)) { 2448 $x = _bigint_to_int($x) if ref($x) eq 'Math::BigInt'; 2449 $y = _bigint_to_int($y) if ref($y) eq 'Math::BigInt'; 2450 ($a,$b,$g,$u,$v,$w) = (1,0,$x,0,1,$y); 2451 while ($w != 0) { 2452 my $r = $g % $w; 2453 my $q = int(($g-$r)/$w); 2454 ($a,$b,$g,$u,$v,$w) = ($u,$v,$w,$a-$q*$u,$b-$q*$v,$r); 2455 } 2456 } else { 2457 ($a,$b,$g,$u,$v,$w) = (BONE->copy,BZERO->copy,Math::BigInt->new("$x"), 2458 BZERO->copy,BONE->copy,Math::BigInt->new("$y")); 2459 while ($w != 0) { 2460 # Using the array bdiv is logical, but is the wrong sign. 2461 my $r = $g->copy->bmod($w); 2462 my $q = $g->copy->bsub($r)->bdiv($w); 2463 ($a,$b,$g,$u,$v,$w) = ($u,$v,$w,$a-$q*$u,$b-$q*$v,$r); 2464 } 2465 $a = _bigint_to_int($a) if $a->bacmp(BMAX) <= 0; 2466 $b = _bigint_to_int($b) if $b->bacmp(BMAX) <= 0; 2467 $g = _bigint_to_int($g) if $g->bacmp(BMAX) <= 0; 2468 } 2469 if ($g < 0) { ($a,$b,$g) = (-$a,-$b,-$g); } 2470 return ($a,$b,$g); 2471} 2472 2473sub chinese { 2474 return 0 unless scalar @_; 2475 return $_[0]->[0] % $_[0]->[1] if scalar @_ == 1; 2476 my($lcm, $sum); 2477 2478 if ($Math::Prime::Util::_GMPfunc{"chinese"} && $Math::Prime::Util::GMP::VERSION >= 0.42) { 2479 $sum = Math::Prime::Util::GMP::chinese(@_); 2480 if (defined $sum) { 2481 $sum = Math::BigInt->new("$sum"); 2482 $sum = _bigint_to_int($sum) if ref($sum) && $sum->bacmp(BMAX) <= 0; 2483 } 2484 return $sum; 2485 } 2486 foreach my $aref (sort { $b->[1] <=> $a->[1] } @_) { 2487 my($ai, $ni) = @$aref; 2488 $ai = Math::BigInt->new("$ai") if !ref($ai) && (abs($ai) > (~0>>1) || OLD_PERL_VERSION); 2489 $ni = Math::BigInt->new("$ni") if !ref($ni) && (abs($ni) > (~0>>1) || OLD_PERL_VERSION); 2490 if (!defined $lcm) { 2491 ($sum,$lcm) = ($ai % $ni, $ni); 2492 next; 2493 } 2494 # gcdext 2495 my($u,$v,$g,$s,$t,$w) = (1,0,$lcm,0,1,$ni); 2496 while ($w != 0) { 2497 my $r = $g % $w; 2498 my $q = ref($g) ? $g->copy->bsub($r)->bdiv($w) : int(($g-$r)/$w); 2499 ($u,$v,$g,$s,$t,$w) = ($s,$t,$w,$u-$q*$s,$v-$q*$t,$r); 2500 } 2501 ($u,$v,$g) = (-$u,-$v,-$g) if $g < 0; 2502 return if $g != 1 && ($sum % $g) != ($ai % $g); # Not co-prime 2503 $s = -$s if $s < 0; 2504 $t = -$t if $t < 0; 2505 # Convert to bigint if necessary. Performance goes to hell. 2506 if (!ref($lcm) && ($lcm*$s) > ~0) { $lcm = Math::BigInt->new("$lcm"); } 2507 if (ref($lcm)) { 2508 $lcm->bmul("$s"); 2509 my $m1 = Math::BigInt->new("$v")->bmul("$s")->bmod($lcm); 2510 my $m2 = Math::BigInt->new("$u")->bmul("$t")->bmod($lcm); 2511 $m1->bmul("$sum")->bmod($lcm); 2512 $m2->bmul("$ai")->bmod($lcm); 2513 $sum = $m1->badd($m2)->bmod($lcm); 2514 } else { 2515 $lcm *= $s; 2516 $u += $lcm if $u < 0; 2517 $v += $lcm if $v < 0; 2518 my $vs = _mulmod($v,$s,$lcm); 2519 my $ut = _mulmod($u,$t,$lcm); 2520 my $m1 = _mulmod($sum,$vs,$lcm); 2521 my $m2 = _mulmod($ut,$ai % $lcm,$lcm); 2522 $sum = _addmod($m1, $m2, $lcm); 2523 } 2524 } 2525 $sum = _bigint_to_int($sum) if ref($sum) && $sum->bacmp(BMAX) <= 0; 2526 $sum; 2527} 2528 2529sub _from_128 { 2530 my($hi, $lo) = @_; 2531 return 0 unless defined $hi && defined $lo; 2532 #print "hi $hi lo $lo\n"; 2533 (Math::BigInt->new("$hi") << MPU_MAXBITS) + $lo; 2534} 2535 2536sub vecsum { 2537 return Math::Prime::Util::_reftyped($_[0], @_ ? $_[0] : 0) if @_ <= 1; 2538 2539 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::vecsum(@_)) 2540 if $Math::Prime::Util::_GMPfunc{"vecsum"}; 2541 my $sum = 0; 2542 my $neglim = -(INTMAX >> 1) - 1; 2543 foreach my $v (@_) { 2544 $sum += $v; 2545 if ($sum > (INTMAX-250) || $sum < $neglim) { 2546 $sum = BZERO->copy; 2547 $sum->badd("$_") for @_; 2548 return $sum; 2549 } 2550 } 2551 $sum; 2552} 2553 2554sub vecprod { 2555 return 1 unless @_; 2556 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::vecprod(@_)) 2557 if $Math::Prime::Util::_GMPfunc{"vecprod"}; 2558 # Product tree: 2559 my $prod = _product(0, $#_, [map { Math::BigInt->new("$_") } @_]); 2560 # Linear: 2561 # my $prod = BONE->copy; $prod *= "$_" for @_; 2562 $prod = _bigint_to_int($prod) if $prod->bacmp(BMAX) <= 0 && $prod->bcmp(-(BMAX>>1)) > 0; 2563 $prod; 2564} 2565 2566sub vecmin { 2567 return unless @_; 2568 my $min = shift; 2569 for (@_) { $min = $_ if $_ < $min; } 2570 $min; 2571} 2572sub vecmax { 2573 return unless @_; 2574 my $max = shift; 2575 for (@_) { $max = $_ if $_ > $max; } 2576 $max; 2577} 2578 2579sub vecextract { 2580 my($aref, $mask) = @_; 2581 2582 return @$aref[@$mask] if ref($mask) eq 'ARRAY'; 2583 2584 # This is concise but very slow. 2585 # map { $aref->[$_] } grep { $mask & (1 << $_) } 0 .. $#$aref; 2586 2587 my($i, @v) = (0); 2588 while ($mask) { 2589 push @v, $i if $mask & 1; 2590 $mask >>= 1; 2591 $i++; 2592 } 2593 @$aref[@v]; 2594} 2595 2596sub sumdigits { 2597 my($n,$base) = @_; 2598 my $sum = 0; 2599 $base = 2 if !defined $base && $n =~ s/^0b//; 2600 $base = 16 if !defined $base && $n =~ s/^0x//; 2601 if (!defined $base || $base == 10) { 2602 $n =~ tr/0123456789//cd; 2603 $sum += $_ for (split(//,$n)); 2604 } else { 2605 croak "sumdigits: invalid base $base" if $base < 2; 2606 my $cmap = substr("0123456789abcdefghijklmnopqrstuvwxyz",0,$base); 2607 for my $c (split(//,lc($n))) { 2608 my $p = index($cmap,$c); 2609 $sum += $p if $p > 0; 2610 } 2611 } 2612 $sum; 2613} 2614 2615sub invmod { 2616 my($a,$n) = @_; 2617 return if $n == 0 || $a == 0; 2618 return 0 if $n == 1; 2619 $n = -$n if $n < 0; # Pari semantics 2620 if ($n > ~0) { 2621 my $invmod = Math::BigInt->new("$a")->bmodinv("$n"); 2622 return if !defined $invmod || $invmod->is_nan; 2623 $invmod = _bigint_to_int($invmod) if $invmod->bacmp(BMAX) <= 0; 2624 return $invmod; 2625 } 2626 my($t,$nt,$r,$nr) = (0, 1, $n, $a % $n); 2627 while ($nr != 0) { 2628 # Use mod before divide to force correct behavior with high bit set 2629 my $quot = int( ($r-($r % $nr))/$nr ); 2630 ($nt,$t) = ($t-$quot*$nt,$nt); 2631 ($nr,$r) = ($r-$quot*$nr,$nr); 2632 } 2633 return if $r > 1; 2634 $t += $n if $t < 0; 2635 $t; 2636} 2637 2638sub _verify_sqrtmod { 2639 my($r,$a,$n) = @_; 2640 if (ref($r)) { 2641 return if $r->copy->bmul($r)->bmod($n)->bcmp($a); 2642 $r = _bigint_to_int($r) if $r->bacmp(BMAX) <= 0; 2643 } else { 2644 return unless (($r*$r) % $n) == $a; 2645 } 2646 $r = $n-$r if $n-$r < $r; 2647 $r; 2648} 2649 2650sub sqrtmod { 2651 my($a,$n) = @_; 2652 return if $n == 0; 2653 if ($n <= 2 || $a <= 1) { 2654 $a %= $n; 2655 return ((($a*$a) % $n) == $a) ? $a : undef; 2656 } 2657 2658 if ($n < 10000000) { 2659 # Horrible trial search 2660 $a = _bigint_to_int($a); 2661 $n = _bigint_to_int($n); 2662 $a %= $n; 2663 return 1 if $a == 1; 2664 my $lim = ($n+1) >> 1; 2665 for my $r (2 .. $lim) { 2666 return $r if (($r*$r) % $n) == $a; 2667 } 2668 undef; 2669 } 2670 2671 $a = Math::BigInt->new("$a") unless ref($a) eq 'Math::BigInt'; 2672 $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; 2673 $a->bmod($n); 2674 my $r; 2675 2676 if (($n % 4) == 3) { 2677 $r = $a->copy->bmodpow(($n+1)>>2, $n); 2678 return _verify_sqrtmod($r, $a, $n); 2679 } 2680 if (($n % 8) == 5) { 2681 my $q = $a->copy->bmodpow(($n-1)>>2, $n); 2682 if ($q->is_one) { 2683 $r = $a->copy->bmodpow(($n+3)>>3, $n); 2684 } else { 2685 my $v = $a->copy->bmul(4)->bmodpow(($n-5)>>3, $n); 2686 $r = $a->copy->bmul(2)->bmul($v)->bmod($n); 2687 } 2688 return _verify_sqrtmod($r, $a, $n); 2689 } 2690 2691 return if $n->is_odd && !$a->copy->bmodpow(($n-1)>>1,$n)->is_one(); 2692 2693 # Horrible trial search. Need to use Tonelli-Shanks here. 2694 $r = Math::BigInt->new(2); 2695 my $lim = int( ($n+1) / 2 ); 2696 while ($r < $lim) { 2697 return $r if $r->copy->bmul($r)->bmod($n) == $a; 2698 $r++; 2699 } 2700 undef; 2701} 2702 2703sub addmod { 2704 my($a, $b, $n) = @_; 2705 return 0 if $n <= 1; 2706 return _addmod($a,$b,$n) if $n < INTMAX && $a>=0 && $a<INTMAX && $b>=0 && $b<INTMAX; 2707 my $ret = Math::BigInt->new("$a")->badd("$b")->bmod("$n"); 2708 $ret = _bigint_to_int($ret) if $ret->bacmp(BMAX) <= 0; 2709 $ret; 2710} 2711 2712sub mulmod { 2713 my($a, $b, $n) = @_; 2714 return 0 if $n <= 1; 2715 return _mulmod($a,$b,$n) if $n < INTMAX && $a>0 && $a<INTMAX && $b>0 && $b<INTMAX; 2716 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::mulmod($a,$b,$n)) 2717 if $Math::Prime::Util::_GMPfunc{"mulmod"}; 2718 my $ret = Math::BigInt->new("$a")->bmod("$n")->bmul("$b")->bmod("$n"); 2719 $ret = _bigint_to_int($ret) if $ret->bacmp(BMAX) <= 0; 2720 $ret; 2721} 2722sub divmod { 2723 my($a, $b, $n) = @_; 2724 return 0 if $n <= 1; 2725 my $ret = Math::BigInt->new("$b")->bmodinv("$n")->bmul("$a")->bmod("$n"); 2726 if ($ret->is_nan) { 2727 $ret = undef; 2728 } else { 2729 $ret = _bigint_to_int($ret) if $ret->bacmp(BMAX) <= 0; 2730 } 2731 $ret; 2732} 2733sub powmod { 2734 my($a, $b, $n) = @_; 2735 return 0 if $n <= 1; 2736 if ($Math::Prime::Util::_GMPfunc{"powmod"}) { 2737 my $r = Math::Prime::Util::GMP::powmod($a,$b,$n); 2738 return (defined $r) ? Math::Prime::Util::_reftyped($_[0], $r) : undef; 2739 } 2740 my $ret = Math::BigInt->new("$a")->bmod("$n")->bmodpow("$b","$n"); 2741 if ($ret->is_nan) { 2742 $ret = undef; 2743 } else { 2744 $ret = _bigint_to_int($ret) if $ret->bacmp(BMAX) <= 0; 2745 } 2746 $ret; 2747} 2748 2749# no validation, x is allowed to be negative, y must be >= 0 2750sub _gcd_ui { 2751 my($x, $y) = @_; 2752 if ($y < $x) { ($x, $y) = ($y, $x); } 2753 elsif ($x < 0) { $x = -$x; } 2754 while ($y > 0) { 2755 ($x, $y) = ($y, $x % $y); 2756 } 2757 $x; 2758} 2759 2760sub is_power { 2761 my ($n, $a, $refp) = @_; 2762 croak("is_power third argument not a scalar reference") if defined($refp) && !ref($refp); 2763 _validate_integer($n); 2764 return 0 if abs($n) <= 3 && !$a; 2765 2766 if ($Math::Prime::Util::_GMPfunc{"is_power"} && 2767 ($Math::Prime::Util::GMP::VERSION >= 0.42 || 2768 ($Math::Prime::Util::GMP::VERSION >= 0.28 && $n > 0))) { 2769 $a = 0 unless defined $a; 2770 my $k = Math::Prime::Util::GMP::is_power($n,$a); 2771 return 0 unless $k > 0; 2772 if (defined $refp) { 2773 $a = $k unless $a; 2774 my $isneg = ($n < 0); 2775 $n =~ s/^-// if $isneg; 2776 $$refp = Math::Prime::Util::rootint($n, $a); 2777 $$refp = Math::Prime::Util::_reftyped($_[0], $$refp) if $$refp > INTMAX; 2778 $$refp = -$$refp if $isneg; 2779 } 2780 return $k; 2781 } 2782 2783 if (defined $a && $a != 0) { 2784 return 1 if $a == 1; # Everything is a 1st power 2785 return 0 if $n < 0 && $a % 2 == 0; # Negative n never an even power 2786 if ($a == 2) { 2787 if (_is_perfect_square($n)) { 2788 $$refp = int(sqrt($n)) if defined $refp; 2789 return 1; 2790 } 2791 } else { 2792 $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; 2793 my $root = $n->copy->babs->broot($a)->bfloor; 2794 $root->bneg if $n->is_neg; 2795 if ($root->copy->bpow($a) == $n) { 2796 $$refp = $root if defined $refp; 2797 return 1; 2798 } 2799 } 2800 } else { 2801 $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; 2802 if ($n < 0) { 2803 my $absn = $n->copy->babs; 2804 my $root = is_power($absn, 0, $refp); 2805 return 0 unless $root; 2806 if ($root % 2 == 0) { 2807 my $power = valuation($root, 2); 2808 $root >>= $power; 2809 return 0 if $root == 1; 2810 $power = BTWO->copy->bpow($power); 2811 $$refp = $$refp ** $power if defined $refp; 2812 } 2813 $$refp = -$$refp if defined $refp; 2814 return $root; 2815 } 2816 my $e = 2; 2817 while (1) { 2818 my $root = $n->copy()->broot($e)->bfloor; 2819 last if $root->is_one(); 2820 if ($root->copy->bpow($e) == $n) { 2821 my $next = is_power($root, 0, $refp); 2822 $$refp = $root if !$next && defined $refp; 2823 $e *= $next if $next != 0; 2824 return $e; 2825 } 2826 $e = next_prime($e); 2827 } 2828 } 2829 0; 2830} 2831 2832sub is_square { 2833 my($n) = @_; 2834 return 0 if $n < 0; 2835 #is_power($n,2); 2836 _validate_integer($n); 2837 _is_perfect_square($n); 2838} 2839 2840sub is_prime_power { 2841 my ($n, $refp) = @_; 2842 croak("is_prime_power second argument not a scalar reference") if defined($refp) && !ref($refp); 2843 return 0 if $n <= 1; 2844 2845 if (Math::Prime::Util::is_prime($n)) { $$refp = $n if defined $refp; return 1; } 2846 my $r; 2847 my $k = Math::Prime::Util::is_power($n,0,\$r); 2848 if ($k) { 2849 $r = _bigint_to_int($r) if ref($r) && $r->bacmp(BMAX) <= 0; 2850 return 0 unless Math::Prime::Util::is_prime($r); 2851 $$refp = $r if defined $refp; 2852 } 2853 $k; 2854} 2855 2856sub is_polygonal { 2857 my ($n, $k, $refp) = @_; 2858 croak("is_polygonal third argument not a scalar reference") if defined($refp) && !ref($refp); 2859 croak("is_polygonal: k must be >= 3") if $k < 3; 2860 return 0 if $n <= 0; 2861 if ($n == 1) { $$refp = 1 if defined $refp; return 1; } 2862 2863 if ($Math::Prime::Util::_GMPfunc{"polygonal_nth"}) { 2864 my $nth = Math::Prime::Util::GMP::polygonal_nth($n, $k); 2865 return 0 unless $nth; 2866 $nth = Math::Prime::Util::_reftyped($_[0], $nth); 2867 $$refp = $nth if defined $refp; 2868 return 1; 2869 } 2870 2871 my($D,$R); 2872 if ($k == 4) { 2873 return 0 unless _is_perfect_square($n); 2874 $$refp = sqrtint($n) if defined $refp; 2875 return 1; 2876 } 2877 if ($n <= MPU_HALFWORD && $k <= MPU_HALFWORD) { 2878 $D = ($k==3) ? 1+($n<<3) : (8*$k-16)*$n + ($k-4)*($k-4); 2879 return 0 unless _is_perfect_square($D); 2880 $D = $k-4 + Math::Prime::Util::sqrtint($D); 2881 $R = 2*$k-4; 2882 } else { 2883 if ($k == 3) { 2884 $D = vecsum(1, vecprod($n, 8)); 2885 } else { 2886 $D = vecsum(vecprod($n, vecprod(8, $k) - 16), vecprod($k-4,$k-4));; 2887 } 2888 return 0 unless _is_perfect_square($D); 2889 $D = vecsum( sqrtint($D), $k-4 ); 2890 $R = vecprod(2, $k) - 4; 2891 } 2892 return 0 if ($D % $R) != 0; 2893 $$refp = $D / $R if defined $refp; 2894 1; 2895} 2896 2897sub valuation { 2898 my($n, $k) = @_; 2899 $n = -$n if defined $n && $n < 0; 2900 _validate_num($n) || _validate_positive_integer($n); 2901 return 0 if $n < 2 || $k < 2; 2902 my $v = 0; 2903 if ($k == 2) { # Accelerate power of 2 2904 if (ref($n) eq 'Math::BigInt') { # This can pay off for big inputs 2905 return 0 unless $n->is_even; 2906 my $s = $n->as_bin; # We could do same for k=10 2907 return length($s) - rindex($s,'1') - 1; 2908 } 2909 while (!($n & 0xFFFF) ) { $n >>=16; $v +=16; } 2910 while (!($n & 0x000F) ) { $n >>= 4; $v += 4; } 2911 } 2912 while ( !($n % $k) ) { 2913 $n /= $k; 2914 $v++; 2915 } 2916 $v; 2917} 2918 2919sub hammingweight { 2920 my $n = shift; 2921 return 0 + (Math::BigInt->new("$n")->as_bin() =~ tr/1//); 2922} 2923 2924my @_digitmap = (0..9, 'a'..'z'); 2925my %_mapdigit = map { $_digitmap[$_] => $_ } 0 .. $#_digitmap; 2926sub _splitdigits { 2927 my($n, $base, $len) = @_; # n is num or bigint, base is in range 2928 my @d; 2929 if ($base == 10) { 2930 @d = split(//,"$n"); 2931 } elsif ($base == 2) { 2932 @d = split(//,substr(Math::BigInt->new("$n")->as_bin,2)); 2933 } elsif ($base == 16) { 2934 @d = map { $_mapdigit{$_} } split(//,substr(Math::BigInt->new("$n")->as_hex,2)); 2935 } else { 2936 while ($n >= 1) { 2937 my $rem = $n % $base; 2938 unshift @d, $rem; 2939 $n = ($n-$rem)/$base; # Always an exact division 2940 } 2941 } 2942 if ($len >= 0 && $len != scalar(@d)) { 2943 while (@d < $len) { unshift @d, 0; } 2944 while (@d > $len) { shift @d; } 2945 } 2946 @d; 2947} 2948 2949sub todigits { 2950 my($n,$base,$len) = @_; 2951 $base = 10 unless defined $base; 2952 $len = -1 unless defined $len; 2953 die "Invalid base: $base" if $base < 2; 2954 return if $n == 0; 2955 $n = -$n if $n < 0; 2956 _validate_num($n) || _validate_positive_integer($n); 2957 _splitdigits($n, $base, $len); 2958} 2959 2960sub todigitstring { 2961 my($n,$base,$len) = @_; 2962 $base = 10 unless defined $base; 2963 $len = -1 unless defined $len; 2964 $n =~ s/^-//; 2965 return substr(Math::BigInt->new("$n")->as_bin,2) if $base == 2 && $len < 0; 2966 return substr(Math::BigInt->new("$n")->as_oct,1) if $base == 8 && $len < 0; 2967 return substr(Math::BigInt->new("$n")->as_hex,2) if $base == 16 && $len < 0; 2968 my @d = ($n == 0) ? () : _splitdigits($n, $base, $len); 2969 return join("", @d) if $base <= 10; 2970 die "Invalid base for string: $base" if $base > 36; 2971 join("", map { $_digitmap[$_] } @d); 2972} 2973 2974sub fromdigits { 2975 my($r, $base) = @_; 2976 $base = 10 unless defined $base; 2977 return $r if $base == 10 && ref($r) =~ /^Math::/; 2978 my $n; 2979 if (ref($r) && ref($r) !~ /^Math::/) { 2980 croak "fromdigits first argument must be a string or array reference" 2981 unless ref($r) eq 'ARRAY'; 2982 ($n,$base) = (BZERO->copy, BZERO + $base); 2983 for my $d (@$r) { 2984 $n = $n * $base + $d; 2985 } 2986 } elsif ($base == 2) { 2987 $n = Math::BigInt->from_bin("0b$r"); 2988 } elsif ($base == 8) { 2989 $n = Math::BigInt->from_oct("0$r"); 2990 } elsif ($base == 16) { 2991 $n = Math::BigInt->from_hex("0x$r"); 2992 } else { 2993 $r =~ s/^0*//; 2994 ($n,$base) = (BZERO->copy, BZERO + $base); 2995 #for my $d (map { $_mapdigit{$_} } split(//,$r)) { 2996 # croak "Invalid digit for base $base" unless defined $d && $d < $base; 2997 # $n = $n * $base + $d; 2998 #} 2999 for my $c (split(//, lc($r))) { 3000 $n->bmul($base); 3001 if ($c ne '0') { 3002 my $d = index("0123456789abcdefghijklmnopqrstuvwxyz", $c); 3003 croak "Invalid digit for base $base" unless $d >= 0; 3004 $n->badd($d); 3005 } 3006 } 3007 } 3008 $n = _bigint_to_int($n) if $n->bacmp(BMAX) <= 0; 3009 $n; 3010} 3011 3012sub sqrtint { 3013 my($n) = @_; 3014 my $sqrt = Math::BigInt->new("$n")->bsqrt; 3015 return Math::Prime::Util::_reftyped($_[0], "$sqrt"); 3016} 3017 3018sub rootint { 3019 my ($n, $k, $refp) = @_; 3020 croak "rootint: k must be > 0" unless $k > 0; 3021 # Math::BigInt returns NaN for any root of a negative n. 3022 my $root = Math::BigInt->new("$n")->babs->broot("$k"); 3023 if (defined $refp) { 3024 croak("logint third argument not a scalar reference") unless ref($refp); 3025 $$refp = $root->copy->bpow($k); 3026 } 3027 return Math::Prime::Util::_reftyped($_[0], "$root"); 3028} 3029 3030sub logint { 3031 my ($n, $b, $refp) = @_; 3032 croak("logint third argument not a scalar reference") if defined($refp) && !ref($refp); 3033 3034 if ($Math::Prime::Util::_GMPfunc{"logint"}) { 3035 my $e = Math::Prime::Util::GMP::logint($n, $b); 3036 if (defined $refp) { 3037 my $r = Math::Prime::Util::GMP::powmod($b, $e, $n); 3038 $r = $n if $r == 0; 3039 $$refp = Math::Prime::Util::_reftyped($_[0], $r); 3040 } 3041 return Math::Prime::Util::_reftyped($_[0], $e); 3042 } 3043 3044 croak "logint: n must be > 0" unless $n > 0; 3045 croak "logint: missing base" unless defined $b; 3046 if ($b == 10) { 3047 my $e = length($n)-1; 3048 $$refp = Math::BigInt->new("1" . "0"x$e) if defined $refp; 3049 return $e; 3050 } 3051 if ($b == 2) { 3052 my $e = length(Math::BigInt->new("$n")->as_bin)-2-1; 3053 $$refp = Math::BigInt->from_bin("1" . "0"x$e) if defined $refp; 3054 return $e; 3055 } 3056 croak "logint: base must be > 1" unless $b > 1; 3057 3058 my $e = Math::BigInt->new("$n")->blog("$b"); 3059 $$refp = Math::BigInt->new("$b")->bpow($e) if defined $refp; 3060 return Math::Prime::Util::_reftyped($_[0], "$e"); 3061} 3062 3063# Seidel (Luschny), core using Trizen's simplications from Math::BigNum. 3064# http://oeis.org/wiki/User:Peter_Luschny/ComputationAndAsymptoticsOfBernoulliNumbers#Bernoulli_numbers__after_Seidel 3065sub _bernoulli_seidel { 3066 my($n) = @_; 3067 return (1,1) if $n == 0; 3068 return (0,1) if $n > 1 && $n % 2; 3069 3070 my $oacc = Math::BigInt->accuracy(); Math::BigInt->accuracy(undef); 3071 my @D = (BZERO->copy, BONE->copy, map { BZERO->copy } 1 .. ($n>>1)-1); 3072 my ($h, $w) = (1, 1); 3073 3074 foreach my $i (0 .. $n-1) { 3075 if ($w ^= 1) { 3076 $D[$_]->badd($D[$_-1]) for 1 .. $h-1; 3077 } else { 3078 $w = $h++; 3079 $D[$w]->badd($D[$w+1]) while --$w; 3080 } 3081 } 3082 my $num = $D[$h-1]; 3083 my $den = BONE->copy->blsft($n+1)->bsub(BTWO); 3084 my $gcd = Math::BigInt::bgcd($num, $den); 3085 $num /= $gcd; 3086 $den /= $gcd; 3087 $num->bneg() if ($n % 4) == 0; 3088 Math::BigInt->accuracy($oacc); 3089 ($num,$den); 3090} 3091 3092sub bernfrac { 3093 my $n = shift; 3094 return (BONE,BONE) if $n == 0; 3095 return (BONE,BTWO) if $n == 1; # We're choosing 1/2 instead of -1/2 3096 return (BZERO,BONE) if $n < 0 || $n & 1; 3097 3098 # We should have used one of the GMP functions before coming here. 3099 3100 _bernoulli_seidel($n); 3101} 3102 3103sub stirling { 3104 my($n, $m, $type) = @_; 3105 return 1 if $m == $n; 3106 return 0 if $n == 0 || $m == 0 || $m > $n; 3107 $type = 1 unless defined $type; 3108 croak "stirling type must be 1, 2, or 3" unless $type == 1 || $type == 2 || $type == 3; 3109 if ($m == 1) { 3110 return 1 if $type == 2; 3111 return factorial($n) if $type == 3; 3112 return factorial($n-1) if $n&1; 3113 return vecprod(-1, factorial($n-1)); 3114 } 3115 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::stirling($n,$m,$type)) 3116 if $Math::Prime::Util::_GMPfunc{"stirling"}; 3117 # Go through vecsum with quoted negatives to make sure we don't overflow. 3118 my $s; 3119 if ($type == 3) { 3120 $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) ); 3121 } elsif ($type == 2) { 3122 my @terms; 3123 for my $j (1 .. $m) { 3124 my $t = Math::Prime::Util::vecprod( 3125 Math::BigInt->new($j) ** $n, 3126 Math::Prime::Util::binomial($m,$j) 3127 ); 3128 push @terms, (($m-$j) & 1) ? "-$t" : $t; 3129 } 3130 $s = Math::Prime::Util::vecsum(@terms) / factorial($m); 3131 } else { 3132 my @terms; 3133 for my $k (1 .. $n-$m) { 3134 my $t = Math::Prime::Util::vecprod( 3135 Math::Prime::Util::binomial($k + $n - 1, $k + $n - $m), 3136 Math::Prime::Util::binomial(2 * $n - $m, $n - $k - $m), 3137 Math::Prime::Util::stirling($k - $m + $n, $k, 2), 3138 ); 3139 push @terms, ($k & 1) ? "-$t" : $t; 3140 } 3141 $s = Math::Prime::Util::vecsum(@terms); 3142 } 3143 $s; 3144} 3145 3146sub _harmonic_split { # From Fredrik Johansson 3147 my($a,$b) = @_; 3148 return (BONE, $a) if $b - $a == BONE; 3149 return ($a+$a+BONE, $a*$a+$a) if $b - $a == BTWO; # Cut down recursion 3150 my $m = $a->copy->badd($b)->brsft(BONE); 3151 my ($p,$q) = _harmonic_split($a, $m); 3152 my ($r,$s) = _harmonic_split($m, $b); 3153 ($p*$s+$q*$r, $q*$s); 3154} 3155 3156sub harmfrac { 3157 my($n) = @_; 3158 return (BZERO,BONE) if $n <= 0; 3159 $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; 3160 my($p,$q) = _harmonic_split($n-$n+1, $n+1); 3161 my $gcd = Math::BigInt::bgcd($p,$q); 3162 ( scalar $p->bdiv($gcd), scalar $q->bdiv($gcd) ); 3163} 3164 3165sub harmreal { 3166 my($n, $precision) = @_; 3167 3168 do { require Math::BigFloat; Math::BigFloat->import(); } unless defined $Math::BigFloat::VERSION; 3169 return Math::BigFloat->bzero if $n <= 0; 3170 3171 # Use asymptotic formula for larger $n if possible. Saves lots of time if 3172 # the default Calc backend is being used. 3173 { 3174 my $sprec = $precision; 3175 $sprec = Math::BigFloat->precision unless defined $sprec; 3176 $sprec = 40 unless defined $sprec; 3177 if ( ($sprec <= 23 && $n > 54) || 3178 ($sprec <= 30 && $n > 348) || 3179 ($sprec <= 40 && $n > 2002) || 3180 ($sprec <= 50 && $n > 12644) ) { 3181 $n = Math::BigFloat->new($n, $sprec+5); 3182 my($n2, $one, $h) = ($n*$n, Math::BigFloat->bone, Math::BigFloat->bzero); 3183 my $nt = $n2; 3184 my $eps = Math::BigFloat->new(10)->bpow(-$sprec-4); 3185 foreach my $d (-12, 120, -252, 240, -132, 32760, -12, 8160, -14364, 6600, -276, 65520, -12) { # OEIS A006593 3186 my $term = $one/($d * $nt); 3187 last if $term->bacmp($eps) < 0; 3188 $h += $term; 3189 $nt *= $n2; 3190 } 3191 $h->badd(scalar $one->copy->bdiv(2*$n)); 3192 $h->badd(_Euler($sprec)); 3193 $h->badd($n->copy->blog); 3194 $h->round($sprec); 3195 return $h; 3196 } 3197 } 3198 3199 my($num,$den) = Math::Prime::Util::harmfrac($n); 3200 # Note, with Calc backend this can be very, very slow 3201 scalar Math::BigFloat->new($num)->bdiv($den, $precision); 3202} 3203 3204sub is_pseudoprime { 3205 my($n, @bases) = @_; 3206 return 0 if int($n) < 0; 3207 _validate_positive_integer($n); 3208 croak("No bases given to is_pseudoprime") unless scalar(@bases) > 0; 3209 return 0+($n >= 2) if $n < 4; 3210 3211 foreach my $base (@bases) { 3212 croak "Base $base is invalid" if $base < 2; 3213 $base = $base % $n if $base >= $n; 3214 if ($base > 1 && $base != $n-1) { 3215 my $x = (ref($n) eq 'Math::BigInt') 3216 ? $n->copy->bzero->badd($base)->bmodpow($n-1,$n)->is_one 3217 : _powmod($base, $n-1, $n); 3218 return 0 unless $x == 1; 3219 } 3220 } 3221 1; 3222} 3223 3224sub is_euler_pseudoprime { 3225 my($n, @bases) = @_; 3226 return 0 if int($n) < 0; 3227 _validate_positive_integer($n); 3228 croak("No bases given to is_euler_pseudoprime") unless scalar(@bases) > 0; 3229 return 0+($n >= 2) if $n < 4; 3230 3231 foreach my $base (@bases) { 3232 croak "Base $base is invalid" if $base < 2; 3233 $base = $base % $n if $base >= $n; 3234 if ($base > 1 && $base != $n-1) { 3235 my $j = kronecker($base, $n); 3236 return 0 if $j == 0; 3237 $j = ($j > 0) ? 1 : $n-1; 3238 my $x = (ref($n) eq 'Math::BigInt') 3239 ? $n->copy->bzero->badd($base)->bmodpow(($n-1)/2,$n) 3240 : _powmod($base, ($n-1)>>1, $n); 3241 return 0 unless $x == $j; 3242 } 3243 } 3244 1; 3245} 3246 3247sub is_euler_plumb_pseudoprime { 3248 my($n) = @_; 3249 return 0 if int($n) < 0; 3250 _validate_positive_integer($n); 3251 return 0+($n >= 2) if $n < 4; 3252 return 0 if ($n % 2) == 0; 3253 my $nmod8 = $n % 8; 3254 my $exp = 1 + ($nmod8 == 1); 3255 my $ap = Math::Prime::Util::powmod(2, ($n-1) >> $exp, $n); 3256 if ($ap == 1) { return ($nmod8 == 1 || $nmod8 == 7); } 3257 if ($ap == $n-1) { return ($nmod8 == 1 || $nmod8 == 3 || $nmod8 == 5); } 3258 0; 3259} 3260 3261sub _miller_rabin_2 { 3262 my($n, $nm1, $s, $d) = @_; 3263 3264 if ( ref($n) eq 'Math::BigInt' ) { 3265 3266 if (!defined $nm1) { 3267 $nm1 = $n->copy->bdec(); 3268 $s = 0; 3269 $d = $nm1->copy; 3270 do { 3271 $s++; 3272 $d->brsft(BONE); 3273 } while $d->is_even; 3274 } 3275 my $x = BTWO->copy->bmodpow($d,$n); 3276 return 1 if $x->is_one || $x->bcmp($nm1) == 0; 3277 foreach my $r (1 .. $s-1) { 3278 $x->bmul($x)->bmod($n); 3279 last if $x->is_one; 3280 return 1 if $x->bcmp($nm1) == 0; 3281 } 3282 3283 } else { 3284 3285 if (!defined $nm1) { 3286 $nm1 = $n-1; 3287 $s = 0; 3288 $d = $nm1; 3289 while ( ($d & 1) == 0 ) { 3290 $s++; 3291 $d >>= 1; 3292 } 3293 } 3294 3295 if ($n < MPU_HALFWORD) { 3296 my $x = _native_powmod(2, $d, $n); 3297 return 1 if $x == 1 || $x == $nm1; 3298 foreach my $r (1 .. $s-1) { 3299 $x = ($x*$x) % $n; 3300 last if $x == 1; 3301 return 1 if $x == $n-1; 3302 } 3303 } else { 3304 my $x = _powmod(2, $d, $n); 3305 return 1 if $x == 1 || $x == $nm1; 3306 foreach my $r (1 .. $s-1) { 3307 $x = ($x < MPU_HALFWORD) ? ($x*$x) % $n : _mulmod($x, $x, $n); 3308 last if $x == 1; 3309 return 1 if $x == $n-1; 3310 } 3311 } 3312 } 3313 0; 3314} 3315 3316sub is_strong_pseudoprime { 3317 my($n, @bases) = @_; 3318 return 0 if int($n) < 0; 3319 _validate_positive_integer($n); 3320 croak("No bases given to is_strong_pseudoprime") unless scalar(@bases) > 0; 3321 3322 return 0+($n >= 2) if $n < 4; 3323 return 0 if ($n % 2) == 0; 3324 3325 if ($bases[0] == 2) { 3326 return 0 unless _miller_rabin_2($n); 3327 shift @bases; 3328 return 1 unless @bases; 3329 } 3330 3331 my @newbases; 3332 for my $base (@bases) { 3333 croak "Base $base is invalid" if $base < 2; 3334 $base %= $n if $base >= $n; 3335 return 0 if $base == 0 || ($base == $n-1 && ($base % 2) == 1); 3336 push @newbases, $base; 3337 } 3338 @bases = @newbases; 3339 3340 if ( ref($n) eq 'Math::BigInt' ) { 3341 3342 my $nminus1 = $n->copy->bdec(); 3343 my $s = 0; 3344 my $d = $nminus1->copy; 3345 do { # n is > 3 and odd, so n-1 must be even 3346 $s++; 3347 $d->brsft(BONE); 3348 } while $d->is_even; 3349 # Different way of doing the above. Fewer function calls, slower on ave. 3350 #my $dbin = $nminus1->as_bin; 3351 #my $last1 = rindex($dbin, '1'); 3352 #my $s = length($dbin)-2-$last1+1; 3353 #my $d = $nminus1->copy->brsft($s); 3354 3355 foreach my $ma (@bases) { 3356 my $x = $n->copy->bzero->badd($ma)->bmodpow($d,$n); 3357 next if $x->is_one || $x->bcmp($nminus1) == 0; 3358 foreach my $r (1 .. $s-1) { 3359 $x->bmul($x); $x->bmod($n); 3360 return 0 if $x->is_one; 3361 do { $ma = 0; last; } if $x->bcmp($nminus1) == 0; 3362 } 3363 return 0 if $ma != 0; 3364 } 3365 3366 } else { 3367 3368 my $s = 0; 3369 my $d = $n - 1; 3370 while ( ($d & 1) == 0 ) { 3371 $s++; 3372 $d >>= 1; 3373 } 3374 3375 if ($n < MPU_HALFWORD) { 3376 foreach my $ma (@bases) { 3377 my $x = _native_powmod($ma, $d, $n); 3378 next if ($x == 1) || ($x == ($n-1)); 3379 foreach my $r (1 .. $s-1) { 3380 $x = ($x*$x) % $n; 3381 return 0 if $x == 1; 3382 last if $x == $n-1; 3383 } 3384 return 0 if $x != $n-1; 3385 } 3386 } else { 3387 foreach my $ma (@bases) { 3388 my $x = _powmod($ma, $d, $n); 3389 next if ($x == 1) || ($x == ($n-1)); 3390 3391 foreach my $r (1 .. $s-1) { 3392 $x = ($x < MPU_HALFWORD) ? ($x*$x) % $n : _mulmod($x, $x, $n); 3393 return 0 if $x == 1; 3394 last if $x == $n-1; 3395 } 3396 return 0 if $x != $n-1; 3397 } 3398 } 3399 3400 } 3401 1; 3402} 3403 3404 3405# Calculate Kronecker symbol (a|b). Cohen Algorithm 1.4.10. 3406# Extension of the Jacobi symbol, itself an extension of the Legendre symbol. 3407sub kronecker { 3408 my($a, $b) = @_; 3409 return (abs($a) == 1) ? 1 : 0 if $b == 0; 3410 my $k = 1; 3411 if ($b % 2 == 0) { 3412 return 0 if $a % 2 == 0; 3413 my $v = 0; 3414 do { $v++; $b /= 2; } while $b % 2 == 0; 3415 $k = -$k if $v % 2 == 1 && ($a % 8 == 3 || $a % 8 == 5); 3416 } 3417 if ($b < 0) { 3418 $b = -$b; 3419 $k = -$k if $a < 0; 3420 } 3421 if ($a < 0) { $a = -$a; $k = -$k if $b % 4 == 3; } 3422 $b = _bigint_to_int($b) if ref($b) eq 'Math::BigInt' && $b <= BMAX; 3423 $a = _bigint_to_int($a) if ref($a) eq 'Math::BigInt' && $a <= BMAX; 3424 # Now: b > 0, b odd, a >= 0 3425 while ($a != 0) { 3426 if ($a % 2 == 0) { 3427 my $v = 0; 3428 do { $v++; $a /= 2; } while $a % 2 == 0; 3429 $k = -$k if $v % 2 == 1 && ($b % 8 == 3 || $b % 8 == 5); 3430 } 3431 $k = -$k if $a % 4 == 3 && $b % 4 == 3; 3432 ($a, $b) = ($b % $a, $a); 3433 # If a,b are bigints and now small enough, finish as native. 3434 if ( ref($a) eq 'Math::BigInt' && $a <= BMAX 3435 && ref($b) eq 'Math::BigInt' && $b <= BMAX) { 3436 return $k * kronecker(_bigint_to_int($a),_bigint_to_int($b)); 3437 } 3438 } 3439 return ($b == 1) ? $k : 0; 3440} 3441 3442sub _binomialu { 3443 my($r, $n, $k) = (1, @_); 3444 return ($k == $n) ? 1 : 0 if $k >= $n; 3445 $k = $n - $k if $k > ($n >> 1); 3446 foreach my $d (1 .. $k) { 3447 if ($r >= int(~0/$n)) { 3448 my($g, $nr, $dr); 3449 $g = _gcd_ui($n, $d); $nr = int($n/$g); $dr = int($d/$g); 3450 $g = _gcd_ui($r, $dr); $r = int($r/$g); $dr = int($dr/$g); 3451 return 0 if $r >= int(~0/$nr); 3452 $r *= $nr; 3453 $r = int($r/$dr); 3454 } else { 3455 $r *= $n; 3456 $r = int($r/$d); 3457 } 3458 $n--; 3459 } 3460 $r; 3461} 3462 3463sub binomial { 3464 my($n, $k) = @_; 3465 3466 # 1. Try GMP 3467 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::binomial($n,$k)) 3468 if $Math::Prime::Util::_GMPfunc{"binomial"}; 3469 3470 # 2. Exit early for known 0 cases, and adjust k to be positive. 3471 if ($n >= 0) { return 0 if $k < 0 || $k > $n; } 3472 else { return 0 if $k < 0 && $k > $n; } 3473 $k = $n - $k if $k < 0; 3474 3475 # 3. Try to do in integer Perl 3476 my $r; 3477 if ($n >= 0) { 3478 $r = _binomialu($n, $k); 3479 return $r if $r > 0; 3480 } else { 3481 $r = _binomialu(-$n+$k-1, $k); 3482 return $r if $r > 0 && !($k & 1); 3483 return -$r if $r > 0 && $r <= (~0>>1); 3484 } 3485 3486 # 4. Overflow. Solve using Math::BigInt 3487 return 1 if $k == 0; # Work around bug in old 3488 return $n if $k == $n-1; # Math::BigInt (fixed in 1.90) 3489 if ($n >= 0) { 3490 $r = Math::BigInt->new(''.$n)->bnok($k); 3491 $r = _bigint_to_int($r) if $r->bacmp(BMAX) <= 0; 3492 } else { # Math::BigInt is incorrect for negative n 3493 $r = Math::BigInt->new(''.(-$n+$k-1))->bnok($k); 3494 if ($k & 1) { 3495 $r->bneg; 3496 $r = _bigint_to_int($r) if $r->bacmp(''.(~0>>1)) <= 0; 3497 } else { 3498 $r = _bigint_to_int($r) if $r->bacmp(BMAX) <= 0; 3499 } 3500 } 3501 $r; 3502} 3503 3504sub _product { 3505 my($a, $b, $r) = @_; 3506 if ($b <= $a) { 3507 $r->[$a]; 3508 } elsif ($b == $a+1) { 3509 $r->[$a] -> bmul( $r->[$b] ); 3510 } elsif ($b == $a+2) { 3511 $r->[$a] -> bmul( $r->[$a+1] ) -> bmul( $r->[$a+2] ); 3512 } else { 3513 my $c = $a + (($b-$a+1)>>1); 3514 _product($a, $c-1, $r); 3515 _product($c, $b, $r); 3516 $r->[$a] -> bmul( $r->[$c] ); 3517 } 3518} 3519 3520sub factorial { 3521 my($n) = @_; 3522 return (1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800,479001600)[$n] if $n <= 12; 3523 return Math::GMP::bfac($n) if ref($n) eq 'Math::GMP'; 3524 do { my $r = Math::GMPz->new(); Math::GMPz::Rmpz_fac_ui($r,$n); return $r; } 3525 if ref($n) eq 'Math::GMPz'; 3526 if (Math::BigInt->config()->{lib} !~ /GMP|Pari/) { 3527 # It's not a GMP or GMPz object, and we have a slow bigint library. 3528 my $r; 3529 if (defined $Math::GMPz::VERSION) { 3530 $r = Math::GMPz->new(); Math::GMPz::Rmpz_fac_ui($r,$n); 3531 } elsif (defined $Math::GMP::VERSION) { 3532 $r = Math::GMP::bfac($n); 3533 } elsif (defined &Math::Prime::Util::GMP::factorial && Math::Prime::Util::prime_get_config()->{'gmp'}) { 3534 $r = Math::Prime::Util::GMP::factorial($n); 3535 } 3536 return Math::Prime::Util::_reftyped($_[0], $r) if defined $r; 3537 } 3538 my $r = Math::BigInt->new($n)->bfac(); 3539 $r = _bigint_to_int($r) if $r->bacmp(BMAX) <= 0; 3540 $r; 3541} 3542 3543sub factorialmod { 3544 my($n,$m) = @_; 3545 3546 return Math::Prime::Util::GMP::factorialmod($n,$m) 3547 if $Math::Prime::Util::_GMPfunc{"factorialmod"}; 3548 3549 return 0 if $n >= $m || $m == 1; 3550 3551 if ($n > 10) { 3552 my($s,$t,$e) = (1); 3553 Math::Prime::Util::forprimes( sub { 3554 ($t,$e) = ($n,0); 3555 while ($t > 0) { 3556 $t = int($t/$_); 3557 $e += $t; 3558 } 3559 $s = Math::Prime::Util::mulmod($s, Math::Prime::Util::powmod($_,$e,$m), $m); 3560 }, 2, $n >> 1); 3561 Math::Prime::Util::forprimes( sub { 3562 $s = Math::Prime::Util::mulmod($s, $_, $m); 3563 }, ($n >> 1)+1, $n); 3564 return $s; 3565 } 3566 3567 return factorial($n) % $m; 3568} 3569 3570sub _is_perfect_square { 3571 my($n) = @_; 3572 return (1,1,0,0,1)[$n] if $n <= 4; 3573 3574 if (ref($n) eq 'Math::BigInt') { 3575 my $mc = _bigint_to_int($n & 31); 3576 if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) { 3577 my $sq = $n->copy->bsqrt->bfloor; 3578 $sq->bmul($sq); 3579 return 1 if $sq == $n; 3580 } 3581 } else { 3582 my $mc = $n & 31; 3583 if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) { 3584 my $sq = int(sqrt($n)); 3585 return 1 if ($sq*$sq) == $n; 3586 } 3587 } 3588 0; 3589} 3590 3591sub is_primitive_root { 3592 my($a, $n) = @_; 3593 $n = -$n if $n < 0; # Ignore sign of n 3594 return ($n==1) ? 1 : 0 if $n <= 1; 3595 $a %= $n if $a < 0 || $a >= $n; 3596 3597 return Math::Prime::Util::GMP::is_primitive_root($a,$n) 3598 if $Math::Prime::Util::_GMPfunc{"is_primitive_root"}; 3599 3600 if ($Math::Prime::Util::_GMPfunc{"znorder"} && $Math::Prime::Util::_GMPfunc{"totient"}) { 3601 my $order = Math::Prime::Util::GMP::znorder($a,$n); 3602 return 0 unless defined $order; 3603 my $totient = Math::Prime::Util::GMP::totient($n); 3604 return ($order eq $totient) ? 1 : 0; 3605 } 3606 3607 return 0 if Math::Prime::Util::gcd($a, $n) != 1; 3608 my $s = Math::Prime::Util::euler_phi($n); 3609 return 0 if ($s % 2) == 0 && Math::Prime::Util::powmod($a, $s/2, $n) == 1; 3610 return 0 if ($s % 3) == 0 && Math::Prime::Util::powmod($a, $s/3, $n) == 1; 3611 return 0 if ($s % 5) == 0 && Math::Prime::Util::powmod($a, $s/5, $n) == 1; 3612 foreach my $f (Math::Prime::Util::factor_exp($s)) { 3613 my $fp = $f->[0]; 3614 return 0 if $fp > 5 && Math::Prime::Util::powmod($a, $s/$fp, $n) == 1; 3615 } 3616 1; 3617} 3618 3619sub znorder { 3620 my($a, $n) = @_; 3621 return if $n <= 0; 3622 return 1 if $n == 1; 3623 return if $a <= 0; 3624 return 1 if $a == 1; 3625 3626 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::znorder($a,$n)) 3627 if $Math::Prime::Util::_GMPfunc{"znorder"}; 3628 3629 # Sadly, Calc/FastCalc are horrendously slow for this function. 3630 return if Math::Prime::Util::gcd($a, $n) > 1; 3631 3632 # The answer is one of the divisors of phi(n) and lambda(n). 3633 my $lambda = Math::Prime::Util::carmichael_lambda($n); 3634 $a = Math::BigInt->new("$a") unless ref($a) eq 'Math::BigInt'; 3635 3636 # This is easy and usually fast, but can bog down with too many divisors. 3637 if ($lambda <= 2**64) { 3638 foreach my $k (Math::Prime::Util::divisors($lambda)) { 3639 return $k if Math::Prime::Util::powmod($a,$k,$n) == 1; 3640 } 3641 return; 3642 } 3643 3644 # Algorithm 1.7 from A. Das applied to Carmichael Lambda. 3645 $lambda = Math::BigInt->new("$lambda") unless ref($lambda) eq 'Math::BigInt'; 3646 my $k = Math::BigInt->bone; 3647 foreach my $f (Math::Prime::Util::factor_exp($lambda)) { 3648 my($pi, $ei, $enum) = (Math::BigInt->new("$f->[0]"), $f->[1], 0); 3649 my $phidiv = $lambda / ($pi**$ei); 3650 my $b = Math::Prime::Util::powmod($a,$phidiv,$n); 3651 while ($b != 1) { 3652 return if $enum++ >= $ei; 3653 $b = Math::Prime::Util::powmod($b,$pi,$n); 3654 $k *= $pi; 3655 } 3656 } 3657 $k = _bigint_to_int($k) if $k->bacmp(BMAX) <= 0; 3658 return $k; 3659} 3660 3661sub _dlp_trial { 3662 my ($a,$g,$p,$limit) = @_; 3663 $limit = $p if !defined $limit || $limit > $p; 3664 my $t = $g->copy; 3665 3666 if ($limit < 1_000_000_000) { 3667 for my $k (1 .. $limit) { 3668 return $k if $t == $a; 3669 $t = Math::Prime::Util::mulmod($t, $g, $p); 3670 } 3671 return 0; 3672 } 3673 3674 for (my $k = BONE->copy; $k < $limit; $k->binc) { 3675 if ($t == $a) { 3676 $k = _bigint_to_int($k) if $k->bacmp(BMAX) <= 0; 3677 return $k; 3678 } 3679 $t->bmul($g)->bmod($p); 3680 } 3681 0; 3682} 3683sub _dlp_bsgs { 3684 my ($a,$g,$p,$n,$_verbose) = @_; 3685 my $invg = invmod($g, $p); 3686 return unless defined $invg; 3687 my $maxm = Math::Prime::Util::sqrtint($n)+1; 3688 my $b = ($p + $maxm - 1) / $maxm; 3689 # Limit for time and space. 3690 $b = ($b > 4_000_000) ? 4_000_000 : int("$b"); 3691 $maxm = ($maxm > $b) ? $b : int("$maxm"); 3692 3693 my %hash; 3694 my $am = BONE->copy; 3695 my $gm = Math::Prime::Util::powmod($invg, $maxm, $p); 3696 my $key = $a->copy; 3697 my $r; 3698 3699 foreach my $m (0 .. $b) { 3700 # Baby Step 3701 if ($m <= $maxm) { 3702 $r = $hash{"$am"}; 3703 if (defined $r) { 3704 print " bsgs found in stage 1 after $m tries\n" if $_verbose; 3705 $r = Math::Prime::Util::addmod($m, Math::Prime::Util::mulmod($r,$maxm,$p), $p); 3706 return $r; 3707 } 3708 $hash{"$am"} = $m; 3709 $am = Math::Prime::Util::mulmod($am,$g,$p); 3710 if ($am == $a) { 3711 print " bsgs found during bs\n" if $_verbose; 3712 return $m+1; 3713 } 3714 } 3715 3716 # Giant Step 3717 $r = $hash{"$key"}; 3718 if (defined $r) { 3719 print " bsgs found in stage 2 after $m tries\n" if $_verbose; 3720 $r = Math::Prime::Util::addmod($r, Math::Prime::Util::mulmod($m,$maxm,$p), $p); 3721 return $r; 3722 } 3723 $hash{"$key"} = $m if $m <= $maxm; 3724 $key = Math::Prime::Util::mulmod($key,$gm,$p); 3725 } 3726 0; 3727} 3728 3729sub znlog { 3730 my ($a,$g,$p) = 3731 map { ref($_) eq 'Math::BigInt' ? $_ : Math::BigInt->new("$_") } @_; 3732 $a->bmod($p); 3733 $g->bmod($p); 3734 return 0 if $a == 1 || $g == 0 || $p < 2; 3735 my $_verbose = Math::Prime::Util::prime_get_config()->{'verbose'}; 3736 3737 # For large p, znorder can be very slow. Do trial test first. 3738 my $x = _dlp_trial($a, $g, $p, 200); 3739 if ($x == 0) { 3740 my $n = znorder($g, $p); 3741 if (defined $n && $n > 1000) { 3742 $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; 3743 $x = _dlp_bsgs($a, $g, $p, $n, $_verbose); 3744 $x = _bigint_to_int($x) if ref($x) && $x->bacmp(BMAX) <= 0; 3745 return $x if $x > 0 && $g->copy->bmodpow($x, $p) == $a; 3746 print " BSGS giving up\n" if $x == 0 && $_verbose; 3747 print " BSGS incorrect answer $x\n" if $x > 0 && $_verbose > 1; 3748 } 3749 $x = _dlp_trial($a,$g,$p); 3750 } 3751 $x = _bigint_to_int($x) if ref($x) && $x->bacmp(BMAX) <= 0; 3752 return ($x == 0) ? undef : $x; 3753} 3754 3755sub znprimroot { 3756 my($n) = @_; 3757 $n = -$n if $n < 0; 3758 if ($n <= 4) { 3759 return if $n == 0; 3760 return $n-1; 3761 } 3762 return if $n % 4 == 0; 3763 my $a = 1; 3764 my $phi = $n-1; 3765 if (!is_prob_prime($n)) { 3766 $phi = euler_phi($n); 3767 # Check that a primitive root exists. 3768 return if $phi != Math::Prime::Util::carmichael_lambda($n); 3769 } 3770 my @exp = map { Math::BigInt->new("$_") } 3771 map { int($phi/$_->[0]) } 3772 Math::Prime::Util::factor_exp($phi); 3773 #print "phi: $phi factors: ", join(",",factor($phi)), "\n"; 3774 #print " exponents: ", join(",", @exp), "\n"; 3775 while (1) { 3776 my $fail = 0; 3777 do { $a++ } while Math::Prime::Util::kronecker($a,$n) == 0; 3778 return if $a >= $n; 3779 foreach my $f (@exp) { 3780 if (Math::Prime::Util::powmod($a,$f,$n) == 1) { 3781 $fail = 1; 3782 last; 3783 } 3784 } 3785 return $a if !$fail; 3786 } 3787} 3788 3789 3790# Find first D in sequence (5,-7,9,-11,13,-15,...) where (D|N) == -1 3791sub _lucas_selfridge_params { 3792 my($n) = @_; 3793 3794 # D is typically quite small: 67 max for N < 10^19. However, it is 3795 # theoretically possible D could grow unreasonably. I'm giving up at 4000M. 3796 my $d = 5; 3797 my $sign = 1; 3798 while (1) { 3799 my $gcd = (ref($n) eq 'Math::BigInt') ? Math::BigInt::bgcd($d, $n) 3800 : _gcd_ui($d, $n); 3801 return (0,0,0) if $gcd > 1 && $gcd != $n; # Found divisor $d 3802 my $j = kronecker($d * $sign, $n); 3803 last if $j == -1; 3804 $d += 2; 3805 croak "Could not find Jacobi sequence for $n" if $d > 4_000_000_000; 3806 $sign = -$sign; 3807 } 3808 my $D = $sign * $d; 3809 my $P = 1; 3810 my $Q = int( (1 - $D) / 4 ); 3811 ($P, $Q, $D) 3812} 3813 3814sub _lucas_extrastrong_params { 3815 my($n, $increment) = @_; 3816 $increment = 1 unless defined $increment; 3817 3818 my ($P, $Q, $D) = (3, 1, 5); 3819 while (1) { 3820 my $gcd = (ref($n) eq 'Math::BigInt') ? Math::BigInt::bgcd($D, $n) 3821 : _gcd_ui($D, $n); 3822 return (0,0,0) if $gcd > 1 && $gcd != $n; # Found divisor $d 3823 last if kronecker($D, $n) == -1; 3824 $P += $increment; 3825 croak "Could not find Jacobi sequence for $n" if $P > 65535; 3826 $D = $P*$P - 4; 3827 } 3828 ($P, $Q, $D); 3829} 3830 3831# returns U_k, V_k, Q_k all mod n 3832sub lucas_sequence { 3833 my($n, $P, $Q, $k) = @_; 3834 3835 croak "lucas_sequence: n must be >= 2" if $n < 2; 3836 croak "lucas_sequence: k must be >= 0" if $k < 0; 3837 croak "lucas_sequence: P out of range" if abs($P) >= $n; 3838 croak "lucas_sequence: Q out of range" if abs($Q) >= $n; 3839 3840 if ($Math::Prime::Util::_GMPfunc{"lucas_sequence"} && $Math::Prime::Util::GMP::VERSION >= 0.30) { 3841 return map { ($_ > ''.~0) ? Math::BigInt->new(''.$_) : $_ } 3842 Math::Prime::Util::GMP::lucas_sequence($n, $P, $Q, $k); 3843 } 3844 3845 $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; 3846 3847 my $ZERO = $n->copy->bzero; 3848 $P = $ZERO+$P unless ref($P) eq 'Math::BigInt'; 3849 $Q = $ZERO+$Q unless ref($Q) eq 'Math::BigInt'; 3850 my $D = $P*$P - BTWO*BTWO*$Q; 3851 if ($D->is_zero) { 3852 my $S = ($ZERO+$P) >> 1; 3853 my $U = $S->copy->bmodpow($k-1,$n)->bmul($k)->bmod($n); 3854 my $V = $S->copy->bmodpow($k,$n)->bmul(BTWO)->bmod($n); 3855 my $Qk = ($ZERO+$Q)->bmodpow($k, $n); 3856 return ($U, $V, $Qk); 3857 } 3858 my $U = BONE->copy; 3859 my $V = $P->copy; 3860 my $Qk = $Q->copy; 3861 3862 return (BZERO->copy, BTWO->copy, $Qk) if $k == 0; 3863 $k = Math::BigInt->new("$k") unless ref($k) eq 'Math::BigInt'; 3864 my $kstr = substr($k->as_bin, 2); 3865 my $bpos = 0; 3866 3867 if (($n % 2)==0) { 3868 $P->bmod($n); 3869 $Q->bmod($n); 3870 my($Uh,$Vl, $Vh, $Ql, $Qh) = (BONE->copy, BTWO->copy, $P->copy, BONE->copy, BONE->copy); 3871 my ($b,$s) = (length($kstr)-1, 0); 3872 if ($kstr =~ /(0+)$/) { $s = length($1); } 3873 for my $bpos (0 .. $b-$s-1) { 3874 $Ql->bmul($Qh)->bmod($n); 3875 if (substr($kstr,$bpos,1)) { 3876 $Qh = $Ql * $Q; 3877 $Uh->bmul($Vh)->bmod($n); 3878 $Vl->bmul($Vh)->bsub($P * $Ql)->bmod($n); 3879 $Vh->bmul($Vh)->bsub(BTWO * $Qh)->bmod($n); 3880 } else { 3881 $Qh = $Ql->copy; 3882 $Uh->bmul($Vl)->bsub($Ql)->bmod($n); 3883 $Vh->bmul($Vl)->bsub($P * $Ql)->bmod($n); 3884 $Vl->bmul($Vl)->bsub(BTWO * $Ql)->bmod($n); 3885 } 3886 } 3887 $Ql->bmul($Qh); 3888 $Qh = $Ql * $Q; 3889 $Uh->bmul($Vl)->bsub($Ql)->bmod($n); 3890 $Vl->bmul($Vh)->bsub($P * $Ql)->bmod($n); 3891 $Ql->bmul($Qh)->bmod($n); 3892 for (1 .. $s) { 3893 $Uh->bmul($Vl)->bmod($n); 3894 $Vl->bmul($Vl)->bsub(BTWO * $Ql)->bmod($n); 3895 $Ql->bmul($Ql)->bmod($n); 3896 } 3897 ($U, $V, $Qk) = ($Uh, $Vl, $Ql); 3898 } elsif ($Q->is_one) { 3899 my $Dinverse = $D->copy->bmodinv($n); 3900 if ($P > BTWO && !$Dinverse->is_nan) { 3901 # Calculate V_k with U=V_{k+1} 3902 $U = $P->copy->bmul($P)->bsub(BTWO)->bmod($n); 3903 while (++$bpos < length($kstr)) { 3904 if (substr($kstr,$bpos,1)) { 3905 $V->bmul($U)->bsub($P )->bmod($n); 3906 $U->bmul($U)->bsub(BTWO)->bmod($n); 3907 } else { 3908 $U->bmul($V)->bsub($P )->bmod($n); 3909 $V->bmul($V)->bsub(BTWO)->bmod($n); 3910 } 3911 } 3912 # Crandall and Pomerance eq 3.13: U_n = D^-1 (2V_{n+1} - PV_n) 3913 $U = $Dinverse * (BTWO*$U - $P*$V); 3914 } else { 3915 while (++$bpos < length($kstr)) { 3916 $U->bmul($V)->bmod($n); 3917 $V->bmul($V)->bsub(BTWO)->bmod($n); 3918 if (substr($kstr,$bpos,1)) { 3919 my $T1 = $U->copy->bmul($D); 3920 $U->bmul($P)->badd( $V); 3921 $U->badd($n) if $U->is_odd; 3922 $U->brsft(BONE); 3923 $V->bmul($P)->badd($T1); 3924 $V->badd($n) if $V->is_odd; 3925 $V->brsft(BONE); 3926 } 3927 } 3928 } 3929 } else { 3930 my $qsign = ($Q == -1) ? -1 : 0; 3931 while (++$bpos < length($kstr)) { 3932 $U->bmul($V)->bmod($n); 3933 if ($qsign == 1) { $V->bmul($V)->bsub(BTWO)->bmod($n); } 3934 elsif ($qsign == -1) { $V->bmul($V)->badd(BTWO)->bmod($n); } 3935 else { $V->bmul($V)->bsub($Qk->copy->blsft(BONE))->bmod($n); } 3936 if (substr($kstr,$bpos,1)) { 3937 my $T1 = $U->copy->bmul($D); 3938 $U->bmul($P)->badd( $V); 3939 $U->badd($n) if $U->is_odd; 3940 $U->brsft(BONE); 3941 3942 $V->bmul($P)->badd($T1); 3943 $V->badd($n) if $V->is_odd; 3944 $V->brsft(BONE); 3945 3946 if ($qsign != 0) { $qsign = -1; } 3947 else { $Qk->bmul($Qk)->bmul($Q)->bmod($n); } 3948 } else { 3949 if ($qsign != 0) { $qsign = 1; } 3950 else { $Qk->bmul($Qk)->bmod($n); } 3951 } 3952 } 3953 if ($qsign == 1) { $Qk->bneg; } 3954 elsif ($qsign == -1) { $Qk = $n->copy->bdec; } 3955 } 3956 $U->bmod($n); 3957 $V->bmod($n); 3958 return ($U, $V, $Qk); 3959} 3960sub _lucasuv { 3961 my($P, $Q, $k) = @_; 3962 3963 croak "lucas_sequence: k must be >= 0" if $k < 0; 3964 return (0,2) if $k == 0; 3965 3966 $P = Math::BigInt->new("$P") unless ref($P) eq 'Math::BigInt'; 3967 $Q = Math::BigInt->new("$Q") unless ref($Q) eq 'Math::BigInt'; 3968 3969 # Simple way, very slow as k increases: 3970 #my($U0, $U1) = (BZERO->copy, BONE->copy); 3971 #my($V0, $V1) = (BTWO->copy, Math::BigInt->new("$P")); 3972 #for (2 .. $k) { 3973 # ($U0,$U1) = ($U1, $P*$U1 - $Q*$U0); 3974 # ($V0,$V1) = ($V1, $P*$V1 - $Q*$V0); 3975 #} 3976 #return ($U1, $V1); 3977 3978 my($Uh,$Vl, $Vh, $Ql, $Qh) = (BONE->copy, BTWO->copy, $P->copy, BONE->copy, BONE->copy); 3979 $k = Math::BigInt->new("$k") unless ref($k) eq 'Math::BigInt'; 3980 my $kstr = substr($k->as_bin, 2); 3981 my ($n,$s) = (length($kstr)-1, 0); 3982 if ($kstr =~ /(0+)$/) { $s = length($1); } 3983 3984 if ($Q == -1) { 3985 # This could be simplified, and it's running 10x slower than it should. 3986 my ($ql,$qh) = (1,1); 3987 for my $bpos (0 .. $n-$s-1) { 3988 $ql *= $qh; 3989 if (substr($kstr,$bpos,1)) { 3990 $qh = -$ql; 3991 $Uh->bmul($Vh); 3992 if ($ql == 1) { 3993 $Vl->bmul($Vh)->bsub( $P ); 3994 $Vh->bmul($Vh)->badd( BTWO ); 3995 } else { 3996 $Vl->bmul($Vh)->badd( $P ); 3997 $Vh->bmul($Vh)->bsub( BTWO ); 3998 } 3999 } else { 4000 $qh = $ql; 4001 if ($ql == 1) { 4002 $Uh->bmul($Vl)->bdec; 4003 $Vh->bmul($Vl)->bsub($P); 4004 $Vl->bmul($Vl)->bsub(BTWO); 4005 } else { 4006 $Uh->bmul($Vl)->binc; 4007 $Vh->bmul($Vl)->badd($P); 4008 $Vl->bmul($Vl)->badd(BTWO); 4009 } 4010 } 4011 } 4012 $ql *= $qh; 4013 $qh = -$ql; 4014 if ($ql == 1) { 4015 $Uh->bmul($Vl)->bdec; 4016 $Vl->bmul($Vh)->bsub($P); 4017 } else { 4018 $Uh->bmul($Vl)->binc; 4019 $Vl->bmul($Vh)->badd($P); 4020 } 4021 $ql *= $qh; 4022 for (1 .. $s) { 4023 $Uh->bmul($Vl); 4024 if ($ql == 1) { $Vl->bmul($Vl)->bsub(BTWO); $ql *= $ql; } 4025 else { $Vl->bmul($Vl)->badd(BTWO); $ql *= $ql; } 4026 } 4027 return map { ($_ > ''.~0) ? Math::BigInt->new(''.$_) : $_ } ($Uh, $Vl); 4028 } 4029 4030 for my $bpos (0 .. $n-$s-1) { 4031 $Ql->bmul($Qh); 4032 if (substr($kstr,$bpos,1)) { 4033 $Qh = $Ql * $Q; 4034 #$Uh = $Uh * $Vh; 4035 #$Vl = $Vh * $Vl - $P * $Ql; 4036 #$Vh = $Vh * $Vh - BTWO * $Qh; 4037 $Uh->bmul($Vh); 4038 $Vl->bmul($Vh)->bsub($P * $Ql); 4039 $Vh->bmul($Vh)->bsub(BTWO * $Qh); 4040 } else { 4041 $Qh = $Ql->copy; 4042 #$Uh = $Uh * $Vl - $Ql; 4043 #$Vh = $Vh * $Vl - $P * $Ql; 4044 #$Vl = $Vl * $Vl - BTWO * $Ql; 4045 $Uh->bmul($Vl)->bsub($Ql); 4046 $Vh->bmul($Vl)->bsub($P * $Ql); 4047 $Vl->bmul($Vl)->bsub(BTWO * $Ql); 4048 } 4049 } 4050 $Ql->bmul($Qh); 4051 $Qh = $Ql * $Q; 4052 $Uh->bmul($Vl)->bsub($Ql); 4053 $Vl->bmul($Vh)->bsub($P * $Ql); 4054 $Ql->bmul($Qh); 4055 for (1 .. $s) { 4056 $Uh->bmul($Vl); 4057 $Vl->bmul($Vl)->bsub(BTWO * $Ql); 4058 $Ql->bmul($Ql); 4059 } 4060 return map { ($_ > ''.~0) ? Math::BigInt->new(''.$_) : $_ } ($Uh, $Vl, $Ql); 4061} 4062sub lucasu { (_lucasuv(@_))[0] } 4063sub lucasv { (_lucasuv(@_))[1] } 4064 4065sub is_lucas_pseudoprime { 4066 my($n) = @_; 4067 4068 return 0+($n >= 2) if $n < 4; 4069 return 0 if ($n % 2) == 0 || _is_perfect_square($n); 4070 4071 my ($P, $Q, $D) = _lucas_selfridge_params($n); 4072 return 0 if $D == 0; # We found a divisor in the sequence 4073 die "Lucas parameter error: $D, $P, $Q\n" if ($D != $P*$P - 4*$Q); 4074 4075 my($U, $V, $Qk) = lucas_sequence($n, $P, $Q, $n+1); 4076 return ($U == 0) ? 1 : 0; 4077} 4078 4079sub is_strong_lucas_pseudoprime { 4080 my($n) = @_; 4081 4082 return 0+($n >= 2) if $n < 4; 4083 return 0 if ($n % 2) == 0 || _is_perfect_square($n); 4084 4085 my ($P, $Q, $D) = _lucas_selfridge_params($n); 4086 return 0 if $D == 0; # We found a divisor in the sequence 4087 die "Lucas parameter error: $D, $P, $Q\n" if ($D != $P*$P - 4*$Q); 4088 4089 my $m = $n+1; 4090 my($s, $k) = (0, $m); 4091 while ( $k > 0 && !($k % 2) ) { 4092 $s++; 4093 $k >>= 1; 4094 } 4095 my($U, $V, $Qk) = lucas_sequence($n, $P, $Q, $k); 4096 4097 return 1 if $U == 0; 4098 $V = Math::BigInt->new("$V") unless ref($V) eq 'Math::BigInt'; 4099 $Qk = Math::BigInt->new("$Qk") unless ref($Qk) eq 'Math::BigInt'; 4100 foreach my $r (0 .. $s-1) { 4101 return 1 if $V->is_zero; 4102 if ($r < ($s-1)) { 4103 $V->bmul($V)->bsub(BTWO*$Qk)->bmod($n); 4104 $Qk->bmul($Qk)->bmod($n); 4105 } 4106 } 4107 return 0; 4108} 4109 4110sub is_extra_strong_lucas_pseudoprime { 4111 my($n) = @_; 4112 4113 return 0+($n >= 2) if $n < 4; 4114 return 0 if ($n % 2) == 0 || _is_perfect_square($n); 4115 4116 my ($P, $Q, $D) = _lucas_extrastrong_params($n); 4117 return 0 if $D == 0; # We found a divisor in the sequence 4118 die "Lucas parameter error: $D, $P, $Q\n" if ($D != $P*$P - 4*$Q); 4119 4120 # We have to convert n to a bigint or Math::BigInt::GMP's stupid set_si bug 4121 # (RT 71548) will hit us and make the test $V == $n-2 always return false. 4122 $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; 4123 4124 my($s, $k) = (0, $n->copy->binc); 4125 while ($k->is_even && !$k->is_zero) { 4126 $s++; 4127 $k->brsft(BONE); 4128 } 4129 4130 my($U, $V, $Qk) = lucas_sequence($n, $P, $Q, $k); 4131 4132 $V = Math::BigInt->new("$V") unless ref($V) eq 'Math::BigInt'; 4133 return 1 if $U == 0 && ($V == BTWO || $V == ($n - BTWO)); 4134 foreach my $r (0 .. $s-2) { 4135 return 1 if $V->is_zero; 4136 $V->bmul($V)->bsub(BTWO)->bmod($n); 4137 } 4138 return 0; 4139} 4140 4141sub is_almost_extra_strong_lucas_pseudoprime { 4142 my($n, $increment) = @_; 4143 $increment = 1 unless defined $increment; 4144 4145 return 0+($n >= 2) if $n < 4; 4146 return 0 if ($n % 2) == 0 || _is_perfect_square($n); 4147 4148 my ($P, $Q, $D) = _lucas_extrastrong_params($n, $increment); 4149 return 0 if $D == 0; # We found a divisor in the sequence 4150 die "Lucas parameter error: $D, $P, $Q\n" if ($D != $P*$P - 4*$Q); 4151 4152 $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; 4153 4154 my $ZERO = $n->copy->bzero; 4155 my $TWO = $ZERO->copy->binc->binc; 4156 my $V = $ZERO + $P; # V_{k} 4157 my $W = $ZERO + $P*$P-$TWO; # V_{k+1} 4158 my $kstr = substr($n->copy->binc()->as_bin, 2); 4159 $kstr =~ s/(0*)$//; 4160 my $s = length($1); 4161 my $bpos = 0; 4162 while (++$bpos < length($kstr)) { 4163 if (substr($kstr,$bpos,1)) { 4164 $V->bmul($W)->bsub($P )->bmod($n); 4165 $W->bmul($W)->bsub($TWO)->bmod($n); 4166 } else { 4167 $W->bmul($V)->bsub($P )->bmod($n); 4168 $V->bmul($V)->bsub($TWO)->bmod($n); 4169 } 4170 } 4171 4172 return 1 if $V == 2 || $V == ($n-$TWO); 4173 foreach my $r (0 .. $s-2) { 4174 return 1 if $V->is_zero; 4175 $V->bmul($V)->bsub($TWO)->bmod($n); 4176 } 4177 return 0; 4178} 4179 4180sub is_frobenius_khashin_pseudoprime { 4181 my($n) = @_; 4182 return 0+($n >= 2) if $n < 4; 4183 return 0 unless $n % 2; 4184 return 0 if _is_perfect_square($n); 4185 4186 $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; 4187 4188 my($k,$c) = (2,1); 4189 if ($n % 4 == 3) { $c = $n-1; } 4190 elsif ($n % 8 == 5) { $c = 2; } 4191 else { 4192 do { 4193 $c += 2; 4194 $k = kronecker($c, $n); 4195 } while $k == 1; 4196 } 4197 return 0 if $k == 0 || ($k == 2 && !($n % 3));; 4198 4199 my $ea = ($k == 2) ? 2 : 1; 4200 my($ra,$rb,$a,$b,$d) = ($ea,1,$ea,1,$n-1); 4201 while (!$d->is_zero) { 4202 if ($d->is_odd()) { 4203 ($ra, $rb) = ( (($ra*$a)%$n + ((($rb*$b)%$n)*$c)%$n) % $n, 4204 (($rb*$a)%$n + ($ra*$b)%$n) % $n ); 4205 } 4206 $d >>= 1; 4207 if (!$d->is_zero) { 4208 ($a, $b) = ( (($a*$a)%$n + ((($b*$b)%$n)*$c)%$n) % $n, 4209 (($b*$a)%$n + ($a*$b)%$n) % $n ); 4210 } 4211 } 4212 return ($ra == $ea && $rb == $n-1) ? 1 : 0; 4213} 4214 4215sub is_frobenius_underwood_pseudoprime { 4216 my($n) = @_; 4217 return 0+($n >= 2) if $n < 4; 4218 return 0 unless $n % 2; 4219 4220 my($a, $temp1, $temp2); 4221 if ($n % 4 == 3) { 4222 $a = 0; 4223 } else { 4224 for ($a = 1; $a < 1000000; $a++) { 4225 next if $a==2 || $a==4 || $a==7 || $a==8 || $a==10 || $a==14 || $a==16 || $a==18; 4226 my $j = kronecker($a*$a - 4, $n); 4227 last if $j == -1; 4228 return 0 if $j == 0 || ($a == 20 && _is_perfect_square($n)); 4229 } 4230 } 4231 $temp1 = Math::Prime::Util::gcd(($a+4)*(2*$a+5), $n); 4232 return 0 if $temp1 != 1 && $temp1 != $n; 4233 4234 $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; 4235 my $ZERO = $n->copy->bzero; 4236 my $ONE = $ZERO->copy->binc; 4237 my $TWO = $ONE->copy->binc; 4238 my($s, $t) = ($ONE->copy, $TWO->copy); 4239 4240 my $ap2 = $TWO + $a; 4241 my $np1string = substr( $n->copy->binc->as_bin, 2); 4242 my $np1len = length($np1string); 4243 4244 foreach my $bit (1 .. $np1len-1) { 4245 $temp2 = $t+$t; 4246 $temp2 += ($s * $a) if $a != 0; 4247 $temp1 = $temp2 * $s; 4248 $temp2 = $t - $s; 4249 $s += $t; 4250 $t = ($s * $temp2) % $n; 4251 $s = $temp1 % $n; 4252 if ( substr( $np1string, $bit, 1 ) ) { 4253 if ($a == 0) { $temp1 = $s + $s; } 4254 else { $temp1 = $s * $ap2; } 4255 $temp1 += $t; 4256 $t->badd($t)->bsub($s); # $t = ($t+$t) - $s; 4257 $s = $temp1; 4258 } 4259 } 4260 $temp1 = (2*$a+5) % $n; 4261 return ($s == 0 && $t == $temp1) ? 1 : 0; 4262} 4263 4264sub _perrin_signature { 4265 my($n) = @_; 4266 my @S = (1,$n-1,3, 3,0,2); 4267 return @S if $n <= 1; 4268 4269 my @nbin = todigits($n,2); 4270 shift @nbin; 4271 4272 while (@nbin) { 4273 my @T = map { addmod(addmod(Math::Prime::Util::mulmod($S[$_],$S[$_],$n), $n-$S[5-$_],$n), $n-$S[5-$_],$n); } 0..5; 4274 my $T01 = addmod($T[2], $n-$T[1], $n); 4275 my $T34 = addmod($T[5], $n-$T[4], $n); 4276 my $T45 = addmod($T34, $T[3], $n); 4277 if (shift @nbin) { 4278 @S = ($T[0], $T01, $T[1], $T[4], $T45, $T[5]); 4279 } else { 4280 @S = ($T01, $T[1], addmod($T01,$T[0],$n), $T34, $T[4], $T45); 4281 } 4282 } 4283 @S; 4284} 4285 4286sub is_perrin_pseudoprime { 4287 my($n, $restrict) = @_; 4288 $restrict = 0 unless defined $restrict; 4289 return 0+($n >= 2) if $n < 4; 4290 return 0 if $restrict > 2 && ($n % 2) == 0; 4291 4292 $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; 4293 4294 my @S = _perrin_signature($n); 4295 return 0 unless $S[4] == 0; 4296 return 1 if $restrict == 0; 4297 return 0 unless $S[1] == $n-1; 4298 return 1 if $restrict == 1; 4299 my $j = kronecker(-23,$n); 4300 if ($j == -1) { 4301 my $B = $S[2]; 4302 my $B2 = mulmod($B,$B,$n); 4303 my $A = addmod(addmod(1,mulmod(3,$B,$n),$n),$n-$B2,$n); 4304 my $C = addmod(mulmod(3,$B2,$n),$n-2,$n); 4305 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; 4306 } else { 4307 return 0 if $j == 0 && $n != 23 && $restrict > 2; 4308 return 1 if $S[0] == 1 && $S[2] == 3 && $S[3] == 3 && $S[5] == 2; 4309 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); 4310 } 4311 0; 4312} 4313 4314sub is_catalan_pseudoprime { 4315 my($n) = @_; 4316 return 0+($n >= 2) if $n < 4; 4317 my $m = ($n-1)>>1; 4318 return (binomial($m<<1,$m) % $n) == (($m&1) ? $n-1 : 1) ? 1 : 0; 4319} 4320 4321sub is_frobenius_pseudoprime { 4322 my($n, $P, $Q) = @_; 4323 ($P,$Q) = (0,0) unless defined $P && defined $Q; 4324 return 0+($n >= 2) if $n < 4; 4325 4326 $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; 4327 return 0 if $n->is_even; 4328 4329 my($k, $Vcomp, $D, $Du) = (0, 4); 4330 if ($P == 0 && $Q == 0) { 4331 ($P,$Q) = (-1,2); 4332 while ($k != -1) { 4333 $P += 2; 4334 $P = 5 if $P == 3; # Skip 3 4335 $D = $P*$P-4*$Q; 4336 $Du = ($D >= 0) ? $D : -$D; 4337 last if $P >= $n || $Du >= $n; # TODO: remove? 4338 $k = kronecker($D, $n); 4339 return 0 if $k == 0; 4340 return 0 if $P == 10001 && _is_perfect_square($n); 4341 } 4342 } else { 4343 $D = $P*$P-4*$Q; 4344 $Du = ($D >= 0) ? $D : -$D; 4345 croak "Frobenius invalid P,Q: ($P,$Q)" if _is_perfect_square($Du); 4346 } 4347 return (is_prime($n) ? 1 : 0) if $n <= $Du || $n <= abs($Q) || $n <= abs($P); 4348 return 0 if Math::Prime::Util::gcd(abs($P*$Q*$D), $n) > 1; 4349 4350 if ($k == 0) { 4351 $k = kronecker($D, $n); 4352 return 0 if $k == 0; 4353 my $Q2 = (2*abs($Q)) % $n; 4354 $Vcomp = ($k == 1) ? 2 : ($Q >= 0) ? $Q2 : $n-$Q2; 4355 } 4356 4357 my($U, $V, $Qk) = lucas_sequence($n, $P, $Q, $n-$k); 4358 return 1 if $U == 0 && $V == $Vcomp; 4359 0; 4360} 4361 4362# Since people have graciously donated millions of CPU years to doing these 4363# tests, it would be rude of us not to use the results. This means we don't 4364# actually use the pretest and Lucas-Lehmer test coded below for any reasonable 4365# size number. 4366# See: http://www.mersenne.org/report_milestones/ 4367my %_mersenne_primes; 4368undef @_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}; 4369 4370sub is_mersenne_prime { 4371 my $p = shift; 4372 4373 # Use the known Mersenne primes 4374 return 1 if exists $_mersenne_primes{$p}; 4375 return 0 if $p < 34007399; # GIMPS has checked all below 4376 # Past this we do a generic Mersenne prime test 4377 4378 return 1 if $p == 2; 4379 return 0 unless is_prob_prime($p); 4380 return 0 if $p > 3 && $p % 4 == 3 && $p < ((~0)>>1) && is_prob_prime($p*2+1); 4381 my $mp = BONE->copy->blsft($p)->bdec; 4382 4383 # Definitely faster than using Math::BigInt that doesn't have GMP. 4384 return (0 == (Math::Prime::Util::GMP::lucas_sequence($mp, 4, 1, $mp+1))[0]) 4385 if $Math::Prime::Util::_GMPfunc{"lucas_sequence"}; 4386 4387 my $V = Math::BigInt->new(4); 4388 for my $k (3 .. $p) { 4389 $V->bmul($V)->bsub(BTWO)->bmod($mp); 4390 } 4391 return $V->is_zero; 4392} 4393 4394 4395my $_poly_bignum; 4396sub _poly_new { 4397 my @poly = @_; 4398 push @poly, 0 unless scalar @poly; 4399 if ($_poly_bignum) { 4400 @poly = map { (ref $_ eq 'Math::BigInt') 4401 ? $_->copy 4402 : Math::BigInt->new("$_"); } @poly; 4403 } 4404 return \@poly; 4405} 4406 4407#sub _poly_print { 4408# my($poly) = @_; 4409# carp "poly has null top degree" if $#$poly > 0 && !$poly->[-1]; 4410# foreach my $d (reverse 1 .. $#$poly) { 4411# my $coef = $poly->[$d]; 4412# print "", ($coef != 1) ? $coef : "", ($d > 1) ? "x^$d" : "x", " + " 4413# if $coef; 4414# } 4415# my $p0 = $poly->[0] || 0; 4416# print "$p0\n"; 4417#} 4418 4419sub _poly_mod_mul { 4420 my($px, $py, $r, $n) = @_; 4421 4422 my $px_degree = $#$px; 4423 my $py_degree = $#$py; 4424 my @res = map { $_poly_bignum ? Math::BigInt->bzero : 0 } 0 .. $r-1; 4425 4426 # convolve(px, py) mod (X^r-1,n) 4427 my @indices_y = grep { $py->[$_] } (0 .. $py_degree); 4428 foreach my $ix (0 .. $px_degree) { 4429 my $px_at_ix = $px->[$ix]; 4430 next unless $px_at_ix; 4431 if ($_poly_bignum) { 4432 foreach my $iy (@indices_y) { 4433 my $rindex = ($ix + $iy) % $r; # reduce mod X^r-1 4434 $res[$rindex]->badd($px_at_ix->copy->bmul($py->[$iy]))->bmod($n); 4435 } 4436 } else { 4437 foreach my $iy (@indices_y) { 4438 my $rindex = ($ix + $iy) % $r; # reduce mod X^r-1 4439 $res[$rindex] = ($res[$rindex] + $px_at_ix * $py->[$iy]) % $n; 4440 } 4441 } 4442 } 4443 # In case we had upper terms go to zero after modulo, reduce the degree. 4444 pop @res while !$res[-1]; 4445 return \@res; 4446} 4447 4448sub _poly_mod_pow { 4449 my($pn, $power, $r, $mod) = @_; 4450 my $res = _poly_new(1); 4451 my $p = $power; 4452 4453 while ($p) { 4454 $res = _poly_mod_mul($res, $pn, $r, $mod) if ($p & 1); 4455 $p >>= 1; 4456 $pn = _poly_mod_mul($pn, $pn, $r, $mod) if $p; 4457 } 4458 return $res; 4459} 4460 4461sub _test_anr { 4462 my($a, $n, $r) = @_; 4463 my $pp = _poly_mod_pow(_poly_new($a, 1), $n, $r, $n); 4464 $pp->[$n % $r] = (($pp->[$n % $r] || 0) - 1) % $n; # subtract X^(n%r) 4465 $pp->[ 0] = (($pp->[ 0] || 0) - $a) % $n; # subtract a 4466 return 0 if scalar grep { $_ } @$pp; 4467 1; 4468} 4469 4470sub is_aks_prime { 4471 my $n = shift; 4472 return 0 if $n < 2 || is_power($n); 4473 4474 my($log2n, $limit); 4475 if ($n > 2**48) { 4476 do { require Math::BigFloat; Math::BigFloat->import(); } 4477 if !defined $Math::BigFloat::VERSION; 4478 # limit = floor( log2(n) * log2(n) ). o_r(n) must be larger than this 4479 my $floatn = Math::BigFloat->new("$n"); 4480 #my $sqrtn = _bigint_to_int($floatn->copy->bsqrt->bfloor); 4481 # The following line seems to trigger a memory leak in Math::BigFloat::blog 4482 # (the part where $MBI is copied to $int) if $n is a Math::BigInt::GMP. 4483 $log2n = $floatn->copy->blog(2); 4484 $limit = _bigint_to_int( ($log2n * $log2n)->bfloor ); 4485 } else { 4486 $log2n = log($n)/log(2) + 0.0001; # Error on large side. 4487 $limit = int( $log2n*$log2n + 0.0001 ); 4488 } 4489 4490 my $r = next_prime($limit); 4491 foreach my $f (@{primes(0,$r-1)}) { 4492 return 1 if $f == $n; 4493 return 0 if !($n % $f); 4494 } 4495 4496 while ($r < $n) { 4497 return 0 if !($n % $r); 4498 #return 1 if $r >= $sqrtn; 4499 last if znorder($n, $r) > $limit; # Note the arguments! 4500 $r = next_prime($r); 4501 } 4502 4503 return 1 if $r >= $n; 4504 4505 # Since r is a prime, phi(r) = r-1 4506 my $rlimit = (ref($log2n) eq 'Math::BigFloat') 4507 ? _bigint_to_int( Math::BigFloat->new("$r")->bdec() 4508 ->bsqrt->bmul($log2n)->bfloor) 4509 : int( (sqrt(($r-1)) * $log2n) + 0.001 ); 4510 4511 $_poly_bignum = 1; 4512 if ( $n < (MPU_HALFWORD-1) ) { 4513 $_poly_bignum = 0; 4514 #$n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt'; 4515 } else { 4516 $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; 4517 } 4518 4519 my $_verbose = Math::Prime::Util::prime_get_config()->{'verbose'}; 4520 print "# aks r = $r s = $rlimit\n" if $_verbose; 4521 local $| = 1 if $_verbose > 1; 4522 for (my $a = 1; $a <= $rlimit; $a++) { 4523 return 0 unless _test_anr($a, $n, $r); 4524 print "." if $_verbose > 1; 4525 } 4526 print "\n" if $_verbose > 1; 4527 4528 return 1; 4529} 4530 4531 4532sub _basic_factor { 4533 # MODIFIES INPUT SCALAR 4534 return ($_[0] == 1) ? () : ($_[0]) if $_[0] < 4; 4535 4536 my @factors; 4537 if (ref($_[0]) ne 'Math::BigInt') { 4538 while ( !($_[0] % 2) ) { push @factors, 2; $_[0] = int($_[0] / 2); } 4539 while ( !($_[0] % 3) ) { push @factors, 3; $_[0] = int($_[0] / 3); } 4540 while ( !($_[0] % 5) ) { push @factors, 5; $_[0] = int($_[0] / 5); } 4541 } else { 4542 # Without this, the bdivs will try to convert the results to BigFloat 4543 # and lose precision. 4544 $_[0]->upgrade(undef) if ref($_[0]) && $_[0]->upgrade(); 4545 if (!Math::BigInt::bgcd($_[0], B_PRIM235)->is_one) { 4546 while ( $_[0]->is_even) { push @factors, 2; $_[0]->brsft(BONE); } 4547 foreach my $div (3, 5) { 4548 my ($q, $r) = $_[0]->copy->bdiv($div); 4549 while ($r->is_zero) { 4550 push @factors, $div; 4551 $_[0] = $q; 4552 ($q, $r) = $_[0]->copy->bdiv($div); 4553 } 4554 } 4555 } 4556 $_[0] = _bigint_to_int($_[0]) if $] >= 5.008 && $_[0] <= BMAX; 4557 } 4558 4559 if ( ($_[0] > 1) && _is_prime7($_[0]) ) { 4560 push @factors, $_[0]; 4561 $_[0] = 1; 4562 } 4563 @factors; 4564} 4565 4566sub trial_factor { 4567 my($n, $limit) = @_; 4568 4569 # Don't use _basic_factor here -- they want a trial forced. 4570 my @factors; 4571 if ($n < 4) { 4572 @factors = ($n == 1) ? () : ($n); 4573 return @factors; 4574 } 4575 4576 my $start_idx = 1; 4577 # Expand small primes if it would help. 4578 push @_primes_small, @{primes($_primes_small[-1]+1, 100_003)} 4579 if $n > 400_000_000 4580 && $_primes_small[-1] < 99_000 4581 && (!defined $limit || $limit > $_primes_small[-1]); 4582 4583 # Do initial bigint reduction. Hopefully reducing it to native int. 4584 if (ref($n) eq 'Math::BigInt') { 4585 $n = $n->copy; # Don't modify their original input! 4586 my $newlim = $n->copy->bsqrt; 4587 $limit = $newlim if !defined $limit || $limit > $newlim; 4588 while ($start_idx <= $#_primes_small) { 4589 my $f = $_primes_small[$start_idx++]; 4590 last if $f > $limit; 4591 if ($n->copy->bmod($f)->is_zero) { 4592 do { 4593 push @factors, $f; 4594 $n->bdiv($f)->bfloor(); 4595 } while $n->copy->bmod($f)->is_zero; 4596 last if $n < BMAX; 4597 my $newlim = $n->copy->bsqrt; 4598 $limit = $newlim if $limit > $newlim; 4599 } 4600 } 4601 return @factors if $n->is_one; 4602 $n = _bigint_to_int($n) if $n <= BMAX; 4603 return (@factors,$n) if $start_idx <= $#_primes_small && $_primes_small[$start_idx] > $limit; 4604 } 4605 4606 { 4607 my $newlim = (ref($n) eq 'Math::BigInt') ? $n->copy->bsqrt : int(sqrt($n) + 0.001); 4608 $limit = $newlim if !defined $limit || $limit > $newlim; 4609 } 4610 4611 if (ref($n) ne 'Math::BigInt') { 4612 for my $i ($start_idx .. $#_primes_small) { 4613 my $p = $_primes_small[$i]; 4614 last if $p > $limit; 4615 if (($n % $p) == 0) { 4616 do { push @factors, $p; $n = int($n/$p); } while ($n % $p) == 0; 4617 last if $n == 1; 4618 my $newlim = int( sqrt($n) + 0.001); 4619 $limit = $newlim if $newlim < $limit; 4620 } 4621 } 4622 if ($_primes_small[-1] < $limit) { 4623 my $inc = (($_primes_small[-1] % 6) == 1) ? 4 : 2; 4624 my $p = $_primes_small[-1] + $inc; 4625 while ($p <= $limit) { 4626 if (($n % $p) == 0) { 4627 do { push @factors, $p; $n = int($n/$p); } while ($n % $p) == 0; 4628 last if $n == 1; 4629 my $newlim = int( sqrt($n) + 0.001); 4630 $limit = $newlim if $newlim < $limit; 4631 } 4632 $p += ($inc ^= 6); 4633 } 4634 } 4635 } else { # n is a bigint. Use mod-210 wheel trial division. 4636 # Generating a wheel mod $w starting at $s: 4637 # mpu 'my($s,$w,$t)=(11,2*3*5); say join ",",map { ($t,$s)=($_-$s,$_); $t; } grep { gcd($_,$w)==1 } $s+1..$s+$w;' 4638 # Should start at $_primes_small[$start_idx], do 11 + next multiple of 210. 4639 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); 4640 my $f = 11; while ($f <= $_primes_small[$start_idx-1]-210) { $f += 210; } 4641 ($f, $limit) = map { Math::BigInt->new("$_") } ($f, $limit); 4642 SEARCH: while ($f <= $limit) { 4643 foreach my $finc (@incs) { 4644 if ($n->copy->bmod($f)->is_zero && $f->bacmp($limit) <= 0) { 4645 my $sf = ($f <= BMAX) ? _bigint_to_int($f) : $f->copy; 4646 do { 4647 push @factors, $sf; 4648 $n->bdiv($f)->bfloor(); 4649 } while $n->copy->bmod($f)->is_zero; 4650 last SEARCH if $n->is_one; 4651 my $newlim = $n->copy->bsqrt; 4652 $limit = $newlim if $limit > $newlim; 4653 } 4654 $f->badd($finc); 4655 } 4656 } 4657 } 4658 push @factors, $n if $n > 1; 4659 @factors; 4660} 4661 4662my $_holf_r; 4663my @_fsublist = ( 4664 [ "pbrent 32k", sub { pbrent_factor (shift, 32*1024, 1, 1) } ], 4665 [ "p-1 1M", sub { pminus1_factor(shift, 1_000_000, undef, 1); } ], 4666 [ "ECM 1k", sub { ecm_factor (shift, 1_000, 5_000, 15) } ], 4667 [ "pbrent 512k",sub { pbrent_factor (shift, 512*1024, 7, 1) } ], 4668 [ "p-1 4M", sub { pminus1_factor(shift, 4_000_000, undef, 1); } ], 4669 [ "ECM 10k", sub { ecm_factor (shift, 10_000, 50_000, 10) } ], 4670 [ "pbrent 512k",sub { pbrent_factor (shift, 512*1024, 11, 1) } ], 4671 [ "HOLF 256k", sub { holf_factor (shift, 256*1024, $_holf_r); $_holf_r += 256*1024; } ], 4672 [ "p-1 20M", sub { pminus1_factor(shift,20_000_000); } ], 4673 [ "ECM 100k", sub { ecm_factor (shift, 100_000, 800_000, 10) } ], 4674 [ "HOLF 512k", sub { holf_factor (shift, 512*1024, $_holf_r); $_holf_r += 512*1024; } ], 4675 [ "pbrent 2M", sub { pbrent_factor (shift, 2048*1024, 13, 1) } ], 4676 [ "HOLF 2M", sub { holf_factor (shift, 2048*1024, $_holf_r); $_holf_r += 2048*1024; } ], 4677 [ "ECM 1M", sub { ecm_factor (shift, 1_000_000, 1_000_000, 10) } ], 4678 [ "p-1 100M", sub { pminus1_factor(shift, 100_000_000, 500_000_000); } ], 4679); 4680 4681sub factor { 4682 my($n) = @_; 4683 _validate_positive_integer($n); 4684 my @factors; 4685 4686 if ($n < 4) { 4687 @factors = ($n == 1) ? () : ($n); 4688 return @factors; 4689 } 4690 $n = $n->copy if ref($n) eq 'Math::BigInt'; 4691 my $lim = 4999; # How much trial factoring to do 4692 4693 # For native integers, we could save a little time by doing hardcoded trials 4694 # by 2-29 here. Skipping it. 4695 4696 push @factors, trial_factor($n, $lim); 4697 return @factors if $factors[-1] < $lim*$lim; 4698 $n = pop(@factors); 4699 4700 my @nstack = ($n); 4701 while (@nstack) { 4702 $n = pop @nstack; 4703 # Don't use bignum on $n if it has gotten small enough. 4704 $n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt' && $n <= BMAX; 4705 #print "Looking at $n with stack ", join(",",@nstack), "\n"; 4706 while ( ($n >= ($lim*$lim)) && !_is_prime7($n) ) { 4707 my @ftry; 4708 $_holf_r = 1; 4709 foreach my $sub (@_fsublist) { 4710 last if scalar @ftry >= 2; 4711 print " starting $sub->[0]\n" if Math::Prime::Util::prime_get_config()->{'verbose'} > 1; 4712 @ftry = $sub->[1]->($n); 4713 } 4714 if (scalar @ftry > 1) { 4715 #print " split into ", join(",",@ftry), "\n"; 4716 $n = shift @ftry; 4717 $n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt' && $n <= BMAX; 4718 push @nstack, @ftry; 4719 } else { 4720 #warn "trial factor $n\n"; 4721 push @factors, trial_factor($n); 4722 #print " trial into ", join(",",@factors), "\n"; 4723 $n = 1; 4724 last; 4725 } 4726 } 4727 push @factors, $n if $n != 1; 4728 } 4729 @factors = sort {$a<=>$b} @factors; 4730 return @factors; 4731} 4732 4733sub _found_factor { 4734 my($f, $n, $what, @factors) = @_; 4735 if ($f == 1 || $f == $n) { 4736 push @factors, $n; 4737 } else { 4738 # Perl 5.6.2 needs things spelled out for it. 4739 my $f2 = (ref($n) eq 'Math::BigInt') ? $n->copy->bdiv($f)->as_int 4740 : int($n/$f); 4741 push @factors, $f; 4742 push @factors, $f2; 4743 croak "internal error in $what" unless $f * $f2 == $n; 4744 # MPU::GMP prints this type of message if verbose, so do the same. 4745 print "$what found factor $f\n" if Math::Prime::Util::prime_get_config()->{'verbose'} > 0; 4746 } 4747 @factors; 4748} 4749 4750# TODO: 4751sub squfof_factor { trial_factor(@_) } 4752 4753sub prho_factor { 4754 my($n, $rounds, $pa, $skipbasic) = @_; 4755 $rounds = 4*1024*1024 unless defined $rounds; 4756 $pa = 3 unless defined $pa; 4757 4758 my @factors; 4759 if (!$skipbasic) { 4760 @factors = _basic_factor($n); 4761 return @factors if $n < 4; 4762 } 4763 4764 my $inloop = 0; 4765 my $U = 7; 4766 my $V = 7; 4767 4768 if ( ref($n) eq 'Math::BigInt' ) { 4769 4770 my $zero = $n->copy->bzero; 4771 $pa = $zero->badd("$pa"); 4772 $U = $zero->copy->badd($U); 4773 $V = $zero->copy->badd($V); 4774 for my $i (1 .. $rounds) { 4775 # Would use bmuladd here, but old Math::BigInt's barf with scalar $pa. 4776 $U->bmul($U)->badd($pa)->bmod($n); 4777 $V->bmul($V)->badd($pa); 4778 $V->bmul($V)->badd($pa)->bmod($n); 4779 my $f = Math::BigInt::bgcd($U-$V, $n); 4780 if ($f->bacmp($n) == 0) { 4781 last if $inloop++; # We've been here before 4782 } elsif (!$f->is_one) { 4783 return _found_factor($f, $n, "prho", @factors); 4784 } 4785 } 4786 4787 } elsif ($n < MPU_HALFWORD) { 4788 4789 my $inner = 32; 4790 $rounds = int( ($rounds + $inner-1) / $inner ); 4791 while ($rounds-- > 0) { 4792 my($m, $oldU, $oldV, $f) = (1, $U, $V); 4793 for my $i (1 .. $inner) { 4794 $U = ($U * $U + $pa) % $n; 4795 $V = ($V * $V + $pa) % $n; 4796 $V = ($V * $V + $pa) % $n; 4797 $f = ($U > $V) ? $U-$V : $V-$U; 4798 $m = ($m * $f) % $n; 4799 } 4800 $f = _gcd_ui( $m, $n ); 4801 next if $f == 1; 4802 if ($f == $n) { 4803 ($U, $V) = ($oldU, $oldV); 4804 for my $i (1 .. $inner) { 4805 $U = ($U * $U + $pa) % $n; 4806 $V = ($V * $V + $pa) % $n; 4807 $V = ($V * $V + $pa) % $n; 4808 $f = ($U > $V) ? $U-$V : $V-$U; 4809 $f = _gcd_ui( $f, $n); 4810 last if $f != 1; 4811 } 4812 last if $f == 1 || $f == $n; 4813 } 4814 return _found_factor($f, $n, "prho", @factors); 4815 } 4816 4817 } else { 4818 4819 for my $i (1 .. $rounds) { 4820 if ($n <= (~0 >> 1)) { 4821 $U = _mulmod($U, $U, $n); $U += $pa; $U -= $n if $U >= $n; 4822 $V = _mulmod($V, $V, $n); $V += $pa; # Let the mulmod handle it 4823 $V = _mulmod($V, $V, $n); $V += $pa; $V -= $n if $V >= $n; 4824 } else { 4825 #$U = _mulmod($U, $U, $n); $U=$n-$U; $U = ($pa>=$U) ? $pa-$U : $n-$U+$pa; 4826 #$V = _mulmod($V, $V, $n); $V=$n-$V; $V = ($pa>=$V) ? $pa-$V : $n-$V+$pa; 4827 #$V = _mulmod($V, $V, $n); $V=$n-$V; $V = ($pa>=$V) ? $pa-$V : $n-$V+$pa; 4828 $U = _mulmod($U, $U, $n); $U = _addmod($U, $pa, $n); 4829 $V = _mulmod($V, $V, $n); $V = _addmod($V, $pa, $n); 4830 $V = _mulmod($V, $V, $n); $V = _addmod($V, $pa, $n); 4831 } 4832 my $f = _gcd_ui( $U-$V, $n ); 4833 if ($f == $n) { 4834 last if $inloop++; # We've been here before 4835 } elsif ($f != 1) { 4836 return _found_factor($f, $n, "prho", @factors); 4837 } 4838 } 4839 4840 } 4841 push @factors, $n; 4842 @factors; 4843} 4844 4845sub pbrent_factor { 4846 my($n, $rounds, $pa, $skipbasic) = @_; 4847 $rounds = 4*1024*1024 unless defined $rounds; 4848 $pa = 3 unless defined $pa; 4849 4850 my @factors; 4851 if (!$skipbasic) { 4852 @factors = _basic_factor($n); 4853 return @factors if $n < 4; 4854 } 4855 4856 my $Xi = 2; 4857 my $Xm = 2; 4858 4859 if ( ref($n) eq 'Math::BigInt' ) { 4860 4861 # Same code as the GMP version, but runs *much* slower. Even with 4862 # Math::BigInt::GMP it's >200x slower. With the default Calc backend 4863 # it's thousands of times slower. 4864 my $inner = 32; 4865 my $zero = $n->copy->bzero; 4866 my $saveXi; 4867 my $f; 4868 $Xi = $zero->copy->badd($Xi); 4869 $Xm = $zero->copy->badd($Xm); 4870 $pa = $zero->copy->badd($pa); 4871 my $r = 1; 4872 while ($rounds > 0) { 4873 my $rleft = ($r > $rounds) ? $rounds : $r; 4874 while ($rleft > 0) { 4875 my $dorounds = ($rleft > $inner) ? $inner : $rleft; 4876 my $m = $zero->copy->bone; 4877 $saveXi = $Xi->copy; 4878 foreach my $i (1 .. $dorounds) { 4879 $Xi->bmul($Xi)->badd($pa)->bmod($n); 4880 $m->bmul($Xi->copy->bsub($Xm)); 4881 } 4882 $rleft -= $dorounds; 4883 $rounds -= $dorounds; 4884 $m->bmod($n); 4885 $f = Math::BigInt::bgcd($m, $n); 4886 last unless $f->is_one; 4887 } 4888 if ($f->is_one) { 4889 $r *= 2; 4890 $Xm = $Xi->copy; 4891 next; 4892 } 4893 if ($f == $n) { # back up to determine the factor 4894 $Xi = $saveXi->copy; 4895 do { 4896 $Xi->bmul($Xi)->badd($pa)->bmod($n); 4897 $f = Math::BigInt::bgcd($Xm-$Xi, $n); 4898 } while ($f != 1 && $r-- != 0); 4899 last if $f == 1 || $f == $n; 4900 } 4901 return _found_factor($f, $n, "pbrent", @factors); 4902 } 4903 4904 } elsif ($n < MPU_HALFWORD) { 4905 4906 # Doing the gcd batching as above works pretty well here, but it's a lot 4907 # of code for not much gain for general users. 4908 for my $i (1 .. $rounds) { 4909 $Xi = ($Xi * $Xi + $pa) % $n; 4910 my $f = _gcd_ui( ($Xi>$Xm) ? $Xi-$Xm : $Xm-$Xi, $n); 4911 return _found_factor($f, $n, "pbrent", @factors) if $f != 1 && $f != $n; 4912 $Xm = $Xi if ($i & ($i-1)) == 0; # i is a power of 2 4913 } 4914 4915 } else { 4916 4917 for my $i (1 .. $rounds) { 4918 $Xi = _addmod( _mulmod($Xi, $Xi, $n), $pa, $n); 4919 my $f = _gcd_ui( ($Xi>$Xm) ? $Xi-$Xm : $Xm-$Xi, $n); 4920 return _found_factor($f, $n, "pbrent", @factors) if $f != 1 && $f != $n; 4921 $Xm = $Xi if ($i & ($i-1)) == 0; # i is a power of 2 4922 } 4923 4924 } 4925 push @factors, $n; 4926 @factors; 4927} 4928 4929sub pminus1_factor { 4930 my($n, $B1, $B2, $skipbasic) = @_; 4931 4932 my @factors; 4933 if (!$skipbasic) { 4934 @factors = _basic_factor($n); 4935 return @factors if $n < 4; 4936 } 4937 4938 if ( ref($n) ne 'Math::BigInt' ) { 4939 # Stage 1 only 4940 $B1 = 10_000_000 unless defined $B1; 4941 my $pa = 2; 4942 my $f = 1; 4943 my($pc_beg, $pc_end, @bprimes); 4944 $pc_beg = 2; 4945 $pc_end = $pc_beg + 100_000; 4946 my $sqrtb1 = int(sqrt($B1)); 4947 while (1) { 4948 $pc_end = $B1 if $pc_end > $B1; 4949 @bprimes = @{ primes($pc_beg, $pc_end) }; 4950 foreach my $q (@bprimes) { 4951 my $k = $q; 4952 if ($q <= $sqrtb1) { 4953 my $kmin = int($B1 / $q); 4954 while ($k <= $kmin) { $k *= $q; } 4955 } 4956 $pa = _powmod($pa, $k, $n); 4957 if ($pa == 0) { push @factors, $n; return @factors; } 4958 my $f = _gcd_ui( $pa-1, $n ); 4959 return _found_factor($f, $n, "pminus1", @factors) if $f != 1; 4960 } 4961 last if $pc_end >= $B1; 4962 $pc_beg = $pc_end+1; 4963 $pc_end += 500_000; 4964 } 4965 push @factors, $n; 4966 return @factors; 4967 } 4968 4969 # Stage 2 isn't really any faster than stage 1 for the examples I've tried. 4970 # Perl's overhead is greater than the savings of multiply vs. powmod 4971 4972 if (!defined $B1) { 4973 for my $mul (1, 100, 1000, 10_000, 100_000, 1_000_000) { 4974 $B1 = 1000 * $mul; 4975 $B2 = 1*$B1; 4976 #warn "Trying p-1 with $B1 / $B2\n"; 4977 my @nf = pminus1_factor($n, $B1, $B2); 4978 if (scalar @nf > 1) { 4979 push @factors, @nf; 4980 return @factors; 4981 } 4982 } 4983 push @factors, $n; 4984 return @factors; 4985 } 4986 $B2 = 1*$B1 unless defined $B2; 4987 4988 my $one = $n->copy->bone; 4989 my ($j, $q, $saveq) = (32, 2, 2); 4990 my $t = $one->copy; 4991 my $pa = $one->copy->binc(); 4992 my $savea = $pa->copy; 4993 my $f = $one->copy; 4994 my($pc_beg, $pc_end, @bprimes); 4995 4996 $pc_beg = 2; 4997 $pc_end = $pc_beg + 100_000; 4998 while (1) { 4999 $pc_end = $B1 if $pc_end > $B1; 5000 @bprimes = @{ primes($pc_beg, $pc_end) }; 5001 foreach my $q (@bprimes) { 5002 my($k, $kmin) = ($q, int($B1 / $q)); 5003 while ($k <= $kmin) { $k *= $q; } 5004 $t *= $k; # accumulate powers for a 5005 if ( ($j++ % 64) == 0) { 5006 next if $pc_beg > 2 && ($j-1) % 256; 5007 $pa->bmodpow($t, $n); 5008 $t = $one->copy; 5009 if ($pa == 0) { push @factors, $n; return @factors; } 5010 $f = Math::BigInt::bgcd( $pa->copy->bdec, $n ); 5011 last if $f == $n; 5012 return _found_factor($f, $n, "pminus1", @factors) unless $f->is_one; 5013 $saveq = $q; 5014 $savea = $pa->copy; 5015 } 5016 } 5017 $q = $bprimes[-1]; 5018 last if !$f->is_one || $pc_end >= $B1; 5019 $pc_beg = $pc_end+1; 5020 $pc_end += 500_000; 5021 } 5022 undef @bprimes; 5023 $pa->bmodpow($t, $n); 5024 if ($pa == 0) { push @factors, $n; return @factors; } 5025 $f = Math::BigInt::bgcd( $pa-1, $n ); 5026 if ($f == $n) { 5027 $q = $saveq; 5028 $pa = $savea->copy; 5029 while ($q <= $B1) { 5030 my ($k, $kmin) = ($q, int($B1 / $q)); 5031 while ($k <= $kmin) { $k *= $q; } 5032 $pa->bmodpow($k, $n); 5033 my $f = Math::BigInt::bgcd( $pa-1, $n ); 5034 if ($f == $n) { push @factors, $n; return @factors; } 5035 last if !$f->is_one; 5036 $q = next_prime($q); 5037 } 5038 } 5039 # STAGE 2 5040 if ($f->is_one && $B2 > $B1) { 5041 my $bm = $pa->copy; 5042 my $b = $one->copy; 5043 my @precomp_bm; 5044 $precomp_bm[0] = ($bm * $bm) % $n; 5045 foreach my $j (1..19) { 5046 $precomp_bm[$j] = ($precomp_bm[$j-1] * $bm * $bm) % $n; 5047 } 5048 $pa->bmodpow($q, $n); 5049 my $j = 1; 5050 $pc_beg = $q+1; 5051 $pc_end = $pc_beg + 100_000; 5052 while (1) { 5053 $pc_end = $B2 if $pc_end > $B2; 5054 @bprimes = @{ primes($pc_beg, $pc_end) }; 5055 foreach my $i (0 .. $#bprimes) { 5056 my $diff = $bprimes[$i] - $q; 5057 $q = $bprimes[$i]; 5058 my $qdiff = ($diff >> 1) - 1; 5059 if (!defined $precomp_bm[$qdiff]) { 5060 $precomp_bm[$qdiff] = $bm->copy->bmodpow($diff, $n); 5061 } 5062 $pa->bmul($precomp_bm[$qdiff])->bmod($n); 5063 if ($pa == 0) { push @factors, $n; return @factors; } 5064 $b->bmul($pa-1); 5065 if (($j++ % 128) == 0) { 5066 $b->bmod($n); 5067 $f = Math::BigInt::bgcd( $b, $n ); 5068 last if !$f->is_one; 5069 } 5070 } 5071 last if !$f->is_one || $pc_end >= $B2; 5072 $pc_beg = $pc_end+1; 5073 $pc_end += 500_000; 5074 } 5075 $f = Math::BigInt::bgcd( $b, $n ); 5076 } 5077 return _found_factor($f, $n, "pminus1", @factors); 5078} 5079 5080sub holf_factor { 5081 my($n, $rounds, $startrounds) = @_; 5082 $rounds = 64*1024*1024 unless defined $rounds; 5083 $startrounds = 1 unless defined $startrounds; 5084 $startrounds = 1 if $startrounds < 1; 5085 5086 my @factors = _basic_factor($n); 5087 return @factors if $n < 4; 5088 5089 if ( ref($n) eq 'Math::BigInt' ) { 5090 for my $i ($startrounds .. $rounds) { 5091 my $ni = $n->copy->bmul($i); 5092 my $s = $ni->copy->bsqrt->bfloor->as_int; 5093 if ($s * $s == $ni) { 5094 # s^2 = n*i, so m = s^2 mod n = 0. Hence f = GCD(n, s) = GCD(n, n*i) 5095 my $f = Math::BigInt::bgcd($ni, $n); 5096 return _found_factor($f, $n, "HOLF", @factors); 5097 } 5098 $s->binc; 5099 my $m = ($s * $s) - $ni; 5100 # Check for perfect square 5101 my $mc = _bigint_to_int($m & 31); 5102 next unless $mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25; 5103 my $f = $m->copy->bsqrt->bfloor->as_int; 5104 next unless ($f*$f) == $m; 5105 $f = Math::BigInt::bgcd( ($s > $f) ? $s-$f : $f-$s, $n); 5106 return _found_factor($f, $n, "HOLF ($i rounds)", @factors); 5107 } 5108 } else { 5109 for my $i ($startrounds .. $rounds) { 5110 my $s = int(sqrt($n * $i)); 5111 $s++ if ($s * $s) != ($n * $i); 5112 my $m = ($s < MPU_HALFWORD) ? ($s*$s) % $n : _mulmod($s, $s, $n); 5113 # Check for perfect square 5114 my $mc = $m & 31; 5115 next unless $mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25; 5116 my $f = int(sqrt($m)); 5117 next unless $f*$f == $m; 5118 $f = _gcd_ui($s - $f, $n); 5119 return _found_factor($f, $n, "HOLF ($i rounds)", @factors); 5120 } 5121 } 5122 push @factors, $n; 5123 @factors; 5124} 5125 5126sub fermat_factor { 5127 my($n, $rounds) = @_; 5128 $rounds = 64*1024*1024 unless defined $rounds; 5129 5130 my @factors = _basic_factor($n); 5131 return @factors if $n < 4; 5132 5133 if ( ref($n) eq 'Math::BigInt' ) { 5134 my $pa = $n->copy->bsqrt->bfloor->as_int; 5135 return _found_factor($pa, $n, "Fermat", @factors) if $pa*$pa == $n; 5136 $pa++; 5137 my $b2 = $pa*$pa - $n; 5138 my $lasta = $pa + $rounds; 5139 while ($pa <= $lasta) { 5140 my $mc = _bigint_to_int($b2 & 31); 5141 if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) { 5142 my $s = $b2->copy->bsqrt->bfloor->as_int; 5143 if ($s*$s == $b2) { 5144 my $i = $pa-($lasta-$rounds)+1; 5145 return _found_factor($pa - $s, $n, "Fermat ($i rounds)", @factors); 5146 } 5147 } 5148 $pa++; 5149 $b2 = $pa*$pa-$n; 5150 } 5151 } else { 5152 my $pa = int(sqrt($n)); 5153 return _found_factor($pa, $n, "Fermat", @factors) if $pa*$pa == $n; 5154 $pa++; 5155 my $b2 = $pa*$pa - $n; 5156 my $lasta = $pa + $rounds; 5157 while ($pa <= $lasta) { 5158 my $mc = $b2 & 31; 5159 if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) { 5160 my $s = int(sqrt($b2)); 5161 if ($s*$s == $b2) { 5162 my $i = $pa-($lasta-$rounds)+1; 5163 return _found_factor($pa - $s, $n, "Fermat ($i rounds)", @factors); 5164 } 5165 } 5166 $pa++; 5167 $b2 = $pa*$pa-$n; 5168 } 5169 } 5170 push @factors, $n; 5171 @factors; 5172} 5173 5174 5175sub ecm_factor { 5176 my($n, $B1, $B2, $ncurves) = @_; 5177 _validate_positive_integer($n); 5178 5179 my @factors = _basic_factor($n); 5180 return @factors if $n < 4; 5181 5182 if ($Math::Prime::Util::_GMPfunc{"ecm_factor"}) { 5183 $B1 = 0 if !defined $B1; 5184 $ncurves = 0 if !defined $ncurves; 5185 my @ef = Math::Prime::Util::GMP::ecm_factor($n, $B1, $ncurves); 5186 if (@ef > 1) { 5187 my $ecmfac = Math::Prime::Util::_reftyped($n, $ef[-1]); 5188 return _found_factor($ecmfac, $n, "ECM (GMP) B1=$B1 curves $ncurves", @factors); 5189 } 5190 push @factors, $n; 5191 return @factors; 5192 } 5193 5194 $ncurves = 10 unless defined $ncurves; 5195 5196 if (!defined $B1) { 5197 for my $mul (1, 10, 100, 1000, 10_000, 100_000, 1_000_000) { 5198 $B1 = 100 * $mul; 5199 $B2 = 10*$B1; 5200 #warn "Trying ecm with $B1 / $B2\n"; 5201 my @nf = ecm_factor($n, $B1, $B2, $ncurves); 5202 if (scalar @nf > 1) { 5203 push @factors, @nf; 5204 return @factors; 5205 } 5206 } 5207 push @factors, $n; 5208 return @factors; 5209 } 5210 5211 $B2 = 10*$B1 unless defined $B2; 5212 my $sqrt_b1 = int(sqrt($B1)+1); 5213 5214 # Affine code. About 3x slower than the projective, and no stage 2. 5215 # 5216 #if (!defined $Math::Prime::Util::ECAffinePoint::VERSION) { 5217 # eval { require Math::Prime::Util::ECAffinePoint; 1; } 5218 # or do { croak "Cannot load Math::Prime::Util::ECAffinePoint"; }; 5219 #} 5220 #my @bprimes = @{ primes(2, $B1) }; 5221 #my $irandf = Math::Prime::Util::_get_rand_func(); 5222 #foreach my $curve (1 .. $ncurves) { 5223 # my $a = $irandf->($n-1); 5224 # my $b = 1; 5225 # my $ECP = Math::Prime::Util::ECAffinePoint->new($a, $b, $n, 0, 1); 5226 # foreach my $q (@bprimes) { 5227 # my $k = $q; 5228 # if ($k < $sqrt_b1) { 5229 # my $kmin = int($B1 / $q); 5230 # while ($k <= $kmin) { $k *= $q; } 5231 # } 5232 # $ECP->mul($k); 5233 # my $f = $ECP->f; 5234 # if ($f != 1) { 5235 # last if $f == $n; 5236 # warn "ECM found factors with B1 = $B1 in curve $curve\n"; 5237 # return _found_factor($f, $n, "ECM B1=$B1 curve $curve", @factors); 5238 # } 5239 # last if $ECP->is_infinity; 5240 # } 5241 #} 5242 5243 require Math::Prime::Util::ECProjectivePoint; 5244 require Math::Prime::Util::RandomPrimes; 5245 5246 # With multiple curves, it's better to get all the primes at once. 5247 # The downside is this can kill memory with a very large B1. 5248 my @bprimes = @{ primes(3, $B1) }; 5249 foreach my $q (@bprimes) { 5250 last if $q > $sqrt_b1; 5251 my($k,$kmin) = ($q, int($B1/$q)); 5252 while ($k <= $kmin) { $k *= $q; } 5253 $q = $k; 5254 } 5255 my @b2primes = ($B2 > $B1) ? @{primes($B1+1, $B2)} : (); 5256 5257 foreach my $curve (1 .. $ncurves) { 5258 my $sigma = Math::Prime::Util::urandomm($n-6) + 6; 5259 my ($u, $v) = ( ($sigma*$sigma - 5) % $n, (4 * $sigma) % $n ); 5260 my ($x, $z) = ( ($u*$u*$u) % $n, ($v*$v*$v) % $n ); 5261 my $cb = (4 * $x * $v) % $n; 5262 my $ca = ( (($v-$u)**3) * (3*$u + $v) ) % $n; 5263 my $f = Math::BigInt::bgcd( $cb, $n ); 5264 $f = Math::BigInt::bgcd( $z, $n ) if $f == 1; 5265 next if $f == $n; 5266 return _found_factor($f,$n, "ECM B1=$B1 curve $curve", @factors) if $f != 1; 5267 $cb = Math::BigInt->new("$cb") unless ref($cb) eq 'Math::BigInt'; 5268 $u = $cb->copy->bmodinv($n); 5269 $ca = (($ca*$u) - 2) % $n; 5270 5271 my $ECP = Math::Prime::Util::ECProjectivePoint->new($ca, $n, $x, $z); 5272 my $fm = $n-$n+1; 5273 my $i = 15; 5274 5275 for (my $q = 2; $q < $B1; $q *= 2) { $ECP->double(); } 5276 foreach my $k (@bprimes) { 5277 $ECP->mul($k); 5278 $fm = ($fm * $ECP->x() ) % $n; 5279 if ($i++ % 32 == 0) { 5280 $f = Math::BigInt::bgcd($fm, $n); 5281 last if $f != 1; 5282 } 5283 } 5284 $f = Math::BigInt::bgcd($fm, $n); 5285 next if $f == $n; 5286 5287 if ($f == 1 && $B2 > $B1) { # BEGIN STAGE 2 5288 my $D = int(sqrt($B2/2)); $D++ if $D % 2; 5289 my $one = $n - $n + 1; 5290 my $g = $one; 5291 5292 my $S2P = $ECP->copy->normalize; 5293 $f = $S2P->f; 5294 if ($f != 1) { 5295 next if $f == $n; 5296 #warn "ECM S2 normalize f=$f\n" if $f != 1; 5297 return _found_factor($f, $n, "ECM S2 B1=$B1 curve $curve"); 5298 } 5299 my $S2x = $S2P->x; 5300 my $S2d = $S2P->d; 5301 my @nqx = ($n-$n, $S2x); 5302 5303 foreach my $i (2 .. 2*$D) { 5304 my($x2, $z2); 5305 if ($i % 2) { 5306 ($x2, $z2) = Math::Prime::Util::ECProjectivePoint::_addx($nqx[($i-1)/2], $nqx[($i+1)/2], $S2x, $n); 5307 } else { 5308 ($x2, $z2) = Math::Prime::Util::ECProjectivePoint::_double($nqx[$i/2], $one, $n, $S2d); 5309 } 5310 $nqx[$i] = $x2; 5311 #($f, $u, undef) = _extended_gcd($z2, $n); 5312 $f = Math::BigInt::bgcd( $z2, $n ); 5313 last if $f != 1; 5314 $u = $z2->copy->bmodinv($n); 5315 $nqx[$i] = ($x2 * $u) % $n; 5316 } 5317 if ($f != 1) { 5318 next if $f == $n; 5319 #warn "ECM S2 1: B1 $B1 B2 $B2 curve $curve f=$f\n"; 5320 return _found_factor($f, $n, "ECM S2 B1=$B1 curve $curve", @factors); 5321 } 5322 5323 $x = $nqx[2*$D-1]; 5324 my $m = 1; 5325 while ($m < ($B2+$D)) { 5326 if ($m != 1) { 5327 my $oldx = $S2x; 5328 my ($x1, $z1) = Math::Prime::Util::ECProjectivePoint::_addx($nqx[2*$D], $S2x, $x, $n); 5329 $f = Math::BigInt::bgcd( $z1, $n ); 5330 last if $f != 1; 5331 $u = $z1->copy->bmodinv($n); 5332 $S2x = ($x1 * $u) % $n; 5333 $x = $oldx; 5334 last if $f != 1; 5335 } 5336 if ($m+$D > $B1) { 5337 my @p = grep { $_ >= $m-$D && $_ <= $m+$D } @b2primes; 5338 foreach my $i (@p) { 5339 last if $i >= $m; 5340 $g = ($g * ($S2x - $nqx[$m+$D-$i])) % $n; 5341 } 5342 foreach my $i (@p) { 5343 next unless $i > $m; 5344 next if $i > ($m+$m) || is_prime($m+$m-$i); 5345 $g = ($g * ($S2x - $nqx[$i-$m])) % $n; 5346 } 5347 $f = Math::BigInt::bgcd($g, $n); 5348 #warn "ECM S2 3: found $f in stage 2\n" if $f != 1; 5349 last if $f != 1; 5350 } 5351 $m += 2*$D; 5352 } 5353 } # END STAGE 2 5354 5355 next if $f == $n; 5356 if ($f != 1) { 5357 #warn "ECM found factors with B1 = $B1 in curve $curve\n"; 5358 return _found_factor($f, $n, "ECM B1=$B1 curve $curve", @factors); 5359 } 5360 # end of curve loop 5361 } 5362 push @factors, $n; 5363 @factors; 5364} 5365 5366sub divisors { 5367 my($n) = @_; 5368 _validate_positive_integer($n); 5369 my(@factors, @d, @t); 5370 5371 # In scalar context, returns sigma_0(n). Very fast. 5372 return Math::Prime::Util::divisor_sum($n,0) unless wantarray; 5373 return ($n == 0) ? (0,1) : (1) if $n <= 1; 5374 5375 if ($Math::Prime::Util::_GMPfunc{"divisors"}) { 5376 # This trips an erroneous compile time error without the eval. 5377 eval ' @d = Math::Prime::Util::GMP::divisors($n); '; ## no critic qw(ProhibitStringyEval) 5378 @d = map { $_ <= ~0 ? $_ : ref($n)->new($_) } @d if ref($n); 5379 return @d; 5380 } 5381 5382 @factors = Math::Prime::Util::factor($n); 5383 return (1,$n) if scalar @factors == 1; 5384 5385 my $bigint = ref($n); 5386 @factors = map { $bigint->new("$_") } @factors if $bigint; 5387 @d = $bigint ? ($bigint->new(1)) : (1); 5388 5389 while (my $p = shift @factors) { 5390 my $e = 1; 5391 while (@factors && $p == $factors[0]) { $e++; shift(@factors); } 5392 push @d, @t = map { $_ * $p } @d; # multiply through once 5393 push @d, @t = map { $_ * $p } @t for 2 .. $e; # repeat 5394 } 5395 5396 @d = map { $_ <= INTMAX ? _bigint_to_int($_) : $_ } @d if $bigint; 5397 @d = sort { $a <=> $b } @d; 5398 @d; 5399} 5400 5401 5402sub chebyshev_theta { 5403 my($n,$low) = @_; 5404 $low = 2 unless defined $low; 5405 my($sum,$high) = (0.0, 0); 5406 while ($low <= $n) { 5407 $high = $low + 1e6; 5408 $high = $n if $high > $n; 5409 $sum += log($_) for @{primes($low,$high)}; 5410 $low = $high+1; 5411 } 5412 $sum; 5413} 5414 5415sub chebyshev_psi { 5416 my($n) = @_; 5417 return 0 if $n <= 1; 5418 my ($sum, $logn, $sqrtn) = (0.0, log($n), int(sqrt($n))); 5419 5420 # Sum the log of prime powers first 5421 for my $p (@{primes($sqrtn)}) { 5422 my $logp = log($p); 5423 $sum += $logp * int($logn/$logp+1e-15); 5424 } 5425 # The rest all have exponent 1: add them in using the segmenting theta code 5426 $sum += chebyshev_theta($n, $sqrtn+1); 5427 5428 $sum; 5429} 5430 5431sub hclassno { 5432 my $n = shift; 5433 5434 return -1 if $n == 0; 5435 return 0 if $n < 0 || ($n % 4) == 1 || ($n % 4) == 2; 5436 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; 5437 5438 my ($h, $square, $b, $b2) = (0, 0, $n & 1, ($n+1) >> 2); 5439 5440 if ($b == 0) { 5441 my $lim = int(sqrt($b2)); 5442 if (_is_perfect_square($b2)) { 5443 $square = 1; 5444 $lim--; 5445 } 5446 #$h += scalar(grep { $_ <= $lim } divisors($b2)); 5447 for my $i (1 .. $lim) { $h++ unless $b2 % $i; } 5448 ($b,$b2) = (2, ($n+4) >> 2); 5449 } 5450 while ($b2 * 3 < $n) { 5451 $h++ unless $b2 % $b; 5452 my $lim = int(sqrt($b2)); 5453 if (_is_perfect_square($b2)) { 5454 $h++; 5455 $lim--; 5456 } 5457 #$h += 2 * scalar(grep { $_ > $b && $_ <= $lim } divisors($b2)); 5458 for my $i ($b+1 .. $lim) { $h += 2 unless $b2 % $i; } 5459 $b += 2; 5460 $b2 = ($n+$b*$b) >> 2; 5461 } 5462 return (($b2*3 == $n) ? 2*(3*$h+1) : $square ? 3*(2*$h+1) : 6*$h) << 1; 5463} 5464 5465# Sigma method for prime powers 5466sub _taup { 5467 my($p, $e, $n) = @_; 5468 my($bp) = Math::BigInt->new("".$p); 5469 if ($e == 1) { 5470 return (0,1,-24,252,-1472,4830,-6048,-16744,84480)[$p] if $p <= 8; 5471 my $ds5 = $bp->copy->bpow( 5)->binc(); # divisor_sum(p,5) 5472 my $ds11 = $bp->copy->bpow(11)->binc(); # divisor_sum(p,11) 5473 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)); 5474 $n = ( 65*$ds11 + 691*$ds5 - (691*252)*$s ) / 756; 5475 } else { 5476 my $t = Math::BigInt->new(""._taup($p,1)); 5477 $n = $t->copy->bpow($e); 5478 if ($e == 2) { 5479 $n -= $bp->copy->bpow(11); 5480 } elsif ($e == 3) { 5481 $n -= BTWO * $t * $bp->copy->bpow(11); 5482 } else { 5483 $n += vecsum( map { vecprod( ($_&1) ? - BONE : BONE, 5484 $bp->copy->bpow(11*$_), 5485 binomial($e-$_, $e-2*$_), 5486 $t ** ($e-2*$_) ) } 1 .. ($e>>1) ); 5487 } 5488 } 5489 $n = _bigint_to_int($n) if ref($n) && $n->bacmp(BMAX) <= 0; 5490 $n; 5491} 5492 5493# Cohen's method using Hurwitz class numbers 5494# The two hclassno calls could be collapsed with some work 5495sub _tauprime { 5496 my $p = shift; 5497 return -24 if $p == 2; 5498 my $sum = Math::BigInt->new(0); 5499 if ($p < (MPU_32BIT ? 300 : 1600)) { 5500 my($p9,$pp7) = (9*$p, 7*$p*$p); 5501 for my $t (1 .. Math::Prime::Util::sqrtint($p)) { 5502 my $t2 = $t * $t; 5503 my $v = $p - $t2; 5504 $sum += $t2**3 * (4*$t2*$t2 - $p9*$t2 + $pp7) * (Math::Prime::Util::hclassno(4*$v) + 2 * Math::Prime::Util::hclassno($v)); 5505 } 5506 $p = Math::BigInt->new("$p"); 5507 } else { 5508 $p = Math::BigInt->new("$p"); 5509 my($p9,$pp7) = (9*$p, 7*$p*$p); 5510 for my $t (1 .. Math::Prime::Util::sqrtint($p)) { 5511 my $t2 = Math::BigInt->new("$t") ** 2; 5512 my $v = $p - $t2; 5513 $sum += $t2**3 * (4*$t2*$t2 - $p9*$t2 + $pp7) * (Math::Prime::Util::hclassno(4*$v) + 2 * Math::Prime::Util::hclassno($v)); 5514 } 5515 } 5516 28*$p**6 - 28*$p**5 - 90*$p**4 - 35*$p**3 - 1 - 32 * ($sum/3); 5517} 5518 5519# Recursive method for handling prime powers 5520sub _taupower { 5521 my($p, $e) = @_; 5522 return 1 if $e <= 0; 5523 return _tauprime($p) if $e == 1; 5524 $p = Math::BigInt->new("$p"); 5525 my($tp, $p11) = ( _tauprime($p), $p**11 ); 5526 return $tp ** 2 - $p11 if $e == 2; 5527 return $tp ** 3 - 2 * $tp * $p11 if $e == 3; 5528 return $tp ** 4 - 3 * $tp**2 * $p11 + $p11**2 if $e == 4; 5529 # Recurse -3 5530 ($tp**3 - 2*$tp*$p11) * _taupower($p,$e-3) + ($p11*$p11 - $tp*$tp*$p11) * _taupower($p,$e-4); 5531} 5532 5533sub ramanujan_tau { 5534 my $n = shift; 5535 return 0 if $n <= 0; 5536 5537 # Use GMP if we have no XS or if size is small 5538 if ($n < 100000 || !Math::Prime::Util::prime_get_config()->{'xs'}) { 5539 if ($Math::Prime::Util::_GMPfunc{"ramanujan_tau"}) { 5540 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::ramanujan_tau($n)); 5541 } 5542 } 5543 5544 # _taup is faster for small numbers, but gets very slow. It's not a huge 5545 # deal, and the GMP code will probably get run for small inputs anyway. 5546 vecprod(map { _taupower($_->[0],$_->[1]) } Math::Prime::Util::factor_exp($n)); 5547} 5548 5549sub _Euler { 5550 my($dig) = @_; 5551 return Math::Prime::Util::GMP::Euler($dig) 5552 if $dig > 70 && $Math::Prime::Util::_GMPfunc{"Euler"}; 5553 '0.57721566490153286060651209008240243104215933593992359880576723488486772677766467'; 5554} 5555sub _Li2 { 5556 my($dig) = @_; 5557 return Math::Prime::Util::GMP::li(2,$dig) 5558 if $dig > 70 && $Math::Prime::Util::_GMPfunc{"li"}; 5559 '1.04516378011749278484458888919461313652261557815120157583290914407501320521'; 5560} 5561 5562sub ExponentialIntegral { 5563 my($x) = @_; 5564 return - MPU_INFINITY if $x == 0; 5565 return 0 if $x == - MPU_INFINITY; 5566 return MPU_INFINITY if $x == MPU_INFINITY; 5567 5568 if ($Math::Prime::Util::_GMPfunc{"ei"}) { 5569 $x = Math::BigFloat->new("$x") if defined $bignum::VERSION && ref($x) ne 'Math::BigFloat'; 5570 return 0.0 + Math::Prime::Util::GMP::ei($x,40) if !ref($x); 5571 my $str = Math::Prime::Util::GMP::ei($x, _find_big_acc($x)); 5572 return $x->copy->bzero->badd($str); 5573 } 5574 5575 $x = Math::BigFloat->new("$x") if defined $bignum::VERSION && ref($x) ne 'Math::BigFloat'; 5576 5577 my $tol = 1e-16; 5578 my $sum = 0.0; 5579 my($y, $t); 5580 my $c = 0.0; 5581 my $val; # The result from one of the four methods 5582 5583 if ($x < -1) { 5584 # Continued fraction 5585 my $lc = 0; 5586 my $ld = 1 / (1 - $x); 5587 $val = $ld * (-exp($x)); 5588 for my $n (1 .. 100000) { 5589 $lc = 1 / (2*$n + 1 - $x - $n*$n*$lc); 5590 $ld = 1 / (2*$n + 1 - $x - $n*$n*$ld); 5591 my $old = $val; 5592 $val *= $ld/$lc; 5593 last if abs($val - $old) <= ($tol * abs($val)); 5594 } 5595 } elsif ($x < 0) { 5596 # Rational Chebyshev approximation 5597 my @C6p = ( -148151.02102575750838086, 5598 150260.59476436982420737, 5599 89904.972007457256553251, 5600 15924.175980637303639884, 5601 2150.0672908092918123209, 5602 116.69552669734461083368, 5603 5.0196785185439843791020); 5604 my @C6q = ( 256664.93484897117319268, 5605 184340.70063353677359298, 5606 52440.529172056355429883, 5607 8125.8035174768735759866, 5608 750.43163907103936624165, 5609 40.205465640027706061433, 5610 1.0000000000000000000000); 5611 my $sumn = $C6p[0]-$x*($C6p[1]-$x*($C6p[2]-$x*($C6p[3]-$x*($C6p[4]-$x*($C6p[5]-$x*$C6p[6]))))); 5612 my $sumd = $C6q[0]-$x*($C6q[1]-$x*($C6q[2]-$x*($C6q[3]-$x*($C6q[4]-$x*($C6q[5]-$x*$C6q[6]))))); 5613 $val = log(-$x) - ($sumn / $sumd); 5614 } elsif ($x < -log($tol)) { 5615 # Convergent series 5616 my $fact_n = 1; 5617 $y = _Euler(18)-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; 5618 $y = log($x)-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; 5619 for my $n (1 .. 200) { 5620 $fact_n *= $x/$n; 5621 my $term = $fact_n / $n; 5622 $y = $term-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; 5623 last if $term < $tol; 5624 } 5625 $val = $sum; 5626 } else { 5627 # Asymptotic divergent series 5628 my $invx = 1.0 / $x; 5629 my $term = $invx; 5630 $sum = 1.0 + $term; 5631 for my $n (2 .. 200) { 5632 my $last_term = $term; 5633 $term *= $n * $invx; 5634 last if $term < $tol; 5635 if ($term < $last_term) { 5636 $y = $term-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; 5637 } else { 5638 $y = (-$last_term/3)-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; 5639 last; 5640 } 5641 } 5642 $val = exp($x) * $invx * $sum; 5643 } 5644 $val; 5645} 5646 5647sub LogarithmicIntegral { 5648 my($x,$opt) = @_; 5649 return 0 if $x == 0; 5650 return - MPU_INFINITY if $x == 1; 5651 return MPU_INFINITY if $x == MPU_INFINITY; 5652 croak "Invalid input to LogarithmicIntegral: x must be > 0" if $x <= 0; 5653 $opt = 0 unless defined $opt; 5654 5655 if ($Math::Prime::Util::_GMPfunc{"li"}) { 5656 $x = Math::BigFloat->new("$x") if defined $bignum::VERSION && ref($x) ne 'Math::BigFloat'; 5657 return 0.0 + Math::Prime::Util::GMP::li($x,40) if !ref($x); 5658 my $str = Math::Prime::Util::GMP::li($x, _find_big_acc($x)); 5659 return $x->copy->bzero->badd($str); 5660 } 5661 5662 if ($x == 2) { 5663 my $li2const = (ref($x) eq 'Math::BigFloat') ? Math::BigFloat->new(_Li2(_find_big_acc($x))) : 0.0+_Li2(30); 5664 return $li2const; 5665 } 5666 5667 if (defined $bignum::VERSION) { 5668 # If bignum is on, always use Math::BigFloat. 5669 $x = Math::BigFloat->new("$x") if ref($x) ne 'Math::BigFloat'; 5670 } elsif (ref($x)) { 5671 # bignum is off, use native if small, BigFloat otherwise. 5672 if ($x <= 1e16) { 5673 $x = _bigint_to_int($x); 5674 } else { 5675 $x = _upgrade_to_float($x) if ref($x) ne 'Math::BigFloat'; 5676 } 5677 } 5678 # Make sure we preserve whatever accuracy setting the input was using. 5679 $x->accuracy($_[0]->accuracy) if ref($x) && ref($_[0]) =~ /^Math::Big/ && $_[0]->accuracy; 5680 5681 # Do divergent series here for big inputs. Common for big pc approximations. 5682 # Why is this here? 5683 # 1) exp(log(x)) results in a lot of lost precision 5684 # 2) exp(x) with lots of precision turns out to be really slow, and in 5685 # this case it was unnecessary. 5686 my $tol = 1e-16; 5687 my $xdigits = 0; 5688 my $finalacc = 0; 5689 if (ref($x) =~ /^Math::Big/) { 5690 $xdigits = _find_big_acc($x); 5691 my $xlen = length($x->copy->bfloor->bstr()); 5692 $xdigits = $xlen if $xdigits < $xlen; 5693 $finalacc = $xdigits; 5694 $xdigits += length(int(log(0.0+"$x"))) + 1; 5695 $tol = Math::BigFloat->new(10)->bpow(-$xdigits); 5696 $x->accuracy($xdigits); 5697 } 5698 my $logx = $xdigits ? $x->copy->blog(undef,$xdigits) : log($x); 5699 5700 # TODO: See if we can tune this 5701 if (0 && $x >= 1) { 5702 _upgrade_to_float(); 5703 my $sum = Math::BigFloat->new(0); 5704 my $inner_sum = Math::BigFloat->new(0); 5705 my $p = Math::BigFloat->new(-1); 5706 my $factorial = 1; 5707 my $power2 = 1; 5708 my $q; 5709 my $k = 0; 5710 my $neglogx = -$logx; 5711 for my $n (1 .. 1000) { 5712 $factorial = vecprod($factorial, $n); 5713 $q = vecprod($factorial, $power2); 5714 $power2 = vecprod(2, $power2); 5715 while ($k <= ($n-1)>>1) { 5716 $inner_sum += Math::BigFloat->new(1) / (2*$k+1); 5717 $k++; 5718 } 5719 $p *= $neglogx; 5720 my $term = ($p / $q) * $inner_sum; 5721 $sum += $term; 5722 last if abs($term) < $tol; 5723 } 5724 $sum *= sqrt($x); 5725 return 0.0+_Euler(18) + log($logx) + $sum unless ref($x)=~/^Math::Big/; 5726 my $val = Math::BigFloat->new(_Euler(40))->badd("".log($logx))->badd("$sum"); 5727 $val->accuracy($finalacc) if $xdigits; 5728 return $val; 5729 } 5730 5731 if ($x > 1e16) { 5732 my $invx = ref($logx) ? Math::BigFloat->bone / $logx : 1.0/$logx; 5733 # n = 0 => 0!/(logx)^0 = 1/1 = 1 5734 # n = 1 => 1!/(logx)^1 = 1/logx 5735 my $term = $invx; 5736 my $sum = 1.0 + $term; 5737 for my $n (2 .. 1000) { 5738 my $last_term = $term; 5739 $term *= $n * $invx; 5740 last if $term < $tol; 5741 if ($term < $last_term) { 5742 $sum += $term; 5743 } else { 5744 $sum -= ($last_term/3); 5745 last; 5746 } 5747 $term->bround($xdigits) if $xdigits; 5748 } 5749 $invx *= $sum; 5750 $invx *= $x; 5751 $invx->accuracy($finalacc) if ref($invx) && $xdigits; 5752 return $invx; 5753 } 5754 # Convergent series. 5755 if ($x >= 1) { 5756 my $fact_n = 1.0; 5757 my $nfac = 1.0; 5758 my $sum = 0.0; 5759 for my $n (1 .. 200) { 5760 $fact_n *= $logx/$n; 5761 my $term = $fact_n / $n; 5762 $sum += $term; 5763 last if $term < $tol; 5764 $term->bround($xdigits) if $xdigits; 5765 } 5766 5767 return 0.0+_Euler(18) + log($logx) + $sum unless ref($x) =~ /^Math::Big/; 5768 5769 my $val = Math::BigFloat->new(_Euler(40))->badd("".log($logx))->badd("$sum"); 5770 $val->accuracy($finalacc) if $xdigits; 5771 return $val; 5772 } 5773 5774 ExponentialIntegral($logx); 5775} 5776 5777# Riemann Zeta function for native integers. 5778my @_Riemann_Zeta_Table = ( 5779 0.6449340668482264364724151666460251892, # zeta(2) - 1 5780 0.2020569031595942853997381615114499908, 5781 0.0823232337111381915160036965411679028, 5782 0.0369277551433699263313654864570341681, 5783 0.0173430619844491397145179297909205279, 5784 0.0083492773819228268397975498497967596, 5785 0.0040773561979443393786852385086524653, 5786 0.0020083928260822144178527692324120605, 5787 0.0009945751278180853371459589003190170, 5788 0.0004941886041194645587022825264699365, 5789 0.0002460865533080482986379980477396710, 5790 0.0001227133475784891467518365263573957, 5791 0.0000612481350587048292585451051353337, 5792 0.0000305882363070204935517285106450626, 5793 0.0000152822594086518717325714876367220, 5794 0.0000076371976378997622736002935630292, 5795 0.0000038172932649998398564616446219397, 5796 0.0000019082127165539389256569577951013, 5797 0.0000009539620338727961131520386834493, 5798 0.0000004769329867878064631167196043730, 5799 0.0000002384505027277329900036481867530, 5800 0.0000001192199259653110730677887188823, 5801 0.0000000596081890512594796124402079358, 5802 0.0000000298035035146522801860637050694, 5803 0.0000000149015548283650412346585066307, 5804 0.0000000074507117898354294919810041706, 5805 0.0000000037253340247884570548192040184, 5806 0.0000000018626597235130490064039099454, 5807 0.0000000009313274324196681828717647350, 5808 0.0000000004656629065033784072989233251, 5809 0.0000000002328311833676505492001455976, 5810 0.0000000001164155017270051977592973835, 5811 0.0000000000582077208790270088924368599, 5812 0.0000000000291038504449709968692942523, 5813 0.0000000000145519218910419842359296322, 5814 0.0000000000072759598350574810145208690, 5815 0.0000000000036379795473786511902372363, 5816 0.0000000000018189896503070659475848321, 5817 0.0000000000009094947840263889282533118, 5818); 5819 5820 5821sub RiemannZeta { 5822 my($x) = @_; 5823 5824 my $ix = ($x == int($x)) ? "" . Math::BigInt->new($x) : 0; 5825 5826 # Try our GMP code if possible. 5827 if ($Math::Prime::Util::_GMPfunc{"zeta"}) { 5828 my($wantbf,$xdigits) = _bfdigits($x); 5829 # If we knew the *exact* number of zero digits, we could let GMP zeta 5830 # handle the correct rounding. But we don't, so we have to go over. 5831 my $zero_dig = "".int($x / 3) - 1; 5832 my $strval = Math::Prime::Util::GMP::zeta($x, $xdigits + 8 + $zero_dig); 5833 if ($strval =~ s/^(1\.0*)/./) { 5834 $strval .= "e-".(length($1)-2) if length($1) > 2; 5835 } else { 5836 $strval =~ s/^(\d+)/$1-1/e; 5837 } 5838 5839 return ($wantbf) ? Math::BigFloat->new($strval,$wantbf) : 0.0 + $strval; 5840 } 5841 5842 # If we need a bigfloat result, then call our PP routine. 5843 if (defined $bignum::VERSION || ref($x) =~ /^Math::Big/) { 5844 require Math::Prime::Util::ZetaBigFloat; 5845 return Math::Prime::Util::ZetaBigFloat::RiemannZeta($x); 5846 } 5847 5848 # Native float results 5849 return 0.0 + $_Riemann_Zeta_Table[int($x)-2] 5850 if $x == int($x) && defined $_Riemann_Zeta_Table[int($x)-2]; 5851 my $tol = 1.11e-16; 5852 5853 # Series based on (2n)! / B_2n. 5854 # This is a simplification of the Cephes zeta function. 5855 my @A = ( 5856 12.0, 5857 -720.0, 5858 30240.0, 5859 -1209600.0, 5860 47900160.0, 5861 -1892437580.3183791606367583212735166426, 5862 74724249600.0, 5863 -2950130727918.1642244954382084600497650, 5864 116467828143500.67248729113000661089202, 5865 -4597978722407472.6105457273596737891657, 5866 181521054019435467.73425331153534235290, 5867 -7166165256175667011.3346447367083352776, 5868 282908877253042996618.18640556532523927, 5869 ); 5870 my $s = 0.0; 5871 my $rb = 0.0; 5872 foreach my $i (2 .. 10) { 5873 $rb = $i ** -$x; 5874 $s += $rb; 5875 return $s if abs($rb/$s) < $tol; 5876 } 5877 my $w = 10.0; 5878 $s = $s + $rb*$w/($x-1.0) - 0.5*$rb; 5879 my $ra = 1.0; 5880 foreach my $i (0 .. 12) { 5881 my $k = 2*$i; 5882 $ra *= $x + $k; 5883 $rb /= $w; 5884 my $t = $ra*$rb/$A[$i]; 5885 $s += $t; 5886 $t = abs($t/$s); 5887 last if $t < $tol; 5888 $ra *= $x + $k + 1.0; 5889 $rb /= $w; 5890 } 5891 return $s; 5892} 5893 5894# Riemann R function 5895sub RiemannR { 5896 my($x) = @_; 5897 5898 croak "Invalid input to ReimannR: x must be > 0" if $x <= 0; 5899 5900 # With MPU::GMP v0.49 this is fast. 5901 if ($Math::Prime::Util::_GMPfunc{"riemannr"}) { 5902 my($wantbf,$xdigits) = _bfdigits($x); 5903 my $strval = Math::Prime::Util::GMP::riemannr($x, $xdigits); 5904 return ($wantbf) ? Math::BigFloat->new($strval,$wantbf) : 0.0 + $strval; 5905 } 5906 5907 5908# TODO: look into this as a generic solution 5909if (0 && $Math::Prime::Util::_GMPfunc{"zeta"}) { 5910 my($wantbf,$xdigits) = _bfdigits($x); 5911 $x = _upgrade_to_float($x); 5912 5913 my $extra_acc = 4; 5914 $xdigits += $extra_acc; 5915 $x->accuracy($xdigits); 5916 5917 my $logx = log($x); 5918 my $part_term = $x->copy->bone; 5919 my $sum = $x->copy->bone; 5920 my $tol = $x->copy->bone->brsft($xdigits-1, 10); 5921 my $bigk = $x->copy->bone; 5922 my $term; 5923 for my $k (1 .. 10000) { 5924 $part_term *= $logx / $bigk; 5925 my $zarg = $bigk->copy->binc; 5926 my $zeta = (RiemannZeta($zarg) * $bigk) + $bigk; 5927 #my $strval = Math::Prime::Util::GMP::zeta($k+1, $xdigits + int(($k+1) / 3)); 5928 #my $zeta = Math::BigFloat->new($strval)->bdec->bmul($bigk)->badd($bigk); 5929 $term = $part_term / $zeta; 5930 $sum += $term; 5931 last if $term < ($tol * $sum); 5932 $bigk->binc; 5933 } 5934 $sum->bround($xdigits-$extra_acc); 5935 my $strval = "$sum"; 5936 return ($wantbf) ? Math::BigFloat->new($strval,$wantbf) : 0.0 + $strval; 5937} 5938 5939 if (defined $bignum::VERSION || ref($x) =~ /^Math::Big/) { 5940 require Math::Prime::Util::ZetaBigFloat; 5941 return Math::Prime::Util::ZetaBigFloat::RiemannR($x); 5942 } 5943 5944 my $sum = 0.0; 5945 my $tol = 1e-18; 5946 my($c, $y, $t) = (0.0); 5947 if ($x > 10**17) { 5948 my @mob = Math::Prime::Util::moebius(0,300); 5949 for my $k (1 .. 300) { 5950 next if $mob[$k] == 0; 5951 my $term = $mob[$k] / $k * 5952 Math::Prime::Util::LogarithmicIntegral($x**(1.0/$k)); 5953 $y = $term-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; 5954 last if abs($term) < ($tol * abs($sum)); 5955 } 5956 } else { 5957 $y = 1.0-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; 5958 my $flogx = log($x); 5959 my $part_term = 1.0; 5960 for my $k (1 .. 10000) { 5961 my $zeta = ($k <= $#_Riemann_Zeta_Table) 5962 ? $_Riemann_Zeta_Table[$k+1-2] # Small k from table 5963 : RiemannZeta($k+1); # Large k from function 5964 $part_term *= $flogx / $k; 5965 my $term = $part_term / ($k + $k * $zeta); 5966 $y = $term-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; 5967 last if $term < ($tol * $sum); 5968 } 5969 } 5970 return $sum; 5971} 5972 5973sub LambertW { 5974 my $x = shift; 5975 croak "Invalid input to LambertW: x must be >= -1/e" if $x < -0.36787944118; 5976 $x = _upgrade_to_float($x) if ref($x) eq 'Math::BigInt'; 5977 my $xacc = ref($x) ? _find_big_acc($x) : 0; 5978 my $w; 5979 5980 if ($Math::Prime::Util::_GMPfunc{"lambertw"}) { 5981 my $w = (!$xacc) 5982 ? 0.0 + Math::Prime::Util::GMP::lambertw($x) 5983 : $x->copy->bzero->badd(Math::Prime::Util::GMP::lambertw($x, $xacc)); 5984 return $w; 5985 } 5986 5987 # Approximation 5988 if ($x < -0.06) { 5989 my $ti = $x * 2 * exp($x-$x+1) + 2; 5990 return -1 if $ti <= 0; 5991 my $t = sqrt($ti); 5992 $w = (-1 + 1/6*$t + (257/720)*$t*$t + (13/720)*$t*$t*$t) / (1 + (5/6)*$t + (103/720)*$t*$t); 5993 } elsif ($x < 1.363) { 5994 my $l1 = log($x + 1); 5995 $w = $l1 * (1 - log(1+$l1) / (2+$l1)); 5996 } elsif ($x < 3.7) { 5997 my $l1 = log($x); 5998 my $l2 = log($l1); 5999 $w = $l1 - $l2 - log(1 - $l2/$l1)/2.0; 6000 } else { 6001 my $l1 = log($x); 6002 my $l2 = log($l1); 6003 my $d1 = 2 * $l1 * $l1; 6004 my $d2 = 3 * $l1 * $d1; 6005 my $d3 = 2 * $l1 * $d2; 6006 my $d4 = 5 * $l1 * $d3; 6007 $w = $l1 - $l2 + $l2/$l1 + $l2*($l2-2)/$d1 6008 + $l2*(6+$l2*(-9+2*$l2))/$d2 6009 + $l2*(-12+$l2*(36+$l2*(-22+3*$l2)))/$d3 6010 + $l2*(60+$l2*(-300+$l2*(350+$l2*(-125+12*$l2))))/$d4; 6011 } 6012 6013 # Now iterate to get the answer 6014 # 6015 # Newton: 6016 # $w = $w*(log($x) - log($w) + 1) / ($w+1); 6017 # Halley: 6018 # my $e = exp($w); 6019 # my $f = $w * $e - $x; 6020 # $w -= $f / ($w*$e+$e - ($w+2)*$f/(2*$w+2)); 6021 6022 # Fritsch converges quadratically, so tolerance could be 4x smaller. Use 2x. 6023 my $tol = ($xacc) ? 10**(-int(1+$xacc/2)) : 1e-16; 6024 $w->accuracy($xacc+10) if $xacc; 6025 for (1 .. 200) { 6026 last if $w == 0; 6027 my $w1 = $w + 1; 6028 my $zn = log($x/$w) - $w; 6029 my $qn = $w1 * 2 * ($w1+(2*$zn/3)); 6030 my $en = ($zn/$w1) * ($qn-$zn)/($qn-$zn*2); 6031 my $wen = $w * $en; 6032 $w += $wen; 6033 last if abs($wen) < $tol; 6034 } 6035 $w->accuracy($xacc) if $xacc; 6036 6037 $w; 6038} 6039 6040my $_Pi = "3.141592653589793238462643383279503"; 6041sub Pi { 6042 my $digits = shift; 6043 return 0.0+$_Pi unless $digits; 6044 return 0.0+sprintf("%.*lf", $digits-1, $_Pi) if $digits < 15; 6045 return _upgrade_to_float($_Pi, $digits) if $digits < 30; 6046 6047 # Performance ranking: 6048 # MPU::GMP Uses AGM or Ramanujan/Chudnosky with binary splitting 6049 # MPFR Uses AGM, from 1x to 1/4x the above 6050 # Perl AGM w/GMP also AGM, nice growth rate, but slower than above 6051 # C pidigits much worse than above, but faster than the others 6052 # Perl AGM without Math::BigInt::GMP, it's sluggish 6053 # Math::BigFloat new versions use AGM, old ones are *very* slow 6054 # 6055 # With a few thousand digits, any of the top 4 are fine. 6056 # At 10k digits, the first two are pulling away. 6057 # At 50k digits, the first three are 5-20x faster than C pidigits, and 6058 # pray you're not having to the Perl BigFloat methods without GMP. 6059 # At 100k digits, the first two are 15x faster than the third, C pidigits 6060 # is 200x slower, and the rest thousands of times slower. 6061 # At 1M digits, the first is under 1 second, MPFR under 2 seconds, 6062 # Perl AGM (Math::BigInt::GMP) is over a minute, and C piigits at 1.5 hours. 6063 # 6064 # Interestingly, Math::BigInt::Pari, while greatly faster than Calc, is 6065 # *much* slower than GMP for these operations (both AGM and Machin). While 6066 # Perl AGM with the Math::BigInt::GMP backend will pull away from C pidigits, 6067 # using it with the other backends doesn't do so. 6068 # 6069 # The GMP program at https://gmplib.org/download/misc/gmp-chudnovsky.c 6070 # will run ~4x faster than MPFR and ~1.5x faster than MPU::GMP. 6071 6072 my $have_bigint_gmp = Math::BigInt->config()->{lib} =~ /GMP/; 6073 my $have_xdigits = Math::Prime::Util::prime_get_config()->{'xs'}; 6074 my $_verbose = Math::Prime::Util::prime_get_config()->{'verbose'}; 6075 6076 if ($Math::Prime::Util::_GMPfunc{"Pi"}) { 6077 print " using MPUGMP for Pi($digits)\n" if $_verbose; 6078 return _upgrade_to_float( Math::Prime::Util::GMP::Pi($digits) ); 6079 } 6080 6081 # We could consider looking for Math::MPFR or Math::Pari 6082 6083 # This has a *much* better growth rate than the later solutions. 6084 if ( !$have_xdigits || ($have_bigint_gmp && $digits > 100) ) { 6085 print " using Perl AGM for Pi($digits)\n" if $_verbose; 6086 # Brent-Salamin (aka AGM or Gauss-Legendre) 6087 $digits += 8; 6088 my $HALF = _upgrade_to_float(0.5); 6089 my ($an, $bn, $tn, $pn) = ($HALF->copy->bone, $HALF->copy->bsqrt($digits), 6090 $HALF->copy->bmul($HALF), $HALF->copy->bone); 6091 while ($pn < $digits) { 6092 my $prev_an = $an->copy; 6093 $an->badd($bn)->bmul($HALF, $digits); 6094 $bn->bmul($prev_an)->bsqrt($digits); 6095 $prev_an->bsub($an); 6096 $tn->bsub($pn * $prev_an * $prev_an); 6097 $pn->badd($pn); 6098 } 6099 $an->badd($bn); 6100 $an->bmul($an,$digits)->bdiv(4*$tn, $digits-8); 6101 return $an; 6102 } 6103 6104 # Spigot method in C. Low overhead but not good growth rate. 6105 if ($have_xdigits) { 6106 print " using XS spigot for Pi($digits)\n" if $_verbose; 6107 return _upgrade_to_float(Math::Prime::Util::_pidigits($digits)); 6108 } 6109 6110 # We're going to have to use the Math::BigFloat code. 6111 # 1) it rounds incorrectly (e.g. 761, 1372, 1509,...). 6112 # Fix by adding some digits and rounding. 6113 # 2) AGM is *much* faster once past ~2000 digits 6114 # 3) It is very slow without the GMP backend. The Pari backend helps 6115 # but it still pretty bad. With Calc it's glacial for large inputs. 6116 6117 # Math::BigFloat AGM spigot AGM 6118 # Size GMP Pari Calc GMP Pari Calc C C+GMP 6119 # 500 0.04 0.60 0.30 0.08 0.10 0.47 0.09 0.06 6120 # 1000 0.04 0.11 1.82 0.09 0.14 1.82 0.09 0.06 6121 # 2000 0.07 0.37 13.5 0.09 0.34 9.16 0.10 0.06 6122 # 4000 0.14 2.17 107.8 0.12 1.14 39.7 0.20 0.06 6123 # 8000 0.52 15.7 0.22 4.63 186.2 0.56 0.08 6124 # 16000 2.73 121.8 0.52 19.2 2.00 0.08 6125 # 32000 15.4 1.42 7.78 0.12 6126 # ^ ^ ^ 6127 # | use this THIRD ---+ | 6128 # use this SECOND ---+ | 6129 # use this FIRST ---+ 6130 # approx 6131 # growth 5.6x 7.6x 8.0x 2.7x 4.1x 4.7x 3.9x 2.0x 6132 6133 print " using BigFloat for Pi($digits)\n" if $_verbose; 6134 _upgrade_to_float(0); 6135 return Math::BigFloat::bpi($digits+10)->round($digits); 6136} 6137 6138sub forpart { 6139 my($sub, $n, $rhash) = @_; 6140 _forcompositions(1, $sub, $n, $rhash); 6141} 6142sub forcomp { 6143 my($sub, $n, $rhash) = @_; 6144 _forcompositions(0, $sub, $n, $rhash); 6145} 6146sub _forcompositions { 6147 my($ispart, $sub, $n, $rhash) = @_; 6148 _validate_positive_integer($n); 6149 my($mina, $maxa, $minn, $maxn, $primeq) = (1,$n,1,$n,-1); 6150 if (defined $rhash) { 6151 croak "forpart second argument must be a hash reference" 6152 unless ref($rhash) eq 'HASH'; 6153 if (defined $rhash->{amin}) { 6154 $mina = $rhash->{amin}; 6155 _validate_positive_integer($mina); 6156 } 6157 if (defined $rhash->{amax}) { 6158 $maxa = $rhash->{amax}; 6159 _validate_positive_integer($maxa); 6160 } 6161 $minn = $maxn = $rhash->{n} if defined $rhash->{n}; 6162 $minn = $rhash->{nmin} if defined $rhash->{nmin}; 6163 $maxn = $rhash->{nmax} if defined $rhash->{nmax}; 6164 _validate_positive_integer($minn); 6165 _validate_positive_integer($maxn); 6166 if (defined $rhash->{prime}) { 6167 $primeq = $rhash->{prime}; 6168 _validate_positive_integer($primeq); 6169 } 6170 $mina = 1 if $mina < 1; 6171 $maxa = $n if $maxa > $n; 6172 $minn = 1 if $minn < 1; 6173 $maxn = $n if $maxn > $n; 6174 $primeq = 2 if $primeq != -1 && $primeq != 0; 6175 } 6176 6177 $sub->() if $n == 0 && $minn <= 1; 6178 return if $n < $minn || $minn > $maxn || $mina > $maxa || $maxn <= 0 || $maxa <= 0; 6179 6180 my $oldforexit = Math::Prime::Util::_start_for_loop(); 6181 my ($x, $y, $r, $k); 6182 my @a = (0) x ($n); 6183 $k = 1; 6184 $a[0] = $mina - 1; 6185 $a[1] = $n - $mina + 1; 6186 while ($k != 0) { 6187 $x = $a[$k-1]+1; 6188 $y = $a[$k]-1; 6189 $k--; 6190 $r = $ispart ? $x : 1; 6191 while ($r <= $y) { 6192 $a[$k] = $x; 6193 $x = $r; 6194 $y -= $x; 6195 $k++; 6196 } 6197 $a[$k] = $x + $y; 6198 # Restrict size 6199 while ($k+1 > $maxn) { 6200 $a[$k-1] += $a[$k]; 6201 $k--; 6202 } 6203 next if $k+1 < $minn; 6204 # Restrict values 6205 if ($mina > 1 || $maxa < $n) { 6206 last if $a[0] > $maxa; 6207 if ($ispart) { 6208 next if $a[$k] > $maxa; 6209 } else { 6210 next if Math::Prime::Util::vecany(sub{ $_ < $mina || $_ > $maxa }, @a[0..$k]); 6211 } 6212 } 6213 next if $primeq == 0 && Math::Prime::Util::vecany(sub{ is_prime($_) }, @a[0..$k]); 6214 next if $primeq == 2 && Math::Prime::Util::vecany(sub{ !is_prime($_) }, @a[0..$k]); 6215 last if Math::Prime::Util::_get_forexit(); 6216 $sub->(@a[0 .. $k]); 6217 } 6218 Math::Prime::Util::_end_for_loop($oldforexit); 6219} 6220sub forcomb { 6221 my($sub, $n, $k) = @_; 6222 _validate_positive_integer($n); 6223 6224 my($begk, $endk); 6225 if (defined $k) { 6226 _validate_positive_integer($k); 6227 return if $k > $n; 6228 $begk = $endk = $k; 6229 } else { 6230 $begk = 0; 6231 $endk = $n; 6232 } 6233 6234 my $oldforexit = Math::Prime::Util::_start_for_loop(); 6235 for my $k ($begk .. $endk) { 6236 if ($k == 0) { 6237 $sub->(); 6238 } else { 6239 my @c = 0 .. $k-1; 6240 while (1) { 6241 $sub->(@c); 6242 last if Math::Prime::Util::_get_forexit(); 6243 next if $c[-1]++ < $n-1; 6244 my $i = $k-2; 6245 $i-- while $i >= 0 && $c[$i] >= $n-($k-$i); 6246 last if $i < 0; 6247 $c[$i]++; 6248 while (++$i < $k) { $c[$i] = $c[$i-1] + 1; } 6249 } 6250 } 6251 last if Math::Prime::Util::_get_forexit(); 6252 } 6253 Math::Prime::Util::_end_for_loop($oldforexit); 6254} 6255sub _forperm { 6256 my($sub, $n, $all_perm) = @_; 6257 my $k = $n; 6258 my @c = reverse 0 .. $k-1; 6259 my $inc = 0; 6260 my $send = 1; 6261 my $oldforexit = Math::Prime::Util::_start_for_loop(); 6262 while (1) { 6263 if (!$all_perm) { # Derangements via simple filtering. 6264 $send = 1; 6265 for my $p (0 .. $#c) { 6266 if ($c[$p] == $k-$p-1) { 6267 $send = 0; 6268 last; 6269 } 6270 } 6271 } 6272 if ($send) { 6273 $sub->(reverse @c); 6274 last if Math::Prime::Util::_get_forexit(); 6275 } 6276 if (++$inc & 1) { 6277 @c[0,1] = @c[1,0]; 6278 next; 6279 } 6280 my $j = 2; 6281 $j++ while $j < $k && $c[$j] > $c[$j-1]; 6282 last if $j >= $k; 6283 my $m = 0; 6284 $m++ while $c[$j] > $c[$m]; 6285 @c[$j,$m] = @c[$m,$j]; 6286 @c[0..$j-1] = reverse @c[0..$j-1]; 6287 } 6288 Math::Prime::Util::_end_for_loop($oldforexit); 6289} 6290sub forperm { 6291 my($sub, $n, $k) = @_; 6292 _validate_positive_integer($n); 6293 croak "Too many arguments for forperm" if defined $k; 6294 return $sub->() if $n == 0; 6295 return $sub->(0) if $n == 1; 6296 _forperm($sub, $n, 1); 6297} 6298sub forderange { 6299 my($sub, $n, $k) = @_; 6300 _validate_positive_integer($n); 6301 croak "Too many arguments for forderange" if defined $k; 6302 return $sub->() if $n == 0; 6303 return if $n == 1; 6304 _forperm($sub, $n, 0); 6305} 6306 6307sub _multiset_permutations { 6308 my($sub, $prefix, $ar, $sum) = @_; 6309 6310 return if $sum == 0; 6311 6312 # Remove any values with 0 occurances 6313 my @n = grep { $_->[1] > 0 } @$ar; 6314 6315 if ($sum == 1) { # A single value 6316 $sub->(@$prefix, $n[0]->[0]); 6317 } elsif ($sum == 2) { # Optimize the leaf case 6318 my($n0,$n1) = map { $_->[0] } @n; 6319 if (@n == 1) { 6320 $sub->(@$prefix, $n0, $n0); 6321 } else { 6322 $sub->(@$prefix, $n0, $n1); 6323 $sub->(@$prefix, $n1, $n0) unless Math::Prime::Util::_get_forexit(); 6324 } 6325 } elsif (0 && $sum == scalar(@n)) { # All entries have 1 occurance 6326 # TODO: Figure out a way to use this safely. We need to capture any 6327 # lastfor that was seen in the forperm. 6328 my @i = map { $_->[0] } @n; 6329 Math::Prime::Util::forperm(sub { $sub->(@$prefix, @i[@_]) }, 1+$#i); 6330 } else { # Recurse over each leading value 6331 for my $v (@n) { 6332 $v->[1]--; 6333 push @$prefix, $v->[0]; 6334 no warnings 'recursion'; 6335 _multiset_permutations($sub, $prefix, \@n, $sum-1); 6336 pop @$prefix; 6337 $v->[1]++; 6338 last if Math::Prime::Util::_get_forexit(); 6339 } 6340 } 6341} 6342 6343sub numtoperm { 6344 my($n,$k) = @_; 6345 _validate_positive_integer($n); 6346 _validate_integer($k); 6347 return () if $n == 0; 6348 return (0) if $n == 1; 6349 my $f = factorial($n-1); 6350 $k %= vecprod($f,$n) if $k < 0 || int($k/$f) >= $n; 6351 my @S = map { $_ } 0 .. $n-1; 6352 my @V; 6353 while ($n-- > 0) { 6354 my $i = int($k/$f); 6355 push @V, splice(@S,$i,1); 6356 last if $n == 0; 6357 $k -= $i*$f; 6358 $f /= $n; 6359 } 6360 @V; 6361} 6362 6363sub permtonum { 6364 my $A = shift; 6365 croak "permtonum argument must be an array reference" 6366 unless ref($A) eq 'ARRAY'; 6367 my $n = scalar(@$A); 6368 return 0 if $n == 0; 6369 { 6370 my %S; 6371 for my $v (@$A) { 6372 croak "permtonum invalid permutation array" 6373 if !defined $v || $v < 0 || $v >= $n || $S{$v}++; 6374 } 6375 } 6376 my $f = factorial($n-1); 6377 my $rank = 0; 6378 for my $i (0 .. $n-2) { 6379 my $k = 0; 6380 for my $j ($i+1 .. $n-1) { 6381 $k++ if $A->[$j] < $A->[$i]; 6382 } 6383 $rank = Math::Prime::Util::vecsum($rank, Math::Prime::Util::vecprod($k,$f)); 6384 $f /= $n-$i-1; 6385 } 6386 $rank; 6387} 6388 6389sub randperm { 6390 my($n,$k) = @_; 6391 _validate_positive_integer($n); 6392 if (defined $k) { 6393 _validate_positive_integer($k); 6394 } 6395 $k = $n if !defined($k) || $k > $n; 6396 return () if $k == 0; 6397 6398 my @S; 6399 if ("$k"/"$n" <= 0.30) { 6400 my %seen; 6401 my $v; 6402 for my $i (1 .. $k) { 6403 do { $v = Math::Prime::Util::urandomm($n); } while $seen{$v}++; 6404 push @S,$v; 6405 } 6406 } else { 6407 @S = map { $_ } 0..$n-1; 6408 for my $i (0 .. $n-2) { 6409 last if $i >= $k; 6410 my $j = Math::Prime::Util::urandomm($n-$i); 6411 @S[$i,$i+$j] = @S[$i+$j,$i]; 6412 } 6413 $#S = $k-1; 6414 } 6415 return @S; 6416} 6417 6418sub shuffle { 6419 my @S=@_; 6420 # Note: almost all the time is spent in urandomm. 6421 for (my $i = $#S; $i >= 1; $i--) { 6422 my $j = Math::Prime::Util::urandomm($i+1); 6423 @S[$i,$j] = @S[$j,$i]; 6424 } 6425 @S; 6426} 6427 6428############################################################################### 6429# Random numbers 6430############################################################################### 6431 6432# PPFE: irand irand64 drand random_bytes csrand srand _is_csprng_well_seeded 6433sub urandomb { 6434 my($n) = @_; 6435 return 0 if $n <= 0; 6436 return ( Math::Prime::Util::irand() >> (32-$n) ) if $n <= 32; 6437 return ( Math::Prime::Util::irand64() >> (64-$n) ) if MPU_MAXBITS >= 64 && $n <= 64; 6438 my $bytes = Math::Prime::Util::random_bytes(($n+7)>>3); 6439 my $binary = substr(unpack("B*",$bytes),0,$n); 6440 return Math::BigInt->new("0b$binary"); 6441} 6442sub urandomm { 6443 my($n) = @_; 6444 # _validate_positive_integer($n); 6445 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::urandomm($n)) 6446 if $Math::Prime::Util::_GMPfunc{"urandomm"}; 6447 return 0 if $n <= 1; 6448 my $r; 6449 if ($n <= 4294967295) { 6450 my $rmax = int(4294967295 / $n) * $n; 6451 do { $r = Math::Prime::Util::irand() } while $r >= $rmax; 6452 } elsif (!ref($n)) { 6453 my $rmax = int(~0 / $n) * $n; 6454 do { $r = Math::Prime::Util::irand64() } while $r >= $rmax; 6455 } else { 6456 # TODO: verify and try to optimize this 6457 my $bits = length($n->as_bin) - 2; 6458 my $bytes = 1 + (($bits+7)>>3); 6459 my $rmax = Math::BigInt->bone->blsft($bytes*8)->bdec; 6460 my $overflow = $rmax - ($rmax % $n); 6461 do { $r = Math::Prime::Util::urandomb($bytes*8); } while $r >= $overflow; 6462 } 6463 return $r % $n; 6464} 6465 6466sub random_prime { 6467 my($low, $high) = @_; 6468 if (scalar(@_) == 1) { ($low,$high) = (2,$low); } 6469 else { _validate_positive_integer($low); } 6470 _validate_positive_integer($high); 6471 6472 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_prime($low, $high)) 6473 if $Math::Prime::Util::_GMPfunc{"random_prime"}; 6474 6475 require Math::Prime::Util::RandomPrimes; 6476 return Math::Prime::Util::RandomPrimes::random_prime($low,$high); 6477} 6478 6479sub random_ndigit_prime { 6480 my($digits) = @_; 6481 _validate_positive_integer($digits, 1); 6482 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_ndigit_prime($digits)) 6483 if $Math::Prime::Util::_GMPfunc{"random_ndigit_prime"}; 6484 require Math::Prime::Util::RandomPrimes; 6485 return Math::Prime::Util::RandomPrimes::random_ndigit_prime($digits); 6486} 6487sub random_nbit_prime { 6488 my($bits) = @_; 6489 _validate_positive_integer($bits, 2); 6490 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_nbit_prime($bits)) 6491 if $Math::Prime::Util::_GMPfunc{"random_nbit_prime"}; 6492 require Math::Prime::Util::RandomPrimes; 6493 return Math::Prime::Util::RandomPrimes::random_nbit_prime($bits); 6494} 6495sub random_strong_prime { 6496 my($bits) = @_; 6497 _validate_positive_integer($bits, 128); 6498 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_strong_prime($bits)) 6499 if $Math::Prime::Util::_GMPfunc{"random_strong_prime"}; 6500 require Math::Prime::Util::RandomPrimes; 6501 return Math::Prime::Util::RandomPrimes::random_strong_prime($bits); 6502} 6503 6504sub random_maurer_prime { 6505 my($bits) = @_; 6506 _validate_positive_integer($bits, 2); 6507 6508 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_maurer_prime($bits)) 6509 if $Math::Prime::Util::_GMPfunc{"random_maurer_prime"}; 6510 6511 require Math::Prime::Util::RandomPrimes; 6512 my ($n, $cert) = Math::Prime::Util::RandomPrimes::random_maurer_prime_with_cert($bits); 6513 croak "maurer prime $n failed certificate verification!" 6514 unless Math::Prime::Util::verify_prime($cert); 6515 6516 return $n; 6517} 6518 6519sub random_shawe_taylor_prime { 6520 my($bits) = @_; 6521 _validate_positive_integer($bits, 2); 6522 6523 return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_shawe_taylor_prime($bits)) 6524 if $Math::Prime::Util::_GMPfunc{"random_shawe_taylor_prime"}; 6525 6526 require Math::Prime::Util::RandomPrimes; 6527 my ($n, $cert) = Math::Prime::Util::RandomPrimes::random_shawe_taylor_prime_with_cert($bits); 6528 croak "shawe-taylor prime $n failed certificate verification!" 6529 unless Math::Prime::Util::verify_prime($cert); 6530 6531 return $n; 6532} 6533 6534sub miller_rabin_random { 6535 my($n, $k, $seed) = @_; 6536 _validate_positive_integer($n); 6537 if (scalar(@_) == 1 ) { $k = 1; } else { _validate_positive_integer($k); } 6538 6539 return 1 if $k <= 0; 6540 6541 if ($Math::Prime::Util::_GMPfunc{"miller_rabin_random"}) { 6542 return Math::Prime::Util::GMP::miller_rabin_random($n, $k, $seed) if defined $seed; 6543 return Math::Prime::Util::GMP::miller_rabin_random($n, $k); 6544 } 6545 6546 # Math::Prime::Util::prime_get_config()->{'assume_rh'}) ==> 2*log(n)^2 6547 if ($k >= int(3*$n/4) ) { 6548 for (2 .. int(3*$n/4)+2) { 6549 return 0 unless Math::Prime::Util::is_strong_pseudoprime($n, $_); 6550 } 6551 return 1; 6552 } 6553 my $brange = $n-2; 6554 return 0 unless Math::Prime::Util::is_strong_pseudoprime($n, Math::Prime::Util::urandomm($brange)+2 ); 6555 $k--; 6556 while ($k > 0) { 6557 my $nbases = ($k >= 20) ? 20 : $k; 6558 return 0 unless is_strong_pseudoprime($n, map { urandomm($brange)+2 } 1 .. $nbases); 6559 $k -= $nbases; 6560 } 6561 1; 6562} 6563 6564sub random_semiprime { 6565 my($b) = @_; 6566 return 0 if defined $b && int($b) < 0; 6567 _validate_positive_integer($b,4); 6568 6569 my $n; 6570 my $min = ($b <= MPU_MAXBITS) ? (1 << ($b-1)) : BTWO->copy->bpow($b-1); 6571 my $max = $min + ($min - 1); 6572 my $L = $b >> 1; 6573 my $N = $b - $L; 6574 my $one = ($b <= MPU_MAXBITS) ? 1 : BONE; 6575 do { 6576 $n = $one * random_nbit_prime($L) * random_nbit_prime($N); 6577 } while $n < $min || $n > $max; 6578 $n = _bigint_to_int($n) if ref($n) && $n->bacmp(BMAX) <= 0; 6579 $n; 6580} 6581 6582sub random_unrestricted_semiprime { 6583 my($b) = @_; 6584 return 0 if defined $b && int($b) < 0; 6585 _validate_positive_integer($b,3); 6586 6587 my $n; 6588 my $min = ($b <= MPU_MAXBITS) ? (1 << ($b-1)) : BTWO->copy->bpow($b-1); 6589 my $max = $min + ($min - 1); 6590 6591 if ($b <= 64) { 6592 do { 6593 $n = $min + urandomb($b-1); 6594 } while !Math::Prime::Util::is_semiprime($n); 6595 } else { 6596 # Try to get probabilities right for small divisors 6597 my %M = ( 6598 2 => 1.91218397452243, 6599 3 => 1.33954826555021, 6600 5 => 0.854756717114822, 6601 7 => 0.635492301836862, 6602 11 => 0.426616792046787, 6603 13 => 0.368193843118344, 6604 17 => 0.290512701603111, 6605 19 => 0.263359264658156, 6606 23 => 0.222406328935102, 6607 29 => 0.181229250520242, 6608 31 => 0.170874199059434, 6609 37 => 0.146112155735473, 6610 41 => 0.133427839963585, 6611 43 => 0.127929010905662, 6612 47 => 0.118254609086782, 6613 53 => 0.106316418106489, 6614 59 => 0.0966989675438643, 6615 61 => 0.0938833658008547, 6616 67 => 0.0864151823151671, 6617 71 => 0.0820822953188297, 6618 73 => 0.0800964416340746, 6619 79 => 0.0747060914833344, 6620 83 => 0.0714973706654851, 6621 89 => 0.0672115468436284, 6622 97 => 0.0622818892486191, 6623 101 => 0.0600855891549939, 6624 103 => 0.0590613570015407, 6625 107 => 0.0570921135626976, 6626 109 => 0.0561691667641485, 6627 113 => 0.0544330141081874, 6628 127 => 0.0490620204315701, 6629 ); 6630 my ($p,$r); 6631 $r = Math::Prime::Util::drand(); 6632 for my $prime (2..127) { 6633 next unless defined $M{$prime}; 6634 my $PR = $M{$prime} / $b + 0.19556 / $prime; 6635 if ($r <= $PR) { 6636 $p = $prime; 6637 last; 6638 } 6639 $r -= $PR; 6640 } 6641 if (!defined $p) { 6642 # Idea from Charles Greathouse IV, 2010. The distribution is right 6643 # at the high level (small primes weighted more and not far off what 6644 # we get with the uniform selection), but there is a noticeable skew 6645 # toward primes with a large gap after them. For instance 3 ends up 6646 # being weighted as much as 2, and 7 more than 5. 6647 # 6648 # Since we handled small divisors earlier, this is less bothersome. 6649 my $M = 0.26149721284764278375542683860869585905; 6650 my $weight = $M + log($b * log(2)/2); 6651 my $minr = log(log(131)); 6652 do { 6653 $r = Math::Prime::Util::drand($weight) - $M; 6654 } while $r < $minr; 6655 # Using Math::BigFloat::bexp is ungodly slow, so avoid at all costs. 6656 my $re = exp($r); 6657 my $a = ($re < log(~0)) ? int(exp($re)+0.5) 6658 : _upgrade_to_float($re)->bexp->bround->as_int; 6659 $p = $a < 2 ? 2 : Math::Prime::Util::prev_prime($a+1); 6660 } 6661 my $ranmin = ref($min) ? $min->badd($p-1)->bdiv($p)->as_int : int(($min+$p-1)/$p); 6662 my $ranmax = ref($max) ? $max->bdiv($p)->as_int : int($max/$p); 6663 my $q = random_prime($ranmin, $ranmax); 6664 $n = Math::Prime::Util::vecprod($p,$q); 6665 } 6666 $n = _bigint_to_int($n) if ref($n) && $n->bacmp(BMAX) <= 0; 6667 $n; 6668} 6669 6670sub random_factored_integer { 6671 my($n) = @_; 6672 return (0,[]) if defined $n && int($n) < 0; 6673 _validate_positive_integer($n,1); 6674 6675 while (1) { 6676 my @S = ($n); 6677 # make s_i chain 6678 push @S, 1 + Math::Prime::Util::urandomm($S[-1]) while $S[-1] > 1; 6679 # first is n, last is 1 6680 @S = grep { is_prime($_) } @S[1 .. $#S-1]; 6681 my $r = Math::Prime::Util::vecprod(@S); 6682 return ($r, [@S]) if $r <= $n && (1+urandomm($n)) <= $r; 6683 } 6684} 6685 6686 6687 66881; 6689 6690__END__ 6691 6692 6693# ABSTRACT: Pure Perl version of Math::Prime::Util 6694 6695=pod 6696 6697=encoding utf8 6698 6699 6700=head1 NAME 6701 6702Math::Prime::Util::PP - Pure Perl version of Math::Prime::Util 6703 6704 6705=head1 VERSION 6706 6707Version 0.73 6708 6709 6710=head1 SYNOPSIS 6711 6712The functionality is basically identical to L<Math::Prime::Util>, as this 6713module is just the Pure Perl implementation. This documentation will only 6714note differences. 6715 6716 # Normally you would just import the functions you are using. 6717 # Nothing is exported by default. 6718 use Math::Prime::Util ':all'; 6719 6720 6721=head1 DESCRIPTION 6722 6723Pure Perl implementations of prime number utilities that are normally 6724handled with XS or GMP. Having the Perl implementations (1) provides examples, 6725(2) allows the functions to run even if XS isn't available, and (3) gives 6726big number support if L<Math::Prime::Util::GMP> isn't available. This is a 6727subset of L<Math::Prime::Util>'s functionality. 6728 6729All routines should work with native integers or multi-precision numbers. To 6730enable big numbers, use bigint or bignum: 6731 6732 use bigint; 6733 say prime_count_approx(1000000000000000000000000)' 6734 # says 18435599767347543283712 6735 6736This is still experimental, and some functions will be very slow. The 6737L<Math::Prime::Util::GMP> module has much faster versions of many of these 6738functions. Alternately, L<Math::Pari> has a lot of these types of functions. 6739 6740 6741=head1 FUNCTIONS 6742 6743=head2 euler_phi 6744 6745Takes a I<single> integer input and returns the Euler totient. 6746 6747=head2 euler_phi_range 6748 6749Takes two values defining a range C<low> to C<high> and returns an array 6750with the totient of each value in the range, inclusive. 6751 6752=head2 moebius 6753 6754Takes a I<single> integer input and returns the Moebius function. 6755 6756=head2 moebius_range 6757 6758Takes two values defining a range C<low> to C<high> and returns an array 6759with the Moebius function of each value in the range, inclusive. 6760 6761 6762=head1 LIMITATIONS 6763 6764The SQUFOF and Fermat factoring algorithms are not implemented yet. 6765 6766Some of the prime methods use more memory than they should, as the segmented 6767sieve is not properly used in C<primes> and C<prime_count>. 6768 6769 6770=head1 PERFORMANCE 6771 6772Performance compared to the XS/C code is quite poor for many operations. Some 6773operations that are relatively close for small and medium-size values: 6774 6775 next_prime / prev_prime 6776 is_prime / is_prob_prime 6777 is_strong_pseudoprime 6778 ExponentialIntegral / LogarithmicIntegral / RiemannR 6779 primearray 6780 6781Operations that are slower include: 6782 6783 primes 6784 random_prime / random_ndigit_prime 6785 factor / factor_exp / divisors 6786 nth_prime 6787 prime_count 6788 is_aks_prime 6789 6790Performance improvement in this code is still possible. The prime sieve is 6791over 2x faster than anything I was able to find online, but it is still has 6792room for improvement. 6793 6794L<Math::Prime::Util::GMP> offers C<C+XS+GMP> support for most of the important 6795functions, and will be vastly faster for most operations. If you install that 6796module, L<Math::Prime::Util> will load it automatically, meaning you should 6797not have to think about what code is actually being used (C, GMP, or Perl). 6798 6799Memory use will generally be higher for the PP code, and in some cases B<much> 6800higher. Some of this may be addressed in a later release. 6801 6802For small values (e.g. primes and prime counts under 10M) most of this will 6803not matter. 6804 6805 6806=head1 SEE ALSO 6807 6808L<Math::Prime::Util> 6809 6810L<Math::Prime::Util::GMP> 6811 6812 6813=head1 AUTHORS 6814 6815Dana Jacobsen E<lt>dana@acm.orgE<gt> 6816 6817 6818=head1 COPYRIGHT 6819 6820Copyright 2012-2016 by Dana Jacobsen E<lt>dana@acm.orgE<gt> 6821 6822This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. 6823 6824=cut 6825