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