File Coverage

blib/lib/Math/Prime/Util/PP.pm
Criterion Covered Total %
statement 2954 4464 66.1
branch 1637 3222 50.8
condition 523 1227 42.6
subroutine 185 256 72.2
pod 4 155 2.5
total 5303 9324 56.8


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