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__ |