File Coverage

blib/lib/Math/Prime/Util/PP.pm
Criterion Covered Total %
statement 2864 4401 65.0
branch 1570 3170 49.5
condition 497 1200 41.4
subroutine 180 254 70.8
pod 4 154 2.6
total 5115 9179 55.7


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