Math-Prime-Util-0.37/0000755000076400007640000000000012271163661012726 5ustar danadanaMath-Prime-Util-0.37/META.json0000664000076400007640000000347412271163661014361 0ustar danadana{ "abstract" : "Utilities related to prime numbers, including fast sieves and factoring", "author" : [ "Dana A Jacobsen " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.86, CPAN::Meta::Converter version 2.133380", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Math-Prime-Util", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "recommends" : { "Math::BigInt::GMP" : "0", "Math::MPFR" : "2.03", "Math::Prime::Util::GMP" : "0.16" }, "requires" : { "Bytes::Random::Secure" : "0.23", "Carp" : "0", "Config" : "0", "Exporter" : "5.562", "Math::BigFloat" : "1.59", "Math::BigInt" : "1.88", "Tie::Array" : "0", "XSLoader" : "0.01", "base" : "0", "constant" : "0", "perl" : "5.006002" } }, "test" : { "requires" : { "Test::More" : "0.45", "bignum" : "0.22" }, "suggests" : { "Test::Warn" : "0" } } }, "release_status" : "stable", "resources" : { "homepage" : "https://github.com/danaj/Math-Prime-Util", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "https://github.com/danaj/Math-Prime-Util" } }, "version" : "0.37" } Math-Prime-Util-0.37/.travis.yml0000644000076400007640000000153312266152412015035 0ustar danadanalanguage: "perl" perl: - "5.16" - "5.10" # There is little reason to have travis run multiple Perls. # - "5.14" # - "5.12" before_install: - sudo apt-get install libgmp3-dev - sudo apt-get install libmpfr-dev - cpanm Test::Pod # optional dependency - cpanm Math::Prime::Util::GMP - cpanm Math::MPFR env: - - MPU_NO_GMP=1 - MPU_NO_MPFR=1 - MPU_NO_GMP=1 MPU_NO_MPFR=1 - MPU_NO_XS=1 MPU_NO_GMP=1 MPU_NO_MPFR=1 install: #- cpanm -v --installdeps --notest --mirror http://cpan.mirrors.travis-ci.org --mirror http://dl.ambiweb.de/mirrors/ftp.cpan.org --mirror http://cpan.cse.msu.edu . - cpanm -v --installdeps --notest . script: "perl Makefile.PL; make test" # branches: # only: # - master notifications: recipients: - dana@acm.org email: on_success: change on_failure: always #env: Math-Prime-Util-0.37/TODO0000644000076400007640000000533212270624726013424 0ustar danadana- Testing requirements after changes: * Test all functions return either native or bigints. Functions that return raw MPU::GMP results will return strings, which isn't right. * Valgrind, coverage * use: -O2 -g -Wall -Wextra -Wdeclaration-after-statement -fsigned-char * Test on 32-bit Perl. Test on Win32. - Figure out documentation solution for PP.pm - Is the current PP.pm setup the way we want to do it? - Move .c / .h files into separate directory. version does it in a painful way. Something simpler to be had? - finish test suite for bignum. Work on making it faster. - An assembler version of mulmod for i386. - More efficient Mertens. The current version has poor growth. For 32-bit, consider doing XS followed by sum for remainder. - It may be possible to have a more efficient ranged totient. We're using the sieve up to n/2, which is better than most people seem to use, but I'm not completely convinced we can't do better. - Big features: - QS factoring - Figure out a way to make the internal FOR_EACH_PRIME macros use a segmented sieve. - Rewrite 23-primality-proofs.t for new format (keep some of the old tests?). - Use Montgomery routines in more places: Factoring. - Factoring in PP code is really wasteful -- we're calling _isprime7 before we've done enough trial division, and later we're calling it on known composites. Note how the XS code splits the factor code into the public API (small factors, isprime, then call main code) and main code (just the algorithm). The PP code isn't doing that, which means we're doing lots of extra primality checks, which aren't cheap in PP. - Consider using Test::Number::Delta for many tests - More tweaking of LMO prime count. - OpenMP. The step 7 inner loop is available. - Convert to 32-bit+GMP to support large inputs, add to MPU::GMP. - Try __int128. - Variable sieve size - look at sieve.c style prime walking - Iterators speedup: 1) config option for sieved next_prime. Very general, would make next_prime run fast when called many times sequentially. Nasty mixing with threads. 2) iterator, PrimeIterator, or PrimeArray in XS using segment sieve. - Perhaps have main segment know the filled in range. That would allow a sieved next_prime, and might speed up some counts and the like. - Consider exporting is_bpsw_prime and inverse Li - Benchmark simple SoEs, SoA. Include Sisyphus SoE hidden in Math::GMPz. - commit Porter example - Try using malloc/free for win32 cache memory. #define NO_XSLOCKS - Investigate optree constant folding in PP compilation for performance. Use B::Deparse to check. - Ensure a fast path for Math::GMP from MPU -> MPU:GMP -> GMP, and back. - znlog better implementation Math-Prime-Util-0.37/bin/0000755000076400007640000000000012271163661013476 5ustar danadanaMath-Prime-Util-0.37/bin/primes.pl0000755000076400007640000005125112270242116015331 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Getopt::Long; use Math::BigInt try => 'GMP'; use Math::Prime::Util qw/primes prime_count next_prime prev_prime is_prime is_provable_prime nth_prime prime_count primorial pn_primorial/; $| = 1; # For many more types, see: # http://en.wikipedia.org/wiki/List_of_prime_numbers # http://mathworld.wolfram.com/IntegerSequencePrimes.html # This program shouldn't contain any special knowledge about the series # members other than perhaps the start. It can know patterns, but don't # include a static list of the members, for instance. It should actually # compute the entries in a range (though go ahead and be clever about it). # Example: # DO use knowledge that F_k is prime only if k <= 4 or k is prime. # DO use knowledge that safe primes are <= 7 or congruent to 11 mod 12. # DO NOT use knowledge that fibprime(14) = 19134702400093278081449423917 # The various primorial primes are confusing. Some things to consider: # 1) there are two definitions of primorial: p# and p_n# # 2) three sequences: # p where 1+p# is prime # n where 1+p_n# is prime # p_n#+1 where 1+p_n# is prime # 3) intersections of sequences (e.g. p_n#+1 and p_n#-1) # 4) other sequences like A057705: p where p+1 is an A002110 primorial # plus all the crazy primorial sequences (unlikely to be confused) # # A005234 p where p#+1 prime # A136351 p# where p#+1 prime 2,6,30,210,2310,200560490130 # A014545 n where p_n#+1 prime 1,2,3,4,5,11,75,171,172 # A018239 p_n#+1 where p_n#+1 prime # # A006794 p where p#-1 prime 3,5,11,13,41,89,317,337 # A057704 n where p_n#-1 prime 2,3,5,6,13,24,66,68,167 # # As an aside, the 18th p#-1 is 15877, but the 19th is 843301. # The p#+1's are a bit denser, with the 22nd at 392113. # There are a few of these prime filters that Math::NumSeq supports, and in # theory it will add them eventually since they are OEIS sequences. Many are # of the form "primes from ####" so aren't hard to work up. Math::NumSeq is # a really neat module for playing with OEIS sequences. # # Example: All Sophie Germain primes under 1M # primes.pl --sophie 1 1000000 # perl -MMath::NumSeq::SophieGermainPrimes=:all -E 'my $seq = Math::NumSeq::SophieGermainPrimes->new; my $v = 0; while (1) { $v = ($seq->next)[1]; last if $v > $end; say $v; } BEGIN {our $end = 1000000}' # # Timing from 1 .. N for small N is going to be similar. As N increases, the # time difference grows rapidly. # # primes.pl Math::NumSeq::SophieGermainPrimes # 1M 0.11s 0.18s # 10M 0.38 3.89s # 100M 2.98s 793s # 1000M 27.7s ? estimated >3 days # # If given a non-zero start value it spreads even more, as for most sequences # primes.pl doesn't have to generate preceeding values, while NumSeq has to # start at the beginning. Additionally, Math::NumSeq may or may not deal with # numbers larger than 2^32 (many sequences do, but it uses Math::Factor::XS # for factoring and primality, which is limited to 32-bit). # # Here's an example of a combination. Palindromic primes: # primes.pl --palin 1 1000000000 # perl -MMath::Prime::Util=is_prime -MMath::NumSeq::Palindromes=:all -E 'my $seq = Math::NumSeq::Palindromes->new; my $v = 0; while (1) { $v = ($seq->next)[1]; last if $v > $end; say $v if is_prime($v); } BEGIN {our $end = 1000000000}' my %opts; # Make Getopt not capture + Getopt::Long::Configure(qw/no_getopt_compat/); GetOptions(\%opts, 'safe|A005385', 'sophie|sg|A005384', 'twin|A001359', 'lucas|A005479', 'fibonacci|A005478', 'lucky|A031157', 'triplet|A007529', 'quadruplet|A007530', 'cousin|A023200', 'sexy|A023201', 'mersenne|A000668', 'palindromic|palindrome|palendrome|A002385', 'pillai|A063980', 'good|A028388', 'cuban1|A002407', 'cuban2|A002648', 'pnp1|A005234', 'pnm1|A006794', 'euclid|A018239', 'circular|A068652', 'panaitopol|A027862', 'provable', 'nompugmp', # turn off MPU::GMP for debugging 'version', 'help', ) || die_usage(); Math::Prime::Util::prime_set_config(gmp=>0) if exists $opts{'nompugmp'}; if (exists $opts{'version'}) { my $version_str = "primes.pl version 1.3 using Math::Prime::Util $Math::Prime::Util::VERSION"; $version_str .= " and MPU::GMP $Math::Prime::Util::GMP::VERSION" if Math::Prime::Util::prime_get_config->{'gmp'}; $version_str .= "\nWritten by Dana Jacobsen.\n"; die "$version_str"; } die_usage() if exists $opts{'help'}; # Get the start and end values. Verify they're positive integers. die_usage() unless @ARGV == 2; my ($start, $end) = @ARGV; # Allow some expression evaluation on the input, but don't just eval it. $end = "($start)$end" if $end =~ /^\+/; $start =~ s/\s*$//; $start =~ s/^\s*//; $end =~ s/\s*$//; $end =~ s/^\s*//; $start = eval_expr($start) unless $start =~ /^\d+$/; $end = eval_expr($end ) unless $end =~ /^\d+$/; die "$start isn't a positive integer" if $start =~ tr/0123456789//c; die "$end isn't a positive integer" if $end =~ tr/0123456789//c; # Turn start and end into bigints if they're very large. # Fun fact: Math::BigInt->new("1") <= 10000000000000000000 is false. Sigh. if ( ($start >= 2**63) || ($end >= 2**63) ) { $start = Math::BigInt->new("$start") unless ref($start) eq 'Math::BigInt'; $end = Math::BigInt->new("$end") unless ref($end) eq 'Math::BigInt'; } my $segment_size = $start - $start + 30 * 128_000; # 128kB # Calculate the mod 210 pre-test. This helps with the individual filters, # but the real benefit is that it convolves the pretests, which can speed # up even more. my ($min_pass, %mod_pass) = find_mod210_restriction(); # Find out if they've filtered so much nothing passes (e.g. cousin quad) if (scalar keys %mod_pass == 0) { $end = $min_pass if $end > $min_pass; } if ($start > $end) { # Do nothing } elsif ( exists $opts{'lucas'} || exists $opts{'fibonacci'} || exists $opts{'euclid'} || exists $opts{'lucky'} || exists $opts{'mersenne'} || exists $opts{'cuban1'} || exists $opts{'cuban2'} ) { my $p = gen_and_filter($start, $end); print join("\n", @$p), "\n" if scalar @$p > 0; } else { while ($start <= $end) { # Adjust segment sizes for some cases $segment_size = 10000 if $start > ~0; # small if doing bigints if (exists $opts{'pillai'}) { $segment_size = ($start < 10000) ? 100 : 1000; # very small for Pillai } if (exists $opts{'pnp1'} || exists $opts{'pnm1'}) { $segment_size = 500; } if (exists $opts{'palindromic'}) { $segment_size = 10**length($start) - $start - 1; # all n-digit numbers } if (exists $opts{'panaitopol'}) { $segment_size = (~0 == 4294967295) ? 2147483648 : int(10**12); } my $seg_start = $start; my $seg_end = int($start + $segment_size); $seg_end = $end if $end < $seg_end; $start = $seg_end+1; my $p = gen_and_filter($seg_start, $seg_end); # print this segment print join("\n", @$p), "\n" if scalar @$p > 0; } } # Fibonacci numbers { my @fibs; sub fib { my $n = shift; return $n if $n < 2; if (!defined $fibs[$n]) { @fibs = (Math::BigInt->new(0), Math::BigInt->new(1)) if scalar @fibs == 0; my ($nm2, $nm1) = ($fibs[-2],$fibs[-1]); for (scalar @fibs .. $n) { ($nm2, $nm1) = ($nm1, $nm2 + $nm1); push @fibs, $nm1; } } return $fibs[$n]; } } # This is OEIS A000032, Lucas numbers beginning at 2. # Use identity: L_n = F_n-1 + F_n+1. Would be faster if calculated directly. sub lucas_primes { my ($start, $end) = @_; my @lprimes; my $k = 0; my $Lk = 2; while ($Lk < $start) { $k++; $Lk = fib($k+1) + fib($k-1); } while ($Lk <= $end) { push @lprimes, $Lk if is_prime($Lk); $k++; $Lk = fib($k+1) + fib($k-1); } @lprimes; } sub fibonacci_primes { my ($start, $end) = @_; my @fprimes; my $k = 3; my $Fk = fib($k); while ($Fk < $start) { $Fk = fib(++$k); } while ($Fk <= $end) { push @fprimes, $Fk if is_prime($Fk); # For all but k=4, F_k is prime only when k is prime. $k = ($k <= 4) ? $k+1 : next_prime($k); $Fk = fib($k); } @fprimes; } sub mersenne_primes { my ($start, $end) = @_; my @mprimes; my $p = 1; while (1) { $p = next_prime($p); # Mp is not prime if p is not prime next if $p > 3 && ($p % 4) == 3 && is_prime(2*$p+1); my $Mp = Math::BigInt->bone->blsft($p)->bsub(1); last if $Mp > $end; # Lucas-Lehmer test would be faster push @mprimes, $Mp if $Mp >= $start && is_prime($Mp); } @mprimes; } sub euclid_primes { my ($start, $end, $add) = @_; my @eprimes; my $k = 0; while (1) { my $primorial = pn_primorial(Math::BigInt->new($k)) + $add; last if $primorial > $end; push @eprimes, $primorial if $primorial >= $start && is_prime($primorial); $k++; } @eprimes; } sub cuban_primes { my ($start, $end, $add) = @_; my @cprimes; my $psub = ($add == 1) ? sub { 3*$_[0]*$_[0] + 3*$_[0] + 1 } : sub { 3*$_[0]*$_[0] + 6*$_[0] + 4 }; # Determine first y via quadratic equation (under-estimate) my $y = ($start <= 2) ? 0 : ($add == 1) ? int((-3 + sqrt(3*3 - 4*3*(1-$start))) / (2*3)) : int((-6 + sqrt(6*6 - 4*3*(4-$start))) / (2*3)); die "Incorrect start calculation" if $y > 0 && $psub->($y - 1) >= $start; # skip forward until p >= start $y++ while $psub->($y) < $start; my $p = $psub->($y); while ($p <= $end) { push @cprimes, $p if is_prime($p); $p = $psub->(++$y); } @cprimes; } sub panaitopol_primes { my ($start, $end) = @_; my @init; push @init, 5 if $start <= 5 && $end >= 5; push @init, 13 if $start <= 13 && $end >= 13; return @init if $end < 41; my $nbeg = ($start <= 41) ? 4 : int( sqrt( ($start-1)/2) ); my $nend = int( sqrt(($end-1)/2) ); $nbeg++ while (2*$nbeg*($nbeg+1)+1) < $start; $nend-- while (2*$nend*($nend+1)+1) > $end; # TODO: BigInts return @init, grep { is_prime($_) } grep { ($_%5) && ($_%13) && ($_%17) && ($_%29) && ($_%37) } map { 2*$_*($_+1)+1 } $nbeg .. $nend; } sub lucky_primes { my ($start, $end) = @_; # First do a (very basic) lucky number sieve to generate A000959. # Evens removed for k=1: # my @lucky = map { $_*2+1 } (0 .. int(($end-1)/2)); # Remove the 3rd elements for k=2: # my @lucky = grep { my $m = $_ % 6; $m == 1 || $m == 3 } (0 .. $end); # Remove the 4th elements for k=3: # my @lucky = grep { my $m = $_ % 21; $m != 18 && $m != 19 } # grep { my $m = $_ % 6; $m == 1 || $m == 3 } # map { $_*2+1 } (0 .. int(($end-1)/2)); # This is the same k=3 sieve, but uses much less memory: my @lucky; my $n = 1; while ($n <= $end) { my $m21 = $n % 21; push @lucky, $n unless $m21 == 18 || $m21 == 19; push @lucky, $n+2 unless $m21 == 16 || $m21 == 17; $n += 6; } delete $lucky[-1] if $lucky[-1] > $end; for (my $k = 3; $k < scalar @lucky; $k++) { my $skip = $lucky[$k]; my $index = $skip-1; last if $index > $#lucky; do { splice(@lucky, $index, 1); $index += $skip-1; } while ($index <= $#lucky); } # Then restrict to primes to get A031157. shift @lucky while $lucky[0] < $start; grep { is_prime($_) } @lucky; } # This is not a general palindromic digit function! sub ndig_palindromes { my $digits = shift; return (2,3,5,7) if $digits == 1; return (11) if $digits == 2; return () if ($digits % 2) == 0; my $rhdig = int(($digits - 1) / 2); return grep { is_prime($_) } map { $_ . reverse substr($_,0,$rhdig) } map { $_ * int(10**$rhdig) .. ($_+1) * int(10**$rhdig) - 1 } 1, 3, 7, 9; } # See: http://en.wikipedia.org/wiki/Pillai_prime sub is_pillai { my $p = shift; return 0 if $p <= 2; my $half_word = (~0 == 4294967295) ? 65535 : 4294967295; if ($p <= $half_word) { my $nfac = 1; for (my $n = 2; $n < $p; $n++) { $nfac = ($nfac * $n) % $p; return 1 if $nfac == $p-1 && ($p % $n) != 1; } } else { # Must use bigints. Very slow. my $n_factorial_mod_p = Math::BigInt->bone(); for (my $n = Math::BigInt->new(2); $n < $p; $n++) { $n_factorial_mod_p->bmul($n)->bmod($p); return 1 if $n_factorial_mod_p == ($p-1) && ($p % $n) != 1; } } 0; } # Not nearly as slow as Pillai, but not fast. sub is_good_prime { my $p = shift; return 0 if $p <= 2; # 2 isn't a good prime my $lower = $p; my $upper = $p; while ($lower > 2) { $lower = prev_prime($lower); $upper = next_prime($upper); return 0 if ($p*$p) <= ($upper * $lower); } 1; } # Assumes the input is prime. Returns 1 if all digit rotations are prime. sub is_circular_prime { my $p = shift; return 1 if $p < 10; return 0 if $p =~ tr/024568//; # TODO: BigInts foreach my $rot (1 .. length($p)-1) { return 0 unless is_prime( substr($p, $rot) . substr($p, 0, $rot) ); } 1; } sub merge_primes { my ($genref, $pref, $name, @primes) = @_; if (!defined $$genref) { @$pref = @primes; $$genref = $name; } else { my %f; undef @f{ @primes }; @$pref = grep { exists $f{$_} } @$pref; } } # This is used for things that can generate a filtered list faster than # searching through all primes in the range. sub gen_and_filter { my ($start, $end) = @_; my $gen; my $p = []; $end-- if ($end % 2) == 0 && $end > 2; if (exists $opts{'lucas'}) { merge_primes(\$gen, $p, 'lucas', lucas_primes($start, $end)); } if (exists $opts{'fibonacci'}) { merge_primes(\$gen, $p, 'fibonacci', fibonacci_primes($start, $end)); } if (exists $opts{'mersenne'}) { merge_primes(\$gen, $p, 'mersenne', mersenne_primes($start, $end)); } if (exists $opts{'euclid'}) { merge_primes(\$gen, $p, 'euclid', euclid_primes($start, $end, 1)); } if (exists $opts{'lucky'}) { merge_primes(\$gen, $p, 'lucky', lucky_primes($start, $end)); } if (exists $opts{'cuban1'}) { merge_primes(\$gen, $p, 'cuban1', cuban_primes($start, $end, 1)); } if (exists $opts{'cuban2'}) { merge_primes(\$gen, $p, 'cuban2', cuban_primes($start, $end, 2)); } if (exists $opts{'panaitopol'}) { merge_primes(\$gen, $p, 'panaitopol', panaitopol_primes($start, $end)); } if (exists $opts{'palindromic'}) { if (!defined $gen) { foreach my $d (length($start) .. length($end)) { push @$p, grep { $_ >= $start && $_ <= $end } ndig_palindromes($d); } $gen = 'palindromic'; } else { @$p = grep { $_ eq reverse $_; } @$p; } } if (exists $opts{'twin'} && !defined $gen) { $p = primes($start, $end); push @$p, is_prime($p->[-1]+2) ? $p->[-1]+2 : 0; my @twin; my $prime = shift @$p; foreach my $next (@$p) { push @twin, $prime if $prime+2 == $next; $prime = $next; } $p = \@twin; $gen = 'twin'; } if (!defined $gen) { $p = primes($start, $end); $gen = 'primes'; } # Apply the mod 210 pretest if ($min_pass > 0) { @$p = grep { $_ <= $min_pass || exists $mod_pass{$_ % 210} } @$p; } if (exists $opts{'twin'} && $gen ne 'twin') { @$p = grep { is_prime( $_+2 ); } @$p; } if (exists $opts{'triplet'}) { @$p = grep { is_prime($_+6) && (is_prime($_+2) || is_prime($_+4)); } @$p; } if (exists $opts{'quadruplet'}) { @$p = grep { is_prime($_+2) && is_prime($_+6) && is_prime($_+8); } @$p; } if (exists $opts{'cousin'}) { @$p = grep { is_prime($_+4); } @$p; } if (exists $opts{'sexy'}) { @$p = grep { is_prime($_+6); } @$p; } if (exists $opts{'safe'}) { @$p = grep { is_prime( ($_-1) >> 1 ); } grep { ($_ <= 7) || ($_ % 12) == 11; } @$p; } if (exists $opts{'sophie'}) { @$p = grep { is_prime( 2*$_+1 ); } @$p; } #if (exists $opts{'cuban1'}) { # @p = grep { my $n = sqrt((4*$_-1)/3); 4*$_ == int($n)*int($n)*3+1; } @p; #} #if (exists $opts{'cuban2'}) { # @p = grep { my $n = sqrt(($_-1)/3); $_ == int($n)*int($n)*3+1; } @p; #} if (exists $opts{'pnm1'}) { @$p = grep { is_prime( primorial(Math::BigInt->new($_))-1 ) } @$p; } if (exists $opts{'pnp1'}) { @$p = grep { is_prime( primorial(Math::BigInt->new($_))+1 ) } @$p; } if (exists $opts{'circular'}) { @$p = grep { is_circular_prime($_) } @$p; } if (exists $opts{'pillai'}) { @$p = grep { is_pillai($_); } @$p; } if (exists $opts{'good'}) { @$p = grep { is_good_prime($_); } @$p; } if (exists $opts{'provable'}) { @$p = grep { is_provable_prime($_) == 2; } @$p; } $p; } sub find_mod210_restriction { my %mods_left; undef @mods_left{ grep { ($_%2) && ($_%3) && ($_%5) && ($_%7) } (0..209) }; my %mod210_restrict = ( cuban1 => {min=> 7, mod=>[1,19,37,61,79,121,127,169,187]}, cuban2 => {min=> 2, mod=>[1,13,43,109,139,151,169,181,193]}, twin => {min=> 5, mod=>[11,17,29,41,59,71,101,107,137,149,167,179,191,197,209]}, triplet => {min=> 7, mod=>[11,13,17,37,41,67,97,101,103,107,137,163,167,187,191,193]}, quadruplet => {min=> 5, mod=>[11,101,191]}, cousin => {min=> 7, mod=>[13,19,37,43,67,79,97,103,109,127,139,163,169,187,193]}, sexy => {min=> 7, mod=>[11,13,17,23,31,37,41,47,53,61,67,73,83,97,101,103,107,121,131,137,143,151,157,163,167,173,181,187,191,193]}, safe => {min=>11, mod=>[17,23,47,53,59,83,89,107,137,143,149,167,173,179,209]}, sophie => {min=> 5, mod=>[11,23,29,41,53,71,83,89,113,131,149,173,179,191,209]}, panaitopol => {min=> 5, mod=>[1,11,13,41,43,53,61,71,83,103,113,131,151,173,181,193]}, # Nothing for good, pillai, palindromic, fib, lucas, mersenne, primorials ); my $min = 0; while (my($filter,$data) = each %mod210_restrict) { next unless exists $opts{$filter}; $min = $data->{min} if $min < $data->{min}; my %thismod; undef @thismod{ @{$data->{mod}} }; foreach my $m (keys %mods_left) { delete $mods_left{$m} unless exists $thismod{$m}; } } return ($min, %mods_left); } # This is rather braindead. We're going to eval their input so they can give # arbitrary expressions. But we only want to allow math-like strings. sub eval_expr { my $expr = shift; die "$expr cannot be evaluated" if $expr =~ /:/; # Use : for escape $expr =~ s/nth_prime\(/:1(/g; $expr =~ s/log\(/:2(/g; die "$expr cannot be evaluated" if $expr =~ tr|-0123456789+*/() :||c; $expr =~ s/:1/nth_prime/g; $expr =~ s/:2/log/g; $expr =~ s/(\d+)/ Math::BigInt->new($1) /g; my $res = eval $expr; ## no critic die "Cannot eval: $expr\n" if !defined $res; $res = int($res->bstr) if ref($res) eq 'Math::BigInt' && $res <= ~0; $res; } sub die_usage { die < p_{n-i}*p_{n+i} for all i in (1..n-1) --cuban1 Cuban (y+1) p = (x^3 - y^3)/(x-y), x=y+1 --cuban2 Cuban (y+2) p = (x^3 - y^3)/(x-y), x=y+2 --pnp1 Primorial+1 p#+1 is prime --pnm1 Primorial-1 p#-1 is prime --euclid Euclid pn#+1 is prime --circular Circular all digit rotations of p are prime --panaitopol Panaitopol p = (x^4-y^4)/(x^3+y^3) for some x,y --provable Ensure all primes are provably prime Note that options can be combined, e.g. display only safe twin primes. In all cases involving multiples (twin, triplet, etc.), the value returned is p -- the least value of the set. EOU } Math-Prime-Util-0.37/bin/factor.pl0000755000076400007640000000625712270242116015316 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Getopt::Long; use Math::Prime::Util qw/factor nth_prime prime_set_config/; $| = 1; # Allow execution of any of these functions in the command line my @mpu_funcs = (qw/next_prime prev_prime prime_count nth_prime random_prime random_ndigit_prime random_nbit_prime random_strong_prime random_maurer_prime primorial pn_primorial moebius mertens euler_phi jordan_totient exp_mangoldt divisor_sum consecutive_integer_lcm/); my %mpu_func_map; my %opts; GetOptions(\%opts, 'version', # turn off MPU::GMP for debugging 'verbose', 'help', ) || die_usage(); if (exists $opts{'version'}) { my $version_str = "factor.pl version 1.2 using Math::Prime::Util $Math::Prime::Util::VERSION"; $version_str .= " and MPU::GMP $Math::Prime::Util::GMP::VERSION" if Math::Prime::Util::prime_get_config->{'gmp'}; $version_str .= "\nWritten by Dana Jacobsen.\n"; die "$version_str"; } die_usage() if exists $opts{'help'}; prime_set_config(verbose => 3) if exists $opts{'verbose'}; if (@ARGV) { foreach my $n (@ARGV) { $n =~ s/\s*$//; $n =~ s/^\s*//; $n = eval_expr($n) unless $n =~ /^\d+$/; print "$n: ", join(" ", factor($n)), "\n"; } } else { while (<>) { chomp; foreach my $n (split / /) { $n = eval_expr($n) unless $n =~ /^\d+$/; print "$n: ", join(" ", factor($n)), "\n"; } } } # This is rather braindead. We're going to eval their input so they can give # arbitrary expressions. But we only want to allow math-like strings. sub eval_expr { my $expr = shift; die "$expr cannot be evaluated" if $expr =~ /:/; # Use : for escape if (scalar(keys %mpu_func_map) == 0) { my $n = 10; foreach my $func (@mpu_funcs) { $mpu_func_map{$func} = sprintf("%03d", $n++); } } $expr =~ s/\blog\(/:001(/g; foreach my $func (@mpu_funcs) { $expr =~ s/\b$func\(/:$mpu_func_map{$func}(/g; } die "$expr cannot be evaluated" if $expr =~ tr|-0123456789+*/() :||c; $expr =~ s/:001/log/g; foreach my $func (@mpu_funcs) { $expr =~ s/:$mpu_func_map{$func}\(/Math::Prime::Util::$func(/g; } $expr =~ s/(\d+)/ Math::BigInt->new("$1") /g; $expr = 'use Math::BigInt try=>"GMP"; ' . $expr; my $res = eval $expr; ## no critic die "Cannot eval: $expr\n" if !defined $res; $res = int($res->bstr) if ref($res) eq 'Math::BigInt' && $res <= ~0; $res; } sub die_usage { die < #include #include #include #include /* * The AKS v6 algorithm, for native integers. Based on the AKS v6 paper. * As with most AKS implementations, it's really slow. * * When n < 2^(wordbits/2)-1, we can do a straightforward intermediate: * r = (r + a * b) % n * If n is larger, then these are replaced with: * r = addmod( r, mulmod(a, b, n), n) * which is a lot more work, but keeps us correct. * * Software that does polynomial convolutions followed by a modulo can be * very fast, but will fail when n >= (2^wordbits)/r. * * This is all much easier in GMP. * * Copyright 2012, Dana Jacobsen. */ #define SQRTN_SHORTCUT 1 #include "ptypes.h" #include "aks.h" #define FUNC_isqrt 1 #define FUNC_log2floor 1 #include "util.h" #include "cache.h" #include "mulmod.h" /* Bach and Sorenson (1993) would be better */ static int is_perfect_power(UV n) { UV b, last; if ((n <= 3) || (n == UV_MAX)) return 0; if ((n & (n-1)) == 0) return 1; /* powers of 2 */ #if (BITS_PER_WORD == 32) || (DBL_DIG > 19) if (1) { #elif DBL_DIG == 10 if (n < UVCONST(10000000000)) { #elif DBL_DIG == 15 if (n < UVCONST(1000000000000000)) { #else if ( n < (UV) pow(10, DBL_DIG) ) { #endif /* Simple floating point method. Fast, but need enough mantissa. */ b = isqrt(n); if (b*b == n) return 1; /* perfect square */ last = log2floor(n-1) + 1; for (b = 3; b < last; b = next_prime(b)) { UV root = (UV) (pow(n, 1.0 / (double)b) + 0.5); if ( ((UV)(pow(root, b)+0.5)) == n) return 1; } } else { /* Dietzfelbinger, algorithm 2.3.5 (without optimized exponential) */ last = log2floor(n-1) + 1; for (b = 2; b <= last; b++) { UV a = 1; UV c = n; while (c >= HALF_WORD) c = (1+c)>>1; while ((c-a) >= 2) { UV m, maxm, p, i; m = (a+c) >> 1; maxm = UV_MAX / m; p = m; for (i = 2; i <= b; i++) { if (p > maxm) { p = n+1; break; } p *= m; } if (p == n) return 1; if (p < n) a = m; else c = m; } } } return 0; } /* Naive znorder. Works well here because limit will be very small. */ static UV order(UV r, UV n, UV limit) { UV j; UV t = 1; for (j = 1; j <= limit; j++) { t = mulmod(t, n, r); if (t == 1) break; } return j; } #if 0 static void poly_print(UV* poly, UV r) { int i; for (i = r-1; i >= 1; i--) { if (poly[i] != 0) printf("%lux^%d + ", poly[i], i); } if (poly[0] != 0) printf("%lu", poly[0]); printf("\n"); } #endif static void poly_mod_mul(UV* px, UV* py, UV* res, UV r, UV mod) { UV degpx, degpy; UV i, j, pxi, pyj, rindex; memset(res, 0, r * sizeof(UV)); /* Determine max degree of px and py */ for (degpx = r-1; degpx > 0 && !px[degpx]; degpx--) ; /* */ for (degpy = r-1; degpy > 0 && !py[degpy]; degpy--) ; /* */ /* We can sum at least j values at once */ j = (mod >= HALF_WORD) ? 0 : (UV_MAX / ((mod-1)*(mod-1))); if (j >= degpx || j >= degpy) { for (rindex = 0; rindex < r; rindex++) { UV sum = 0; j = rindex; for (i = 0; i <= degpx; i++) { if (j <= degpy) sum += px[i] * py[j]; j = (j == 0) ? r-1 : j-1; } res[rindex] = sum % mod; } } else { for (i = 0; i <= degpx; i++) { pxi = px[i]; if (pxi == 0) continue; if (mod < HALF_WORD) { for (j = 0; j <= degpy; j++) { pyj = py[j]; rindex = i+j; if (rindex >= r) rindex -= r; res[rindex] = (res[rindex] + (pxi*pyj) ) % mod; } } else { for (j = 0; j <= degpy; j++) { pyj = py[j]; rindex = i+j; if (rindex >= r) rindex -= r; res[rindex] = muladdmod(pxi, pyj, res[rindex], mod); } } } } memcpy(px, res, r * sizeof(UV)); /* put result in px */ } static void poly_mod_sqr(UV* px, UV* res, UV r, UV mod) { UV c, d, s, sum, rindex, maxpx; UV degree = r-1; memset(res, 0, r * sizeof(UV)); /* zero out sums */ /* Discover index of last non-zero value in px */ for (s = degree; s > 0; s--) if (px[s] != 0) break; maxpx = s; /* 1D convolution */ for (d = 0; d <= 2*degree; d++) { UV *pp1, *pp2, *ppend; UV s_beg = (d <= degree) ? 0 : d-degree; UV s_end = ((d/2) <= maxpx) ? d/2 : maxpx; if (s_end < s_beg) continue; sum = 0; pp1 = px + s_beg; pp2 = px + d - s_beg; ppend = px + s_end; while (pp1 < ppend) sum += 2 * *pp1++ * *pp2--; /* Special treatment for last point */ c = px[s_end]; sum += (s_end*2 == d) ? c*c : 2*c*px[d-s_end]; rindex = (d < r) ? d : d-r; /* d % r */ res[rindex] = (res[rindex] + sum) % mod; } memcpy(px, res, r * sizeof(UV)); /* put result in px */ } static UV* poly_mod_pow(UV* pn, UV power, UV r, UV mod) { UV* res; UV* temp; int use_sqr = (mod > isqrt(UV_MAX/r)) ? 0 : 1; Newz(0, res, r, UV); New(0, temp, r, UV); if ( (res == 0) || (temp == 0) ) croak("Couldn't allocate space for polynomial of degree %lu\n", (unsigned long) r); res[0] = 1; while (power) { if (power & 1) poly_mod_mul(res, pn, temp, r, mod); power >>= 1; if (power) { if (use_sqr) poly_mod_sqr(pn, temp, r, mod); else poly_mod_mul(pn, pn, temp, r, mod); } } Safefree(temp); return res; } static int test_anr(UV a, UV n, UV r) { UV* pn; UV* res; UV i; int retval = 1; Newz(0, pn, r, UV); if (pn == 0) croak("Couldn't allocate space for polynomial of degree %lu\n", (unsigned long) r); a %= r; pn[0] = a; pn[1] = 1; res = poly_mod_pow(pn, n, r, n); res[n % r] = addmod(res[n % r], n - 1, n); res[0] = addmod(res[0], n - a, n); for (i = 0; i < r; i++) if (res[i] != 0) retval = 0; Safefree(res); Safefree(pn); return retval; } int _XS_is_aks_prime(UV n) { UV sqrtn, limit, r, rlimit, a; double log2n; int verbose; if (n < 2) return 0; if (n == 2) return 1; if (is_perfect_power(n)) return 0; sqrtn = isqrt(n); log2n = log(n) / log(2); /* C99 has a log2() function */ limit = (UV) floor(log2n * log2n); verbose = _XS_get_verbose(); if (verbose) { printf("# aks limit is %lu\n", (unsigned long) limit); } for (r = 2; r < n; r++) { if ((n % r) == 0) return 0; #if SQRTN_SHORTCUT if (r > sqrtn) return 1; #endif if (order(r, n, limit) > limit) break; } if (r >= n) return 1; rlimit = (UV) floor(sqrt(r-1) * log2n); if (verbose) { printf("# aks r = %lu rlimit = %lu\n", (unsigned long) r, (unsigned long) rlimit); } for (a = 1; a <= rlimit; a++) { if (! test_anr(a, n, r) ) return 0; if (verbose>1) { printf("."); fflush(stdout); } } if (verbose>1) { printf("\n"); } return 1; } Math-Prime-Util-0.37/LICENSE0000644000076400007640000004367512270242116013742 0ustar danadanaThis software is Copyright (c) 2011-2014 by Dana Jacobsen. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2011-2014 by Dana Jacobsen. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2011-2014 by Dana Jacobsen. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Math-Prime-Util-0.37/README0000644000076400007640000000350212270242116013576 0ustar danadanaMath::Prime::Util version 0.37 A set of utilities related to prime numbers. These include multiple sieving methods, is_prime, prime_count, nth_prime, approximations and bounds for the prime_count and nth prime, next_prime and prev_prime, moebius and totient functions, random primes, integer factoring, primality proofs, and more. The default sieving and factoring are intended to be the fastest on CPAN. Current measurements show it is faster than: Math::Prime::XS Math::Prime::FastSieve Math::Factor::XS Math::Big Math::Big::Factors Math::Factoring Math::Primality Math::Prime::TiedArray Crypt::Primes For non-bignums, it is typically faster than Math::Pari (and doesn't require Pari to be installed). With Math::Prime::Util::GMP installed it is usually faster than Math::Pari for bigints. SYNOPSIS use Math::Prime::Util qw/primes/; # Get a big array reference of many primes my $aref = primes( 100_000_000 ); # All the primes between 5k and 10k inclusive in a regular array my @primes = @{ primes( 5_000, 10_000 ) }; See the POD module documentation for examples and more information on all the methods included. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install You will need a C compiler compatible with the compiler used to build Perl. Since the routines are meant to be used from Perl, the data types will match the ones used with the Perl you are installing for. This means a 32-bit Perl running on a 64-bit machine will result in a 32-bit library. DEPENDENCIES Perl 5.6.2 or later (5.8 or later is preferred). Bytes::Random::Secure 0.23 or later. COPYRIGHT AND LICENCE Copyright (C) 2011-2014 by Dana Jacobsen This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Math-Prime-Util-0.37/util.c0000644000076400007640000015112512271163506014052 0ustar danadana#include #include #include #include /* Use long double to get a little more precision when we're calculating the * math functions -- especially those calculated with a series. Long double * is defined in C89 (ISO C), so it should be supported by any reasonable * compiler we're using (seriously is your C compiler 20+ years out of date?). * Noting that 'long double' on many platforms is no different than 'double' * so it may buy us nothing. But it's worth trying. */ /* These math functions are a clusterfrack. They're defined by C99, but * NetBSD doesn't have them. You need them in both the headers and libraries, * but there is no standard way to find out if the libraries have them. The * best way (I believe) to deal with this is having the make system do test * compiles. Barring that, we make limited guesses, and just give up * precision on any system we don't recognize. */ #if _MSC_VER /* MSVS has these as macros, and really doesn't want us defining them. */ #elif defined(__MATH_DECLARE_LDOUBLE) || \ defined(__LONG_DOUBLE_128__) || \ defined(__LONGDOUBLE128) /* GLIBC */ extern long double powl(long double, long double); extern long double expl(long double); extern long double logl(long double); extern long double fabsl(long double); extern long double floorl(long double); extern long double ceill(long double); #else #define powl(x, y) (long double) pow( (double) (x), (double) (y) ) #define expl(x) (long double) exp( (double) (x) ) #define logl(x) (long double) log( (double) (x) ) #define fabsl(x) (long double) fabs( (double) (x) ) #define floorl(x) (long double) floor( (double) (x) ) #define ceill(x) (long double) ceil( (double) (x) ) #endif #ifdef LDBL_INFINITY #undef INFINITY #define INFINITY LDBL_INFINITY #elif !defined(INFINITY) #define INFINITY (DBL_MAX + DBL_MAX) #endif #ifndef LDBL_EPSILON #define LDBL_EPSILON 1e-16 #endif #define KAHAN_INIT(s) \ long double s ## _y, s ## _t; \ long double s ## _c = 0.0; \ long double s = 0.0; #define KAHAN_SUM(s, term) \ do { \ s ## _y = (term) - s ## _c; \ s ## _t = s + s ## _y; \ s ## _c = (s ## _t - s) - s ## _y; \ s = s ## _t; \ } while (0) #include "ptypes.h" #define FUNC_isqrt 1 #define FUNC_lcm_ui 1 #define FUNC_ctz 1 #define FUNC_log2floor 1 #define FUNC_next_prime_in_sieve 1 #define FUNC_prev_prime_in_sieve 1 #include "util.h" #include "sieve.h" #include "primality.h" #include "cache.h" #include "lmo.h" #include "factor.h" #include "mulmod.h" #include "constants.h" static int _verbose = 0; void _XS_set_verbose(int v) { _verbose = v; } int _XS_get_verbose(void) { return _verbose; } static int _call_gmp = 0; void _XS_set_callgmp(int v) { _call_gmp = v; } int _XS_get_callgmp(void) { return _call_gmp; } /* GCC 3.4 - 4.1 has broken 64-bit popcount. * GCC 4.2+ can generate awful code when it doesn't have asm (GCC bug 36041). * When the asm is present (e.g. compile with -march=native on a platform that * has them, like Nahelem+), then it is almost as fast as the direct asm. */ #if BITS_PER_WORD == 64 #if defined(__POPCNT__) && defined(__GNUC__) && (__GNUC__> 4 || (__GNUC__== 4 && __GNUC_MINOR__> 1)) #define popcnt(b) __builtin_popcountll(b) #else static UV popcnt(UV b) { b -= (b >> 1) & 0x5555555555555555; b = (b & 0x3333333333333333) + ((b >> 2) & 0x3333333333333333); b = (b + (b >> 4)) & 0x0f0f0f0f0f0f0f0f; return (b * 0x0101010101010101) >> 56; } #endif #endif #if defined(__GNUC__) #define word_unaligned(m,wordsize) ((uintptr_t)m & (wordsize-1)) #else /* uintptr_t is part of C99 */ #define word_unaligned(m,wordsize) ((unsigned int)m & (wordsize-1)) #endif static const unsigned char byte_zeros[256] = {8,7,7,6,7,6,6,5,7,6,6,5,6,5,5,4,7,6,6,5,6,5,5,4,6,5,5,4,5,4,4,3, 7,6,6,5,6,5,5,4,6,5,5,4,5,4,4,3,6,5,5,4,5,4,4,3,5,4,4,3,4,3,3,2, 7,6,6,5,6,5,5,4,6,5,5,4,5,4,4,3,6,5,5,4,5,4,4,3,5,4,4,3,4,3,3,2, 6,5,5,4,5,4,4,3,5,4,4,3,4,3,3,2,5,4,4,3,4,3,3,2,4,3,3,2,3,2,2,1, 7,6,6,5,6,5,5,4,6,5,5,4,5,4,4,3,6,5,5,4,5,4,4,3,5,4,4,3,4,3,3,2, 6,5,5,4,5,4,4,3,5,4,4,3,4,3,3,2,5,4,4,3,4,3,3,2,4,3,3,2,3,2,2,1, 6,5,5,4,5,4,4,3,5,4,4,3,4,3,3,2,5,4,4,3,4,3,3,2,4,3,3,2,3,2,2,1, 5,4,4,3,4,3,3,2,4,3,3,2,3,2,2,1,4,3,3,2,3,2,2,1,3,2,2,1,2,1,1,0}; static UV count_zero_bits(const unsigned char* m, UV nbytes) { UV count = 0; #if BITS_PER_WORD == 64 if (nbytes >= 16) { while ( word_unaligned(m,sizeof(UV)) && nbytes--) count += byte_zeros[*m++]; if (nbytes >= 8) { UV* wordptr = (UV*)m; UV nwords = nbytes / 8; UV nzeros = nwords * 64; m += nwords * 8; nbytes %= 8; while (nwords--) nzeros -= popcnt(*wordptr++); count += nzeros; } } #endif while (nbytes--) count += byte_zeros[*m++]; return count; } /* We'll use this little static sieve to quickly answer small values of * is_prime, next_prime, prev_prime, prime_count * for non-threaded Perl it's basically the same as getting the primary * cache. It guarantees we'll have an answer with no waiting on any version. */ static const unsigned char prime_sieve30[] = {0x01,0x20,0x10,0x81,0x49,0x24,0xc2,0x06,0x2a,0xb0,0xe1,0x0c,0x15,0x59,0x12, 0x61,0x19,0xf3,0x2c,0x2c,0xc4,0x22,0xa6,0x5a,0x95,0x98,0x6d,0x42,0x87,0xe1, 0x59,0xa9,0xa9,0x1c,0x52,0xd2,0x21,0xd5,0xb3,0xaa,0x26,0x5c,0x0f,0x60,0xfc, 0xab,0x5e,0x07,0xd1,0x02,0xbb,0x16,0x99,0x09,0xec,0xc5,0x47,0xb3,0xd4,0xc5, 0xba,0xee,0x40,0xab,0x73,0x3e,0x85,0x4c,0x37,0x43,0x73,0xb0,0xde,0xa7,0x8e, 0x8e,0x64,0x3e,0xe8,0x10,0xab,0x69,0xe5,0xf7,0x1a,0x7c,0x73,0xb9,0x8d,0x04, 0x51,0x9a,0x6d,0x70,0xa7,0x78,0x2d,0x6d,0x27,0x7e,0x9a,0xd9,0x1c,0x5f,0xee, 0xc7,0x38,0xd9,0xc3,0x7e,0x14,0x66,0x72,0xae,0x77,0xc1,0xdb,0x0c,0xcc,0xb2, 0xa5,0x74,0xe3,0x58,0xd5,0x4b,0xa7,0xb3,0xb1,0xd9,0x09,0xe6,0x7d,0x23,0x7c, 0x3c,0xd3,0x0e,0xc7,0xfd,0x4a,0x32,0x32,0xfd,0x4d,0xb5,0x6b,0xf3,0xa8,0xb3, 0x85,0xcf,0xbc,0xf4,0x0e,0x34,0xbb,0x93,0xdb,0x07,0xe6,0xfe,0x6a,0x57,0xa3, 0x8c,0x15,0x72,0xdb,0x69,0xd4,0xaf,0x59,0xdd,0xe1,0x3b,0x2e,0xb7,0xf9,0x2b, 0xc5,0xd0,0x8b,0x63,0xf8,0x95,0xfa,0x77,0x40,0x97,0xea,0xd1,0x9f,0xaa,0x1c, 0x48,0xae,0x67,0xf7,0xeb,0x79,0xa5,0x55,0xba,0xb2,0xb6,0x8f,0xd8,0x2d,0x6c, 0x2a,0x35,0x54,0xfd,0x7c,0x9e,0xfa,0xdb,0x31,0x78,0xdd,0x3d,0x56,0x52,0xe7, 0x73,0xb2,0x87,0x2e,0x76,0xe9,0x4f,0xa8,0x38,0x9d,0x5d,0x3f,0xcb,0xdb,0xad, 0x51,0xa5,0xbf,0xcd,0x72,0xde,0xf7,0xbc,0xcb,0x49,0x2d,0x49,0x26,0xe6,0x1e, 0x9f,0x98,0xe5,0xc6,0x9f,0x2f,0xbb,0x85,0x6b,0x65,0xf6,0x77,0x7c,0x57,0x8b, 0xaa,0xef,0xd8,0x5e,0xa2,0x97,0xe1,0xdc,0x37,0xcd,0x1f,0xe6,0xfc,0xbb,0x8c, 0xb7,0x4e,0xc7,0x3c,0x19,0xd5,0xa8,0x9e,0x67,0x4a,0xe3,0xf5,0x97,0x3a,0x7e, 0x70,0x53,0xfd,0xd6,0xe5,0xb8,0x1c,0x6b,0xee,0xb1,0x9b,0xd1,0xeb,0x34,0xc2, 0x23,0xeb,0x3a,0xf9,0xef,0x16,0xd6,0x4e,0x7d,0x16,0xcf,0xb8,0x1c,0xcb,0xe6, 0x3c,0xda,0xf5,0xcf}; #define NPRIME_SIEVE30 (sizeof(prime_sieve30)/sizeof(prime_sieve30[0])) /* Return of 2 if n is prime, 0 if not. Do it fast. */ int _XS_is_prime(UV n) { if (n <= 10) return (n == 2 || n == 3 || n == 5 || n == 7) ? 2 : 0; if (n < UVCONST(200000000)) { UV d = n/30; UV m = n - d*30; unsigned char mtab = masktab30[m]; /* Bitmask in mod30 wheel */ const unsigned char* sieve; int isprime; /* Return 0 if a multiple of 2, 3, or 5 */ if (mtab == 0) return 0; /* Check static tiny sieve */ if (d < NPRIME_SIEVE30) return (prime_sieve30[d] & mtab) ? 0 : 2; if (!(n%7) || !(n%11) || !(n%13)) return 0; /* Check primary cache */ isprime = -1; if (n <= get_prime_cache(0, &sieve)) isprime = 2*((sieve[d] & mtab) == 0); release_prime_cache(sieve); if (isprime >= 0) return isprime; } return is_prob_prime(n); } UV next_prime(UV n) { UV m, sieve_size, next; const unsigned char* sieve; if (n < 30*NPRIME_SIEVE30) { next = next_prime_in_sieve(prime_sieve30, n,30*NPRIME_SIEVE30); if (next != 0) return next; } if (n >= MPU_MAX_PRIME) return 0; /* Overflow */ sieve_size = get_prime_cache(0, &sieve); next = (n < sieve_size) ? next_prime_in_sieve(sieve, n, sieve_size) : 0; release_prime_cache(sieve); if (next != 0) return next; m = n % 30; do { /* Move forward one. */ n += wheeladvance30[m]; m = nextwheel30[m]; } while (!is_prob_prime(n)); return n; } UV prev_prime(UV n) { const unsigned char* sieve; UV m, prev; if (n < 30*NPRIME_SIEVE30) return prev_prime_in_sieve(prime_sieve30, n); if (n < get_prime_cache(0, &sieve)) { prev = prev_prime_in_sieve(sieve, n); release_prime_cache(sieve); return prev; } release_prime_cache(sieve); m = n % 30; do { /* Move back one. */ n -= wheelretreat[m]; m = prevwheel30[m]; } while (!is_prob_prime(n)); return n; } /* Given a sieve of size nbytes, walk it counting zeros (primes) until: * * (1) we counted them all: return the count, which will be less than maxcount. * * (2) we hit maxcount: set position to the index of the maxcount'th prime * and return count (which will be equal to maxcount). */ static UV count_segment_maxcount(const unsigned char* sieve, UV base, UV nbytes, UV maxcount, UV* pos) { UV count = 0; UV byte = 0; const unsigned char* sieveptr = sieve; const unsigned char* maxsieve = sieve + nbytes; MPUassert(sieve != 0, "count_segment_maxcount incorrect args"); MPUassert(pos != 0, "count_segment_maxcount incorrect args"); *pos = 0; if ( (nbytes == 0) || (maxcount == 0) ) return 0; /* Do fixed-length word counts to start, with possible overcounting */ while ((count+64) < maxcount && sieveptr < maxsieve) { UV top = base + 3*maxcount; UV div = (top < 8000) ? 8 : /* 8 cannot overcount */ (top < 1000000) ? 4 : (top < 10000000) ? 3 : 2; UV minbytes = (maxcount-count)/div; if (minbytes > (UV)(maxsieve-sieveptr)) minbytes = maxsieve-sieveptr; count += count_zero_bits(sieveptr, minbytes); sieveptr += minbytes; } /* Count until we reach the end or >= maxcount */ while ( (sieveptr < maxsieve) && (count < maxcount) ) count += byte_zeros[*sieveptr++]; /* If we went too far, back up. */ while (count >= maxcount) count -= byte_zeros[*--sieveptr]; /* We counted this many bytes */ byte = sieveptr - sieve; MPUassert(count < maxcount, "count_segment_maxcount wrong count"); if (byte == nbytes) return count; /* The result is somewhere in the next byte */ START_DO_FOR_EACH_SIEVE_PRIME(sieve, byte*30+1, nbytes*30-1) if (++count == maxcount) { *pos = p; return count; } END_DO_FOR_EACH_SIEVE_PRIME; MPUassert(0, "count_segment_maxcount failure"); return 0; } /* Given a sieve of size nbytes, counting zeros (primes) but excluding the * areas outside lowp and highp. */ static UV count_segment_ranged(const unsigned char* sieve, UV nbytes, UV lowp, UV highp) { UV count, hi_d, lo_d, lo_m; MPUassert( sieve != 0, "count_segment_ranged incorrect args"); if (nbytes == 0) return 0; count = 0; hi_d = highp/30; if (hi_d >= nbytes) { hi_d = nbytes-1; highp = hi_d*30+29; } if (highp < lowp) return 0; #if 0 /* Dead simple way */ START_DO_FOR_EACH_SIEVE_PRIME(sieve, lowp, highp) count++; END_DO_FOR_EACH_SIEVE_PRIME; return count; #endif lo_d = lowp/30; lo_m = lowp - lo_d*30; /* Count first fragment */ if (lo_m > 1) { UV upper = (highp <= (lo_d*30+29)) ? highp : (lo_d*30+29); START_DO_FOR_EACH_SIEVE_PRIME(sieve, lowp, upper) count++; END_DO_FOR_EACH_SIEVE_PRIME; lowp = upper+2; lo_d = lowp/30; } if (highp < lowp) return count; /* Count bytes in the middle */ { UV hi_m = highp - hi_d*30; UV count_bytes = hi_d - lo_d + (hi_m == 29); if (count_bytes > 0) { count += count_zero_bits(sieve+lo_d, count_bytes); lowp += 30*count_bytes; } } if (highp < lowp) return count; /* Count last fragment */ START_DO_FOR_EACH_SIEVE_PRIME(sieve, lowp, highp) count++; END_DO_FOR_EACH_SIEVE_PRIME; return count; } /* * The pi(x) prime count functions. prime_count(x) gives an exact number, * but requires determining all the primes up to x, so will be much slower. * * prime_count_lower(x) and prime_count_upper(x) give lower and upper limits, * which will bound the exact value. These bounds should be fairly tight. * * pi_upper(x) - pi(x) pi_lower(x) - pi(x) * < 10 for x < 5_371 < 10 for x < 9_437 * < 50 for x < 295_816 < 50 for x < 136_993 * < 100 for x < 1_761_655 < 100 for x < 909_911 * < 200 for x < 9_987_821 < 200 for x < 8_787_901 * < 400 for x < 34_762_891 < 400 for x < 30_332_723 * < 1000 for x < 372_748_528 < 1000 for x < 233_000_533 * < 5000 for x < 1_882_595_905 < 5000 for x < over 4300M * * The average of the upper and lower bounds is within 9 for all x < 15809, and * within 50 for all x < 1_763_367. * * It is common to use the following Chebyshev inequality for x >= 17: * 1*x/logx <-> 1.25506*x/logx * but this gives terribly loose bounds. * * Rosser and Schoenfeld's bound for x >= 67 of * x/(logx-1/2) <-> x/(logx-3/2) * is much tighter. These bounds can be tightened even more. * * The formulas of Dusart for higher x are better yet. I recommend the paper * by Burde for further information. Dusart's thesis is also a good resource. * * I have tweaked the bounds formulas for small (under 70_000M) numbers so they * are tighter. These bounds are verified via trial. The Dusart bounds * (1.8 and 2.51) are used for larger numbers since those are proven. * */ #define USE_PC_TABLES 1 #if USE_PC_TABLES /* These tables let us have fast answers up to 3000M for the cost of ~1.4k of * static data/code. We can get a 4 to 100x speedup here. We don't want to * push this idea too far because Lehmer's method should be faster. */ /* mpu '$step=30_000; $pc=prime_count(5); print "$pc\n", join(",", map { $spc=$pc; $pc=prime_count($_*$step); $pc-$spc; } 1..200), "\n"' */ static const unsigned short step_counts_30k[] = /* starts at 7 */ {3242,2812,2656,2588,2547,2494,2465,2414,2421,2355,2407,2353,2310,2323,2316, 2299,2286,2281,2247,2279,2243,2223,2251,2214,2209,2230,2215,2207,2205,2179, 2200,2144,2159,2193,2164,2136,2180,2152,2162,2174,2113,2131,2150,2101,2111, 2146,2115,2123,2119,2108,2124,2097,2075,2089,2094,2119,2084,2065,2069,2101, 2094,2083,2089,2076,2088,2027,2109,2073,2061,2033,2079,2078,2036,2025,2058, 2083,2037,2005,2048,2048,2024,2045,2027,2025,2039,2049,2022,2034,2046,2032, 2019,2000,2014,2069,2042,1980,2021,2014,1995,2017,1992,1985,2045,2007,1990, 2008,2052,2033,1988,1984,2010,1943,2024,2005,2027,1937,1955,1956,1993,1976, 2048,1940,2002,2007,1994,1954,1972,2002,1973,1993,1984,1969,1940,1960,2026, 1966,1981,1912,1994,1971,1977,1952,1932,1977,1932,1954,1938,2018,1987,1967, 1937,1938,1963,1973,1947,1947,1963,1959,1941,1923,1943,1957,1974,1964,1958, 1984,1933,1935,1935,1949,1928,1943,1917,1956,1970,1932,1937,1929,1932,1947, 1927,1944,1915,1913,1918,1925,1931,1919,1900,1952,1934,1922,1891,1926,1925, 1903,1970,1962,1905,1905}; #define NSTEP_COUNTS_30K (sizeof(step_counts_30k)/sizeof(step_counts_30k[0])) /* mpu '$step=300_000; $pc=prime_count(20*$step); print "$pc\n", join(",", map { $spc=$pc; $pc=prime_count($_*$step); $pc-$spc; } 21..212), "\n"' */ static const unsigned short step_counts_300k[] = /* starts at 6M */ {19224,19086,19124,19036,18942,18893,18870,18853,18837,18775,18688,18674, 18594,18525,18639,18545,18553,18424,18508,18421,18375,18366,18391,18209, 18239,18298,18209,18294,18125,18138,18147,18115,18126,18021,18085,18068, 18094,17963,18041,18003,17900,17881,17917,17888,17880,17852,17892,17779, 17823,17764,17806,17762,17780,17716,17633,17758,17746,17678,17687,17613, 17709,17628,17634,17556,17528,17598,17604,17532,17606,17548,17493,17576, 17456,17468,17555,17452,17407,17472,17415,17500,17508,17418,17463,17240, 17345,17351,17380,17394,17379,17330,17322,17335,17354,17113,17210,17231, 17238,17305,17268,17219,17281,17235,17119,17292,17161,17212,17166,17277, 17137,17260,17228,17197,17154,17097,17195,17136,17067,17058,17041,17045, 17187,17034,17029,17037,17090,16985,17054,17017,17106,17001,17095,17125, 17027,16948,16969,17031,16916,17031,16905,16937,16881,16952,16919,16938, 17028,16963,16902,16922,16944,16901,16847,16969,16900,16876,16841,16874, 16894,16861,16761,16886,16778,16820,16727,16921,16817,16845,16847,16824, 16844,16809,16859,16783,16713,16752,16762,16857,16760,16626,16784,16784, 16718,16745,16871,16635,16714,16630,16779,16709,16660,16730,16715,16724}; #define NSTEP_COUNTS_300K (sizeof(step_counts_300k)/sizeof(step_counts_300k[0])) static const unsigned int step_counts_30m[] = /* starts at 60M */ {1654839,1624694,1602748,1585989,1571241,1559918,1549840,1540941,1533150, 1525813,1519922,1513269,1508559,1503386,1497828,1494129,1489905,1486417, 1482526,1478941,1475577,1472301,1469133,1466295,1464711,1461223,1458478, 1455327,1454218,1451883,1449393,1447612,1445029,1443285,1442268,1438511, 1437688,1435603,1433623,1432638,1431158,1429158,1427934,1426191,1424449, 1423146,1421898,1421628,1419519,1417646,1416274,1414828,1414474,1412536, 1412147,1410149,1409474,1408847,1406619,1405863,1404699,1403820,1402802, 1402215,1401459,1399972,1398687,1397968,1397392,1396025,1395311,1394081, 1393614,1393702,1391745,1390950,1389856,1389245,1388381,1387557,1387087, 1386285,1386089,1385355,1383659,1383030,1382174,1382128,1380556,1379940, 1379988,1379181,1378300,1378033,1376974,1376282,1375646,1374445,1373813}; #define NSTEP_COUNTS_30M (sizeof(step_counts_30m)/sizeof(step_counts_30m[0])) #endif UV _XS_prime_count(UV low, UV high) { const unsigned char* cache_sieve; unsigned char* segment; UV segment_size, low_d, high_d; UV count = 0; if ((low <= 2) && (high >= 2)) count++; if ((low <= 3) && (high >= 3)) count++; if ((low <= 5) && (high >= 5)) count++; if (low < 7) low = 7; if (low > high) return count; if (low == 7 && high <= 30*NPRIME_SIEVE30) { count += count_segment_ranged(prime_sieve30, NPRIME_SIEVE30, low, high); return count; } #if USE_PC_TABLES if (low == 7 && high >= 30000) { UV i, maxi; if (high < (30000*(NSTEP_COUNTS_30K+1))) { low = 0; maxi = high/30000; for (i = 0; i < maxi && i < NSTEP_COUNTS_30K; i++) { count += step_counts_30k[i]; low += 30000; } } else if (high < (6000000 + 300000*(NSTEP_COUNTS_300K+1))) { count = 412849; low = 6000000; maxi = (high-6000000)/300000; for (i = 0; i < maxi && i < NSTEP_COUNTS_300K; i++) { count += step_counts_300k[i]; low += 300000; } } else { count = 3562115; low = 60000000; maxi = (high-60000000)/30000000; for (i = 0; i < maxi && i < NSTEP_COUNTS_30M; i++) { count += step_counts_30m[i]; low += 30000000; } } } #endif low_d = low/30; high_d = high/30; /* Count full bytes only -- no fragments from primary cache */ segment_size = get_prime_cache(0, &cache_sieve) / 30; if (segment_size < high_d) { /* Expand sieve to sqrt(n) */ UV endp = (high_d >= (UV_MAX/30)) ? UV_MAX-2 : 30*high_d+29; release_prime_cache(cache_sieve); segment_size = get_prime_cache( isqrt(endp) + 1 , &cache_sieve) / 30; } if ( (segment_size > 0) && (low_d <= segment_size) ) { /* Count all the primes in the primary cache in our range */ count += count_segment_ranged(cache_sieve, segment_size, low, high); if (high_d < segment_size) { release_prime_cache(cache_sieve); return count; } low_d = segment_size; if (30*low_d > low) low = 30*low_d; } release_prime_cache(cache_sieve); /* More primes needed. Repeatedly segment sieve. */ { void* ctx = start_segment_primes(low, high, &segment); UV seg_base, seg_low, seg_high; while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { segment_size = seg_high/30 - seg_low/30 + 1; count += count_segment_ranged(segment, segment_size, seg_low-seg_base, seg_high-seg_base); } end_segment_primes(ctx); } return count; } UV prime_count_approx(UV n) { if (n < 3000000) return _XS_prime_count(2, n); return (UV) (_XS_RiemannR( (long double) n ) + 0.5 ); } UV prime_count_lower(UV n) { long double fn, flogn, lower, a; if (n < 33000) return _XS_prime_count(2, n); fn = (long double) n; flogn = logl(n); if (n < 176000) a = 1.80; else if (n < 315000) a = 2.10; else if (n < 1100000) a = 2.20; else if (n < 4500000) a = 2.31; else if (n <233000000) a = 2.36; #if BITS_PER_WORD == 32 else a = 2.32; #else else if (n < UVCONST( 5433800000)) a = 2.32; else if (n < UVCONST(60000000000)) a = 2.15; else a = 2.00; #endif lower = fn/flogn * (1.0 + 1.0/flogn + a/(flogn*flogn)); return (UV) floorl(lower); } typedef struct { UV thresh; float aval; } thresh_t; static const thresh_t _upper_thresh[] = { { 59000, 2.48 }, { 350000, 2.52 }, { 355991, 2.54 }, { 356000, 2.51 }, { 3550000, 2.50 }, { 3560000, 2.49 }, { 5000000, 2.48 }, { 8000000, 2.47 }, { 13000000, 2.46 }, { 18000000, 2.45 }, { 31000000, 2.44 }, { 41000000, 2.43 }, { 48000000, 2.42 }, { 119000000, 2.41 }, { 182000000, 2.40 }, { 192000000, 2.395 }, { 213000000, 2.390 }, { 271000000, 2.385 }, { 322000000, 2.380 }, { 400000000, 2.375 }, { 510000000, 2.370 }, { 682000000, 2.367 }, { UVCONST(2953652287), 2.362 } }; #define NUPPER_THRESH (sizeof(_upper_thresh)/sizeof(_upper_thresh[0])) UV prime_count_upper(UV n) { int i; long double fn, flogn, upper, a; if (n < 33000) return _XS_prime_count(2, n); fn = (long double) n; flogn = logl(n); for (i = 0; i < (int)NUPPER_THRESH; i++) if (n < _upper_thresh[i].thresh) break; if (i < (int)NUPPER_THRESH) a = _upper_thresh[i].aval; else a = 2.334; /* Dusart 2010, page 2 */ upper = fn/flogn * (1.0 + 1.0/flogn + a/(flogn*flogn)); return (UV) ceill(upper); } static const unsigned short primes_small[] = {0,2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97, 101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191, 193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283, 293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401, 409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499}; #define NPRIMES_SMALL (sizeof(primes_small)/sizeof(primes_small[0])) /* The nth prime will be less or equal to this number */ UV nth_prime_upper(UV n) { long double fn, flogn, flog2n, upper; if (n < NPRIMES_SMALL) return primes_small[n]; fn = (long double) n; flogn = logl(n); flog2n = logl(flogn); /* Note distinction between log_2(n) and log^2(n) */ if (n >= 688383) /* Dusart 2010 page 2 */ upper = fn * (flogn + flog2n - 1.0 + ((flog2n-2.00)/flogn)); else if (n >= 178974) /* Dusart 2010 page 7 */ upper = fn * (flogn + flog2n - 1.0 + ((flog2n-1.95)/flogn)); else if (n >= 39017) /* Dusart 1999 page 14 */ upper = fn * (flogn + flog2n - 0.9484); else if (n >= 6) /* Modified from Robin 1983 for 6-39016 _only_ */ upper = fn * ( flogn + 0.6000 * flog2n ); else upper = fn * ( flogn + flog2n ); /* For all three analytical functions, it is possible that for a given valid * input, we will not be able to return an output that fits in the UV type. * For example, if they ask for the 203280222nd prime, we should return * 4294967311. But in 32-bit, that overflows. What we do is calculate our * double precision value. If that would overflow, then we look at the input * and if it is <= the index of the last representable prime, then we return * the last representable prime. Otherwise, we croak an overflow message. * This should maintain the invariant: * nth_prime_lower(n) <= nth_prime(n) <= nth_prime_upper(n) */ /* Watch out for overflow */ if (upper >= (long double)UV_MAX) { if (n <= MPU_MAX_PRIME_IDX) return MPU_MAX_PRIME; croak("nth_prime_upper(%"UVuf") overflow", n); } return (UV) ceill(upper); } /* The nth prime will be greater than or equal to this number */ UV nth_prime_lower(UV n) { long double fn, flogn, flog2n, lower; if (n < NPRIMES_SMALL) return primes_small[n]; fn = (long double) n; flogn = logl(n); flog2n = logl(flogn); /* Note distinction between log_2(n) and log^2(n) */ /* Dusart 2010 page 2, for all n >= 3 */ lower = fn * (flogn + flog2n - 1.0 + ((flog2n-2.10)/flogn)); return (UV) floorl(lower); } UV nth_prime_approx(UV n) { long double fn, flogn, flog2n, approx, order; if (n < NPRIMES_SMALL) return primes_small[n]; fn = (long double) n; flogn = logl(n); flog2n = logl(flogn); /* Note distinction between log_2(n) and log^2(n) */ /* Cipolla 1902: * m=0 fn * ( flogn + flog2n - 1 ); * m=1 + ((flog2n - 2)/flogn) ); * m=2 - (((flog2n*flog2n) - 6*flog2n + 11) / (2*flogn*flogn)) * + O((flog2n/flogn)^3) */ approx = fn * ( flogn + flog2n - 1.0 + ((flog2n - 2.0) / flogn) - (((flog2n*flog2n) - 6.0*flog2n + 11.0) / (2*flogn*flogn)) ); /* Apply a correction */ order = flog2n / flogn; order = order * order * order * fn; if (n < 259) { approx += 10.4 * order; } else if (n < 775) { approx += 7.52 * order; } else if (n < 1271) { approx += 5.6 * order; } else if (n < 2000) { approx += 5.2 * order; } else if (n < 4000) { approx += 4.3 * order; } else if (n < 12000) { approx += 3.0 * order; } else if (n < 150000) { approx += 2.1 * order; } else if (n <200000000) { } else { approx += -0.01 * order; } /* -0.25 is closer */ return (UV) floorl(approx + 0.5); } UV nth_prime(UV n) { const unsigned char* cache_sieve; unsigned char* segment; UV upper_limit, segbase, segment_size; UV p = 0; UV target = n-3; UV count = 0; /* If very small, return the table entry */ if (n < NPRIMES_SMALL) return primes_small[n]; /* Determine a bound on the nth prime. We know it comes before this. */ upper_limit = nth_prime_upper(n); MPUassert(upper_limit > 0, "nth_prime got an upper limit of 0"); /* For relatively small values, generate a sieve and count the results. * * For larger values, compute an approximate low estimate, use our fast * prime count, then segment sieve forwards or backwards for the rest. */ if (upper_limit <= get_prime_cache(0, 0) || upper_limit <= 32*1024*30) { /* Generate a sieve and count. */ segment_size = get_prime_cache(upper_limit, &cache_sieve) / 30; /* Count up everything in the cached sieve. */ if (segment_size > 0) count += count_segment_maxcount(cache_sieve, 0, segment_size, target, &p); release_prime_cache(cache_sieve); } else { /* A binary search on RiemannR is nice, but ends up either often being * being higher (requiring going backwards) or biased and then far too * low. Using the inverse Li is easier and more consistent. */ UV lower_limit = _XS_Inverse_Li(n); /* For even better performance, add in half the usual correction, which * will get us even closer, so even less sieving required. However, it * is now possible to get a result higher than the value, so we'll need * to handle that case. It still ends up being a better deal than R, * given that we don't have a fast backward sieve. */ lower_limit += _XS_Inverse_Li(isqrt(n))/4; segment_size = lower_limit / 30; lower_limit = 30 * segment_size - 1; count = _XS_LMO_pi(lower_limit); /* printf("We've estimated %lu too %s.\n", (count>n)?count-n:n-count, (count>n)?"FAR":"little"); */ /* printf("Our limit %lu %s a prime\n", lower_limit, _XS_is_prime(lower_limit) ? "is" : "is not"); */ if (count >= n) { /* Too far. Walk backwards */ if (_XS_is_prime(lower_limit)) count--; for (p = 0; p <= (count-n); p++) lower_limit = prev_prime(lower_limit); return lower_limit; } count -= 3; /* Make sure the segment siever won't have to keep resieving. */ prime_precalc(isqrt(upper_limit)); } if (count == target) return p; /* Start segment sieving. Get memory to sieve into. */ segbase = segment_size; segment = get_prime_segment(&segment_size); while (count < target) { /* Limit the segment size if we know the answer comes earlier */ if ( (30*(segbase+segment_size)+29) > upper_limit ) segment_size = (upper_limit - segbase*30 + 30) / 30; /* Do the actual sieving in the range */ sieve_segment(segment, segbase, segbase + segment_size-1); /* Count up everything in this segment */ count += count_segment_maxcount(segment, 30*segbase, segment_size, target-count, &p); if (count < target) segbase += segment_size; } release_prime_segment(segment); MPUassert(count == target, "nth_prime got incorrect count"); return ( (segbase*30) + p ); } /* Return a char array with lo-hi+1 elements. mu[k-lo] = µ(k) for k = lo .. hi. * It is the callers responsibility to call Safefree on the result. */ #define PGTLO(p,lo) ((p) >= lo) ? (p) : ((p)*(lo/(p)) + ((lo%(p))?(p):0)) #define P2GTLO(pinit, p, lo) \ ((pinit) >= lo) ? (pinit) : ((p)*(lo/(p)) + ((lo%(p))?(p):0)) signed char* _moebius_range(UV lo, UV hi) { signed char* mu; UV i; UV sqrtn = isqrt(hi); /* Kuznetsov indicates that the Deléglise & Rivat (1996) method can be * modified to work on logs, which allows us to operate with no * intermediate memory at all. Same time as the D&R method, less memory. */ unsigned char logp; UV nextlog; Newz(0, mu, hi-lo+1, signed char); if (sqrtn*sqrtn != hi) sqrtn++; /* ceil sqrtn */ logp = 1; nextlog = 3; /* 2+1 */ START_DO_FOR_EACH_PRIME(2, sqrtn) { UV p2 = p*p; if (p > nextlog) { logp += 2; /* logp is 1 | ceil(log(p)/log(2)) */ nextlog = ((nextlog-1)*4)+1; } for (i = PGTLO(p, lo); i <= hi; i += p) mu[i-lo] += logp; for (i = PGTLO(p2, lo); i <= hi; i += p2) mu[i-lo] |= 0x80; } END_DO_FOR_EACH_PRIME logp = log2floor(lo); nextlog = 2UL << logp; for (i = lo; i <= hi; i++) { unsigned char a = mu[i-lo]; if (i >= nextlog) { logp++; nextlog *= 2; } /* logp is log(p)/log(2) */ if (a & 0x80) { a = 0; } else if (a >= logp) { a = 1 - 2*(a&1); } else { a = -1 + 2*(a&1); } mu[i-lo] = a; } if (lo == 0) mu[0] = 0; return mu; } UV* _totient_range(UV lo, UV hi) { UV* totients; UV i, seg_base, seg_low, seg_high; unsigned char* segment; void* ctx; if (hi < lo) croak("_totient_range error hi %"UVuf" < lo %"UVuf"\n", hi, lo); New(0, totients, hi-lo+1, UV); /* Do via factoring if very small or if we have a small range */ if (hi < 100 || hi/(hi-lo+1) > 1000) { for (i = lo; i <= hi; i++) totients[i-lo] = totient(i); return totients; } for (i = lo; i <= hi; i++) { UV v = i; if (i % 2 == 0) v -= v/2; if (i % 3 == 0) v -= v/3; if (i % 5 == 0) v -= v/5; totients[i-lo] = v; } ctx = start_segment_primes(7, hi/2, &segment); while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_low - seg_base, seg_high - seg_base ) { p += seg_base; for (i = P2GTLO(2*p,p,lo); i <= hi; i += p) totients[i-lo] -= totients[i-lo]/p; } END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); /* Fill in all primes */ for (i = lo | 1; i <= hi; i += 2) if (totients[i-lo] == i) totients[i-lo]--; return totients; } IV mertens(UV n) { /* See Deléglise and Rivat (1996) for O(n^2/3 log(log(n))^1/3) algorithm. * This implementation uses their lemma 2.1 directly, so is ~ O(n). * In serial it is quite a bit faster than segmented summation of mu * ranges, though the latter seems to be a favored method for GPUs. */ UV u, i, m, nmk, maxmu; signed char* mu; IV* M; IV sum; if (n <= 1) return n; u = isqrt(n); maxmu = (n/(u+1)); /* maxmu lets us handle u < sqrt(n) */ if (maxmu < u) maxmu = u; mu = _moebius_range(0, maxmu); New(0, M, maxmu+1, IV); M[0] = 0; for (i = 1; i <= maxmu; i++) M[i] = M[i-1] + mu[i]; sum = M[u]; for (m = 1; m <= u; m++) { if (mu[m] != 0) { IV inner_sum = 0; UV lower = (u/m) + 1; UV last_nmk = n/(m*lower); UV this_k = 0; UV next_k = n/(m*1); UV nmkm = m * 2; for (nmk = 1; nmk <= last_nmk; nmk++, nmkm += m) { this_k = next_k; next_k = n/nmkm; /* if (nmk > maxmu) croak("n = %lu m = %lu u/m = %lu n/m = %lu nmk %lu\n", n, m, u/m, n/m, nmk); */ inner_sum += M[nmk] * (this_k - next_k); } sum -= mu[m] * inner_sum; } } Safefree(M); Safefree(mu); return sum; } /* How many times does 2 divide n? */ #define padic2(n) ctz(n) #define IS_MOD8_3OR5(x) (((x)&7)==3 || ((x)&7)==5) static int kronecker_uu_sign(UV a, UV b, int s) { while (a) { int r = padic2(a); if (r) { if ((r&1) && IS_MOD8_3OR5(b)) s = -s; a >>= r; } if (a & b & 2) s = -s; { UV t = b % a; b = a; a = t; } } return (b == 1) ? s : 0; } int kronecker_uu(UV a, UV b) { int r, s; if (b & 1) return kronecker_uu_sign(a, b, 1); if (!(a&1)) return 0; s = 1; r = padic2(b); if (r) { if ((r&1) && IS_MOD8_3OR5(a)) s = -s; b >>= r; } return kronecker_uu_sign(a, b, s); } int kronecker_su(IV a, UV b) { int r, s; if (a >= 0) return kronecker_uu(a, b); if (b == 0) return (a == 1 || a == -1) ? 1 : 0; s = 1; r = padic2(b); if (r) { if (!(a&1)) return 0; if ((r&1) && IS_MOD8_3OR5(a)) s = -s; b >>= r; } a %= (IV) b; if (a < 0) a += b; return kronecker_uu_sign(a, b, s); } int kronecker_ss(IV a, IV b) { if (a >= 0 && b >= 0) return (b & 1) ? kronecker_uu_sign(a, b, 1) : kronecker_uu(a,b); if (b >= 0) return kronecker_su(a, b); return kronecker_su(a, -b) * ((a < 0) ? -1 : 1); } UV totient(UV n) { UV i, nfacs, totient, lastf, facs[MPU_MAX_FACTORS+1]; if (n <= 1) return n; nfacs = factor(n, facs); totient = 1; lastf = 0; for (i = 0; i < nfacs; i++) { UV f = facs[i]; if (f == lastf) { totient *= f; } else { totient *= f-1; lastf = f; } } return totient; } static const UV jordan_overflow[5] = #if BITS_PER_WORD == 64 {UVCONST(4294967311), 2642249, 65537, 7133, 1627}; #else {UVCONST( 65537), 1627, 257, 85, 41}; #endif UV jordan_totient(UV k, UV n) { UV factors[MPU_MAX_FACTORS+1]; int nfac, i; UV j, totient; if (k == 0 || n <= 1) return (n == 1); if (k > 6 || (k > 1 && n >= jordan_overflow[k-2])) return 0; totient = 1; nfac = factor(n,factors); for (i = 0; i < nfac; i++) { UV p = factors[i]; UV pk = p; for (j = 1; j < k; j++) pk *= p; totient *= (pk-1); while (i+1 < nfac && p == factors[i+1]) { i++; totient *= pk; } } return totient; } UV carmichael_lambda(UV n) { UV fac[MPU_MAX_FACTORS+1]; UV exp[MPU_MAX_FACTORS+1]; int i, nfactors; UV j, lambda = 1; if (n < 8) return totient(n); if ((n & (n-1)) == 0) return n >> 2; nfactors = factor_exp(n, fac, exp); if (fac[0] == 2 && exp[0] > 2) exp[0]--; for (i = 0; i < nfactors; i++) { UV pk = fac[i]-1; for (j = 1; j < exp[i]; j++) pk *= fac[i]; lambda = lcm_ui(lambda, pk); } return lambda; } int moebius(UV n) { UV factors[MPU_MAX_FACTORS+1]; UV i, nfactors; if (n <= 1) return (int)n; if ( n >= 49 && (!(n% 4) || !(n% 9) || !(n%25) || !(n%49)) ) return 0; nfactors = factor(n, factors); for (i = 1; i < nfactors; i++) if (factors[i] == factors[i-1]) return 0; return (nfactors % 2) ? -1 : 1; } UV exp_mangoldt(UV n) { if (n <= 1) return 1; else if ((n & (n-1)) == 0) return 2; /* Power of 2 */ else if ((n & 1) == 0) return 1; /* Even number (not 2) */ else { UV i, factors[MPU_MAX_FACTORS+1]; UV nfactors = factor(n, factors); for (i = 1; i < nfactors; i++) if (factors[i] != factors[0]) return 1; return factors[0]; } } UV znorder(UV a, UV n) { UV fac[MPU_MAX_FACTORS+1]; UV exp[MPU_MAX_FACTORS+1]; int i, nfactors; UV j, phi, k = 1; if (n <= 1) return n; /* znorder(x,0) = 0, znorder(x,1) = 1 */ if (a <= 1) return a; /* znorder(0,x) = 0, znorder(1,x) = 1 (x > 1) */ if (gcd_ui(a,n) > 1) return 0; /* Abhijit Das, algorithm 1.7, applied to Carmichael Lambda */ phi = carmichael_lambda(n); nfactors = factor_exp(phi, fac, exp); for (i = 0; i < nfactors; i++) { UV b, ek, pi = fac[i], ei = exp[i]; UV phidiv = phi / pi; for (j = 1; j < ei; j++) phidiv /= pi; b = powmod(a, phidiv, n); for (ek = 0; b != 1; b = powmod(b, pi, n)) { if (ek++ >= ei) return 0; k *= pi; } } return k; } UV znprimroot(UV n) { UV fac[MPU_MAX_FACTORS+1]; UV exp[MPU_MAX_FACTORS+1]; UV a, phi; int i, nfactors; if (n <= 4) return (n == 0) ? 0 : n-1; if (n % 4 == 0) return 0; phi = totient(n); /* Check if a primitive root exists. */ if (!is_prob_prime(n) && phi != carmichael_lambda(n)) return 0; nfactors = factor_exp(phi, fac, exp); for (i = 0; i < nfactors; i++) exp[i] = phi / fac[i]; /* exp[i] = phi(n) / i-th-factor-of-phi(n) */ for (a = 2; a < n; a++) { if (kronecker_uu(a, n) == 0) continue; for (i = 0; i < nfactors; i++) if (powmod(a, exp[i], n) == 1) break; if (i == nfactors) return a; } return 0; } /* Calculate 1/a mod p. From William Hart. */ UV modinverse(UV a, UV p) { IV u1 = 1, u3 = a; IV v1 = 0, v3 = p; IV t1 = 0, t3 = 0; IV quot; while (v3) { quot = u3 - v3; if (u3 < (v3<<2)) { if (quot < v3) { if (quot < 0) { t1 = u1; u1 = v1; v1 = t1; t3 = u3; u3 = v3; v3 = t3; } else { t1 = u1 - v1; u1 = v1; v1 = t1; t3 = u3 - v3; u3 = v3; v3 = t3; } } else if (quot < (v3<<1)) { t1 = u1 - (v1<<1); u1 = v1; v1 = t1; t3 = u3 - (v3<<1); u3 = v3; v3 = t3; } else { t1 = u1 - v1*3; u1 = v1; v1 = t1; t3 = u3 - v3*3; u3 = v3; v3 = t3; } } else { quot = u3 / v3; t1 = u1 - v1*quot; u1 = v1; v1 = t1; t3 = u3 - v3*quot; u3 = v3; v3 = t3; } } if (u1 < 0) u1 += p; return u1; } UV divmod(UV a, UV b, UV n) { /* a / b mod n */ UV binv = modinverse(b, n); if (binv == 0) return 0; return mulmod(a, binv, n); } /* Find smallest k where a = g^k mod p * This implementation is just a stupid placeholder. * When prho or bsgs starts working well, lower the trial limit */ #define DLP_TRIAL_NUM 1000000 UV znlog(UV a, UV g, UV p) { UV k; const int verbose = _XS_get_verbose(); if (a <= 1 || g == 0 || p < 2) return 0; k = dlp_trial(a, g, p, DLP_TRIAL_NUM); if (k != 0 || p <= DLP_TRIAL_NUM) return k; if (verbose) printf(" dlp trial failed. Trying prho\n"); k = dlp_prho(a, g, p, 1000000); if (k != 0) return k; if (verbose) printf(" dlp prho failed. Back to trial\n"); k = dlp_trial(a, g, p, p); return k; } long double chebyshev_function(UV n, int which) { long double logp, logn = logl(n); UV sqrtn = which ? isqrt(n) : 0; /* for theta, p <= sqrtn always false */ KAHAN_INIT(sum); if (n < primes_small[NPRIMES_SMALL-1]) { UV p, pi; for (pi = 1; (p = primes_small[pi]) <= n; pi++) { logp = logl(p); if (p <= sqrtn) logp *= floorl(logn/logp+1e-15); KAHAN_SUM(sum, logp); } } else { UV seg_base, seg_low, seg_high; unsigned char* segment; void* ctx; long double logl2 = logl(2); long double logl3 = logl(3); long double logl5 = logl(5); if (!which) { KAHAN_SUM(sum,logl2); KAHAN_SUM(sum,logl3); KAHAN_SUM(sum,logl5); } else { KAHAN_SUM(sum, logl2 * floorl(logn/logl2 + 1e-15)); KAHAN_SUM(sum, logl3 * floorl(logn/logl3 + 1e-15)); KAHAN_SUM(sum, logl5 * floorl(logn/logl5 + 1e-15)); } ctx = start_segment_primes(7, n, &segment); while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_low - seg_base, seg_high - seg_base ) { p += seg_base; logp = logl(p); if (p <= sqrtn) logp *= floorl(logn/logp+1e-15); KAHAN_SUM(sum, logp); } END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } return sum; } /* * See: * "Multiple-Precision Exponential Integral and Related Functions" * by David M. Smith * "On the Evaluation of the Complex-Valued Exponential Integral" * by Vincent Pegoraro and Philipp Slusallek * "Numerical Recipes" 3rd edition * by William H. Press et al. * "Rational Chevyshev Approximations for the Exponential Integral E_1(x)" * by W. J. Cody and Henry C. Thacher, Jr. * * Any mistakes here are completely my fault. This code has not been * verified for anything serious. For better results, see: * http://www.trnicely.net/pi/pix_0000.htm * which although the author claims are demonstration programs, will * undoubtedly produce more reliable results than this code does (I don't * know of any obvious issues with this code, but it just hasn't been used * by many people). */ static long double const euler_mascheroni = 0.57721566490153286060651209008240243104215933593992L; static long double const li2 = 1.045163780117492784844588889194613136522615578151L; long double _XS_ExponentialIntegral(long double x) { long double val, term; unsigned int n; KAHAN_INIT(sum); if (x == 0) croak("Invalid input to ExponentialIntegral: x must be != 0"); if (x < -1) { /* Continued fraction, good for x < -1 */ long double lc = 0; long double ld = 1.0L / (1.0L - (long double)x); val = ld * (-expl(x)); for (n = 1; n <= 100000; n++) { long double old, t, n2; t = (long double)(2*n + 1) - (long double) x; n2 = n * n; lc = 1.0L / (t - n2 * lc); ld = 1.0L / (t - n2 * ld); old = val; val *= ld/lc; if ( fabsl(val-old) <= LDBL_EPSILON*fabsl(val) ) break; } } else if (x < 0) { /* Rational Chebyshev approximation (Cody, Thacher), good for -1 < x < 0 */ static const long double C6p[7] = { -148151.02102575750838086L, 150260.59476436982420737L, 89904.972007457256553251L, 15924.175980637303639884L, 2150.0672908092918123209L, 116.69552669734461083368L, 5.0196785185439843791020L }; static const long double C6q[7] = { 256664.93484897117319268L, 184340.70063353677359298L, 52440.529172056355429883L, 8125.8035174768735759866L, 750.43163907103936624165L, 40.205465640027706061433L, 1.0000000000000000000000L }; long double sumn = C6p[0]-x*(C6p[1]-x*(C6p[2]-x*(C6p[3]-x*(C6p[4]-x*(C6p[5]-x*C6p[6]))))); long double sumd = C6q[0]-x*(C6q[1]-x*(C6q[2]-x*(C6q[3]-x*(C6q[4]-x*(C6q[5]-x*C6q[6]))))); val = logl(-x) - sumn/sumd; } else if (x < -logl(LDBL_EPSILON)) { /* Convergent series */ long double fact_n = x; for (n = 2; n <= 200; n++) { long double invn = 1.0L / n; fact_n *= (long double)x * invn; term = fact_n * invn; KAHAN_SUM(sum, term); /* printf("C after adding %.20Lf, val = %.20Lf\n", term, sum); */ if ( term < LDBL_EPSILON*sum) break; } KAHAN_SUM(sum, euler_mascheroni); KAHAN_SUM(sum, logl(x)); KAHAN_SUM(sum, x); val = sum; } else { /* Asymptotic divergent series */ long double invx = 1.0L / x; term = 1.0; for (n = 1; n <= 200; n++) { long double last_term = term; term = term * ( (long double)n * invx ); if (term < LDBL_EPSILON*sum) break; if (term < last_term) { KAHAN_SUM(sum, term); /* printf("A after adding %.20llf, sum = %.20llf\n", term, sum); */ } else { KAHAN_SUM(sum, (-last_term/3) ); /* printf("A after adding %.20llf, sum = %.20llf\n", -last_term/3, sum); */ break; } } term = expl(x) * invx; val = term * sum + term; } return val; } long double _XS_LogarithmicIntegral(long double x) { if (x == 0) return 0; if (x == 1) return -INFINITY; if (x == 2) return li2; if (x < 0) croak("Invalid input to LogarithmicIntegral: x must be >= 0"); return _XS_ExponentialIntegral(logl(x)); } /* Thanks to Kim Walisch for this idea */ UV _XS_Inverse_Li(UV x) { double nlogn = (double)x * log((double)x); UV lo = (UV) (nlogn); UV hi = (UV) (nlogn * 2 + 2); if (x == 0) return 0; if (hi <= lo) hi = UV_MAX; while (lo < hi) { UV mid = lo + (hi-lo)/2; if (_XS_LogarithmicIntegral(mid) < x) lo = mid+1; else hi = mid; } return lo; } /* * Storing the first 10-20 Zeta values makes sense. Past that it is purely * to avoid making the call to generate them ourselves. We could cache the * calculated values. These all have 1 subtracted from them. */ static const long double riemann_zeta_table[] = { 0.6449340668482264364724151666460251892L, /* zeta(2) */ 0.2020569031595942853997381615114499908L, 0.0823232337111381915160036965411679028L, 0.0369277551433699263313654864570341681L, 0.0173430619844491397145179297909205279L, 0.0083492773819228268397975498497967596L, 0.0040773561979443393786852385086524653L, 0.0020083928260822144178527692324120605L, 0.0009945751278180853371459589003190170L, 0.0004941886041194645587022825264699365L, 0.0002460865533080482986379980477396710L, 0.0001227133475784891467518365263573957L, 0.0000612481350587048292585451051353337L, 0.0000305882363070204935517285106450626L, 0.0000152822594086518717325714876367220L, 0.0000076371976378997622736002935630292L, /* zeta(17) Past here all we're */ 0.0000038172932649998398564616446219397L, /* zeta(18) getting is speed. */ 0.0000019082127165539389256569577951013L, 0.0000009539620338727961131520386834493L, 0.0000004769329867878064631167196043730L, 0.0000002384505027277329900036481867530L, 0.0000001192199259653110730677887188823L, 0.0000000596081890512594796124402079358L, 0.0000000298035035146522801860637050694L, 0.0000000149015548283650412346585066307L, 0.0000000074507117898354294919810041706L, 0.0000000037253340247884570548192040184L, 0.0000000018626597235130490064039099454L, 0.0000000009313274324196681828717647350L, 0.0000000004656629065033784072989233251L, 0.0000000002328311833676505492001455976L, 0.0000000001164155017270051977592973835L, 0.0000000000582077208790270088924368599L, 0.0000000000291038504449709968692942523L, 0.0000000000145519218910419842359296322L, 0.0000000000072759598350574810145208690L, 0.0000000000036379795473786511902372363L, 0.0000000000018189896503070659475848321L, 0.0000000000009094947840263889282533118L, 0.0000000000004547473783042154026799112L, 0.0000000000002273736845824652515226821L, 0.0000000000001136868407680227849349105L, 0.0000000000000568434198762758560927718L, 0.0000000000000284217097688930185545507L, 0.0000000000000142108548280316067698343L, 0.00000000000000710542739521085271287735L, 0.00000000000000355271369133711367329847L, 0.00000000000000177635684357912032747335L, 0.000000000000000888178421093081590309609L, 0.000000000000000444089210314381336419777L, 0.000000000000000222044605079804198399932L, 0.000000000000000111022302514106613372055L, 0.0000000000000000555111512484548124372374L, 0.0000000000000000277555756213612417258163L, 0.0000000000000000138777878097252327628391L, }; #define NPRECALC_ZETA (sizeof(riemann_zeta_table)/sizeof(riemann_zeta_table[0])) /* Riemann Zeta on the real line, with 1 subtracted. * Compare to Math::Cephes zetac. Also zeta with q=1 and subtracting 1. * * The Cephes zeta function uses a series (2k)!/B_2k which converges rapidly * and has a very wide range of values. We use it here for some values. * * Note: Calculations here are done on long doubles and we try to generate as * much accuracy as possible. They will get returned to Perl as an NV, * which is typically a 64-bit double with 15 digits. * * For values 0.5 to 5, this code uses the rational Chebyshev approximation * from Cody and Thacher. This method is extraordinarily fast and very * accurate over its range (slightly better than Cephes for most values). If * we had quad floats, we could use the 9-term polynomial. */ long double ld_riemann_zeta(long double x) { int i; if (x < 0) croak("Invalid input to RiemannZeta: x must be >= 0"); if (x == 1) return INFINITY; if (x == (unsigned int)x) { int k = x - 2; if ((k >= 0) && (k < (int)NPRECALC_ZETA)) return riemann_zeta_table[k]; } /* Cody / Thacher rational Chebyshev approximation for small values */ if (x >= 0.5 && x <= 5.0) { static const long double C8p[9] = { 1.287168121482446392809e10L, 1.375396932037025111825e10L, 5.106655918364406103683e09L, 8.561471002433314862469e08L, 7.483618124380232984824e07L, 4.860106585461882511535e06L, 2.739574990221406087728e05L, 4.631710843183427123061e03L, 5.787581004096660659109e01L }; static const long double C8q[9] = { 2.574336242964846244667e10L, 5.938165648679590160003e09L, 9.006330373261233439089e08L, 8.042536634283289888587e07L, 5.609711759541920062814e06L, 2.247431202899137523543e05L, 7.574578909341537560115e03L, -2.373835781373772623086e01L, 1.000000000000000000000L }; long double sumn = C8p[0]+x*(C8p[1]+x*(C8p[2]+x*(C8p[3]+x*(C8p[4]+x*(C8p[5]+x*(C8p[6]+x*(C8p[7]+x*C8p[8]))))))); long double sumd = C8q[0]+x*(C8q[1]+x*(C8q[2]+x*(C8q[3]+x*(C8q[4]+x*(C8q[5]+x*(C8q[6]+x*(C8q[7]+x*C8q[8]))))))); long double sum = (sumn - (x-1)*sumd) / ((x-1)*sumd); return sum; } if (x > 17000.0) return 0.0; #if 0 { KAHAN_INIT(sum); /* Simple defining series, works well. */ for (i = 5; i <= 1000000; i++) { long double term = powl(i, -x); KAHAN_SUM(sum, term); if (term < LDBL_EPSILON*sum) break; } KAHAN_SUM(sum, powl(4, -x) ); KAHAN_SUM(sum, powl(3, -x) ); KAHAN_SUM(sum, powl(2, -x) ); return sum; } #endif /* The 2n!/B_2k series used by the Cephes library. */ { /* gp/pari: factorial(2n)/bernfrac(2n) */ static const long double A[] = { 12.0L, -720.0L, 30240.0L, -1209600.0L, 47900160.0L, -1892437580.3183791606367583212735166426L, 74724249600.0L, -2950130727918.1642244954382084600497650L, 116467828143500.67248729113000661089202L, -4597978722407472.6105457273596737891657L, 181521054019435467.73425331153534235290L, -7166165256175667011.3346447367083352776L, 282908877253042996618.18640556532523927L, }; long double a, b, s, t; const long double w = 10.0; s = 0.0; b = 0.0; for (i = 2; i < 11; i++) { b = powl( i, -x ); s += b; if (fabsl(b) < fabsl(LDBL_EPSILON * s)) return s; } s = s + b*w/(x-1.0) - 0.5 * b; a = 1.0; for (i = 0; i < 13; i++) { long double k = 2*i; a *= x + k; b /= w; t = a*b/A[i]; s = s + t; if (fabsl(t) < fabsl(LDBL_EPSILON * s)) break; a *= x + k + 1.0; b /= w; } return s; } } long double _XS_RiemannR(long double x) { long double part_term, term, flogx; unsigned int k; KAHAN_INIT(sum); if (x <= 0) croak("Invalid input to ReimannR: x must be > 0"); KAHAN_SUM(sum, 1.0); flogx = logl(x); part_term = 1; for (k = 1; k <= 10000; k++) { part_term *= flogx / k; if (k-1 < NPRECALC_ZETA) term = part_term / (k+k*riemann_zeta_table[k-1]); else term = part_term / (k+k*ld_riemann_zeta(k+1)); KAHAN_SUM(sum, term); /* printf("R %5d after adding %.18Lg, sum = %.19Lg\n", k, term, sum); */ if (fabsl(term) < fabsl(LDBL_EPSILON*sum)) break; } return sum; } Math-Prime-Util-0.37/cpanfile0000644000076400007640000000101312270242116014415 0ustar danadanarequires 'ExtUtils::MakeMaker'; requires 'Exporter', '5.562'; requires 'XSLoader', '0.01'; requires 'Carp'; requires 'Tie::Array'; requires 'base'; requires 'constant'; requires 'Config'; requires 'Math::BigInt', '1.88'; requires 'Math::BigFloat', '1.59'; requires 'Bytes::Random::Secure', '0.23'; recommends 'Math::Prime::Util::GMP', '0.16'; recommends 'Math::BigInt::GMP'; recommends 'Math::MPFR', '2.03'; on test => sub { requires 'Test::More', '0.45'; requires 'bignum', '0.22'; recommends 'Test::Warn'; }; Math-Prime-Util-0.37/sieve.c0000644000076400007640000004502112270242116014177 0ustar danadana#include #include #include #include #define FUNC_next_prime_in_sieve #include "sieve.h" #include "ptypes.h" #include "cache.h" #define FUNC_isqrt 1 #include "util.h" #include "primality.h" /* If the base sieve is larger than this, presieve and test */ #define BASE_SIEVE_LIMIT 4000000 /* 1001 bytes of presieved mod-30 bytes. If the area to be sieved is * appropriately filled with this data, then 7, 11, and 13 do not have * to be sieved. It wraps, so multiple memcpy's can be used. Do be * aware that if you start at 0, you'll have to correct the first byte. */ #define PRESIEVE_SIZE (7*11*13) static const unsigned char presieve13[PRESIEVE_SIZE] = { 0x0e,0x20,0x10,0x81,0x49,0x24,0xc2,0x06,0x2a,0x90,0xa1,0x0c,0x14, 0x58,0x02,0x61,0x11,0xc3,0x28,0x0c,0x44,0x22,0xa4,0x10,0x91,0x18, 0x4d,0x40,0x82,0x21,0x58,0xa1,0x28,0x04,0x42,0x92,0x20,0x51,0x91, 0x8a,0x04,0x48,0x03,0x60,0x34,0x81,0x1c,0x06,0xc1,0x02,0xa2,0x10, 0x89,0x08,0x24,0x45,0x42,0x30,0x10,0xc5,0x0a,0x86,0x40,0x0a,0x30, 0x38,0x85,0x08,0x15,0x40,0x63,0x20,0x96,0x83,0x88,0x04,0x60,0x16, 0x28,0x10,0x81,0x49,0x44,0xe2,0x02,0x2c,0x12,0xa1,0x0c,0x04,0x50, 0x0a,0x61,0x10,0x83,0x48,0x2c,0x40,0x26,0x26,0x90,0x91,0x08,0x55, 0x48,0x82,0x20,0x19,0xc1,0x28,0x04,0x44,0x12,0xa0,0x51,0x81,0x9a, 0x0c,0x48,0x02,0x21,0x54,0xa1,0x18,0x04,0x43,0x82,0xa2,0x10,0x99, 0x08,0x24,0x44,0x03,0x70,0x30,0xc1,0x0c,0x86,0xc0,0x0a,0x20,0x30, 0x8d,0x08,0x14,0x41,0x43,0x20,0x92,0x85,0x0a,0x84,0x60,0x06,0x30, 0x18,0x81,0x49,0x05,0xc2,0x22,0x28,0x14,0xa3,0x8c,0x04,0x50,0x12, 0x69,0x10,0x83,0x09,0x4c,0x60,0x22,0x24,0x12,0x91,0x08,0x45,0x50, 0x8a,0x20,0x18,0x81,0x68,0x24,0x40,0x16,0x22,0xd1,0x81,0x8a,0x14, 0x48,0x02,0x20,0x15,0xc1,0x38,0x04,0x45,0x02,0xa2,0x10,0x89,0x18, 0x2c,0x44,0x02,0x31,0x50,0xe1,0x08,0x86,0x42,0x8a,0x20,0x30,0x95, 0x08,0x14,0x40,0x43,0x60,0xb2,0x81,0x0c,0x06,0xe0,0x06,0x20,0x10, 0x89,0x49,0x04,0xc3,0x42,0x28,0x10,0xa5,0x0e,0x84,0x50,0x02,0x71, 0x18,0x83,0x08,0x0d,0x40,0x22,0x24,0x14,0x93,0x88,0x45,0x40,0x92, 0x28,0x18,0x81,0x29,0x44,0x60,0x12,0x24,0x53,0x81,0x8a,0x04,0x58, 0x0a,0x20,0x14,0x81,0x58,0x24,0x41,0x06,0xa2,0x90,0x89,0x08,0x34, 0x4c,0x02,0x30,0x11,0xc1,0x28,0x86,0x44,0x0a,0xa0,0x30,0x85,0x18, 0x1c,0x40,0x43,0x21,0xd2,0xa1,0x08,0x04,0x62,0x86,0x20,0x10,0x91, 0x49,0x04,0xc2,0x03,0x68,0x30,0xa1,0x0c,0x06,0xd0,0x02,0x61,0x10, 0x8b,0x08,0x0c,0x41,0x62,0x24,0x10,0x95,0x0a,0xc5,0x40,0x82,0x30, 0x18,0x81,0x28,0x05,0x40,0x32,0x20,0x55,0x83,0x8a,0x04,0x48,0x12, 0x28,0x14,0x81,0x19,0x44,0x61,0x02,0xa6,0x12,0x89,0x08,0x24,0x54, 0x0a,0x30,0x10,0xc1,0x48,0xa6,0x40,0x0e,0x22,0xb0,0x85,0x08,0x14, 0x48,0x43,0x20,0x93,0xc1,0x28,0x04,0x64,0x06,0xa0,0x10,0x81,0x59, 0x0c,0xc2,0x02,0x29,0x50,0xa1,0x0c,0x04,0x52,0x82,0x61,0x10,0x93, 0x08,0x0c,0x40,0x23,0x64,0x30,0x91,0x0c,0x47,0xc0,0x82,0x20,0x18, 0x89,0x28,0x04,0x41,0x52,0x20,0x51,0x85,0x8a,0x84,0x48,0x02,0x30, 0x1c,0x81,0x18,0x05,0x41,0x22,0xa2,0x14,0x8b,0x88,0x24,0x44,0x12, 0x38,0x10,0xc1,0x09,0xc6,0x60,0x0a,0x24,0x32,0x85,0x08,0x14,0x50, 0x4b,0x20,0x92,0x81,0x48,0x24,0x60,0x06,0x22,0x90,0x81,0x49,0x14, 0xca,0x02,0x28,0x11,0xe1,0x2c,0x04,0x54,0x02,0xe1,0x10,0x83,0x18, 0x0c,0x40,0x22,0x25,0x50,0xb1,0x08,0x45,0x42,0x82,0x20,0x18,0x91, 0x28,0x04,0x40,0x13,0x60,0x71,0x81,0x8e,0x06,0xc8,0x02,0x20,0x14, 0x89,0x18,0x04,0x41,0x42,0xa2,0x10,0x8d,0x0a,0xa4,0x44,0x02,0x30, 0x18,0xc1,0x08,0x87,0x40,0x2a,0x20,0x34,0x87,0x88,0x14,0x40,0x53, 0x28,0x92,0x81,0x09,0x44,0x60,0x06,0x24,0x12,0x81,0x49,0x04,0xd2, 0x0a,0x28,0x10,0xa1,0x4c,0x24,0x50,0x06,0x63,0x90,0x83,0x08,0x1c, 0x48,0x22,0x24,0x11,0xd1,0x28,0x45,0x44,0x82,0xa0,0x18,0x81,0x38, 0x0c,0x40,0x12,0x21,0x51,0xa1,0x8a,0x04,0x4a,0x82,0x20,0x14,0x91, 0x18,0x04,0x41,0x03,0xe2,0x30,0x89,0x0c,0x26,0xc4,0x02,0x30,0x10, 0xc9,0x08,0x86,0x41,0x4a,0x20,0x30,0x85,0x0a,0x94,0x40,0x43,0x30, 0x9a,0x81,0x08,0x05,0x60,0x26,0x20,0x14,0x83,0xc9,0x04,0xc2,0x12, 0x28,0x10,0xa1,0x0d,0x44,0x70,0x02,0x65,0x12,0x83,0x08,0x0c,0x50, 0x2a,0x24,0x10,0x91,0x48,0x65,0x40,0x86,0x22,0x98,0x81,0x28,0x14, 0x48,0x12,0x20,0x51,0xc1,0xaa,0x04,0x4c,0x02,0xa0,0x14,0x81,0x18, 0x0c,0x41,0x02,0xa3,0x50,0xa9,0x08,0x24,0x46,0x82,0x30,0x10,0xd1, 0x08,0x86,0x40,0x0b,0x60,0x30,0x85,0x0c,0x16,0xc0,0x43,0x20,0x92, 0x89,0x08,0x04,0x61,0x46,0x20,0x10,0x85,0x4b,0x84,0xc2,0x02,0x38, 0x18,0xa1,0x0c,0x05,0x50,0x22,0x61,0x14,0x83,0x88,0x0c,0x40,0x32, 0x2c,0x10,0x91,0x09,0x45,0x60,0x82,0x24,0x1a,0x81,0x28,0x04,0x50, 0x1a,0x20,0x51,0x81,0xca,0x24,0x48,0x06,0x22,0x94,0x81,0x18,0x14, 0x49,0x02,0xa2,0x11,0xc9,0x28,0x24,0x44,0x02,0xb0,0x10,0xc1,0x18, 0x8e,0x40,0x0a,0x21,0x70,0xa5,0x08,0x14,0x42,0xc3,0x20,0x92,0x91, 0x08,0x04,0x60,0x07,0x60,0x30,0x81,0x4d,0x06,0xc2,0x02,0x28,0x10, 0xa9,0x0c,0x04,0x51,0x42,0x61,0x10,0x87,0x0a,0x8c,0x40,0x22,0x34, 0x18,0x91,0x08,0x45,0x40,0xa2,0x20,0x1c,0x83,0xa8,0x04,0x40,0x12, 0x28,0x51,0x81,0x8b,0x44,0x68,0x02,0x24,0x16,0x81,0x18,0x04,0x51, 0x0a,0xa2,0x10,0x89,0x48,0x24,0x44,0x06,0x32,0x90,0xc1,0x08,0x96, 0x48,0x0a,0x20,0x31,0xc5,0x28,0x14,0x44,0x43,0xa0,0x92,0x81,0x18, 0x0c,0x60,0x06,0x21,0x50,0xa1,0x49,0x04,0xc2,0x82,0x28,0x10,0xb1, 0x0c,0x04,0x50,0x03,0x61,0x30,0x83,0x0c,0x0e,0xc0,0x22,0x24,0x10, 0x99,0x08,0x45,0x41,0xc2,0x20,0x18,0x85,0x2a,0x84,0x40,0x12,0x30, 0x59,0x81,0x8a,0x05,0x48,0x22,0x20,0x14,0x83,0x98,0x04,0x41,0x12, 0xaa,0x10,0x89,0x09,0x64,0x64,0x02,0x34,0x12,0xc1,0x08,0x86,0x50, 0x0a,0x20,0x30,0x85,0x48,0x34,0x40,0x47,0x22,0x92,0x81,0x08,0x14, 0x68,0x06,0x20,0x11,0xc1,0x69,0x04,0xc6,0x02,0xa8,0x10,0xa1,0x1c, 0x0c,0x50,0x02,0x61,0x50,0xa3,0x08,0x0c,0x42,0xa2,0x24,0x10,0x91, 0x08,0x45,0x40,0x83,0x60,0x38,0x81,0x2c,0x06,0xc0,0x12,0x20,0x51, 0x89,0x8a,0x04,0x49,0x42,0x20,0x14,0x85,0x1a,0x84,0x41,0x02,0xb2, 0x18,0x89,0x08,0x25,0x44,0x22,0x30,0x14,0xc3,0x88,0x86,0x40,0x1a, 0x28,0x30,0x85,0x09,0x54,0x60,0x43,0x24,0x92,0x81,0x08,0x04,0x70}; static const unsigned char stepdata[8][8][8] = { { {96,65,34,67,36,69,102,47}, {64,47,75,106,46,105,77,44}, {32,86,33,87,115,45,114,84}, {72,46,85,42,73,127,44,123}, {96,35,100,79,33,66,37,78}, {64,108,34,109,67,47,65,46}, {32,76,117,33,118,74,35,87}, {32,127,86,45,84,43,82,121}, }, { {65,34,67,36,69,102,47,96}, {105,77,44,64,47,75,106,46}, {33,87,115,45,114,84,32,86}, {73,127,44,123,72,46,85,42}, {33,66,37,78,96,35,100,79}, {65,46,64,108,34,109,67,47}, {33,118,74,35,87,32,76,117}, {121,32,127,86,45,84,43,82}, }, { {34,67,36,69,102,47,96,65}, {106,46,105,77,44,64,47,75}, {114,84,32,86,33,87,115,45}, {42,73,127,44,123,72,46,85}, {66,37,78,96,35,100,79,33}, {34,109,67,47,65,46,64,108}, {74,35,87,32,76,117,33,118}, {82,121,32,127,86,45,84,43}, }, { {67,36,69,102,47,96,65,34}, {75,106,46,105,77,44,64,47}, {115,45,114,84,32,86,33,87}, {123,72,46,85,42,73,127,44}, {35,100,79,33,66,37,78,96}, {67,47,65,46,64,108,34,109}, {35,87,32,76,117,33,118,74}, {43,82,121,32,127,86,45,84}, }, { {36,69,102,47,96,65,34,67}, {44,64,47,75,106,46,105,77}, {84,32,86,33,87,115,45,114}, {44,123,72,46,85,42,73,127}, {100,79,33,66,37,78,96,35}, {108,34,109,67,47,65,46,64}, {76,117,33,118,74,35,87,32}, {84,43,82,121,32,127,86,45}, }, { {69,102,47,96,65,34,67,36}, {77,44,64,47,75,106,46,105}, {45,114,84,32,86,33,87,115}, {85,42,73,127,44,123,72,46}, {37,78,96,35,100,79,33,66}, {109,67,47,65,46,64,108,34}, {117,33,118,74,35,87,32,76}, {45,84,43,82,121,32,127,86}, }, { {102,47,96,65,34,67,36,69}, {46,105,77,44,64,47,75,106}, {86,33,87,115,45,114,84,32}, {46,85,42,73,127,44,123,72}, {78,96,35,100,79,33,66,37}, {46,64,108,34,109,67,47,65}, {118,74,35,87,32,76,117,33}, {86,45,84,43,82,121,32,127}, }, { {47,96,65,34,67,36,69,102}, {47,75,106,46,105,77,44,64}, {87,115,45,114,84,32,86,33}, {127,44,123,72,46,85,42,73}, {79,33,66,37,78,96,35,100}, {47,65,46,64,108,34,109,67}, {87,32,76,117,33,118,74,35}, {127,86,45,84,43,82,121,32}, }, }; static const int wheelmap[30] = {0,0,0,0,0,0,0,1,0,0,0,2,0,3,0,0,0,4,0,5,0,0,0,6,0,0,0,0,0,7}; static const int wheel2xmap[30] = /* (2*p)%30 => 2,14,22,26,4,8,16,28 */ {0,0,0,0,4,0,0,0,5,0,0,0,0,0,1,0,6,0,0,0,0,0,2,0,0,0,3,0,7,0}; /* 2 4 8 14 16 22 26 28 (2*p)%30 */ #define FIND_COMPOSITE_POSITIONS(d, m, p) \ do { \ int v; \ UV dinc = (2*p) / 30; \ UV minc = (2*p) - dinc*30; \ const unsigned char* steps = stepdata [wheelmap[m]] [wheel2xmap[minc]]; \ v = steps[0]; wdinc[0] = dinc*(v>>5)+((v>>3)&0x3); wmask[0] = 1<<(v&0x7); \ v = steps[1]; wdinc[1] = dinc*(v>>5)+((v>>3)&0x3); wmask[1] = 1<<(v&0x7); \ v = steps[2]; wdinc[2] = dinc*(v>>5)+((v>>3)&0x3); wmask[2] = 1<<(v&0x7); \ v = steps[3]; wdinc[3] = dinc*(v>>5)+((v>>3)&0x3); wmask[3] = 1<<(v&0x7); \ v = steps[4]; wdinc[4] = dinc*(v>>5)+((v>>3)&0x3); wmask[4] = 1<<(v&0x7); \ v = steps[5]; wdinc[5] = dinc*(v>>5)+((v>>3)&0x3); wmask[5] = 1<<(v&0x7); \ v = steps[6]; wdinc[6] = dinc*(v>>5)+((v>>3)&0x3); wmask[6] = 1<<(v&0x7); \ v = steps[7]; wdinc[7] = dinc*(v>>5)+((v>>3)&0x3); wmask[7] = 1<<(v&0x7); \ } while (0) static const UV max_sieve_prime = (BITS_PER_WORD==64) ? 4294967291U : 65521U; static void memtile(unsigned char* src, UV from, UV to) { while (from < to) { UV bytes = (2*from > to) ? to-from : from; memcpy(src+from, src, bytes); from += bytes; } } static UV sieve_prefill(unsigned char* mem, UV startd, UV endd) { UV vnext_prime = 17; UV nbytes = endd - startd + 1; MPUassert( (mem != 0) && (endd >= startd), "sieve_prefill bad arguments"); if (startd != 0) { UV pstartd = startd % PRESIEVE_SIZE; UV tailbytes = PRESIEVE_SIZE - pstartd; if (tailbytes > nbytes) tailbytes = nbytes; memcpy(mem, presieve13 + pstartd, tailbytes); /* Copy tail to mem */ mem += tailbytes; /* Advance so mem points at the beginning */ nbytes -= tailbytes; } if (nbytes > 0) { memcpy(mem, presieve13, (nbytes < PRESIEVE_SIZE) ? nbytes : PRESIEVE_SIZE); memtile(mem, PRESIEVE_SIZE, nbytes); if (startd == 0) mem[0] = 0x01; /* Correct first byte */ } /* Leaving option open to tile 17 out and sieve, then return 19 */ return vnext_prime; } /* Wheel 30 sieve. Ideas from Terje Mathisen and Quesada / Van Pelt. */ unsigned char* sieve_erat30(UV end) { unsigned char* mem; UV max_buf, limit, prime; max_buf = (end/30) + ((end%30) != 0); /* Round up to a word */ max_buf = ((max_buf + sizeof(UV) - 1) / sizeof(UV)) * sizeof(UV); New(0, mem, max_buf, unsigned char ); /* Fill buffer with marked 7, 11, and 13 */ prime = sieve_prefill(mem, 0, max_buf-1); limit = isqrt(end); /* prime*prime can overflow */ for ( ; prime <= limit; prime = next_prime_in_sieve(mem,prime,end)) { UV p2 = prime*prime; UV d = p2 / 30; UV m = p2 - d*30; UV wdinc[8]; unsigned char wmask[8]; /* Find the positions of the next composites we will mark */ FIND_COMPOSITE_POSITIONS(d, m, prime); #if 0 assert(d == ((prime*prime)/30)); assert(d < max_buf); assert(prime = (wdinc[0]+wdinc[1]+wdinc[2]+wdinc[3]+wdinc[4]+wdinc[5]+wdinc[6]+wdinc[7])); #endif /* Regular code to mark composites: * i = 0; * do {mem[d] |= wmask[i]; d += wdinc[i]; i = (i+1)&7;} while (d < max_buf); * Unrolled version: */ while ( (d+prime) < max_buf ) { mem[d] |= wmask[0]; d += wdinc[0]; mem[d] |= wmask[1]; d += wdinc[1]; mem[d] |= wmask[2]; d += wdinc[2]; mem[d] |= wmask[3]; d += wdinc[3]; mem[d] |= wmask[4]; d += wdinc[4]; mem[d] |= wmask[5]; d += wdinc[5]; mem[d] |= wmask[6]; d += wdinc[6]; mem[d] |= wmask[7]; d += wdinc[7]; } while (1) { mem[d] |= wmask[0]; d += wdinc[0]; if (d >= max_buf) break; mem[d] |= wmask[1]; d += wdinc[1]; if (d >= max_buf) break; mem[d] |= wmask[2]; d += wdinc[2]; if (d >= max_buf) break; mem[d] |= wmask[3]; d += wdinc[3]; if (d >= max_buf) break; mem[d] |= wmask[4]; d += wdinc[4]; if (d >= max_buf) break; mem[d] |= wmask[5]; d += wdinc[5]; if (d >= max_buf) break; mem[d] |= wmask[6]; d += wdinc[6]; if (d >= max_buf) break; mem[d] |= wmask[7]; d += wdinc[7]; if (d >= max_buf) break; } } return mem; } int sieve_segment(unsigned char* mem, UV startd, UV endd) { const unsigned char* sieve; UV limit, slimit, start_base_prime, sieve_size; UV startp = 30*startd; UV endp = (endd >= (UV_MAX/30)) ? UV_MAX-2 : 30*endd+29; MPUassert( (mem != 0) && (endd >= startd) && (endp >= startp), "sieve_segment bad arguments"); /* It's possible we can just use the primary cache */ sieve_size = get_prime_cache(0, &sieve); if (sieve_size >= endp) { memcpy(mem, sieve+startd, endd-startd+1); release_prime_cache(sieve); return 1; } /* Fill buffer with marked 7, 11, and 13 */ start_base_prime = sieve_prefill(mem, startd, endd); limit = isqrt(endp); /* floor(sqrt(n)), will include p if p*p=endp */ /* Don't use a sieve prime such that p*p > UV_MAX */ if (limit > max_sieve_prime) limit = max_sieve_prime; slimit = limit; if (slimit > BASE_SIEVE_LIMIT) slimit = BASE_SIEVE_LIMIT; /* printf("segment sieve from %"UVuf" to %"UVuf" (aux sieve to %"UVuf")\n", startp, endp, slimit); */ if (slimit > sieve_size) { release_prime_cache(sieve); get_prime_cache(slimit, &sieve); } START_DO_FOR_EACH_SIEVE_PRIME(sieve, start_base_prime, slimit) { /* p increments from 17 to at most sqrt(endp). Note on overflow: * 32-bit: limit= 65535, max p = 65521, p*p = ~0-1965854 * 64-bit: limit=4294967295, max p = 4294967291, p*p = ~0-42949672934 * No overflow here, but possible after the incrementing below. */ UV p2 = p*p; if (p2 < startp) { UV f = 1+(startp-1)/p; p2 = p * (f + distancewheel30[f%30]); } /* It is possible we've overflowed p2, so check for that */ if ( (p2 <= endp) && (p2 >= startp) ) { /* Sieve from startd to endd starting at p2, stepping p */ #if 0 /* Basic sieve */ do { mem[(p2 - startp)/30] |= masktab30[p2%30]; do { p2 += 2*p; } while (masktab30[p2%30] == 0); } while ( (p2 <= endp) && (p2 >= startp) ); #else UV d = p2 / 30; UV m = p2 - d*30; if ((p2 + 2*p) > endp) { /* There is only one composite to be marked in this segment */ mem[d-startd] |= masktab30[m]; } else { UV wdinc[8]; unsigned char wmask[8]; UV offset_endd = endd - startd; UV unrolls = (endd-d+1) / p; /* Find the positions of the next composites we will mark */ FIND_COMPOSITE_POSITIONS(d, m, p); d -= startd; /* Unrolled inner loop for marking composites */ while ( unrolls-- > 0) { mem[d] |= wmask[0]; d += wdinc[0]; mem[d] |= wmask[1]; d += wdinc[1]; mem[d] |= wmask[2]; d += wdinc[2]; mem[d] |= wmask[3]; d += wdinc[3]; mem[d] |= wmask[4]; d += wdinc[4]; mem[d] |= wmask[5]; d += wdinc[5]; mem[d] |= wmask[6]; d += wdinc[6]; mem[d] |= wmask[7]; d += wdinc[7]; } while (d <= offset_endd) { mem[d] |= wmask[0]; d += wdinc[0]; if (d > offset_endd) break; mem[d] |= wmask[1]; d += wdinc[1]; if (d > offset_endd) break; mem[d] |= wmask[2]; d += wdinc[2]; if (d > offset_endd) break; mem[d] |= wmask[3]; d += wdinc[3]; if (d > offset_endd) break; mem[d] |= wmask[4]; d += wdinc[4]; if (d > offset_endd) break; mem[d] |= wmask[5]; d += wdinc[5]; if (d > offset_endd) break; mem[d] |= wmask[6]; d += wdinc[6]; if (d > offset_endd) break; mem[d] |= wmask[7]; d += wdinc[7]; } } #endif } } END_DO_FOR_EACH_SIEVE_PRIME; release_prime_cache(sieve); if (limit > slimit) { /* We've sieved out most composites, but not all. */ START_DO_FOR_EACH_SIEVE_PRIME(mem, 0, endp-startp) { if (!_XS_BPSW(startp + p)) /* If the candidate is not prime, */ mem[d_] |= mask_; /* mark the sieve location. */ } END_DO_FOR_EACH_SIEVE_PRIME; } return 1; } /**************************************************************************/ typedef struct { UV lod; UV hid; UV low; UV high; UV endp; UV segment_size; unsigned char* segment; unsigned char* base; } segment_context_t; /* * unsigned char* segment; * UV seg_base, seg_low, seg_high; * void* ctx = start_segment_primes(low, high, &segment); * while (beg < 7) { * beg = (beg <= 2) ? 2 : (beg <= 3) ? 3 : 5; * .... with beg .... * beg += 1 + (beg > 2); * } * while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { * START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_low - seg_base, seg_high - seg_base ) * .... with seg_base + p .... * END_DO_FOR_EACH_SIEVE_PRIME * } * end_segment_primes(ctx); */ void* start_segment_primes(UV low, UV high, unsigned char** segmentmem) { segment_context_t* ctx; UV slimit; MPUassert( high >= low, "start_segment_primes bad arguments"); New(0, ctx, 1, segment_context_t); ctx->low = low; ctx->high = high; ctx->lod = low / 30; ctx->hid = high / 30; ctx->endp = (ctx->hid >= (UV_MAX/30)) ? UV_MAX-2 : 30*ctx->hid+29; ctx->segment = get_prime_segment( &(ctx->segment_size) ); *segmentmem = ctx->segment; ctx->base = 0; /* Expand primary cache so we won't regen each call */ slimit = isqrt(ctx->endp)+1; if (slimit > BASE_SIEVE_LIMIT) slimit = BASE_SIEVE_LIMIT; get_prime_cache( slimit, 0); return (void*) ctx; } int next_segment_primes(void* vctx, UV* base, UV* low, UV* high) { UV seghigh_d, range_d; segment_context_t* ctx = (segment_context_t*) vctx; if (ctx->lod > ctx->hid) return 0; seghigh_d = ((ctx->hid - ctx->lod) < ctx->segment_size) ? ctx->hid : (ctx->lod + ctx->segment_size - 1); range_d = seghigh_d - ctx->lod + 1; *low = ctx->low; *high = (seghigh_d == ctx->hid) ? ctx->high : (seghigh_d*30 + 29); *base = ctx->lod * 30; MPUassert( seghigh_d >= ctx->lod, "next_segment_primes: highd < lowd"); MPUassert( range_d <= ctx->segment_size, "next_segment_primes: range > segment size"); sieve_segment(ctx->segment, ctx->lod, seghigh_d); ctx->lod += range_d; ctx->low = *high + 2; return 1; } void end_segment_primes(void* vctx) { segment_context_t* ctx = (segment_context_t*) vctx; MPUassert(ctx != 0, "end_segment_primes given a null pointer"); if (ctx->segment != 0) { release_prime_segment(ctx->segment); ctx->segment = 0; } if (ctx->base != 0) { Safefree(ctx->base); ctx->base = 0; } Safefree(ctx); } Math-Prime-Util-0.37/cache.h0000644000076400007640000000272212270624726014150 0ustar danadana#ifndef MPU_CACHE_H #define MPU_CACHE_H #include "EXTERN.h" #include "perl.h" /* Sieve from 0 to x and store in primary cache */ extern void prime_precalc(UV x); /* Release all extra memory -- go back to initial amounts */ extern void prime_memfree(void); /* Seriously shut everything down, including destroying mutexes. * This should ONLY be called when we're leaving for good. */ extern void _prime_memfreeall(void); /* Get the primary cache (mod-30 wheel sieve). * Try to make sure it contains n. * Returns the maximum value in the cache. * Sets sieve* to the cache, unless given 0. * If you get a pointer back, you MUST call release when you're done. * * Ex: just give me the current size: * UV cache_size = get_prime_cache(0, 0); * * Ex: give me the current cache and size: * UV cache_size = get_prime_cache(0, &sieve); * * Ex: give me the cache at least size n: * UV cache_size = get_prime_cache(n, &sieve); */ extern UV get_prime_cache(UV n, const unsigned char** sieve); /* Inform the system we're done using the primary cache if we got a ptr. */ #ifdef USE_ITHREADS extern void release_prime_cache(const unsigned char* sieve); #else #define release_prime_cache(mem) #endif /* Get the segment cache. Set size to its size. */ extern unsigned char* get_prime_segment(UV* size); /* Inform the system we're done using the segment cache. */ extern void release_prime_segment(unsigned char* segment); #endif Math-Prime-Util-0.37/lmo.h0000644000076400007640000000020312270242116013651 0ustar danadana#ifndef MPU_LMO_H #define MPU_LMO_H #include "ptypes.h" extern UV _XS_LMO_pi(UV n); extern UV legendre_phi(UV n, UV a); #endif Math-Prime-Util-0.37/t/0000755000076400007640000000000012271163661013171 5ustar danadanaMath-Prime-Util-0.37/t/14-nthprime.t0000644000076400007640000001037012270011421015410 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/primes nth_prime nth_prime_lower nth_prime_upper nth_prime_approx/; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $broken64 = (18446744073709550592 == ~0); my $nsmallprimes = 1000; my $nth_small_prime = 7919; # nth_prime(1000) my %pivals32 = ( 1 => 0, 10 => 4, 100 => 25, 1000 => 168, 10000 => 1229, 100000 => 9592, 1000000 => 78498, ); # Powers of 10: http://oeis.org/A006988/b006988.txt # Powers of 2: http://oeis.org/A033844/b033844.txt my %nthprimes32 = ( 1 => 2, 10 => 29, 100 => 541, 1000 => 7919, 10000 => 104729, 100000 => 1299709, 1000000 => 15485863, 10000000 => 179424673, 100000000 => 2038074743, # Some values that estimate right around the value 6305537 => 110040379, 6305538 => 110040383, 6305539 => 110040391, 6305540 => 110040407, 6305541 => 110040467, 6305542 => 110040499, 6305543 => 110040503, ); my %nthprimes64 = ( 1000000000 => 22801763489, 10000000000 => 252097800623, 100000000000 => 2760727302517, 1000000000000 => 29996224275833, 10000000000000 => 323780508946331, 100000000000000 => 3475385758524527, 1000000000000000 => 37124508045065437, 10000000000000000 => 394906913903735329, 100000000000000000 => 4185296581467695669, ); my %nthprimes_small = map { $_ => $nthprimes32{$_} } grep { ($_ <= 10_000_000) || $extra } keys %nthprimes32; my @small_primes = (0, @{primes($nth_small_prime)}); plan tests => 0 + 2*scalar(keys %pivals32) + 1 + 3*scalar(keys %nthprimes32) + scalar(keys %nthprimes_small) + $use64 * 3 * scalar(keys %nthprimes64) + 3 + (($extra && $use64 && $usexs) ? 1 : 0); while (my($n, $pin) = each (%pivals32)) { my $next = $pin+1; cmp_ok( nth_prime($pin), '<=', $n, "nth_prime($pin) <= $n"); cmp_ok( nth_prime($next), '>=', $n, "nth_prime($next) >= $n"); } { my @nth_primes = map { nth_prime($_) } (0 .. $#small_primes); is_deeply( \@nth_primes, \@small_primes, "nth_prime for primes 0 .. $#small_primes" ); } while (my($n, $nth) = each (%nthprimes32)) { cmp_ok( nth_prime_upper($n), '>=', $nth, "nth_prime($n) <= upper estimate" ); cmp_ok( nth_prime_lower($n), '<=', $nth, "nth_prime($n) >= lower estimate" ); my $approx = nth_prime_approx($n); my $percent_limit = ($n >= 775) ? 1 : 2; cmp_ok( abs($nth - $approx) / $nth, '<=', $percent_limit/100.0, "nth_prime_approx($n) = $approx within $percent_limit\% of $nth"); } while (my($n, $nth) = each (%nthprimes_small)) { is( nth_prime($n), $nth, "nth_prime($n) = $nth" ); } if ($use64) { while (my($n, $nth) = each (%nthprimes64)) { cmp_ok( nth_prime_upper($n), '>=', $nth, "nth_prime($n) <= upper estimate" ); cmp_ok( nth_prime_lower($n), '<=', $nth, "nth_prime($n) >= lower estimate" ); my $approx = nth_prime_approx($n); my $percent_limit = 0.001; cmp_ok( abs($nth - $approx) / $nth, '<=', $percent_limit/100.0, "nth_prime_approx($n) = $approx within $percent_limit\% of $nth"); } } my $maxindex = $use64 ? '425656284035217743' : '203280221'; my $maxindexp1 = $use64 ? '425656284035217744' : '203280222'; my $maxprime = $use64 ? '18446744073709551557' : '4294967291'; cmp_ok( nth_prime_lower($maxindex), '<=', $maxprime, "nth_prime_lower(maxindex) <= maxprime"); cmp_ok( nth_prime_upper($maxindex), '>=', $maxprime, "nth_prime_upper(maxindex) >= maxprime"); cmp_ok( nth_prime_lower($maxindexp1), '>=', nth_prime_lower($maxindex), "nth_prime_lower(maxindex+1) >= nth_prime_lower(maxindex)"); my $overindex = ($broken64) ? 425656284035217843 : $maxindexp1; if ($extra && $use64 && $usexs) { # Test an nth prime value that uses the binary-search-on-R(n) algorithm is( nth_prime(21234567890), 551990503367, "nth_prime(21234567890)" ); } Math-Prime-Util-0.37/t/22-aks-prime.t0000644000076400007640000000373612266152412015474 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_aks_prime/; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $ispp = !Math::Prime::Util::prime_get_config->{xs}; plan tests => 6 # range + 1 # small number + 2 # medium numbers + 1*$extra + 0; ok(!eval { is_aks_prime(undef); }, "is_prime(undef)"); ok( is_aks_prime(2), '2 is prime'); ok(!is_aks_prime(1), '1 is not prime'); ok(!is_aks_prime(0), '0 is not prime'); ok(!is_aks_prime(-1), '-1 is not prime'); ok(!is_aks_prime(-2), '-2 is not prime'); # Simple number (cought by sqrt test) is( is_aks_prime(877), 1, "is_aks_prime(877) is true" ); # Perhaps let them know this is probably not a hung test? # This runs in milliseconds on an i3930K, but 1.5 minutes on an UltraSPARC. # These are the smallest numbers that actually run the code, so I don't know # how to make them run any faster. On the 32-bit UltraSPARC, it's the mulmod # that is painfully slow. #diag "Unfortunately these tests are very slow."; SKIP: { # If we're pure Perl, then this is definitely too slow. # Arguably we should check to see if they have the GMP code. skip "Skipping PP AKS on PP -- just too slow.", 1 if $ispp; # If we have 64-bit available in the compiler (e.g. uint64_t), this can # still be quite fast. However for pretty much everyone else, this is # just far too slow for running in a test suite. skip "Skipping PP AKS on 32-bit -- just too slow.", 1 if !$use64; # The first number that makes it past the sqrt test to actually run. is( is_aks_prime(69197), 1, "is_aks_prime(69197) is true" ); } # A small composite that runs the real primality test. is( is_aks_prime(69199), 0, "is_aks_prime(69199) is false" ); if ($extra) { # A composite (product of two 5-digit primes) is( is_aks_prime(1262952907), 0, "is_aks_prime(1262952907) is false" ); } Math-Prime-Util-0.37/t/03-init.t0000644000076400007640000000527412270242116014541 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/prime_precalc prime_memfree prime_get_config/; use Test::More tests => 3 + 3 + 3 + 6; my $bigsize = 10_000_000; # This is still a slightly dubious assumption, that the precalc size _must_ # go up when we request it. can_ok( 'Math::Prime::Util', 'prime_get_config' ); my $diag = "Using " . ((Math::Prime::Util::prime_get_config->{xs}) ? "XS" : "PP") . ((Math::Prime::Util::prime_get_config->{gmp}) ? " with MPU::GMP version $Math::Prime::Util::GMP::VERSION." : ".") . "\n"; diag $diag; my $init_size = prime_get_config->{'precalc_to'}; prime_precalc($bigsize); cmp_ok( prime_get_config->{'precalc_to'}, '>', $init_size, "Internal space grew after large precalc" ); prime_memfree; is( prime_get_config->{'precalc_to'}, $init_size, "Internal space went back to original size after memfree" ); # Now do the object way. { #my $mf = new_ok( 'Math::Prime::Util::MemFree'); # Better 0.88+ way my $mf = Math::Prime::Util::MemFree->new; isa_ok $mf, 'Math::Prime::Util::MemFree'; prime_precalc($bigsize); cmp_ok( prime_get_config->{'precalc_to'}, '>', $init_size, "Internal space grew after large precalc" ); } is( prime_get_config->{'precalc_to'}, $init_size, "Memory released after MemFree object goes out of scope"); # Wrap multiple calls, make sure we wait until the last one is done. { my $mf = Math::Prime::Util::MemFree->new; prime_precalc($bigsize); cmp_ok( prime_get_config->{'precalc_to'}, '>', $init_size, "Internal space grew after large precalc" ); { my $mf2 = Math::Prime::Util::MemFree->new; prime_precalc( 2 * $bigsize ); } cmp_ok( prime_get_config->{'precalc_to'}, '>', $init_size, "Memory not freed yet because a MemFree object still live." ); } is( prime_get_config->{'precalc_to'}, $init_size, "Memory released after last MemFree object goes out of scope"); # Show how an eval death can leak eval { prime_precalc($bigsize); cmp_ok( prime_get_config->{'precalc_to'}, '>', $init_size, "Internal space grew after large precalc" ); prime_memfree; }; is( prime_get_config->{'precalc_to'}, $init_size, "Memory freed after successful eval"); eval { prime_precalc($bigsize); cmp_ok( prime_get_config->{'precalc_to'}, '>', $init_size, "Internal space grew after large precalc" ); die; prime_memfree; }; isnt( prime_get_config->{'precalc_to'}, $init_size, "Memory normally not freed after eval die"); prime_memfree; eval { my $mf = Math::Prime::Util::MemFree->new; prime_precalc($bigsize); cmp_ok( prime_get_config->{'precalc_to'}, '>', $init_size, "Internal space grew after large precalc" ); die; }; is( prime_get_config->{'precalc_to'}, $init_size, "Memory is freed after eval die using object scoper"); Math-Prime-Util-0.37/t/32-iterators.t0000644000076400007640000002602312270242116015607 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/primes prev_prime next_prime forprimes forcomposites fordivisors prime_iterator prime_iterator_object/; use Math::BigInt try => "GMP,Pari"; use Math::BigFloat; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; my $broken64 = (18446744073709550592 == ~0); plan tests => 8 # forprimes errors + 12 + 6 # forprimes simple + 3 # forcomposites simple + 2 # fordivisors simple + 3 # iterator errors + 7 # iterator simple + 2 # forprimes/iterator nesting + 2 # forprimes BigInt/BigFloat + 3 # oo iterator errors + 7 # oo iterator simple + 25 # oo iterator methods + 0; ok(!eval { forprimes { 1 } undef; }, "forprimes undef"); ok(!eval { forprimes { 1 } 2, undef; }, "forprimes 2,undef"); ok(!eval { forprimes { 1 } undef, 2; }, "forprimes 2,undef"); # This is caught at compile type because of the prototype #ok(!eval { forprimes { 1 } 2, 3, 4; }, "forprimes 2,3,4"); ok(!eval { forprimes { 1 } -2, 3; }, "forprimes -2,3"); ok(!eval { forprimes { 1 } 2, -3; }, "forprimes 2,-3"); ok(!eval { forprimes { 1 } "abc"; }, "forprimes abc"); ok(!eval { forprimes { 1 } 2, "abc"; }, "forprimes 2, abc"); ok(!eval { forprimes { 1 } 5.6; }, "forprimes abc"); {my @t; forprimes {push @t,$_} 1; is_deeply( [@t], [], "forprimes 1" ); } {my @t; forprimes {push @t,$_} 2; is_deeply( [@t], [2], "forprimes 3" ); } {my @t; forprimes {push @t,$_} 3; is_deeply( [@t], [2,3], "forprimes 3" ); } {my @t; forprimes {push @t,$_} 4; is_deeply( [@t], [2,3], "forprimes 4" ); } {my @t; forprimes {push @t,$_} 5; is_deeply( [@t], [2,3,5], "forprimes 5" ); } {my @t; forprimes {push @t,$_} 3,5; is_deeply( [@t], [3,5], "forprimes 3,5" ); } {my @t; forprimes {push @t,$_} 3,6; is_deeply( [@t], [3,5], "forprimes 3,6" ); } {my @t; forprimes {push @t,$_} 3,7; is_deeply( [@t], [3,5,7], "forprimes 3,7" ); } {my @t; forprimes {push @t,$_} 5,7; is_deeply( [@t], [5,7], "forprimes 5,7" ); } {my @t; forprimes {push @t,$_} 6,7; is_deeply( [@t], [7], "forprimes 6,7" ); } {my @t; forprimes {push @t,$_} 5,11; is_deeply( [@t], [5,7,11], "forprimes 5,11" ); } {my @t; forprimes {push @t,$_} 7,11; is_deeply( [@t], [7,11], "forprimes 7,11" ); } { my @t; forprimes { push @t, $_ } 50; is_deeply( [@t], [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47], "forprimes 50" ); } { my @t; forprimes { push @t, $_ } 2,20; is_deeply( [@t], [2,3,5,7,11,13,17,19], "forprimes 2,20" ); } { my @t; forprimes { push @t, $_ } 20,30; is_deeply( [@t], [23,29], "forprimes 20,30" ); } { my @t; forprimes { push @t, $_ } 199, 223; is_deeply( [@t], [199,211,223], "forprimes 199,223" ); } { my @t; forprimes { push @t, $_ } 31398, 31468; is_deeply( [@t], [], "forprimes 31398,31468 (empty region)" ); } { my @t; forprimes { push @t, $_ } 2147483647,2147483659; is_deeply( [@t], [2147483647,2147483659], "forprimes 2147483647,2147483659" ); } { my @t; forcomposites { push @t, $_ } 2147483647,2147483659; is_deeply( [@t], [qw/2147483648 2147483649 2147483650 2147483651 2147483652 2147483653 2147483654 2147483655 2147483656 2147483657 2147483658/], "forcomposites 2147483647,2147483659" ); } { my @t; forcomposites { push @t, $_ } 50; is_deeply( [@t], [qw/4 6 8 9 10 12 14 15 16 18 20 21 22 24 25 26 27 28 30 32 33 34 35 36 38 39 40 42 44 45 46 48 49 50/], "forcomposites 50" ); } { my @t; forcomposites { push @t, $_ } 200,410; is_deeply( [@t], [qw/200 201 202 203 204 205 206 207 208 209 210 212 213 214 215 216 217 218 219 220 221 222 224 225 226 228 230 231 232 234 235 236 237 238 240 242 243 244 245 246 247 248 249 250 252 253 254 255 256 258 259 260 261 262 264 265 266 267 268 270 272 273 274 275 276 278 279 280 282 284 285 286 287 288 289 290 291 292 294 295 296 297 298 299 300 301 302 303 304 305 306 308 309 310 312 314 315 316 318 319 320 321 322 323 324 325 326 327 328 329 330 332 333 334 335 336 338 339 340 341 342 343 344 345 346 348 350 351 352 354 355 356 357 358 360 361 362 363 364 365 366 368 369 370 371 372 374 375 376 377 378 380 381 382 384 385 386 387 388 390 391 392 393 394 395 396 398 399 400 402 403 404 405 406 407 408 410/], "forcomposites 200,410" ); } { my $a = 0; fordivisors { $a += $_ + $_*$_ } 54321; is($a, 3287796520, "fordivisors: d|54321: a+=d+d^2"); # Matches Math::Pari: # my $a = PARI(0); my $j; fordiv(54321,$j,sub { $a += $j + $j**2 }); } { # Pari: v=List(); for(n=1, 50, fordiv(n, d, listput(v, d))); Vec(v) my @A027750 = (1,1,2,1,3,1,2,4,1,5,1,2,3,6,1,7,1,2,4,8,1,3,9,1,2,5,10,1,11,1,2,3,4,6,12,1,13,1,2,7,14,1,3,5,15,1,2,4,8,16,1,17,1,2,3,6,9,18,1,19,1,2,4,5,10,20,1,3,7,21,1,2,11,22,1,23,1,2,3,4,6,8,12,24,1,5,25,1,2,13,26,1,3,9,27,1,2,4,7,14,28,1,29,1,2,3,5,6,10,15,30,1,31,1,2,4,8,16,32,1,3,11,33,1,2,17,34,1,5,7,35,1,2,3,4,6,9,12,18,36,1,37,1,2,19,38,1,3,13,39,1,2,4,5,8,10,20,40,1,41,1,2,3,6,7,14,21,42,1,43,1,2,4,11,22,44,1,3,5,9,15,45,1,2,23,46,1,47,1,2,3,4,6,8,12,16,24,48,1,7,49,1,2,5,10,25,50); my @a; do { fordivisors { push @a, $_ } $_ } for 1..50; is_deeply(\@a, \@A027750, "A027750 using fordivisors"); } ok(!eval { prime_iterator(-2); }, "iterator -2"); ok(!eval { prime_iterator("abc"); }, "iterator abc"); ok(!eval { prime_iterator(4.5); }, "iterator 4.5"); { my $it = prime_iterator(); is_deeply( [map { $it->() } 1..10], [2,3,5,7,11,13,17,19,23,29], "iterator first 10 primes" ); } {my $it = prime_iterator(47); is_deeply( [map { $it->() } 1..5], [47,53,59,61,67], "iterator 5 primes starting at 47" ); } {my $it = prime_iterator(199); is_deeply( [map { $it->() } 1..3], [199,211,223], "iterator 3 primes starting at 199" ); } {my $it = prime_iterator(200); is_deeply( [map { $it->() } 1..3], [211,223,227], "iterator 3 primes starting at 200" ); } {my $it = prime_iterator(31397); is_deeply( [map { $it->() } 1..3], [31397,31469,31477], "iterator 3 primes starting at 31397" ); } {my $it = prime_iterator(31396); is_deeply( [map { $it->() } 1..3], [31397,31469,31477], "iterator 3 primes starting at 31396" ); } {my $it = prime_iterator(31398); is_deeply( [map { $it->() } 1..3], [31469,31477,31481], "iterator 3 primes starting at 31398" ); } # For fun, nest them. { my @t; forprimes { forprimes { forprimes { push @t, $_ } $_,$_+10; } 10*$_,10*$_+10; } 10; is_deeply( [@t], [qw/23 29 31 29 31 37 31 37 41 37 41 43 47 53 59 61 59 61 67 71 73 79 73 79 83 79 83 89/], "triple nested forprimes" ); } { my @t; my $ita = prime_iterator(); while ((my $a = $ita->()) <= 10) { my $itb = prime_iterator(10*$a); while ((my $b = $itb->()) <= 10*$a+10) { my $itc = prime_iterator($b); while ((my $c = $itc->()) <= $b+10) { push @t, $c; } } } is_deeply( [@t], [qw/23 29 31 29 31 37 31 37 41 37 41 43 47 53 59 61 59 61 67 71 73 79 73 79 83 79 83 89/], "triple nested iterator" ); } # With BigInt and BigFloat objects { my @t; forprimes { push @t, $_ } Math::BigInt->new("5"), Math::BigInt->new("11"); is_deeply( [@t], [5,7,11], "forprimes with BigInt range" ); } { my @t; forprimes { push @t, $_ } Math::BigFloat->new("5"), Math::BigFloat->new("11"); is_deeply( [@t], [5,7,11], "forprimes with BigFloat range" ); } # Test new object iterator ok(!eval { prime_iterator_object(-2); }, "iterator -2"); ok(!eval { prime_iterator_object("abc"); }, "iterator abc"); ok(!eval { prime_iterator_object(4.5); }, "iterator 4.5"); { my $it = prime_iterator_object(); is_deeply( [map { $it->iterate() } 1..10], [2,3,5,7,11,13,17,19,23,29], "iterator first 10 primes" ); } {my $it = prime_iterator_object(47); is_deeply( [map { $it->iterate() } 1..5], [47,53,59,61,67], "iterator 5 primes starting at 47" ); } {my $it = prime_iterator_object(199); is_deeply( [map { $it->iterate() } 1..3], [199,211,223], "iterator 3 primes starting at 199" ); } {my $it = prime_iterator_object(200); is_deeply( [map { $it->iterate() } 1..3], [211,223,227], "iterator 3 primes starting at 200" ); } {my $it = prime_iterator_object(31397); is_deeply( [map { $it->iterate() } 1..3], [31397,31469,31477], "iterator 3 primes starting at 31397" ); } {my $it = prime_iterator_object(31396); is_deeply( [map { $it->iterate() } 1..3], [31397,31469,31477], "iterator 3 primes starting at 31396" ); } {my $it = prime_iterator_object(31398); is_deeply( [map { $it->iterate() } 1..3], [31469,31477,31481], "iterator 3 primes starting at 31398" ); } { my $it = prime_iterator_object; do { $it->next } for 1..10; is( $it->value(), 31, "iterator object moved forward 10 now returns 31"); $it->prev; is( $it->value(), 29, "iterator object moved back now returns 29"); is( $it->iterate(), 29, "iterator object iterates to 29"); is( $it->iterate(), 31, "iterator object iterates to 31"); $it->rewind->next->next->next->prev; is( $it->value(), 5, "iterator object rewind and move returns 5"); # Validate that it automatically handles bigint range traversal. SKIP: { skip "Skipping bigint traversals on a Perl that can't add correctly",5 if $broken64; my $top_prime = prev_prime(~0); my $big_prime = next_prime(Math::BigInt->new(''.~0)); ok( $big_prime > ~0, "internal check, next_prime on big int works"); $it->rewind($top_prime); is( $it->value(), $top_prime, "iterator object can rewind to $top_prime"); $it->next; is( $it->value(), $big_prime, "iterator object next is $big_prime"); $it->rewind(~0); is( $it->value(), $big_prime, "iterator object rewound to ~0 is $big_prime"); $it->prev; is( $it->value(), $top_prime, "iterator object prev goes back to $top_prime"); } # Validation for the Math::NumSeq compatiblity stuff $it->rewind; do { $it->next } for 1..200; is( $it->tell_i(), 201, "iterator object tell_i"); is( $it->i_start, 1, "iterator object i_start = 1"); like( $it->description, qr/prime numbers/, "iterator object description"); is( $it->values_min, 2, "iterator object values_min = 2"); is( $it->values_max, undef, "iterator object values_max = undef"); # missing: characteristic is( $it->oeis_anum, "A000040", "iterator object oeis_anum = A000040"); # missing: parameter_info_array / parameter_info_list is( $it->seek_to_i(156)->value, 911, "iterator object seek_to_i goes to nth prime"); is( $it->seek_to_value(156)->value, 157, "iterator object seek_to_value goes to value"); is( $it->ith(589), 4289, "iterator object ith returns nth prime"); ok( $it->pred(577), "iterator object pred returns true if is_prime"); is( $it->value_to_i(4289), 589, "iterator object value_to_i works"); is( $it->value_to_i(4290), undef, "iterator object value_to_i for non-prime returns undef"); is( $it->value_to_i_floor(4290), 589, "iterator object value_to_i_floor"); is( $it->value_to_i_ceil(4290), 590, "iterator object value_to_i_ceil"); my $est = $it->value_to_i_estimate( 4171510507 ); my $act = 197710788; # We will get an estimate that is much, much closer than Math::NumSeq ok( ($est > ($act-500)) && ($est < ($act+500)), "iterator object value_to_i_estimage is in range"); } Math-Prime-Util-0.37/t/16-randomprime.t0000644000076400007640000001576212270242116016122 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; #use Math::Random::MT qw/rand/; #use Math::Random::MT::Auto qw/rand/; #sub rand { return 0.5; } use Math::Prime::Util qw/random_prime random_ndigit_prime random_nbit_prime random_maurer_prime random_proven_prime is_prime prime_set_config/; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; my $broken64 = (18446744073709550592 == ~0); my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $maxbits = $use64 ? 64 : 32; my @random_to = (2, 3, 4, 5, 6, 7, 8, 9, 100, 1000, 1000000, 4294967295); my @random_nbit_tests = ( 2 .. 6, 10, 15 .. 17, 28, 32 ); push @random_nbit_tests, (34) if $use64; @random_nbit_tests = (2 .. $maxbits) if $extra; my @random_ndigit_tests = (1 .. ($use64 ? 20 : 10)); if ($use64 && $broken64) { diag "Skipping some tests with broken 64-bit Perl\n"; @random_ndigit_tests = grep { $_ < 10 } @random_ndigit_tests; @random_nbit_tests = grep { $_ < 50 } @random_nbit_tests; } my %ranges = ( "2 to 20" => [2,19], "3 to 7" => [3,7], "20 to 100" => [23,97], "5678 to 9876" => [5683,9871], "27767 to 88493" => [27767,88493], "27764 to 88498" => [27767,88493], "27764 to 88493" => [27767,88493], "27767 to 88498" => [27767,88493], "17051687 to 17051899" => [17051687,17051899], "17051688 to 17051898" => [17051707,17051887], ); my %range_edge = ( "0 to 2" => [2,2], "2 to 2" => [2,2], "2 to 3" => [2,3], "3 to 5" => [3,5], "10 to 20" => [11,19], "8 to 12" => [11,11], "10 to 12" => [11,11], "16706143 to 16706143" => [16706143,16706143], "16706142 to 16706144" => [16706143,16706143], "3842610773 to 3842611109" => [3842610773,3842611109], "3842610772 to 3842611110" => [3842610773,3842611109], ); my %range_edge_empty = ( "0 to 0" => [], "0 to 1" => [], "2 to 1" => [], "3 to 2" => [], "1294268492 to 1294268778" => [], "3842610774 to 3842611108" => [], ); plan tests => 13+3+3+3 + (1 * scalar (keys %range_edge_empty)) + (3 * scalar (keys %range_edge)) + (2 * scalar (keys %ranges)) + (2 * scalar @random_to) + (1 * scalar @random_ndigit_tests) + (3 * scalar @random_nbit_tests) + 2 + 4 + 0; my $infinity = 20**20**20; my $nrandom_range_samples = $extra ? 1000 : 50; ok(!eval { random_prime(undef); }, "random_prime(undef)"); ok(!eval { random_prime(-3); }, "random_prime(-3)"); ok(!eval { random_prime("a"); }, "random_prime(a)"); ok(!eval { random_prime(undef,undef); }, "random_prime(undef,undef)"); ok(!eval { random_prime(2,undef); }, "random_prime(2,undef)"); ok(!eval { random_prime(2,"a"); }, "random_prime(2,a)"); ok(!eval { random_prime(undef,0); }, "random_prime(undef,0)"); ok(!eval { random_prime(0,undef); }, "random_prime(0,undef)"); ok(!eval { random_prime(2,undef); }, "random_prime(2,undef)"); ok(!eval { random_prime(2,-4); }, "random_prime(2,-4)"); ok(!eval { random_prime(2,$infinity); }, "random_prime(2,+infinity)"); ok(!eval { random_prime($infinity); }, "random_prime(+infinity)"); ok(!eval { random_prime(-$infinity); }, "random_prime(-infinity)"); ok(!eval { random_ndigit_prime(undef); }, "random_ndigit_prime(undef)"); ok(!eval { random_ndigit_prime(0); }, "random_ndigit_prime(0)"); ok(!eval { random_ndigit_prime(-5); }, "random_ndigit_prime(-5)"); ok(!eval { random_nbit_prime(undef); }, "random_nbit_prime(undef)"); ok(!eval { random_nbit_prime(0); }, "random_nbit_prime(0)"); ok(!eval { random_nbit_prime(-5); }, "random_nbit_prime(-5)"); ok(!eval { random_maurer_prime(undef); }, "random_maurer_prime(undef)"); ok(!eval { random_maurer_prime(0); }, "random_maurer_prime(0)"); ok(!eval { random_maurer_prime(-5); }, "random_maurer_prime(-5)"); while (my($range, $expect) = each (%range_edge_empty)) { my($low,$high) = $range =~ /(\d+) to (\d+)/; is( random_prime($low,$high), undef, "primes($low,$high) should return undef" ); } while (my($range, $expect) = each (%range_edge)) { my($low,$high) = $range =~ /(\d+) to (\d+)/; my $got = random_prime($low,$high); ok( is_prime($got), "Prime in range $low-$high is indeed prime" ); cmp_ok( $got, '>=', $expect->[0], "random_prime($low,$high) >= $expect->[0]"); cmp_ok( $got, '<=', $expect->[1], "random_prime($low,$high) >= $expect->[1]"); } while (my($range, $expect) = each (%ranges)) { my($low,$high) = $range =~ /(\d+) to (\d+)/; my $isprime = 1; my $inrange = 1; for (1 .. $nrandom_range_samples) { my $got = random_prime($low,$high); $isprime *= is_prime($got) ? 1 : 0; $inrange *= (($got >= $expect->[0]) && ($got <= $expect->[1])) ? 1 : 0; } ok($isprime, "All returned values for $low-$high were prime" ); ok($inrange, "All returned values for $low-$high were in the range" ); } # We want to test the no-bigint stuff here. This makes calls for 10-digit # (32-bit) and 20-digit (64-bit) random primes stay inside native range. prime_set_config(nobigint=>1); foreach my $high (@random_to) { my $isprime = 1; my $inrange = 1; for (1 .. $nrandom_range_samples) { my $got = random_prime($high); $isprime *= is_prime($got) ? 1 : 0; $inrange *= (($got >= 2) && ($got <= $high)) ? 1 : 0; } ok($isprime, "All returned values for $high were prime" ); ok($inrange, "All returned values for $high were in the range" ); } foreach my $digits ( @random_ndigit_tests ) { my $n = random_ndigit_prime($digits); ok ( length($n) == $digits && is_prime($n), "$digits-digit random prime is in range and prime"); } foreach my $bits ( @random_nbit_tests ) { check_bits( random_nbit_prime($bits), $bits, "nbit" ); check_bits( random_maurer_prime($bits), $bits, "Maurer" ); check_bits( random_proven_prime($bits), $bits, "proven" ); } sub check_bits { my($n, $bits, $what) = @_; my $min = 1 << ($bits-1); my $max = ~0 >> ($maxbits - $bits); $max = Math::BigInt->new("$max") if ref($n) eq 'Math::BigInt'; ok ( $n >= $min && $n <= $max && is_prime($n), "$bits-bit random $what prime is in range and prime"); } prime_set_config(nobigint=>0); # Now check with custom irand { my $seed = 2389743; sub mysrand { $seed = $_[0]; } #sub irand { $seed = (1103515245*$seed + 12345) % 4294967296; } sub irand { $seed = ( 16807 * $seed ) % 2147483647; } prime_set_config( irand => \&irand ); } is( random_nbit_prime(20), 771283, "random 20-bit prime with custom irand" ); is( random_ndigit_prime(9), 980824987, "random 9-digit with custom irand" ); { my $n = random_nbit_prime(80); is( ref($n), 'Math::BigInt', "random 80-bit prime returns a BigInt" ); ok( $n >= Math::BigInt->new(2)->bpow(79) && $n <= Math::BigInt->new(2)->bpow(80), "random 80-bit prime is in range" ); } SKIP: { skip "Skipping 30-digit random prime with broken 64-bit Perl", 2 if $broken64; my $n = random_ndigit_prime(30); is( ref($n), 'Math::BigInt', "random 30-digit prime returns a BigInt" ); ok( $n >= Math::BigInt->new(10)->bpow(29) && $n <= Math::BigInt->new(10)->bpow(30), "random 30-digit prime is in range" ); } Math-Prime-Util-0.37/t/93-release-spelling.t0000644000076400007640000000147212266152412017042 0ustar danadana#!/usr/bin/env perl use strict; use warnings; BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } #--------------------------------------------------------------------- use Test::More; eval "use Test::Spellunker"; plan skip_all => "Test::Spellunker required for testing POD spelling" if $@; add_stopwords(qw/bigint bigints bignum bignums pseudoprime pseudoprimes primorial primorials semiprime semiprimes precalculated premultiplier benchmarking hardcoded online unoptimized unusably coprime summatory RiemannR pp/); all_pod_files_spelling_ok(); Math-Prime-Util-0.37/t/02-can.t0000644000076400007640000000276112270242116014334 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util; use Test::More tests => 1; my @functions = qw( prime_get_config prime_set_config prime_precalc prime_memfree is_prime is_prob_prime is_provable_prime is_provable_prime_with_cert prime_certificate verify_prime is_pseudoprime is_strong_pseudoprime is_lucas_pseudoprime is_strong_lucas_pseudoprime is_extra_strong_lucas_pseudoprime is_almost_extra_strong_lucas_pseudoprime is_frobenius_underwood_pseudoprime is_aks_prime miller_rabin miller_rabin_random lucas_sequence primes forprimes forcomposites fordivisors prime_iterator prime_iterator_object next_prime prev_prime prime_count prime_count_lower prime_count_upper prime_count_approx nth_prime nth_prime_lower nth_prime_upper nth_prime_approx random_prime random_ndigit_prime random_nbit_prime random_strong_prime random_proven_prime random_proven_prime_with_cert random_maurer_prime random_maurer_prime_with_cert primorial pn_primorial consecutive_integer_lcm gcd lcm factor factor_exp all_factors divisors moebius mertens euler_phi jordan_totient exp_mangoldt liouville partitions chebyshev_theta chebyshev_psi divisor_sum carmichael_lambda kronecker znorder znprimroot legendre_phi ExponentialIntegral LogarithmicIntegral RiemannZeta RiemannR ); can_ok( 'Math::Prime::Util', @functions); Math-Prime-Util-0.37/t/30-relations.t0000644000076400007640000000177612266152412015605 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/primes nth_prime nth_prime_lower nth_prime_upper nth_prime_approx prime_count prime_count_lower prime_count_upper prime_count_approx next_prime prev_prime /; my @trials = qw/1 2 3 4 5 6 7 17 57 89 102 1337 8573 84763 784357 1000001 2573622/; plan tests => 5 * scalar @trials; my $last = 0; foreach my $n (@trials) { is( prime_count($n), scalar @{primes($n)}, "Prime count and scalar primes agree for $n" ); is( prime_count($n) - prime_count($last), scalar @{primes( $last+1, $n )}, "scalar primes($last+1,$n) = prime_count($n) - prime_count($last)" ); is( prime_count(nth_prime($n)), $n, "Pi(pn)) = n for $n"); is( nth_prime(prime_count($n)+1), next_prime($n), "p(Pi(n)+1) = next_prime(n) for $n" ); is( nth_prime(prime_count($n)), prev_prime($n+1), "p(Pi(n)) = prev_prime(n) for $n" ); $last = $n; } Math-Prime-Util-0.37/t/24-partitions.t0000644000076400007640000000303412266152412015771 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/partitions/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my @parts = qw/ 1 1 2 3 5 7 11 15 22 30 42 56 77 101 135 176 231 297 385 490 627 792 1002 1255 1575 1958 2436 3010 3718 4565 5604 6842 8349 10143 12310 14883 17977 21637 26015 31185 37338 44583 53174 63261 75175 89134 105558 124754 147273 173525 204226 /; my %bparts = ( 101 => "214481126", 256 => "365749566870782", 501 => "2431070104309287327876", 1001 => "25032297938763929621013218349796", 2347 => "56751384003004060684283391440819878903446789803099", 4128 => "13036233928924552978434294180871407270098426394166677221003078079504", #9988 => "31043825285346179203111322344702502691204288916782299617140664920755263693739998376431336412511604846065386", #13337 => "4841449229081281114351180373774137636239639013054790559544724995314398354517477085116206336008004971541987422037760634642695", #37373 => "885240148270777711759915557428752066370785294706979437063536090533501018735098279767013023483349639513395622225840616033227700794918506274833787569446519667398089943122156454986205555766363295867812094833219935", ); if (!$extra) { my @ns = grep { $_ > 300 } keys %bparts; foreach my $n (@ns) { delete $bparts{$n} } } plan tests => scalar(@parts) + scalar(keys(%bparts)); foreach my $n (0..$#parts) { is( partitions($n), $parts[$n], "partitions($n)" ); } while (my($n, $epart) = each (%bparts)) { is( partitions($n), $epart, "partitions($n)" ); } Math-Prime-Util-0.37/t/81-bignum.t0000644000076400007640000004525512271121021015060 0ustar danadana#!/usr/bin/env perl use strict; use warnings; # If you're not using ancient perl 5.6.2 with super early releases of bigint, # then you can define bigint up here and not have to quote every number. # Note: In 5.16.0 (and perhaps others?), using labels like "SKIP:" will create # a small memory leak. So running the test suite through valgrind will show # some small leaks in this test, which has nothing to do with the module. my $extra = 0+(defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}); my $use64 = ~0 > 4294967295; my $broken64 = (18446744073709550592 == ~0); use Test::More; my @primes = qw/ 777777777777777777777767 777777777777777777777787 877777777777777777777753 877777777777777777777871 87777777777777777777777795577 890745785790123461234805903467891234681243 618970019642690137449562111 /; push @primes, "531137992816767098689588206552468627329593117727031923199444138200403559860852242739162502265229285668889329486246501015346579337652707239409519978766587351943831270835393219031728127" if $extra; my @composites = qw/ 777777777777777777777777 877777777777777777777777 87777777777777777777777795475 890745785790123461234805903467891234681234 /; # Primes where n-1 is easy to factor, so we finish quickly. my @proveprimes = qw/ 65635624165761929287 1162566711635022452267983 77123077103005189615466924501 3991617775553178702574451996736229 273952953553395851092382714516720001799 /; # pseudoprimes to various small prime bases # These must not be themselves prime, as we're going to primality test them. my %pseudoprimes = ( '75792980677' => [ qw/2/ ], '21652684502221' => [ qw/2 7 37 61 9375/ ], '3825123056546413051' => [ qw/2 3 5 7 11 13 17 19 23 29 31 325 9375/ ], '318665857834031151167461' => [ qw/2 3 5 7 11 13 17 19 23 29 31 37 325 9375/ ], '3317044064679887385961981' => [ qw/2 3 5 7 11 13 17 19 23 29 31 37 73 325 9375/ ], '6003094289670105800312596501' => [ qw/2 3 5 7 11 13 17 19 23 29 31 37 61 325 9375/ ], '59276361075595573263446330101' => [ qw/2 3 5 7 11 13 17 19 23 29 31 37 325 9375/ ], '564132928021909221014087501701' => [ qw/2 3 5 7 11 13 17 19 23 29 31 37 325 9375/ ], #'1543267864443420616877677640751301' => [ qw/2 3 5 7 11 13 17 19 23 29 31 37 61 325 9375/ ], ); delete $pseudoprimes{'3825123056546413051'} if $broken64; my $num_pseudoprime_tests = 0; foreach my $psrp (keys %pseudoprimes) { push @composites, $psrp; $num_pseudoprime_tests += scalar @{$pseudoprimes{$psrp}}; } my %factors = ( '1234567890' => [2, 3, 3, 5, 3607, 3803], '190128090927491' => [61, 73, 196291, 217517], '23489223467134234890234680' => [2, 2, 2, 5, 4073, 4283, "33662485846146713"], #'7674353466844111807691499613711' => [11783, 12239, 18869, 22277, 37861, 55163, 60617], ); my %allfactors = ( #'7674353466844111807691499613711' => [qw/11783 12239 18869 22277 37861 55163 60617 144212137 222333427 230937691 262489891 272648203 420344713 446116163 463380779 649985629 675139957 714250111 714399209 741891463 843429497 1040870647 1143782173 1228866151 1350364909 2088526343 2295020237 3343815571 2721138813053 3212613775949 4952921753279 5144598942407 5460015718957 7955174113331 8417765879647 8741707108529 8743531918951 9938129763151 10322733613783 12264578833601 12739215848633 13477185344459 13998750015347 14479729857233 15040092822089 15911349722747 15914671178893 16527116121251 23187475403219 24609105899569 25480035467921 25561473911977 27042223452571 28088752680643 39400178873093 39408403566067 40924958773469 43304736851953 46526101343011 51126165819649 63094456009199 74490179475167 126600201333631 60618809338381681 103025036600999633 121632770171205089 150106180344442639 164947271430833701 177217413722674687 187522570500896219 194739009256700533 194779660558471427 273218022676129477 283791511459997341 300231257918513143 301190847104824991 311850154091885119 330969772836016469 464349219218967461 482218789227785227 482319451245094013 510259714326562199 530006674331052767 548217052124698613 569432954337111629 602419611852924167 625733143466684111 743441975156391817 772213047096586561 877717784755892761 877901006241274559 911685306596568913 964699622850956981 1405555196516926123 1491730172314174073 1549459864122309809 2388819198964283339 2820272685109297787 2295088740360468824341 3343915379533148669003 3674530365664682357177 5683170094020942755179 6245068643642794753561 6709628500954186324507 7373013629467938879913 9098986333939079448263 10344307556540938128697 10742387967627371501879 10744630415386959327601 11367055656052826107123 11806958684072862490459 16561656880558940507309 17202590050170658819397 18257285578953176479447 28147456621396150583437 29236758176123863786021 33231273048642855824221 34517317393052695615093 53215725295327339942903 126603980184504541757122583 139121394174430538725078397 202698118561160872868954851 344496721589267486990685443 406717550842339912432640819 627040891154842046547226049 651307261889511313561189817/], '23489223467134234890234680' => [qw/1 2 4 5 8 10 20 40 4073 4283 8146 8566 16292 17132 20365 21415 32584 34264 40730 42830 81460 85660 162920 171320 17444659 34889318 69778636 87223295 139557272 174446590 348893180 697786360 33662485846146713 67324971692293426 134649943384586852 168312429230733565 269299886769173704 336624858461467130 673249716922934260 1346499433845868520 137107304851355562049 144176426879046371779 274214609702711124098 288352853758092743558 548429219405422248196 576705707516185487116 685536524256777810245 720882134395231858895 1096858438810844496392 1153411415032370974232 1371073048513555620490 1441764268790463717790 2742146097027111240980 2883528537580927435580 5484292194054222481960 5767057075161854871160 587230586678355872255867 1174461173356711744511734 2348922346713423489023468 2936152933391779361279335 4697844693426846978046936 5872305866783558722558670 11744611733567117445117340 23489223467134234890234680/], ); plan tests => 0 + 2*(@primes + @composites + @proveprimes) + 1 # primes + 2 # next/prev prime + 1 # primecount large base small range + scalar(keys %pseudoprimes) + 6 # PC lower, upper, approx + 6*2*$extra # more PC tests + 2*scalar(keys %factors) + scalar(keys %allfactors) + 14+3*$extra # moebius, euler_phi, jordan totient, divsum, etc. + 2 # liouville + 3 # gcd + 3 # lcm + 15 # random primes + 2 # miller-rabin random + 1; # Using GMP makes these tests run about 2x faster on some machines use bigint try => 'GMP,Pari'; # <--------------- large numbers ahead! > 2^64 use Math::BigFloat; use Math::Prime::Util qw/ prime_set_config is_prob_prime prime_count_lower prime_count_upper prime_count_approx nth_prime_lower nth_prime_upper nth_prime_approx factor factor_exp divisors kronecker moebius euler_phi carmichael_lambda jordan_totient divisor_sum znorder znprimroot znlog liouville gcd lcm pn_primorial ExponentialIntegral LogarithmicIntegral RiemannR primes prime_count nth_prime is_prime is_provable_prime next_prime prev_prime is_strong_pseudoprime random_prime random_ndigit_prime random_nbit_prime random_strong_prime random_maurer_prime miller_rabin_random verify_prime /; # TODO: is_strong_lucas_pseudoprime # ExponentialIntegral # LogarithmicIntegral # RiemannR my $usegmp = Math::Prime::Util::prime_get_config->{gmp}; my $bignumver = $bigint::VERSION; my $bigintver = $Math::BigInt::VERSION; my $bigintlib = Math::BigInt->config()->{lib}; $bigintlib =~ s/^Math::BigInt:://; my $mpugmpver = $usegmp ? $Math::Prime::Util::GMP::VERSION : ""; diag "BigInt $bignumver/$bigintver, lib: $bigintlib. MPU::GMP $mpugmpver\n"; # Turn off use of BRS - ECM tries to use this. prime_set_config( irand => sub { int(rand(4294967296)) } ); ############################################################################### $_ = 'this should not change'; foreach my $n (@primes) { ok( is_prime($n), "$n is prime" ); ok( is_prob_prime($n), "$n is probably prime"); } foreach my $n (@composites) { ok( !is_prime($n), "$n is not prime" ); ok( !is_prob_prime($n), "$n is not probably prime"); } foreach my $n (@proveprimes) { ok( is_prime($n), "$n is prime" ); SKIP: { skip "Large proof on 32-bit machine without EXTENDED_TESTING.", 1 if !$use64 && !$extra && $n > 2**66; skip "Large proof without GMP or EXTENDED_TESTING.", 1 if !$usegmp && !$extra && $n > 2**66; skip "Skipping provable primes on broken 64-bit", 1 if $broken64; ok( is_provable_prime($n), "$n is provably prime" ); } } ############################################################################### # Used to be (2**66, 2**66+100), but old ActiveState chokes for some reason. is_deeply( primes(73786976294838206464, 73786976294838206564), [73786976294838206473,73786976294838206549], "primes( 2^66, 2^66 + 100 )" ); ############################################################################### is( next_prime(777777777777777777777777), 777777777777777777777787, "next_prime(777777777777777777777777)"); is( prev_prime(777777777777777777777777), 777777777777777777777767, "prev_prime(777777777777777777777777)"); ############################################################################### # Testing prime_count only on a small range -- it would take a very long time # otherwise. is( prime_count(877777777777777777777752, 877777777777777777777872), 2, "prime_count(87..7752, 87..7872)"); ############################################################################### # Testing nth_prime would be far too time consuming. ############################################################################### while (my($psrp, $baseref) = each (%pseudoprimes)) { my $baselist = join(",", @$baseref); my @expmr = map { (0!=1) } @$baseref; my @gotmr = map { is_strong_pseudoprime($psrp, $_) } @$baseref; is_deeply(\@gotmr, \@expmr, "$psrp is a strong pseudoprime to bases $baselist"); } ############################################################################### check_pcbounds(31415926535897932384, 716115441142294636, '8e-5', '2e-8'); if ($extra) { check_pcbounds(314159265358979323846, 6803848951392700268, '7e-5', '5e-9'); check_pcbounds(31415926535897932384626433, 544551456607147153724423, '4e-5', '3e-11'); } ############################################################################### SKIP: { skip "Your 64-bit Perl is broken, skipping bignum factoring tests", 2*scalar(keys %factors) + scalar(keys %allfactors) if $broken64; while (my($n, $factors) = each(%factors)) { is_deeply( [factor($n)], $factors, "factor($n)" ); is_deeply( [factor_exp($n)], [linear_to_exp(@$factors)], "factor_exp($n)" ); } while (my($n, $allfactors) = each(%allfactors)) { is_deeply( [divisors($n)], $allfactors, "divisors($n)" ); } } ############################################################################### SKIP: { skip "Your 64-bit Perl is broken, skipping moebius, totient, etc.", 14+3*$extra if $broken64; my $n; $n = 618970019642690137449562110; is( moebius($n), -1, "moebius($n)" ); is( euler_phi($n), 145857122964987051805507584, "euler_phi($n)" ); is( carmichael_lambda($n), 3271601336256, "carmichael_lambda($n)" ); $n = 2188536338969724335807; is( jordan_totient(5,$n), 50207524710890617788554288878260755791080217791665431423557510096680804997771551711694188532723268222129800, "jordan_totient(5,$n)" ); is( divisor_sum( $n, sub { my $d=shift; $d**5 * moebius($n/$d); }), 50207524710890617788554288878260755791080217791665431423557510096680804997771551711694188532723268222129800, "jordan totient using divisor_sum and moebius" ); if ($extra) { $n = 48981631802481400359696467; is( jordan_totient(5,$n), "281946200770875813001683560563488308767928594805846855593191749929654015729263525162226378019837608857421063724603387506651820000", "jordan_totient(5,$n)" ); is( divisor_sum( $n, sub { my $d=shift; $d**5 * moebius($n/$d); }), "281946200770875813001683560563488308767928594805846855593191749929654015729263525162226378019837608857421063724603387506651820000", "jordan totient using divisor_sum and moebius" ); } # Done wrong, the following will have a bunch of extra zeros. my $hundredfac = Math::BigInt->new(100)->bfac; is( divisor_sum($hundredfac), 774026292208877355243820142464115597282472420387824628823543695735957009720184359087194959566149232506852422409529601312686157396490982598473425595924480000000, "Divisor sum of 100!" ); # These should yield bigint results. # Quoted 0 to prevent error in perl 5.8.2 + bigint 0.23 (0 turns into NaN) is( divisor_sum(pn_primorial(27),"0"), 134217728, "Divisor count(103#)" ); is( divisor_sum(pn_primorial(27),1), "123801167235014219383860918985791897600000", "Divisor sum(103#)" ); is( divisor_sum(pn_primorial(27),2), "872887488619258559049272439859735080160421720974947767918289356800000000000000000", "sigma_2(103#)" ); if ($extra) { is( divisor_sum(pn_primorial(71),"0"), 2361183241434822606848, "Divisor count(353#)" ); } # Calc/FastCalc are slugs with this function, so tone things down. #is( znorder(82734587234,927208363107752634625923555185111613055040823736157), # 4360156780036190093445833597286118936800, # "znorder" ); is(znorder(8267,927208363107752634625923),2843344277735759285436,"znorder 1"); is(znorder(902,827208363107752634625947),undef,"znorder 2"); is( kronecker(878944444444444447324234,216539985579699669610468715172511426009), -1, "kronecker(..., ...)" ); is( znprimroot(333822190384002421914469856494764513809), 3, "znprimroot(333822190384002421914469856494764513809)" ); is( znlog(232752345212475230211680, 23847293847923847239847098123812075234, 804842536444911030681947), 13, "znlog(b,g,p): find k where b^k = g mod p" ); } ############################################################################### is( liouville( 560812147176208202656339069), -1, "liouville(a x b x c) = -1" ); is( liouville(10571644062695614514374497899), 1, "liouville(a x b x c x d) = 1" ); ############################################################################### is( gcd(921166566073002915606255698642,1168315374100658224561074758384,951943731056111403092536868444), 14, "gcd(a,b,c)" ); is( gcd(1214969109355385138343690512057521757303400673155500334102084,1112036111724848964580068879654799564977409491290450115714228), 42996, "gcd(a,b)" ); is( gcd(745845206184162095041321,61540282492897317017092677682588744425929751009997907259657808323805386381007), 1, "gcd of two primes = 1" ); is( lcm(9999999998987,10000000001011), 99999999999979999998975857, "lcm(p1,p2)" ); is( lcm(892478777297173184633,892478777297173184633), 892478777297173184633, "lcm(p1,p1)" ); is( lcm(23498324,32497832409432,328732487324,328973248732,3487234897324), 1124956497899814324967019145509298020838481660295598696, "lcm(a,b,c,d,e)" ); ############################################################################### my $randprime; SKIP: { skip "Skipping large random prime tests on broken 64-bit Perl", 6 if $broken64; $randprime = random_prime(147573952590750158861, 340282366920939067930896100764782952647); cmp_ok( $randprime, '>=', 147573952590750158861, "random range prime isn't too small"); cmp_ok( $randprime, '<=', 340282366920939067930896100764782952647, "random range prime isn't too big"); ok( is_prime($randprime), "random range prime is prime"); $randprime = random_ndigit_prime(25); cmp_ok( $randprime, '>', 10**24, "random 25-digit prime is not too small"); cmp_ok( $randprime, '<', 10**25, "random 25-digit prime is not too big"); ok( is_prime($randprime), "random 25-digit prime is just right"); } $randprime = random_nbit_prime(80); cmp_ok( $randprime, '>', 2**79, "random 80-bit prime is not too small"); cmp_ok( $randprime, '<', 2**80, "random 80-bit prime is not too big"); ok( is_prime($randprime), "random 80-bit prime is just right"); $randprime = random_strong_prime(190); cmp_ok( $randprime, '>', 2**189, "random 190-bit strong prime is not too small"); cmp_ok( $randprime, '<', 2**190, "random 190-bit strong prime is not too big"); ok( is_prime($randprime), "random 190-bit strong prime is just right"); $randprime = random_maurer_prime(80); cmp_ok( $randprime, '>', 2**79, "random 80-bit Maurer prime is not too small"); cmp_ok( $randprime, '<', 2**80, "random 80-bit Maurer prime is not too big"); ok( is_prime($randprime), "random 80-bit Maurer prime is just right"); ############################################################################### $randprime = random_nbit_prime(80); is( miller_rabin_random( $randprime, 20 ), 1, "80-bit prime passes Miller-Rabin with 20 random bases" ); do { $randprime += 2 } while is_prime($randprime); is( miller_rabin_random( $randprime, 40 ), "0", "80-bit composite fails Miller-Rabin with 40 random bases" ); ############################################################################### is( $_, 'this should not change', "Nobody clobbered \$_" ); sub check_pcbounds { my ($n, $expn, $percent, $percentrh) = @_; $percent = Math::BigFloat->new($percent); $percentrh = Math::BigFloat->new($percentrh); my $pcap = prime_count_approx($n); is( $pcap, "$expn", "PC approx($n)" ); my $pclo = prime_count_lower($n); my $pcup = prime_count_upper($n); prime_set_config(assume_rh=>1); my $pclo_rh = prime_count_lower($n); my $pcup_rh = prime_count_upper($n); prime_set_config(assume_rh => undef); #diag "lower: " . $pclo->bstr() . " " . ($pcap-$pclo)->bstr; #diag "rh lower: " . $pclo_rh->bstr() . " " . ($pcap-$pclo_rh)->bstr; #diag "approx: " . $pcap->bstr(); #diag "rh upper: " . $pcup_rh->bstr() . " " . ($pcup_rh-$pcap)->bstr; #diag "upper: " . $pcup->bstr() . " " . ($pcup-$pcap)->bstr; # lower: 544534406675337676203117 17049931809477521306 # rh lower: 544551456594152957592704 12994196131719 # approx: 544551456607147153724423 # rh upper: 544551456620339152603564 13191998879141 # upper: 544586259732074697890498 34803124927544166075 ok( $pclo <= $pclo_rh && $pclo_rh <= $pcap && $pcap <= $pcup_rh && $pcup_rh <= $pcup, "prime count bounds for $n are in the right order"); my $pcapf = Math::BigFloat->new($pcap); #diag "" . ($pcapf - $pclo_rh)/($pcapf) . " " . $percentrh/100.0 . ""; cmp_ok( ($pcapf - $pclo_rh)/$pcapf, '<=', $percentrh , "PC lower with RH"); cmp_ok( ($pcup_rh - $pcapf)/$pcapf, '<=', $percentrh , "PC upper with RH"); cmp_ok( ($pcapf - $pclo)/$pcapf, '<=', $percent , "PC lower"); cmp_ok( ($pcup - $pcapf)/$pcapf, '<=', $percent , "PC upper"); } ############################################################################### sub linear_to_exp { # Convert factor() output to factor_exp() output my %exponents; my @factors = grep { !$exponents{$_}++ } @_; return (map { [$_, $exponents{$_}] } @factors); } Math-Prime-Util-0.37/t/94-weaken.t0000644000076400007640000000270712270242116015060 0ustar danadana#!/usr/bin/env perl use strict; use warnings; BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } #--------------------------------------------------------------------- use Test::More; eval "use Test::Weaken"; plan skip_all => "Test::Weaken required for testing leaks" if $@; use Math::Prime::Util qw/prime_iterator primes factor moebius/; use Math::Prime::Util::PrimeIterator; my $leaks; $leaks = Test::Weaken::leaks( { constructor => sub { my $it = prime_iterator(100); return \$it; } }); ok(!$leaks, "Prime iterator doesn't leak"); $leaks = Test::Weaken::leaks( { constructor => sub { my $it = Math::Prime::Util::PrimeIterator->new(100); return \$it; } }); ok(!$leaks, "Prime iterator object doesn't leak"); $leaks = Test::Weaken::leaks( { constructor => sub { my $it = prime_iterator("1000000000000000000000000"); my $p = $it->(); return \$it; } }); ok(!$leaks, "Prime iterator object doesn't leak"); $leaks = Test::Weaken::leaks( sub { my $primes = primes(66000); return $primes }); ok(!$leaks, "primes array doesn't leak"); $leaks = Test::Weaken::leaks( sub { return [factor(2938424874)]; }); ok(!$leaks, "factor array doesn't leak"); $leaks = Test::Weaken::leaks( sub { return [moebius(500,1000)]; }); ok(!$leaks, "moebius range doesn't leak"); done_testing(); Math-Prime-Util-0.37/t/23-primality-proofs.t0000644000076400007640000003656712270242116017131 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_prime is_provable_prime is_provable_prime_with_cert prime_certificate verify_prime prime_get_config prime_set_config /; my $use_test_warn; BEGIN { eval "use Test::Warn"; $use_test_warn = $@ ? 0 : 1; } my $extra = 0+(defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}); my $use64 = ~0 > 4294967295; my $broken64 = (18446744073709550592 == ~0); # Do some tests only if: # EXTENDED_TESTING is on OR we have the GMP backend # Note that with Calc, these things are incredibly slow. use Math::BigInt try=>"GMP,Pari"; my $doexpensive = 0 + ($extra || ( (!$use64 || !$broken64) && Math::BigInt->config()->{lib} eq 'Math::BigInt::GMP' )); my @plist = qw/20907001 809120722675364249/; if ($extra || $use64) { push @plist, "677826928624294778921"; } if ($extra || prime_get_config->{'gmp'}) { push @plist, "980098182126316404630169387"; } ## This is too slow without Math::Prime::Util::GMP. #push @plist, '3364125245431456304736426076174232972735419017865223025179282077503701' # if prime_get_config->{'gmp'}; # #push @plist, '6864797660130609714981900799081393217269435300143305409394463459185543183397656052122559640661454554977296311391480858037121987999716643812574028291115057151' # if $extra # && (prime_get_config->{'gmp'} || Math::BigInt->config()->{lib} eq 'Math::BigInt::GMP'); # #push @plist, '531137992816767098689588206552468627329593117727031923199444138200403559860852242739162502265229285668889329486246501015346579337652707239409519978766587351943831270835393219031728127' # if $extra && prime_get_config->{'gmp'}; plan tests => 0 + 2 # is_provable_prime + 6 * scalar(@plist) # hand-done proofs + 1*$doexpensive # n-1 for 2^521-1 + 1*$extra # n-1 for 2^607-1 #+ (($doexpensive && !$broken64) ? 1 : 0) # n-1 proof + (($doexpensive) ? 1 : 0) # n-1 proof + 2 # Pratt and ECPP + 28 # borked up certificates generate warnings + 6 # verification failures (tiny/BPSW) + 8 # verification failures (Lucas/Pratt) + 8 # verification failures (n-1) + 7 # verification failures (ECPP) + 3 # Verious other types + 0; is( is_provable_prime(871139809), 0, "871139809 is composite" ); is( is_provable_prime(1490266103), 2, "1490266103 is provably prime" ); foreach my $p (@plist) { SKIP: { skip "Broken 64-bit causes trial factor to barf", 6 if $broken64 && $p > 2**60; ok( is_prime($p), "$p is prime" ); my($isp, $cert) = is_provable_prime_with_cert($p); is( $isp, 2, " is_provable_prime_with_cert returns 2" ); ok( defined($cert) && $cert =~ /^Type/m, " certificate is non-null" ); prime_set_config(verbose=>1); ok( verify_prime($cert), " verification of certificate for $p done" ); prime_set_config(verbose=>0); # Note, in some cases the certs could be non-equal (but both must be valid!) my $cert2 = prime_certificate($p); ok( defined($cert2) && $cert2 =~ /^Type/m, " prime_certificate is also non-null" ); if ($cert2 eq $cert) { ok(1, " certificate is identical to first"); } else { ok( verify_prime($cert2), " different cert, verified" ); } } } # Some hand-done proofs if ($doexpensive) { my $proof = < qr/^verify_prime: / }, "warning for unknown method"; is( $result, 0, " ...and returns 0" ); warning_like { $result = verify_prime([1490266103, 'Pratt', 1, 2, 3]) } { carped => qr/^verify_prime: / }, "warning for invalid Lucas/Pratt"; is( $result, 0, " ...and returns 0" ); warning_like { $result = verify_prime([1490266103, 'Pratt', 1, [2], 3]) } { carped => qr/^verify_prime: / }, "warning for invalid Lucas/Pratt"; is( $result, 0, " ...and returns 0" ); warning_like { $result = verify_prime([1490266103, 'Pratt', [1], 2, 3]) } { carped => qr/^verify_prime: / }, "warning for invalid Lucas/Pratt"; is( $result, 0, " ...and returns 0" ); warning_like { $result = verify_prime([1490266103, 'n-1', 1, 2, 3]) } { carped => qr/^verify_prime: / }, "warning for invalid n-1 (too many arguments)"; is( $result, 0, " ...and returns 0" ); warning_like { $result = verify_prime([1490266103, 'n-1', 1, 2]) } { carped => qr/^verify_prime: / }, "warning for invalid n-1 (non-array f,a)"; is( $result, 0, " ...and returns 0" ); warning_like { $result = verify_prime([1490266103, 'n-1', [1], 2]) } { carped => qr/^verify_prime: / }, "warning for invalid n-1 (non-array a)"; is( $result, 0, " ...and returns 0" ); warning_like { $result = verify_prime([1490266103, 'n-1', [2, 13, 19, 1597, 1889], [2, 2, 2, 2]]) } { carped => qr/^verify_prime: / }, "warning for invalid n-1 (too few a values)"; is( $result, 0, " ...and returns 0" ); warning_like { $result = verify_prime([1490266103, 'ECPP']) } { carped => qr/^verify_prime: / }, "warning for invalid ECPP (no n-certs)"; is( $result, 0, " ...and returns 0" ); warning_like { $result = verify_prime([1490266103, 'ECPP', 15]) } { carped => qr/^verify_prime: / }, "warning for invalid ECPP (non-array block)"; is( $result, 0, " ...and returns 0" ); warning_like { $result = verify_prime([1490266103, 'ECPP', [15,16,17]]) } { carped => qr/^verify_prime: / }, "warning for invalid ECPP (wrong size block)"; is( $result, 0, " ...and returns 0" ); warning_like { $result = verify_prime([1490266103, 'ECPP', [694361, 694358, 0, 695162, 26737, [348008, 638945]]]) } { carped => qr/^verify_prime: / }, "warning for invalid ECPP (block n != q)"; is( $result, 0, " ...and returns 0" ); warning_like { $result = verify_prime([1490266103, 'ECPP', [1490266103, 1442956066, 1025050760, 1490277784, 2780369, 531078754]]) } { carped => qr/^verify_prime: / }, "warning for invalid ECPP (block point wrong format)"; is( $result, 0, " ...and returns 0" ); warning_like { $result = verify_prime([1490266103, 'ECPP', [1490266103, 1442956066, 1025050760, 1490277784, 2780369, [531078754, 0, 195830554]]]) } { carped => qr/^verify_prime: / }, "warning for invalid ECPP (block point wrong format)"; is( $result, 0, " ...and returns 0" ); } is( verify_prime([]), 0, "verify null is composite" ); is( verify_prime([2]), 1, "verify [2] is prime" ); is( verify_prime([9]), 0, "verify [9] is composite" ); is( verify_prime([14]), 0, "verify [14] is composite" ); is( verify_prime(['28446744073709551615']), 0, "verify BPSW with n > 2^64 fails" ); is( verify_prime([871139809]), 0, "verify BPSW with composite fails" ); is( verify_prime([1490266103, 'Pratt', [2,13,19,1597,1889], 5]), 1, "Lucas/Pratt proper" ); is( verify_prime([1490266103, 'Pratt', [4,13,19,1597,1889], 5]), 0, "Pratt with non-prime factors" ); is( verify_prime([1490266103, 'Pratt', [[4],13,19,1597,1889], 5]), 0, "Pratt with non-prime factors" ); is( verify_prime([1490266103, 'Pratt', [2,13,29,1597,1889], 5]), 0, "Pratt with wrong factors" ); is( verify_prime([1490266103, 'Pratt', [2,13,19,1597], 5]), 0, "Pratt with not enough factors" ); is( verify_prime([1490266103, 'Pratt', [2,13,19,1597,1889], 1490266103]), 0, "Pratt with coprime a" ); is( verify_prime([185156263, 'Pratt', [2,3,3,10286459], 2]), 0, "Pratt with non-psp a" ); is( verify_prime([1490266103, 'Pratt', [2,13,19,1597,1889], 3]), 0, "Pratt with a not valid for all f" ); is( verify_prime([1490266103, 'n-1', [2, 13, 19, 1597, 1889], [5, 2, 2, 2, 2]]), 1, "n-1 proper" ); is( verify_prime([1490266103, 'n-1', [2, 23, 19, 1597, 1889], [5, 2, 2, 2, 2]]), 0, "n-1 with wrong factors" ); is( verify_prime([1490266103, 'n-1', [13, 19, 1597, 1889], [2, 2, 2, 2]]), 0, "n-1 without 2 as a factor" ); is( verify_prime([1490266103, 'n-1', [2, 13, 1889, 30343], [5, 2, 2, 2]]), 0, "n-1 with a non-prime factor" ); is( verify_prime([1490266103, 'n-1', [2, 13, 1889, [30343]], [5, 2, 2, 2]]), 0, "n-1 with a non-prime array factor" ); # I don't know how to make F and R (A and B) to not be coprime #is( verify_prime(['9848131514359', 'n-1', ["B", 20000, 890588851, 2], [2, 3, 19, 97], [3, 5, 2, 2]]), 1, "n-1 T7 proper" ); #is( verify_prime(['9848131514359', 'n-1', ["B", 20000, 890588951, 2], [2, 3, 19, 97], [3, 5, 2, 2]]), 0, "n-1 T7 with misfactor" ); #is( verify_prime(['9848131514359', 'n-1', ["B", 0, 890588851, 2], [2, 3, 19, 97], [3, 5, 2, 2]]), 0, "n-1 T7 with B < 1" ); #is( verify_prime(['9848131514359', 'n-1', ["B", 20000, 16921188169, 2], [2, 3, 97], [3, 5, 2]]), 0, "n-1 T7 with wrong B" ); is( verify_prime([1490266103, 'n-1', [2, 13], [5, 2]]), 0, "n-1 without enough factors" ); is( verify_prime([914144252447488195, 'n-1', [2, 3, 11, 17, 1531], [2, 2, 2, 2, 2]]), 0, "n-1 with bad BLS75 r/s" ); is( verify_prime([1490266103, 'n-1', [2, 13, 19, 1597, 1889], [3, 2, 2, 2, 2]]), 0, "n-1 with bad a value" ); is( verify_prime([1490266103, "ECPP", [1490266103, 1442956066, 1025050760, 1490277784, 2780369, [531078754, 195830554]], [2780369, 2780360, 0, 2777444, 694361, [2481811, 1317449]], [694361, 694358, 0, 695162, 26737, [348008, 638945]]]), 1, "ECPP proper" ); is( verify_prime([1490266103, "ECPP", [1490266103, 1442956066, 1025050760, 1490277784, 5560738, [531078754, 195830554]], [5560738, 2780360, 0, 2777444, 694361, [2481811, 1317449]]]), 0, "ECPP q is divisible by 2" ); is( verify_prime([74468183, "ECPP", [74468183, 89, 1629, 74475075, 993001, [47943960, 8832604]], [993001, 0, 992984, 994825, 3061, [407531, 231114]]]), 0, "ECPP a/b invalid" ); is( verify_prime([1490266103, "ECPP", [1490266103, 1442956066, 1025050760, 1490277784, 536, [531078754, 195830554]], [536, 2780360, 0, 2777444, 694361, [2481811, 1317449]]]), 0, "ECPP q is too small" ); is( verify_prime([694361, "ECPP", [694361, 694358, 0, 30, 26737, [264399, 59977]]]), 0, "ECPP multiplication wrong (infinity)" ); is( verify_prime([694361, "ECPP", [694361, 694358, 0, 695161, 26737, [264399, 59977]]]), 0, "ECPP multiplication wrong (not infinity)" ); is( verify_prime([1490266103, "ECPP", [1490266103, 1442956066, 1025050760, 1490277784, 2780369, [531078754, 195830554]], [2780369, 2780360, 0, 2777444, 694361, [2481811, 1317449]], [694361, 694358, 0, 695162, [26737, "n-1", [2],[2]], [348008, 638945]]]), 0, "ECPP non-prime last q" ); { my $header = "[MPU - Primality Certificate]\nVersion 1.0\nProof for:"; { my $cert = join "\n", $header, "N 2297612322987260054928384863", "Type Pocklington", "N 2297612322987260054928384863", "Q 16501461106821092981", "A 5"; is( verify_prime($cert), 1, "Verify Pocklington"); } { my $cert = join "\n", $header, "N 5659942549665396263282978117", "Type BLS15", "N 5659942549665396263282978117", "Q 42941814754495493", "LP 2", "LQ 3"; is( verify_prime($cert), 1, "Verify BLS15"); } { my $cert = join "\n", $header, "N 43055019307158602560279", "Type ECPP3", "N 43055019307158602560279", "S 106563369", "R 404032076977387", "A 0", "B 4", "T 1"; is( verify_prime($cert), 1, "Verify ECPP3"); } } Math-Prime-Util-0.37/t/51-primearray.t0000644000076400007640000001052012270242116015742 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util::PrimeArray; # From List::Util sub shuffle (@) { my @a=\(@_); my $n; my $i=@_; map { $n = rand($i--); (${$a[$n]}, $a[$n] = $a[$i])[0]; } @_; } my @small_primes = qw/ 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947 953 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069 1087 1091 1093 1097 1103 1109 1117 1123 1129 1151 1153 1163 1171 1181 1187 1193 1201 1213 1217 1223 1229 1231 1237 1249 1259 1277 1279 1283 1289 1291 1297 1301 1303 1307 1319 1321 1327 1361 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459 1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543 1549 1553 1559 1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627 1637 1657 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753 1759 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877 1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997 1999 2003 2011 2017 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089 2099 2111 2113 2129 2131 2137 2141 2143 2153 2161 2179 2203 2207 2213 2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 2297 2309 2311 2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 2399 2411 2417 2423 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 2543 2549 2551 2557 2579 2591 2593 2609 2617 2621 2633 2647 2657 2659 2663 2671 2677 2683 2687 2689 2693 2699 2707 2711 2713 2719 2729 2731 2741 2749 2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851 2857 2861 2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969 2971 2999 3001 3011 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089 3109 3119 3121 3137 3163 3167 3169 3181 3187 3191 3203 3209 3217 3221 3229 3251 3253 3257 3259 3271 3299 3301 3307 3313 3319 3323 3329 3331 3343 3347 3359 3361 3371 3373 3389 3391 3407 3413 3433 3449 3457 3461 3463 3467 3469 3491 3499 3511 3517 3527 3529 3533 3539 3541 3547 3557 3559 3571 /; my %test_indices = ( 377 => 2593, 1999 => 17389, 4500 => 43063, 4999 => 48611, 15678 => 172157, 30107 => 351707, 78901 => 1005413, 123456 => 1632913, ); plan tests => 3 + 2 + scalar(keys %test_indices) + 8; { my @primes; tie @primes, 'Math::Prime::Util::PrimeArray'; my (@order, @got, @exp); # Random @order = shuffle (0 .. $#small_primes); @got = map { $primes[$_] } @order; @exp = map { $small_primes[$_] } @order; is_deeply(\@got, \@exp, "primes 0 .. $#small_primes can be randomly selected"); # Forwards @order = (0 .. $#small_primes); @got = map { $primes[$_] } @order; @exp = map { $small_primes[$_] } @order; is_deeply(\@got, \@exp, "primes 0 .. $#small_primes in forward order"); # Backwards @order = reverse (0 .. $#small_primes); @got = map { $primes[$_] } @order; @exp = map { $small_primes[$_] } @order; is_deeply(\@got, \@exp, "primes 0 .. $#small_primes in reverse order"); } { my @primes; tie @primes, 'Math::Prime::Util::PrimeArray'; is_deeply( [@primes[0..50]], [@small_primes[0..50]], "51 primes using array slice" ); is_deeply( [sort {$a<=>$b} @primes[shuffle (0 .. $#small_primes)]], \@small_primes, "random array slice of small primes" ); } { my @primes; tie @primes, 'Math::Prime::Util::PrimeArray'; while (my($n, $pn) = each(%test_indices)) { is( $primes[$n], $pn, "primes[$n] == $pn" ); } } # Test shifting { my @primes; tie @primes, 'Math::Prime::Util::PrimeArray'; is( shift @primes, 2, "shift 2"); is( shift @primes, 3, "shift 3"); is( shift @primes, 5, "shift 5"); is( shift @primes, 7, "shift 7"); is( shift @primes, 11, "shift 11"); is( $primes[0], 13, "13 after shifts"); unshift @primes, 1; is( $primes[0], 11, "11 after unshift"); unshift @primes, 3; is( $primes[0], 3, "3 after unshift 3"); } Math-Prime-Util-0.37/t/70-rt-bignum.t0000644000076400007640000000324112270242116015476 0ustar danadana#!/usr/bin/env perl use strict; use warnings; # I found these issues when doing some testing of is_provable_prime. When # bignum is loaded, we get some strange behavior. There are two fixes for # it in the code: # 1) make sure every divide and bdiv is coerced back to an integer. # 2) turn off upgrade in input validation. # The second method in theory is all that is needed. use Math::Prime::Util qw/:all/; use Math::Prime::Util::PP; use bignum; use Test::More tests => 2; if ($] < 5.008) { diag "A prototype warning was expected with old, old Perl"; } my $n = 100199294509778143137521762187425301691197073534078445671945250753109628678272; # 2 2 2 2 2 2 2 3 7 509 277772399 263650456338779643073784729209358382310353002641378210462709359 my @partial_factor = Math::Prime::Util::PP::prho_factor(100199294509778143137521762187425301691197073534078445671945250753109628678272, 5); my @expected_factors = map { ($_ <= 4294967295 && ref($_)) ? int($_->bstr) : $_ } (2,2,2,2,2,2,2,3,7,37276523255125797298185179385202865212498911284999421752955822452793760669); is_deeply( \@partial_factor, \@expected_factors, "PP prho factors correctly with 'use bignum'" ); # The same thing happens in random primes, PP holf factoring, # PP is_provable_primes, and possibly elsewhere ################################################################################ # Here is another test case that has to do with reference counting # in the XS subroutine callback code. SKIP: { skip "No MPU::GMP, skipping callback test",1 unless prime_get_config->{'gmp'}; my $n = 10**1200+5226; my $expect = $n+1; is(next_prime($n), $expect, "next_prime(10^1200+5226) = 10^1200+5227"); } Math-Prime-Util-0.37/t/11-primes.t0000644000076400007640000001511212270242116015064 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/primes prime_count/; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; $use64 = 0 if 18446744073709550592 == ~0; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my %primesubs = ( trial => \&Math::Prime::Util::trial_primes, erat => \&Math::Prime::Util::erat_primes, segment => \&Math::Prime::Util::segment_primes, sieve => \&Math::Prime::Util::sieve_primes, primes => \&Math::Prime::Util::primes, ); # Don't test the private XS methods if we're not using XS. delete @primesubs{qw/trial erat segment sieve/} unless $usexs; plan tests => 12+3 + 12 + 1 + 19 + ($use64 ? 1 : 0) + 1 + 13*scalar(keys(%primesubs)); ok(!eval { primes(undef); }, "primes(undef)"); ok(!eval { primes("a"); }, "primes(a)"); ok(!eval { primes(-4); }, "primes(-4)"); ok(!eval { primes(2,undef); }, "primes(2,undef)"); ok(!eval { primes(2,'x'); }, "primes(2,x)"); ok(!eval { primes(2,-4); }, "primes(2,-4)"); ok(!eval { primes(undef,7); }, "primes(undef,7)"); ok(!eval { primes('x',7); }, "primes(x,7)"); ok(!eval { primes(-10,7); }, "primes(-10,7)"); ok(!eval { primes(undef,undef); }, "primes(undef,undef)"); ok(!eval { primes('x','x'); }, "primes(x,x)"); ok(!eval { primes(-10,-4); }, "primes(-10,-4)"); ok(!eval { primes(50000000000000000000); }, "primes(inf)"); ok(!eval { primes(2,50000000000000000000); }, "primes(2,inf)"); ok(!eval { primes(50000000000000000000,50000000000000000001); }, "primes(inf,inf)"); my @small_primes = qw/ 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947 953 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069 1087 1091 1093 1097 1103 1109 1117 1123 1129 1151 1153 1163 1171 1181 1187 1193 1201 1213 1217 1223 1229 1231 1237 1249 1259 1277 1279 1283 1289 1291 1297 1301 1303 1307 1319 1321 1327 1361 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459 1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543 1549 1553 1559 1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627 1637 1657 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753 1759 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877 1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997 1999 2003 2011 2017 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089 2099 2111 2113 2129 2131 2137 2141 2143 2153 2161 2179 2203 2207 2213 2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 2297 2309 2311 2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 2399 2411 2417 2423 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 2543 2549 2551 2557 2579 2591 2593 2609 2617 2621 2633 2647 2657 2659 2663 2671 2677 2683 2687 2689 2693 2699 2707 2711 2713 2719 2729 2731 2741 2749 2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851 2857 2861 2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969 2971 2999 3001 3011 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089 3109 3119 3121 3137 3163 3167 3169 3181 3187 3191 3203 3209 3217 3221 3229 3251 3253 3257 3259 3271 3299 3301 3307 3313 3319 3323 3329 3331 3343 3347 3359 3361 3371 3373 3389 3391 3407 3413 3433 3449 3457 3461 3463 3467 3469 3491 3499 3511 3517 3527 3529 3533 3539 3541 3547 3557 3559 3571 /; my %small_single = ( 0 => [], 1 => [], 2 => [2], 3 => [2, 3], 4 => [2, 3], 5 => [2, 3, 5], 6 => [2, 3, 5], 7 => [2, 3, 5, 7], 11 => [2, 3, 5, 7, 11], 18 => [2, 3, 5, 7, 11, 13, 17], 19 => [2, 3, 5, 7, 11, 13, 17, 19], 20 => [2, 3, 5, 7, 11, 13, 17, 19], ); while (my($high, $expect) = each (%small_single)) { is_deeply( primes($high), $expect, "primes($high) should return [@{$expect}]"); } is_deeply( primes(0, 3572), \@small_primes, "Primes between 0 and 3572" ); my %small_range = ( "3 to 9" => [3,5,7], "2 to 20" => [2,3,5,7,11,13,17,19], "30 to 70" => [31,37,41,43,47,53,59,61,67], "70 to 30" => [], "20 to 2" => [], "2 to 2" => [2], "3 to 3" => [3], "2 to 3" => [2,3], "2 to 5" => [2,3,5], "3 to 6" => [3,5], "3 to 7" => [3,5,7], "4 to 8" => [5,7], "2010733 to 2010881" => [2010733,2010881], "2010734 to 2010880" => [], "3088 to 3164" => [3089,3109,3119,3121,3137,3163], "3089 to 3163" => [3089,3109,3119,3121,3137,3163], "3090 to 3162" => [3109,3119,3121,3137], "3842610773 to 3842611109" => [3842610773,3842611109], "3842610774 to 3842611108" => [], ); while (my($range, $expect) = each (%small_range)) { my($low,$high) = $range =~ /(\d+) to (\d+)/; is_deeply( primes($low, $high), $expect, "primes($low,$high) should return [@{$expect}]"); } if ($use64) { is_deeply( primes(1_693_182_318_746_371, 1_693_182_318_747_671), [qw/1693182318746371 1693182318747503 1693182318747523 1693182318747553 1693182318747583 1693182318747613 1693182318747631 1693182318747637/], "Primes between 1_693_182_318_746_371 and 1_693_182_318_747_671"); } is( scalar @{primes(474973,838390)}, prime_count(838390) - prime_count(474973), "count primes within a range" ); # Test individual methods while (my($method, $sub) = each (%primesubs)) { is_deeply( $sub->(0, 3572), \@small_primes, "$method(0, 3572)" ); is_deeply( $sub->(2, 20), [2,3,5,7,11,13,17,19], "$method(2, 20)" ); is_deeply( $sub->(30, 70), [31,37,41,43,47,53,59,61,67], "$method(30, 70)" ); is_deeply( $sub->(30, 70), [31,37,41,43,47,53,59,61,67], "$method(30, 70)" ); is_deeply( $sub->(20, 2), [], "$method(20, 2)" ); is_deeply( $sub->(1, 1), [], "$method(1, 1)" ); is_deeply( $sub->(2, 2), [2], "$method(2, 2)" ); is_deeply( $sub->(3, 3), [3], "$method(3, 3)" ); is_deeply( $sub->(2010733, 2010733+148), [2010733,2010733+148], "$method Primegap 21 inclusive" ); is_deeply( $sub->(2010733+1, 2010733+148-2), [], "$method Primegap 21 exclusive" ); is_deeply( $sub->(3088, 3164), [3089,3109,3119,3121,3137,3163], "$method(3088, 3164)" ); is_deeply( $sub->(3089, 3163), [3089,3109,3119,3121,3137,3163], "$method(3089, 3163)" ); is_deeply( $sub->(3090, 3162), [3109,3119,3121,3137], "$method(3090, 3162)" ); } Math-Prime-Util-0.37/t/31-threading.t0000644000076400007640000001145012270242116015535 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Config; BEGIN { if (! $Config{useithreads} || $] < 5.008) { print("1..0 # Skip perl isn't compiled with threading support\n"); exit(0); } # Should be be looking for newer than 5.008? if (! eval { require threads }) { print "1..0 # Skip threads.pm not installed\n"; exit 0; } } use Test::More 'tests' => 10; use Math::Prime::Util ":all"; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $is_win32 = ($Config{osname} eq 'MSWin32') ? 1 : 0; # threads are memory hogs, so we want few of them. But for testing purposes, # we want a lot of them. 4-8 perhaps. my $numthreads = 4; # Random numbers, pregenerated my @randn = ( qw/71094 1864 14650 58418 46196 45215 70355 80402 70420 33457 73424 45744 22229 61529 82574 61578 26369 76750 15724 61272 52128 77252 2207 3579 69734 14488 20846 46906 6992 43938 34945 51978 11336 58462 11973 75248 39165 8147 62890 63565 39279 47830 43617 40299 65372 37479 884 27007 24978 55716 38115 71502 30134 40903 71231 40095 9054 54133 13876 55660 44544 1880 39217 36609 38711 49576 55029 21831 75022 69128 2311 16321 1400 9659 6010 8206 78113 76539 17430 69393 26519 50162 49317 20231/); if ($extra) { $numthreads *= 2; push @randn, (qw/ 11019 28515 73527 50147 33512 28347 19122 66580 14286 81842 38344 10886 52253 57834 37446 49360 24401 45815 54811 1703 38180 22473 17946 58833 29700 55366 35155 31902 28299 34139 51961 75210 9126 30331 54658 50208 13936 57086 27118 75817 31571 76715 53441 31118 22091 47356 67284 37756 67826 819 78844 64174 53566 28410 40455 76690 69141 2001 1251 39140 2328 49159 14379 73801 30195 19745 72355 51038 76557 63516 54486 45951 65586 61730 6310 73490 71132 25970 51034 27856 11490 25817 24283 52759 68248 9246 52896 72365 31983 74001 16616 63960 70718 43518 27054 6397 1247 64241 27517 2927 3557 76192 36376 21334 1395 20926 36088 65519 2650 9739 23758 74720 34458 41096 51926 45932 14850 38181 60833 53481 8086 43319 11891 22674 22916 72918 3650 35246 39543 25544 35578 67023 50752 29653 76351 64909 9425 27547 10108 13399 69540 3833 12748 6386 76511 28041 31586 50034 8828 17845 44376 74301 39762 40216 5092 16261 7434 29908 18671 7189 18373 31608 67155 19129 20586 6713 73424 20568 64299 71411 53762 20070 56014 3560 9129 50993 44983 15434 5035 77815 22836 9786 24808 50756 15298 48358 36466 4308 195 69058 55813 18840 23284 41448 37349 59268 36894 79674 31694 73975 71738 18344 26328 5264 79976 26714 27187 65237 18881 74975 28505 16271 51390 22598 65689 65512 20357 68743 72422 69481 26714 6824 30012/); } thread_test( sub { my $sum = 0; $sum += prime_count($_) for (@randn); return $sum;}, $numthreads, "sum prime_count"); SKIP: { skip "Win32 needs precalc, skipping alloc/free stress test", 1 if $is_win32; thread_test( sub { my $sum = 0; for (@randn) {$sum += prime_count($_); prime_memfree; } return $sum;}, $numthreads, "sum prime_count with overlapping memfree calls"); } thread_test( sub { my $sum = 0; for my $d (@randn) { for my $f (factor($d)) { $sum += $f; } } return $sum; }, $numthreads, "factor"); thread_test( sub { my $sum = 0; $sum += nth_prime($_) for (@randn); return $sum;}, $numthreads, "nth_prime"); thread_test( sub { my $sum = 0; $sum += next_prime($_) for (@randn); return $sum;}, $numthreads, "next_prime"); thread_test( sub { my $sum = 0; $sum += prev_prime($_) for (@randn); return $sum;}, $numthreads, "prev_prime"); thread_test( sub { my $sum = 0; $sum += is_prime($_) for (@randn); return $sum;}, $numthreads, "is_prime"); thread_test( sub { my $sum = 0; foreach my $n (@randn) { $sum += $_ for moebius($n,$n+50); } return $sum;}, $numthreads, "moebius"); # Custom rand, so we get the same result each time. { my $seed = 1; sub mysrand { $seed = $_[0]; } sub irand { $seed = (1103515245*$seed + 12345) % 4294967296; } prime_set_config( irand => \&irand ); } thread_test( sub { my $sum = 0; for (@randn) { mysrand($_); $sum += random_ndigit_prime(6); } return $sum;}, $numthreads, "random 6-digit prime"); thread_test( sub { my $sum = 0; $sum += int(RiemannR($_)) for (@randn); return $sum;}, $numthreads, "RiemannR"); sub thread_test { my $tsub = shift; my $nthreads = shift; my $text = shift; if ($is_win32) { prime_precalc(1_200_000); # enough for all these tests } my @threads; # Fire off all our threads push @threads, threads->create($tsub) for (1..$nthreads); # Get results my $par_sum = 0; $par_sum += $_->join() for (@threads); prime_memfree; # Now do the same operation sequentially my $seq_sum = 0; $seq_sum += $tsub->() for (1..$nthreads); prime_memfree; is($par_sum, $seq_sum, "$nthreads threads $text"); } Math-Prime-Util-0.37/t/12-nextprime.t0000644000076400007640000001106012270011421015570 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/next_prime prev_prime/; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; plan tests => 2 + 3*2 + 6 + 2 + 148 + 148 + 1; my @small_primes = qw/ 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947 953 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069 1087 1091 1093 1097 1103 1109 1117 1123 1129 1151 1153 1163 1171 1181 1187 1193 1201 1213 1217 1223 1229 1231 1237 1249 1259 1277 1279 1283 1289 1291 1297 1301 1303 1307 1319 1321 1327 1361 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459 1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543 1549 1553 1559 1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627 1637 1657 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753 1759 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877 1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997 1999 2003 2011 2017 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089 2099 2111 2113 2129 2131 2137 2141 2143 2153 2161 2179 2203 2207 2213 2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 2297 2309 2311 2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 2399 2411 2417 2423 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 2543 2549 2551 2557 2579 2591 2593 2609 2617 2621 2633 2647 2657 2659 2663 2671 2677 2683 2687 2689 2693 2699 2707 2711 2713 2719 2729 2731 2741 2749 2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851 2857 2861 2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969 2971 2999 3001 3011 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089 3109 3119 3121 3137 3163 3167 3169 3181 3187 3191 3203 3209 3217 3221 3229 3251 3253 3257 3259 3271 3299 3301 3307 3313 3319 3323 3329 3331 3343 3347 3359 3361 3371 3373 3389 3391 3407 3413 3433 3449 3457 3461 3463 3467 3469 3491 3499 3511 3517 3527 3529 3533 3539 3541 3547 3557 3559 3571 /; { # insert primes before and after unshift @small_primes, 0; push @small_primes, 3581; # Now test next_prime and prev_prime for all numbers 0 to 3572 my $prev_index = 0; my $next_index = 1; # We'll collect them here my(@got_next, @got_prev, @exp_next, @exp_prev); foreach my $n (0 .. 3572) { $next_index++ if $n >= $small_primes[$next_index]; $prev_index++ if $n > $small_primes[$prev_index+1]; push @got_next, next_prime($n); push @got_prev, prev_prime($n); push @exp_next, $small_primes[$next_index]; push @exp_prev, $small_primes[$prev_index]; } is_deeply( \@got_next, \@exp_next, "next_prime 0 .. 3572" ); is_deeply( \@got_prev, \@exp_prev, "prev_prime 0 .. 3572" ); } my %primegaps = ( 19609 => 52, 360653 => 96, 2010733 => 148, ); while (my($base, $range) = each (%primegaps)) { is( next_prime($base), $base+$range, "next prime of $base is $base+$range" ); is( prev_prime($base+$range), $base, "prev prime of $base+$range is $base" ); } is( next_prime(19608), 19609, "next prime of 19608 is 19609" ); is( next_prime(19610), 19661, "next prime of 19610 is 19661" ); is( next_prime(19660), 19661, "next prime of 19660 is 19661" ); is( prev_prime(19662), 19661, "prev prime of 19662 is 19661" ); is( prev_prime(19660), 19609, "prev prime of 19660 is 19609" ); is( prev_prime(19610), 19609, "prev prime of 19610 is 19609" ); is( prev_prime(2), 0, "Previous prime of 2 returns 0" ); if ($use64) { is( next_prime(18446744073709551611), "18446744073709551629", "Next prime of ~0-4 returns bigint next prime" ); } else { is( next_prime(4294967291), "4294967311", "Next prime of ~0-4 returns bigint next prime" ); } # Turns out the testing of prev/next from 0-3572 still misses some cases. foreach my $n (2010733 .. 2010880) { is(next_prime($n), 2010881, "next_prime($n) == 2010881"); } foreach my $n (2010734 .. 2010881) { is(prev_prime($n), 2010733, "prev_prime($n) == 2010733"); } # Similar test case to 2010870, where m=0 and next_prime is at m=1 is(next_prime(1234567890), 1234567891, "next_prime(1234567890) == 1234567891)"); Math-Prime-Util-0.37/t/80-pp.t0000644000076400007640000007012612270244414014223 0ustar danadana#!/usr/bin/env perl use strict; use warnings; # This is a subset of our tests. You really should run the whole test suite # on the PP code. What this will do is basic regression testing. my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $use64 = ~0 > 4294967295 && ~0 != 18446744073709550592; use Test::More; my @small_primes = qw/ 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947 953 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069 /; # next prime is 1087 my @primes = qw/ 1129 1327 9551 15683 19609 31397 155921 5 11 29 97 127 541 907 1151 1361 9587 15727 19661 31469 156007 360749 370373 492227 1349651 1357333 2010881 4652507 17051887 20831533 47326913 122164969 189695893 191913031 /; my @composites = qw/ 0 4 6 8 9 10 12 14 15 16 18 20 21 22 9 2047 1373653 25326001 3215031751 561 1105 1729 2465 2821 6601 8911 10585 15841 29341 41041 46657 52633 62745 63973 75361 101101 340561 488881 852841 1857241 6733693 9439201 17236801 23382529 34657141 56052361 146843929 341 561 645 1105 1387 1729 1905 2047 2465 2701 2821 3277 4033 4369 4371 4681 5461 6601 7957 8321 52633 88357 66066 173645446 7500135 115501463 /; # pseudoprimes to various small prime bases my %pseudoprimes = ( 2 => [ qw/2047 42799 4335241 1078467589/ ], 3 => [ qw/121 44287 4252381 1075490821/ ], 5 => [ qw/781 38081 4265257 1075156291/ ], 7 => [ qw/25 325 29857 4411681 1074439981/ ], 11 => [ qw/133 43213 4224533 1076929261/ ], 13 => [ qw/85 35371 4336879 1079159203/ ], 17 => [ qw/9 91 71071 4224533 1076237119/ ], 19 => [ qw/9 49 49771 4384693 1074718783/ ], 23 => [ qw/169 25201 4219129 1079063371/ ], 29 => [ qw/15 91 48133 4219129 1075151447/ ], 31 => [ qw/15 49 29341 4270657 1073833843/ ], 37 => [ qw/9 451 59563 4287817 1075430539/ ], 61 => [ qw/217 79381 4219129 1079326249/ ], 73 => [ qw/205 34219 4321153 1074220489/ ], psp2 => [ qw/341 561 29341 4259905 1073823745/ ], psp3 => [ qw/91 121 44287 4252381 1073827147/ ], lucas => [ qw/9179 10877 44099 4259789 1074039119/ ], slucas => [ qw/5459 5777 75077 4309631 1080085439/ ], eslucas => [ qw/989 3239 5777 72389 4226777 1076503199/ ], aeslucas1 => [ qw/989 10469 39059 4269341 1076503199/ ], aeslucas2 => [ qw/4531 12209 62479 4403027 1074695441/ ], ); # Test a pseudoprime larger than 2^32. push @{$pseudoprimes{2}}, 75792980677 if $use64; my $num_pseudoprimes = 0; foreach my $ppref (values %pseudoprimes) { push @composites, @$ppref; $num_pseudoprimes += scalar @$ppref; } { my %uniq; $uniq{$_}++ for (@composites); @composites = sort {$a<=>$b} keys %uniq; } my %small_single = ( 0 => [], 1 => [], 2 => [2], 3 => [2, 3], 4 => [2, 3], 5 => [2, 3, 5], 6 => [2, 3, 5], 7 => [2, 3, 5, 7], 11 => [2, 3, 5, 7, 11], 18 => [2, 3, 5, 7, 11, 13, 17], 19 => [2, 3, 5, 7, 11, 13, 17, 19], 20 => [2, 3, 5, 7, 11, 13, 17, 19], ); my %small_range = ( "3 to 9" => [3,5,7], "2 to 20" => [2,3,5,7,11,13,17,19], "30 to 70" => [31,37,41,43,47,53,59,61,67], "70 to 30" => [], "20 to 2" => [], "1 to 1" => [], "2 to 2" => [2], "3 to 3" => [3], "2 to 3" => [2,3], "2 to 5" => [2,3,5], "3 to 6" => [3,5], "3 to 7" => [3,5,7], "4 to 8" => [5,7], "2010733 to 2010881" => [2010733,2010881], "2010734 to 2010880" => [], "3088 to 3164" => [3089,3109,3119,3121,3137,3163], "3089 to 3163" => [3089,3109,3119,3121,3137,3163], "3090 to 3162" => [3109,3119,3121,3137], "3842610773 to 3842611109" => [3842610773,3842611109], "3842610774 to 3842611108" => [], ); my %primegaps = ( 19609 => 52, 360653 => 96, 2010733 => 148, ); my %pivals32 = ( 1 => 0, 10 => 4, 100 => 25, 1000 => 168, 10000 => 1229, 100000 => 9592, 1000000 => 78498, 10000000 => 664579, 100000000 => 5761455, 1000000000 => 50847534, 60067 => 6062, 65535 => 6542, 16777215 => 1077871, 2147483647 => 105097565, 4294967295 => 203280221, ); my %pivals_small = map { $_ => $pivals32{$_} } grep {$_ <= 80000} keys %pivals32; my %pi_intervals = ( "1e9 +2**14" => 785, "17 to 13" => 0, "3 to 17" => 6, "4 to 17" => 5, "4 to 16" => 4, "191912783 +248" => 2, "191912784 +247" => 1, "191912783 +247" => 1, "191912784 +246" => 0, ); my %extra_pi_intervals = ( "868396 to 9478505" => 563275, "1118105 to 9961674" => 575195, "24689 to 7973249" => 535368, ); # Add extra intervals to pi_intervals if we're doing release testing @pi_intervals{keys %extra_pi_intervals} = values %extra_pi_intervals if $extra; # Remove any entries where the high value is too large for us # ikegami++ for the delete from a hash slice idea delete @pi_intervals{ grep { (parse_range($_))[1] > ~0 } keys %pi_intervals }; my %nthprimes32 = ( 1 => 2, 10 => 29, 100 => 541, 1000 => 7919, 10000 => 104729, 100000 => 1299709, 1000000 => 15485863, 10000000 => 179424673, 100000000 => 2038074743, ); my %nthprimes_small = map { $_ => $nthprimes32{$_} } grep { $extra ? ($_ <= 2_000_000) : ($_ <= 5_000) } keys %nthprimes32; my %eivals = ( -10 => -0.00000415696892968532438, -0.5 => -0.55977359477616, -0.1 => -1.8229239584193906660809, -0.001 => -6.33153936413615, -0.00001 => -10.9357198000436956, -0.00000001 => -17.843465089050832587, 0.693147180559945 => 1.0451637801174927848446, # log2 1 => 1.8951178163559367554665, 1.5 => 3.3012854491297978379574, 2 => 4.9542343560018901633795, 5 => 40.185275355803177455091, 10 => 2492.2289762418777591384, 12 => 14959.532666397528852292, 20 => 25615652.664056588820481, 40 => 6039718263611241.5783592, 41 => 16006649143245041.110700, ); my %livals = ( 0 => 0, 1.01 => -4.0229586739299358695031, 2 => 1.0451637801174927848446, 10 => 6.1655995047872979375230, 24 => 11.200315795232698830550, 1000 => 177.60965799015222668764, 100000 => 9629.8090010507982050343, 100000000 => 5762209.3754480314675691, 4294967295 => 203284081.95454158906409, 10000000000 => 455055614.58662307560953, 100000000000 => 4118066400.6216115150394, ); my %rvals = ( 1.01 => 1.0060697180622924796117, 2 => 1.5410090161871318832885, 10 => 4.5645831410050902398658, 1000 => 168.35944628116734806491, 1000000 => 78527.399429127704858870, 10000000 => 664667.44756474776798535, 4294967295 => 203280697.51326064541983, 10000000000 => 455050683.30684692446315, 18446744073709551615 => 4.25656284014012122706963685602e17, ); my %rzvals = ( 2 => 0.6449340668482264364724151666, 2.5 => 0.3414872572509171797567696934, 4.5 => 0.0547075107614542640229672890, 7 => 0.0083492773819228268397975498, 8.5 => 0.0028592508824156277133439825, 20.6 => 0.0000006293391573578212882457, 80 => 8.27180612553034e-25, 180 => 6.52530446799852e-55, ); my %ipp = ( 5 => 2, 10 => 0, 49 => 0, 347 => 2, 697 => 0, 7080233 => 2, 7080249 => 0, 17471059 => 2, 17471061 => 0, 36010357 => 2, 36010359 => 0, ); plan tests => 2 + 3 + 3 + scalar(keys %small_single) + scalar(keys %small_range) + 2*scalar(keys %primegaps) + 8 + 1 + 1 + 1 + scalar(keys %pivals_small) + scalar(keys %pi_intervals) + 2*scalar(keys %pivals_small) + scalar(keys %nthprimes_small) + 4 + scalar(keys %pseudoprimes) + scalar(keys %eivals) + scalar(keys %livals) + scalar(keys %rvals) + scalar(keys %rzvals) + ($extra ? 4 : 0) + # Bigfloat RiemannZeta 1 + 1 + # factor 10 + 7*3 + # factoring subs 1 + # HOLF ($extra ? 3 : 0) + # HOLF extra 10 + # AKS ($use64 ? 3 : 2) + # Lucas and BLS75 primality proofs 4 + # M-R and Lucas on bigint 13 + # Misc util.pm functions scalar(keys %ipp) + # is_prob_prime 1; use Math::Prime::Util qw/primes prime_count_approx prime_count_lower prime_get_config prime_set_config consecutive_integer_lcm chebyshev_theta chebyshev_psi is_prob_prime /; use Math::BigInt; use Math::BigFloat; require_ok 'Math::Prime::Util::PP'; require_ok 'Math::Prime::Util::PrimalityProving'; # This function skips some setup undef *primes; *primes = \&Math::Prime::Util::PP::primes; *prime_count = \&Math::Prime::Util::PP::prime_count; *nth_prime = \&Math::Prime::Util::PP::nth_prime; *is_prime = \&Math::Prime::Util::PP::is_prime; *next_prime = \&Math::Prime::Util::PP::next_prime; *prev_prime = \&Math::Prime::Util::PP::prev_prime; *is_pseudoprime = \&Math::Prime::Util::PP::is_pseudoprime; *is_strong_pseudoprime = \&Math::Prime::Util::PP::is_strong_pseudoprime; *is_lucas_pseudoprime = \&Math::Prime::Util::PP::is_lucas_pseudoprime; *is_strong_lucas_pseudoprime = \&Math::Prime::Util::PP::is_strong_lucas_pseudoprime; *is_extra_strong_lucas_pseudoprime = \&Math::Prime::Util::PP::is_extra_strong_lucas_pseudoprime; *is_almost_extra_strong_lucas_pseudoprime = \&Math::Prime::Util::PP::is_almost_extra_strong_lucas_pseudoprime; *is_frobenius_underwood_pseudoprime = \&Math::Prime::Util::PP::is_frobenius_underwood_pseudoprime; *is_aks_prime = \&Math::Prime::Util::PP::is_aks_prime; *factor = \&Math::Prime::Util::PP::factor; *moebius = \&Math::Prime::Util::PP::moebius; *euler_phi = \&Math::Prime::Util::PP::euler_phi; *mertens = \&Math::Prime::Util::PP::mertens; *exp_mangoldt = \&Math::Prime::Util::PP::exp_mangoldt; *RiemannR = \&Math::Prime::Util::PP::RiemannR; *RiemannZeta = \&Math::Prime::Util::PP::RiemannZeta; *LogarithmicIntegral = \&Math::Prime::Util::PP::LogarithmicIntegral; *ExponentialIntegral = \&Math::Prime::Util::PP::ExponentialIntegral; # Turn off use of BRS - ECM tries to use this. prime_set_config( irand => sub { int(rand(4294967296.0)) } ); ############################################################################### $_ = 'this should not change'; { my %small_primes = map { $_ => 1 } @small_primes; my @isprime = map { is_prime($_) } (0 .. 1086); my @exprime = map { $small_primes{$_} ? 2 : 0 } (0 .. 1086); is_deeply( \@isprime, \@exprime, "is_prime 0 .. 1086" ); } { my @isprime = map { is_prime($_) ? "$_ is prime" : "$_ is composite" } @primes, @composites; my @exprime = map { "$_ is prime" } @primes; push @exprime, map { "$_ is composite" } @composites; is_deeply( \@isprime, \@exprime, "is_prime for selected numbers" ); } is_deeply( Math::Prime::Util::PP::trial_primes(80), [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79], "Trial primes 2-80" ); ############################################################################### is_deeply( primes(1069), \@small_primes, "Primes between 0 and 1069" ); is_deeply( primes(1070), \@small_primes, "Primes between 0 and 1070" ); is_deeply( primes(1086), \@small_primes, "Primes between 0 and 1086" ); while (my($high, $expect) = each (%small_single)) { is_deeply( primes($high), $expect, "primes($high) should return [@{$expect}]") ; } while (my($range, $expect) = each (%small_range)) { my($low,$high) = $range =~ /(\d+) to (\d+)/; is_deeply( primes($low, $high), $expect, "primes($low,$high) should return [@{$expect}]"); } ############################################################################### while (my($base, $range) = each (%primegaps)) { is( next_prime($base), $base+$range, "next prime of $base is $base+$range" ); is( prev_prime($base+$range), $base, "prev prime of $base+$range is $base" ); } is( next_prime(19608), 19609, "next prime of 19608 is 19609" ); is( next_prime(19610), 19661, "next prime of 19610 is 19661" ); is( next_prime(19660), 19661, "next prime of 19660 is 19661" ); is( prev_prime(19662), 19661, "prev prime of 19662 is 19661" ); is( prev_prime(19660), 19609, "prev prime of 19660 is 19609" ); is( prev_prime(19610), 19609, "prev prime of 19610 is 19609" ); is( prev_prime(2), 0, "Previous prime of 2 returns 0" ); if ($use64) { is( next_prime(18446744073709551611), "18446744073709551629", "Next prime of ~0-4 returns bigint next prime" ); } else { is( next_prime(4294967291), "4294967311", "Next prime of ~0-4 returns bigint next prime" ); } { my @exprime = map { "next_prime($_) == 2010881" } (2010733..2010880); my @isprime = map { "next_prime($_) == ".next_prime($_) } (2010733..2010880); is_deeply(\@isprime, \@exprime, "next_prime for 148 primes before primegap end 2010881"); } { my @exprime = map { "prev_prime($_) == 2010733" } (2010734..2010881); my @isprime = map { "prev_prime($_) == ".prev_prime($_) } (2010734..2010881); is_deeply(\@isprime, \@exprime, "prev_prime for 148 primes before primegap start 2010733"); } # Similar test case to 2010870, where m=0 and next_prime is at m=1 is(next_prime(1234567890), 1234567891, "next_prime(1234567890) == 1234567891)"); ############################################################################### while (my($n, $pin) = each (%pivals_small)) { is( prime_count($n), $pin, "Pi($n) = $pin" ); } while (my($range, $expect) = each (%pi_intervals)) { my($low,$high) = parse_range($range); is( prime_count($low,$high), $expect, "prime_count($range) = $expect"); } ############################################################################### while (my($n, $pin) = each (%pivals_small)) { my $next = $pin+1; cmp_ok( nth_prime($pin), '<=', $n, "nth_prime($pin) <= $n"); cmp_ok( nth_prime($next), '>=', $n, "nth_prime($next) >= $n"); } while (my($n, $nth) = each (%nthprimes_small)) { is( nth_prime($n), $nth, "nth_prime($n) = $nth" ); } ############################################################################### is( is_strong_pseudoprime(0, 2), 0, "MR with 0 shortcut composite"); is( is_strong_pseudoprime(1, 2), 0, "MR with 0 shortcut composite"); is( is_strong_pseudoprime(2, 2), 1, "MR with 2 shortcut prime"); is( is_strong_pseudoprime(3, 2), 1, "MR with 3 shortcut prime"); while (my($base, $ppref) = each (%pseudoprimes)) { my $npseudos = scalar @$ppref; my @expmr = map { 1 } @$ppref; my @gotmr; if ($base =~ /^psp(\d+)/) { my $pbase = $1; @gotmr = map { is_pseudoprime($_, $pbase) } @$ppref; } elsif ($base =~ /^aeslucas(\d+)/) { my $inc = $1; @gotmr = map { is_almost_extra_strong_lucas_pseudoprime($_, $inc) } @$ppref; } elsif ($base eq 'eslucas') { @gotmr = map { is_extra_strong_lucas_pseudoprime($_) } @$ppref; } elsif ($base eq 'slucas') { @gotmr = map { is_strong_lucas_pseudoprime($_) } @$ppref; } elsif ($base eq 'lucas') { @gotmr = map { is_lucas_pseudoprime($_) } @$ppref; } else { @gotmr = map { is_strong_pseudoprime($_, $base) } @$ppref; } is_deeply(\@gotmr, \@expmr, "$npseudos pseudoprimes (base $base)"); } ############################################################################### while (my($n, $ein) = each (%eivals)) { cmp_closeto( ExponentialIntegral($n), $ein, 0.00000001 * abs($ein), "Ei($n) ~= $ein"); } while (my($n, $lin) = each (%livals)) { cmp_closeto( LogarithmicIntegral($n), $lin, 0.00000001 * abs($lin), "li($n) ~= $lin"); } while (my($n, $rin) = each (%rvals)) { cmp_closeto( RiemannR($n), $rin, 0.00000001 * abs($rin), "R($n) ~= $rin"); } while (my($n, $zin) = each (%rzvals)) { cmp_closeto( RiemannZeta($n), $zin, 0.00000001 * abs($zin), "Zeta($n) ~= $zin"); } if ($extra) { my ($n, $zin); ($n, $zin) = (4.5, $rzvals{4.5}); cmp_closeto( RiemannZeta(Math::BigFloat->new($n)), $zin, 0.00000001 * abs($zin), "Zeta($n) ~= $zin"); ($n, $zin) = (20.6, $rzvals{20.6}); cmp_closeto( RiemannZeta(Math::BigFloat->new($n)), $zin, 0.00000001 * abs($zin), "Zeta($n) ~= $zin"); ($n, $zin) = (80, $rzvals{80}); cmp_closeto( RiemannZeta(Math::BigFloat->new($n)), $zin, 0.00000001 * abs($zin), "Zeta($n) ~= $zin"); ($n, $zin) = (180, $rzvals{180}); cmp_closeto( RiemannZeta(Math::BigFloat->new($n)), $zin, 0.00000001 * abs($zin), "Zeta($n) ~= $zin"); } ############################################################################### #foreach my $n (@primes) { # my @f = factor($n); # is_deeply( \@f, [$n], "factor prime $n yields $n" ); #} { my $ntests = scalar @primes; my @expfactor = map { "$_" } @primes; my @gotfactor = map { join(' * ', factor($_)) } @primes; is_deeply( \@gotfactor, \@expfactor, "test factoring for $ntests primes"); } { my $ntests = scalar @composites; my @expfactor = map { "$_ factored correctly" } @composites; my @gotfactor; foreach my $n (@composites) { my @f = factor($n); my $facstring = join(' * ', @f); if ($n < 2) { push @gotfactor, (@f == 1 && $f[0] == $n) ? "$n factored correctly" : "$n not correct: $facstring"; next; } my $product = 1; $product = int($product * $_) for @f; my $allprime = 1; $allprime *= is_prime($_) for @f; if (@f >= 2 && $product == $n && $allprime) { push @gotfactor, "$n factored correctly"; } else { push @gotfactor, "$n not correct: $facstring"; } } is_deeply( \@gotfactor, \@expfactor, "test factoring for $ntests composites"); } # The PP factor code does small trials, then loops doing 64k rounds of HOLF # if the composite is less than a half word, followed by 64k rounds each of # prho with a = {3,5,7,11,13}. Most numbers are handled by these. The ones # that aren't end up being too slow for us to put in a test. So we'll try # running the various factoring methods manually. { is_deeply( [ sort {$a<=>$b} Math::Prime::Util::PP::holf_factor(403) ], [ 13, 31 ], "holf(403)" ); is_deeply( [ sort {$a<=>$b} Math::Prime::Util::PP::fermat_factor(403) ], [ 13, 31 ], "fermat(403)" ); is_deeply( [ sort {$a<=>$b} Math::Prime::Util::PP::prho_factor(403) ], [ 13, 31 ], "prho(403)" ); is_deeply( [ sort {$a<=>$b} Math::Prime::Util::PP::pbrent_factor(403) ], [ 13, 31 ], "pbrent(403)" ); is_deeply( [ sort {$a<=>$b} Math::Prime::Util::PP::pminus1_factor(403) ], [ 13, 31 ], "pminus1(403)" ); is_deeply( [ sort {$a<=>$b} Math::Prime::Util::PP::prho_factor(851981) ], [ 13, 65537 ], "prho(851981)" ); is_deeply( [ sort {$a<=>$b} Math::Prime::Util::PP::pbrent_factor(851981) ], [ 13, 65537 ], "pbrent(851981)" ); is_deeply( [ sort {$a<=>$b} Math::Prime::Util::PP::ecm_factor(851981) ], [ 13, 65537 ], "ecm(851981)" ); my $n64 = $use64 ? 55834573561 : Math::BigInt->new("55834573561"); is_deeply( [ sort {$a<=>$b} Math::Prime::Util::PP::prho_factor($n64) ], [ 13, 4294967197 ], "prho(55834573561)" ); is_deeply( [ sort {$a<=>$b} Math::Prime::Util::PP::pbrent_factor($n64) ], [ 13, 4294967197 ], "pbrent(55834573561)" ); # 1013 4294967197 4294967291 my $nbig = Math::BigInt->new("18686551294184381720251"); my @nfac; @nfac = sort {$a<=>$b} Math::Prime::Util::PP::prho_factor($nbig); is(scalar @nfac, 2, "prho finds a factor of 18686551294184381720251"); is($nfac[0] * $nfac[1], $nbig, "prho found a correct factor"); ok($nfac[0] != 1 && $nfac[1] != 1, "prho didn't return a degenerate factor"); @nfac = sort {$a<=>$b} Math::Prime::Util::PP::pbrent_factor($nbig); is(scalar @nfac, 2, "pbrent finds a factor of 18686551294184381720251"); is($nfac[0] * $nfac[1], $nbig, "pbrent found a correct factor"); ok($nfac[0] != 1 && $nfac[1] != 1, "pbrent didn't return a degenerate factor"); @nfac = sort {$a<=>$b} Math::Prime::Util::PP::pminus1_factor($nbig); is(scalar @nfac, 2, "pminus1 finds a factor of 18686551294184381720251"); is($nfac[0] * $nfac[1], $nbig, "pminus1 found a correct factor"); ok($nfac[0] != 1 && $nfac[1] != 1, "pminus1 didn't return a degenerate factor"); @nfac = sort {$a<=>$b} Math::Prime::Util::PP::ecm_factor($nbig); is(scalar @nfac, 2, "ecm finds a factor of 18686551294184381720251"); is($nfac[0] * $nfac[1], $nbig, "ecm found a correct factor"); ok($nfac[0] != 1 && $nfac[1] != 1, "ecm didn't return a degenerate factor"); $nbig = Math::BigInt->new("73786976930493367637"); # Check stage 2 p-1. Fast with Math::BigInt::GMP, slow without. SKIP: { skip "Skipping p-1 stage 2 tests", 3 unless $extra; @nfac = sort {$a<=>$b} Math::Prime::Util::PP::pminus1_factor($nbig, 27000, 35000); is(scalar @nfac, 2, "pminus1 finds a factor of 73786976930493367637"); is($nfac[0] * $nfac[1], $nbig, "pminus1 found a correct factor"); ok($nfac[0] != 1 && $nfac[1] != 1, "pminus1 didn't return a degenerate factor"); } @nfac = sort {$a<=>$b} Math::Prime::Util::PP::fermat_factor($nbig); is(scalar @nfac, 2, "fermat finds a factor of 73786976930493367637"); is($nfac[0] * $nfac[1], $nbig, "fermat found a correct factor"); ok($nfac[0] != 1 && $nfac[1] != 1, "fermat didn't return a degenerate factor"); if ($extra) { @nfac = sort {$a<=>$b} Math::Prime::Util::PP::holf_factor($nbig); is(scalar @nfac, 2, "holf finds a factor of 18686551294184381720251"); is($nfac[0] * $nfac[1], $nbig, "holf found a correct factor"); ok($nfac[0] != 1 && $nfac[1] != 1, "holf didn't return a degenerate factor"); } { $nbig = Math::BigInt->new("99999999999979999998975857"); @nfac = sort {$a<=>$b} Math::Prime::Util::PP::holf_factor($nbig); is_deeply(\@nfac, [9999999998987,10000000001011], "holf correctly factors 99999999999979999998975857"); } SKIP: { # Unfortunately we can't guarantee this isn't found in stage 1. skip "ecm stage 2", 3 unless $extra; $nbig = Math::BigInt->new("14270401808568703916861"); @nfac = sort {$a<=>$b} Math::Prime::Util::PP::ecm_factor($nbig, 5, 2000, 40); is(scalar @nfac, 2, "ecm(5,2000) finds a factor of 14270401808568703916861"); is($nfac[0] * $nfac[1], $nbig, "ecm(5,2000) found a correct factor"); ok($nfac[0] != 1 && $nfac[1] != 1, "ecm(5,2000) didn't return a degenerate factor"); } } ##### AKS primality test. Be very careful with performance. is( is_aks_prime(1), 0, "AKS: 1 is composite (less than 2)" ); is( is_aks_prime(2), 1, "AKS: 2 is prime" ); is( is_aks_prime(3), 1, "AKS: 3 is prime" ); is( is_aks_prime(4), 0, "AKS: 4 is composite" ); is( is_aks_prime(64), 0, "AKS: 64 is composite (perfect power)" ); is( is_aks_prime(65), 0, "AKS: 65 is composite (caught in trial)" ); is( is_aks_prime(23), 1, "AKS: 23 is prime (r >= n)" ); is( is_aks_prime(70747), 0, "AKS: 70747 is composite (n mod r)" ); SKIP: { skip "Skipping PP AKS test without EXTENDED_TESTING", 2 unless $extra; diag "32-bit Perl will be very slow for AKS" unless $use64; is( is_aks_prime(101), 1, "AKS: 101 is prime (passed anr test)" ); is( is_aks_prime(74513), 0, "AKS: 74513 is composite (failed anr test)" ); } is_deeply( [Math::Prime::Util::PrimalityProving::primality_proof_lucas(100003)], [2, "[MPU - Primality Certificate]\nVersion 1.0\n\nProof for:\nN 100003\n\nType Lucas\nN 100003\nQ[1] 2\nQ[2] 3\nQ[3] 7\nQ[4] 2381\nA 2\n"], "primality_proof_lucas(100003)" ); # Had to reduce these to make borked up Perl 5.6.2 work. #is_deeply( [Math::Prime::Util::PP::primality_proof_bls75("210596120454733723")], # [2, ["210596120454733723", "n-1", [2, 3, 82651, "47185492693"], [2, 2, 2, 2]]], # "primality_proof_bls75(210596120454733723)" ); is_deeply( [Math::Prime::Util::PrimalityProving::primality_proof_bls75(1490266103)], [2, "[MPU - Primality Certificate]\nVersion 1.0\n\nProof for:\nN 1490266103\n\nType BLS5\nN 1490266103\nQ[1] 13\nQ[2] 19\nQ[3] 1597\nQ[4] 1889\nA[0] 5\n----\n"], "primality_proof_bls75(1490266103)" ); if ($use64) { is_deeply( [Math::Prime::Util::PrimalityProving::primality_proof_bls75(27141057803)], [2, "[MPU - Primality Certificate]\nVersion 1.0\n\nProof for:\nN 27141057803\n\nType BLS5\nN 27141057803\nQ[1] 47533\nQ[2] 285497\n----\n"], "primality_proof_bls75(27141057803)" ); } { my $n = Math::BigInt->new("168790877523676911809192454171451"); is( is_strong_pseudoprime( $n, 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47), 1, "168790877523676911809192454171451 looks prime with bases 2..52" ); is( is_strong_pseudoprime( $n, 53), 0, "168790877523676911809192454171451 found composite with base 53" ); is ( is_strong_lucas_pseudoprime($n), 0, "168790877523676911809192454171451 is not a strong Lucas pseudoprime" ); SKIP: { skip "Old Perl+bigint segfaults in F-U code", 1 if $] < 5.008; is ( is_frobenius_underwood_pseudoprime($n), 0, "168790877523676911809192454171451 is not a Frobenius pseudoprime" ); } } { # Test some functions usually not tested in Util.pm my $xs = prime_get_config->{'xs'}; my $gmp = prime_get_config->{'gmp'}; my $verbose = prime_get_config->{'verbose'}; prime_set_config(xs=>0, gmp=>0); is( consecutive_integer_lcm(13), 360360, "consecutive_integer_lcm(13)" ); is( consecutive_integer_lcm(52), Math::BigInt->new("3099044504245996706400"), "consecutive_integer_lcm(52)" ); is_deeply( [moebius(513,537)], [qw/0 1 1 0 1 -1 1 0 -1 0 -1 0 0 1 1 0 0 -1 0 0 1 -1 1 0 1/], "moebius(513,537)" ); is( mertens(4219), -13, "mertens(4219)" ); is_deeply( [euler_phi(1513,1537)], [qw/1408 756 800 756 1440 440 1260 576 936 760 1522 504 1200 648 1016 760 1380 384 1530 764 864 696 1224 512 1456/], "euler_phi(1513,1537)" ); is( euler_phi(324234), 108072, "euler_phi(324234)" ); is( exp_mangoldt(16), 2, "exp_mangoldt of power of 2 = 2" ); is( exp_mangoldt(14), 1, "exp_mangoldt of even = 1" ); is( exp_mangoldt(21), 1, "exp_mangoldt of 21 = 1" ); is( exp_mangoldt(23), 23, "exp_mangoldt of 23 = 23" ); is( exp_mangoldt(27), 3, "exp_mangoldt of 27 (3^3) = 3" ); cmp_closeto( chebyshev_theta(27001), 26837.3487140827, 0.00027, "chebyshev_theta(27001) =~ 26837.35"); cmp_closeto( chebyshev_psi(87001), 86964.5577535435, 0.00087, "chebyshev_psi(87001) =~ 86964.56"); while (my($n, $isp) = each (%ipp)) { is( is_prob_prime($n), $isp, "is_prob_prime($n) should be $isp" ); } prime_set_config(xs=>$xs, gmp=>$gmp, verbose=>$verbose); } is( $_, 'this should not change', "Nobody clobbered \$_" ); ############################################################################### sub parse_range { my($range) = @_; my($low,$high); my $fixnum = sub { my $nstr = shift; $nstr =~ s/^(\d+)e(\d+)$/$1*(10**$2)/e; $nstr =~ s/^(\d+)\*\*(\d+)$/$1**$2/e; die "Unknown string in test" unless $nstr =~ /^\d+$/; $nstr; }; if ($range =~ /(\S+)\s+to\s+(\S+)/) { $low = $fixnum->($1); $high = $fixnum->($2); } elsif ($range =~ /(\S+)\s*\+\s*(\S+)/) { $low = $fixnum->($1); $high = $low + $fixnum->($2); } else { die "Can't parse test data"; } ($low,$high); } sub cmp_closeto { my $got = shift; my $expect = shift; my $tolerance = shift; my $message = shift; cmp_ok( abs($got - $expect), '<=', $tolerance, $message ); } Math-Prime-Util-0.37/t/21-conseq-lcm.t0000644000076400007640000000664112262252474015647 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/consecutive_integer_lcm/; plan tests => 101 + 1; my @lcms = qw/ 0 1 2 6 12 60 60 420 840 2520 2520 27720 27720 360360 360360 360360 720720 12252240 12252240 232792560 232792560 232792560 232792560 5354228880 5354228880 26771144400 26771144400 80313433200 80313433200 2329089562800 2329089562800 72201776446800 144403552893600 144403552893600 144403552893600 144403552893600 144403552893600 5342931457063200 5342931457063200 5342931457063200 5342931457063200 219060189739591200 219060189739591200 9419588158802421600 9419588158802421600 9419588158802421600 9419588158802421600 442720643463713815200 442720643463713815200 3099044504245996706400 3099044504245996706400 3099044504245996706400 3099044504245996706400 164249358725037825439200 164249358725037825439200 164249358725037825439200 164249358725037825439200 164249358725037825439200 164249358725037825439200 9690712164777231700912800 9690712164777231700912800 591133442051411133755680800 591133442051411133755680800 591133442051411133755680800 1182266884102822267511361600 1182266884102822267511361600 1182266884102822267511361600 79211881234889091923261227200 79211881234889091923261227200 79211881234889091923261227200 79211881234889091923261227200 5624043567677125526551547131200 5624043567677125526551547131200 410555180440430163438262940577600 410555180440430163438262940577600 410555180440430163438262940577600 410555180440430163438262940577600 410555180440430163438262940577600 410555180440430163438262940577600 32433859254793982911622772305630400 32433859254793982911622772305630400 97301577764381948734868316916891200 97301577764381948734868316916891200 8076030954443701744994070304101969600 8076030954443701744994070304101969600 8076030954443701744994070304101969600 8076030954443701744994070304101969600 8076030954443701744994070304101969600 8076030954443701744994070304101969600 718766754945489455304472257065075294400 718766754945489455304472257065075294400 718766754945489455304472257065075294400 718766754945489455304472257065075294400 718766754945489455304472257065075294400 718766754945489455304472257065075294400 718766754945489455304472257065075294400 718766754945489455304472257065075294400 69720375229712477164533808935312303556800 69720375229712477164533808935312303556800 69720375229712477164533808935312303556800 69720375229712477164533808935312303556800 /; foreach my $n (0..100) { is( consecutive_integer_lcm($n), $lcms[$n], "consecutive_integer_lcm($n)" ); } is( consecutive_integer_lcm(2000), '151117794877444315307536308337572822173736308853579339903227904473000476322347234655122160866668946941993951014270933512030194957221371956828843521568082173786251242333157830450435623211664308500316844478617809101158220672108895053508829266120497031742749376045929890296052805527212315382805219353316270742572401962035464878235703759464796806075131056520079836955770415021318508272982103736658633390411347759000563271226062182345964184167346918225243856348794013355418404695826256911622054015423611375261945905974225257659010379414787547681984112941581325198396634685659217861208771400322507388161967513719166366839894214040787733471287845629833993885413462225294548785581641804620417256563685280586511301918399010451347815776570842790738545306707750937624267501103840324470083425714138183905657667736579430274197734179172691637931540695631396056193786415805463680000', "consecutive_integer_lcm(2000)" ); Math-Prime-Util-0.37/t/91-release-pod-syntax.t0000644000076400007640000000062311762666376017351 0ustar danadana#!/usr/bin/perl use strict; use warnings; BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } #--------------------------------------------------------------------- use Test::More; eval "use Test::Pod 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(); Math-Prime-Util-0.37/t/20-primorial.t0000644000076400007640000000425412270242116015570 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/primorial pn_primorial/; my @pn_primorials = qw/ 1 2 6 30 210 2310 30030 510510 9699690 223092870 6469693230 200560490130 7420738134810 304250263527210 13082761331670030 614889782588491410 32589158477190044730 1922760350154212639070 117288381359406970983270 7858321551080267055879090 557940830126698960967415390 40729680599249024150621323470 3217644767340672907899084554130 267064515689275851355624017992790 23768741896345550770650537601358310 2305567963945518424753102147331756070 232862364358497360900063316880507363070 23984823528925228172706521638692258396210 2566376117594999414479597815340071648394470 279734996817854936178276161872067809674997230 31610054640417607788145206291543662493274686990 /; plan tests => 0 + 2 * (scalar @pn_primorials) + 2; my @small_primes = qw/ 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 /; sub nth_prime { my $n = shift; return 0 if $n <= 0; die "Out of range for fake nth_prime: $n" unless defined $small_primes[$n-1]; $small_primes[$n-1]; } foreach my $n (0 .. $#pn_primorials) { is( primorial(nth_prime($n)), $pn_primorials[$n], "primorial(nth($n))" ); is( pn_primorial($n), $pn_primorials[$n], "pn_primorial($n)" ); } is( primorial(100), '2305567963945518424753102147331756070', "primorial(100)"); is( primorial(541), '4711930799906184953162487834760260422020574773409675520188634839616415335845034221205289256705544681972439104097777157991804380284218315038719444943990492579030720635990538452312528339864352999310398481791730017201031090', "primorial(541)" ); Math-Prime-Util-0.37/t/90-release-perlcritic.t0000644000076400007640000000106211762666376017400 0ustar danadana#!/usr/bin/perl use strict; use warnings; use Test::More; BEGIN { unless ($ENV{RELEASE_TESTING}) { plan( skip_all => 'these tests are for release candidate testing' ); } } #--------------------------------------------------------------------- eval { require Test::Perl::Critic; }; plan skip_all => "Test::Perl::Critic required for testing PBP compliance" if $@; Test::Perl::Critic->import( -verbose => 10, -severity => 'gentle', # default -force => 0, # default (allow ## no critic) ); all_critic_ok(); Math-Prime-Util-0.37/t/17-pseudoprime.t0000644000076400007640000003153712270242116016140 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_prime is_pseudoprime is_strong_pseudoprime is_lucas_pseudoprime is_strong_lucas_pseudoprime is_extra_strong_lucas_pseudoprime is_almost_extra_strong_lucas_pseudoprime is_frobenius_underwood_pseudoprime lucas_sequence/; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $extra = 0+(defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}); # small primes my @sp = qw/2 3 5 7 11 13 17 19 23 29 31 37/; # strong pseudoprimes for all prime bases 2 .. pn my @phis = qw/2047 1373653 25326001 3215031751 2152302898747 3474749660383 341550071728321 341550071728321/; $#phis = 3 unless $use64; # pseudoprimes from 2-100k for each prime base # # Using a different codebase to get reference values: # perl -E 'use Math::Primality ":all"; for (2 .. 100000) { print "$_ " if is_strong_pseudoprime($_,17) && !is_prime($_); } print "\n"' # # With large values, one of: # # perl -MMath::Primality=:all -E 'my $_=$base|1; while(1) {print "$_ " if is_strong_pseudoprime($_,$base) && !is_prime($_); $_+=2; } print "\n"; BEGIN {$|=1; $base=553174392}' # # perl -MMath::Primality=is_strong_pseudoprime -MMath::Prime::Util=is_prime -E 'my $_=$base|1; while(1) {print "$_ " if is_strong_pseudoprime($_,$base) && !is_prime($_); $_+=2; } print "\n"; BEGIN {$|=1; $base=553174392}' # # ~30x faster than Math::Primality: # perl -MMath::Prime::Util=:all -E 'my $_=$base|1; while(1) {print "$_ " if is_strong_pseudoprime($_,$base) && !is_prime($_); $_+=2; } print "\n"; BEGIN {$|=1; $base=553174392}' my %pseudoprimes = ( 2 => [ qw/2047 3277 4033 4681 8321 15841 29341 42799 49141 52633 65281 74665 80581 85489 88357 90751 1194649/ ], 3 => [ qw/121 703 1891 3281 8401 8911 10585 12403 16531 18721 19345 23521 31621 44287 47197 55969 63139 74593 79003 82513 87913 88573 97567/ ], 5 => [ qw/781 1541 5461 5611 7813 13021 14981 15751 24211 25351 29539 38081 40501 44801 53971 79381/ ], 7 => [ qw/25 325 703 2101 2353 4525 11041 14089 20197 29857 29891 39331 49241 58825 64681 76627 78937 79381 87673 88399 88831/ ], 11 => [ qw/133 793 2047 4577 5041 12403 13333 14521 17711 23377 43213 43739 47611 48283 49601 50737 50997 56057 58969 68137 74089 85879 86347 87913 88831/ ], 13 => [ qw/85 1099 5149 7107 8911 9637 13019 14491 17803 19757 20881 22177 23521 26521 35371 44173 45629 54097 56033 57205 75241 83333 85285 86347/ ], 17 => [ qw/9 91 145 781 1111 2821 4033 4187 5365 5833 6697 7171 15805 19729 21781 22791 24211 26245 31621 33001 33227 34441 35371 38081 42127 49771 71071 74665 77293 78881 88831 96433 97921 98671/ ], 19 => [ qw/9 49 169 343 1849 2353 2701 4033 4681 6541 6697 7957 9997 12403 13213 13747 15251 16531 18769 19729 24761 30589 31621 31861 32477 41003 49771 63139 64681 65161 66421 68257 73555 96049/ ], 23 => [ qw/169 265 553 1271 2701 4033 4371 4681 6533 6541 7957 8321 8651 8911 9805 14981 18721 25201 31861 34133 44173 47611 47783 50737 57401 62849 82513 96049/ ], 29 => [ qw/15 91 341 469 871 2257 4371 4411 5149 6097 8401 11581 12431 15577 16471 19093 25681 28009 29539 31417 33001 48133 49141 54913 79003/ ], 31 => [ qw/15 49 133 481 931 6241 8911 9131 10963 11041 14191 17767 29341 56033 58969 68251 79003 83333 87061 88183/ ], 37 => [ qw/9 451 469 589 685 817 1333 3781 8905 9271 18631 19517 20591 25327 34237 45551 46981 47587 48133 59563 61337 68101 68251 73633 79381 79501 83333 84151 96727/ ], 61 => [ qw/217 341 1261 2701 3661 6541 6697 7613 13213 16213 22177 23653 23959 31417 50117 61777 63139 67721 76301 77421 79381 80041/ ], 73 => [ qw/205 259 533 1441 1921 2665 3439 5257 15457 23281 24617 26797 27787 28939 34219 39481 44671 45629 64681 67069 76429 79501 93521/ ], 325 => [ qw/341 343 697 1141 2059 2149 3097 3537 4033 4681 4941 5833 6517 7987 8911 12403 12913 15043 16021 20017 22261 23221 24649 24929 31841 35371 38503 43213 44173 47197 50041 55909 56033 58969 59089 61337 65441 68823 72641 76793 78409 85879/ ], 9375 => [ qw/11521 14689 17893 18361 20591 28093 32809 37969 44287 60701 70801 79957 88357 88831 94249 96247 99547/ ], 28178 => [ qw/28179 29381 30353 34441 35371 37051 38503 43387 50557 51491 57553 79003 82801 83333 87249 88507 97921 99811/ ], 75088 => [ qw/75089 79381 81317 91001 100101 111361 114211 136927 148289 169641 176661 191407 195649/ ], 450775 => [ qw/465991 468931 485357 505441 536851 556421 578771 585631 586249 606361 631651 638731 641683 645679/ ], 642735 => [ qw/653251 653333 663181 676651 714653 759277 794683 805141 844097 872191 874171 894671/ ], 9780504 => [ qw/9780505 9784915 9826489 9882457 9974791 10017517 10018081 10084177 10188481 10247357 10267951 10392241 10427209 10511201/ ], 203659041 => [ qw/204172939 204456793 206407057 206976001 207373483 209301121 210339397 211867969 212146507 212337217 212355793 214400629 214539841 215161459/ ], 553174392 => [ qw/553174393 553945231 554494951 554892787 555429169 557058133 557163157 557165209 558966793 559407061 560291719 561008251 563947141/ ], 1005905886 => [ qw/1005905887 1007713171 1008793699 1010415421 1010487061 1010836369 1012732873 1015269391 1016250247 1018405741 1020182041/ ], 1340600841 => [ qw/1345289261 1345582981 1347743101 1348964401 1350371821 1353332417 1355646961 1357500901 1361675929 1364378203 1366346521 1367104639/ ], 1795265022 => [ qw/1795265023 1797174457 1797741901 1804469753 1807751977 1808043283 1808205701 1813675681 1816462201 1817936371 1819050257/ ], 3046413974 => [ qw/3046413975 3048698683 3051199817 3068572849 3069705673 3070556233 3079010071 3089940811 3090723901 3109299161 3110951251 3113625601/ ], 3613982119 => [ qw/3626488471 3630467017 3643480501 3651840727 3653628247 3654142177 3672033223 3672036061 3675774019 3687246109 3690036017 3720856369/ ], psp2 => [ qw/341 561 645 1105 1387 1729 1905 2047 2465 2701 2821 3277 4033 4369 4371 4681 5461 6601 7957 8321 8481 8911 10261 10585 11305 12801 13741 13747 13981 14491 15709 15841 16705 18705 18721 19951 23001 23377 25761 29341/ ], psp3 => [ qw/91 121 286 671 703 949 1105 1541 1729 1891 2465 2665 2701 2821 3281 3367 3751 4961 5551 6601 7381 8401 8911 10585 11011 12403 14383 15203 15457 15841 16471 16531 18721 19345 23521 24046 24661 24727 28009 29161/ ], lucas => [ qw/323 377 1159 1829 3827 5459 5777 9071 9179 10877 11419 11663 13919 14839 16109 16211 18407 18971 19043/ ], slucas => [ qw/5459 5777 10877 16109 18971 22499 24569 25199 40309 58519 75077 97439 100127 113573 115639 130139/ ], eslucas => [ qw/989 3239 5777 10877 27971 29681 30739 31631 39059 72389 73919 75077 100127 113573 125249 137549 137801 153931 155819/ ], aeslucas1 => [ qw/989 3239 5777 10469 10877 27971 29681 30739 31631 39059 72389 73919 75077 100127 113573 125249 137549 137801 153931 154697 155819/ ], aeslucas2 => [ qw/3239 4531 5777 10877 12209 21899 31631 31831 32129 34481 36079 37949 47849 50959 51641 62479 73919 75077 97109 100127 108679 113573 116899 154697 161027/ ], ); if ($use64) { push @{$pseudoprimes{psp3}}, 4398117272641; push @{$pseudoprimes{3}}, 1099558795087; push @{$pseudoprimes{lucas}}, 2199055761527; push @{$pseudoprimes{slucas}}, 12598021314449; push @{$pseudoprimes{eslucas}}, 10099386070337; push @{$pseudoprimes{aeslucas1}}, 10071551814917; push @{$pseudoprimes{aeslucas2}}, 34372519409; } my $num_pseudoprimes = 0; foreach my $ppref (values %pseudoprimes) { $num_pseudoprimes += scalar @$ppref; } my @small_lucas_trials = (2, 9, 16, 100, 102, 2047, 2048, 5781, 9000, 14381); my %lucas_sequences = ( "323 1 1 324" => [0,2,1], "323 4 1 324" => [170,308,1], "323 4 5 324" => [194,156,115], "323 3 1 324" => [0,2,1], "323 3 1 81" => [0,287,1], "323 5 -1 81" => [153,195,322], "49001 25 117 24501" => [20933,18744,19141], "18971 10001 -1 4743" => [5866,14421,18970], "18971 10001 -1 4743" => [5866,14421,18970], "3613982123 1 -1 3613982124" => [0,3613982121,1], "3613982121 1 -1 3613982122" => [2586640546,2746447323,1], "3613982121 1 -1 1806991061" => [3535079342,1187662808,3613982120], "547968611 1 -1 547968612" => [1,3,1], "547968611 1 -1 136992153" => [27044236,448467899,547968610], ); plan tests => 0 + 3 + 4 + $num_pseudoprimes + scalar @phis + 1 # mr base 2 2-4k + 9 # mr with large bases + scalar @small_lucas_trials + scalar(keys %lucas_sequences) + 1 # frob-underwood + 2*$use64 # frob-underwood + 1*$extra; ok(!eval { is_strong_pseudoprime(2047); }, "MR with no base fails"); ok(!eval { is_strong_pseudoprime(2047,0); }, "MR base 0 fails"); ok(!eval { is_strong_pseudoprime(2047,1); }, "MR base 1 fails"); is( is_strong_pseudoprime(0, 2), 0, "MR with 0 shortcut composite"); is( is_strong_pseudoprime(1, 2), 0, "MR with 0 shortcut composite"); is( is_strong_pseudoprime(2, 2), 1, "MR with 2 shortcut prime"); is( is_strong_pseudoprime(3, 2), 1, "MR with 3 shortcut prime"); # Check that each strong pseudoprime base b makes it through MR with that base while (my($base, $ppref) = each (%pseudoprimes)) { foreach my $p (@$ppref) { if ($base =~ /^psp(\d+)/) { my $base = $1; ok(is_pseudoprime($p, $base), "$p is a pseudoprime to base $base"); } elsif ($base =~ /^aeslucas(\d+)/) { my $inc = $1; ok(is_almost_extra_strong_lucas_pseudoprime($p,$inc), "$p is an almost extra strong Lucas pseudoprime (increment $inc)"); } elsif ($base eq 'eslucas') { ok(is_extra_strong_lucas_pseudoprime($p), "$p is an extra strong Lucas pseudoprime"); } elsif ($base eq 'slucas') { ok(is_strong_lucas_pseudoprime($p), "$p is a strong Lucas-Selfridge pseudoprime"); } elsif ($base eq 'lucas') { ok(is_lucas_pseudoprime($p), "$p is a Lucas-Selfridge pseudoprime"); } else { ok(is_strong_pseudoprime($p, $base), "Pseudoprime (base $base) $p passes MR"); } } } # Check that phi_n makes passes MR with all prime bases < pn for my $phi (1 .. scalar @phis) { #next if ($phi > 4) && (!$use64); ok( is_strong_pseudoprime($phis[$phi-1], @sp[0 .. $phi-1]), "phi_$phi passes MR with first $phi primes"); } # Verify MR base 2 for all small numbers { my $mr2fail = 0; for (2 .. 4032) { next if $_ == 2047 || $_ == 3277; if (is_prime($_)) { if (!is_strong_pseudoprime($_,2)) { $mr2fail = $_; last; } } else { if (is_strong_pseudoprime($_,2)) { $mr2fail = $_; last; } } } is($mr2fail, 0, "MR base 2 matches is_prime for 2-4032 (excl 2047,3277)"); } # Verify MR for bases >= n is( is_strong_pseudoprime( 3, 3), 1, "spsp( 3, 3)"); is( is_strong_pseudoprime( 11, 11), 1, "spsp( 11, 11)"); is( is_strong_pseudoprime( 89, 5785), 1, "spsp( 89, 5785)"); is( is_strong_pseudoprime(257, 6168), 1, "spsp(257, 6168)"); is( is_strong_pseudoprime(367, 367), 1, "spsp(367, 367)"); is( is_strong_pseudoprime(367, 1101), 1, "spsp(367, 1101)"); is( is_strong_pseudoprime(49001, 921211727), 0, "spsp(49001, 921211727)"); is( is_strong_pseudoprime( 331, 921211727), 1, "spsp( 331, 921211727)"); is( is_strong_pseudoprime(49117, 921211727), 1, "spsp(49117, 921211727)"); # Verify Lucas for some small numbers for my $n (@small_lucas_trials) { next if $n == 5459 || $n == 5777 || $n == 10877 || $n == 16109 || $n == 18971; if (is_prime($n)) { # Technically if it is a prime it isn't a pseudoprime. ok(is_strong_lucas_pseudoprime($n), "$n is a prime and a strong Lucas-Selfridge pseudoprime"); } else { ok(!is_strong_lucas_pseudoprime($n), "$n is not a prime and not a strong Lucas-Selfridge pseudoprime"); } } # Verify MR base 2-3 for many small numbers (up to phi2) if ($extra) { my $mr2fail = 0; foreach my $i (1 .. 50000) { my $n = int(rand(1373652)) + 1; my $isp23 = !!is_strong_pseudoprime($n,2,3); my $prime = !!is_prime($n); if ($isp23 != $prime) { $mr2fail = $n; last; } } is($mr2fail, 0, "is_strong_pseudoprime bases 2,3 matches is_prime"); } # Lucas sequences, used for quite a few primality tests while (my($params, $expect) = each (%lucas_sequences)) { is_deeply( [lucas_sequence(split(' ', $params))], $expect, "Lucas sequence $params" ); } { my $fufail = 0; my $ntests = ($usexs) ? 100 : 2; foreach my $i (1 .. $ntests) { my $n = 2*int(rand(1000000000)) + 1; my $ispfu = !!is_frobenius_underwood_pseudoprime($n); my $prime = !!is_prime($n); if ($ispfu != $prime) { $fufail = $n; last; } } is($fufail, 0, "is_frobenius_underwood_pseudoprime matches is_prime"); if ($use64) { is( is_frobenius_underwood_pseudoprime("2727480595375747"), 1, "frobenius with 52-bit prime" ); is( is_frobenius_underwood_pseudoprime(10099386070337), 0, "frobenius with 44-bit lucas pseudoprime" ); } } Math-Prime-Util-0.37/t/04-inputvalidation.t0000644000076400007640000000412212270242116017000 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/next_prime/; use Math::BigInt try=>"GMP,Pari"; use Math::BigFloat; use Carp; my @incorrect = ( -4, '-', '+', '++4', '+-4', '-0004', 'a', '5.6', '4e', '1.1e12', '1e8', 'NaN', Math::BigInt->bnan(), Math::BigInt->new("-4"), Math::BigFloat->new("15.6"), ); my %correct = ( 4 => 5, '+4' => 5, '0004' => 5, '+0004' => 5, 5.0 => 7, 1e8 => 100000007, Math::BigInt->new("10000000000000000000000012") => "10000000000000000000000013", Math::BigFloat->new("9") => 11, ); plan tests => 2 # undefined and empty string + scalar(@incorrect) # values that should be rejected + scalar(keys(%correct)) # values that should be accepted + 2 # infinity and nan + 1; # long invalid string eval { next_prime(undef); }; like($@, qr/^Parameter must be defined/, "next_prime(undef)"); eval { next_prime(""); }; like($@, qr/^Parameter must be a positive integer/, "next_prime('')"); foreach my $v (@incorrect) { eval { next_prime($v); }; like($@, qr/^Parameter '\Q$v\E' must be a positive integer/, "next_prime($v)"); } while (my($v, $expect) = each (%correct)) { is(next_prime($v), $expect, "Correct: next_prime($v)"); } # The actual strings can be implementation specific. my $infinity = 0+'inf'; # Might be 0 on some platforms. $infinity = +(20**20**20) if 65535 > $infinity; my $nan = $infinity / $infinity; eval { next_prime($infinity); }; like($@, qr/must be a positive integer/, "next_prime( infinity )"); eval { next_prime($nan); }; like($@, qr/must be a positive integer/, "next_prime( nan )"); SKIP: { skip "You need to upgrade either Perl or Carp to avoid invalid non-native inputs from causing a segfault. Makefile.PL should have requested a Carp upgrade.", 1 if $] < 5.008 && $Carp::VERSION < 1.17; eval { next_prime("11111111111111111111111111111111111111111x"); }; like($@, qr/must be a positive integer/, "next_prime('111...111x')"); } Math-Prime-Util-0.37/t/18-functions.t0000644000076400007640000000730512266152412015615 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/ prime_count ExponentialIntegral LogarithmicIntegral RiemannR RiemannZeta /; my $infinity = 20**20**20; plan tests => 3 + 6 + 1 + 16 + 11 + 9 + 6; eval { LogarithmicIntegral(-1); }; like($@, qr/invalid/i, "li(-1) is invalid"); eval { RiemannR(0); }; like($@, qr/invalid/i, "R(0) is invalid"); eval { RiemannR(-1); }; like($@, qr/invalid/i, "R(-1) is invalid"); cmp_ok( ExponentialIntegral(0), '<=',-$infinity, "Ei(0) is -infinity"); cmp_ok( ExponentialIntegral(-$infinity),'==', 0, "Ei(-inf) is 0" ); cmp_ok( ExponentialIntegral($infinity), '>=', $infinity, "Ei(inf) is infinity"); cmp_ok( LogarithmicIntegral(0), '==', 0, "li(0) is 0"); cmp_ok( LogarithmicIntegral(1), '<=',-$infinity, "li(1) is -infinity"); cmp_ok( LogarithmicIntegral($infinity), '>=', $infinity, "li(inf) is infinity"); # Example used in Math::Cephes cmp_closeto( ExponentialIntegral(2.2), 5.732614700, 1e-06, "Ei(2.2)"); my %eivals = ( -10 => -0.00000415696892968532438, -0.5 => -0.55977359477616, -0.1 => -1.8229239584193906660809, -0.001 => -6.33153936413615, -0.00001 => -10.9357198000436956, -0.00000001 => -17.843465089050832587, 0.693147180559945 => 1.0451637801174927848446, # log2 1 => 1.8951178163559367554665, 1.5 => 3.3012854491297978379574, 2 => 4.9542343560018901633795, 5 => 40.185275355803177455091, 10 => 2492.2289762418777591384, 12 => 14959.532666397528852292, 20 => 25615652.664056588820481, 40 => 6039718263611241.5783592, 41 => 16006649143245041.110700, ); while (my($n, $ein) = each (%eivals)) { cmp_closeto( ExponentialIntegral($n), $ein, 0.00000001 * abs($ein), "Ei($n) ~= $ein"); } # In pari these are: -eint1(-log($n)) my %livals = ( 0 => 0, 1.01 => -4.0229586739299358695031, 2 => 1.0451637801174927848446, 10 => 6.1655995047872979375230, 24 => 11.200315795232698830550, 1000 => 177.60965799015222668764, 100000 => 9629.8090010507982050343, 100000000 => 5762209.3754480314675691, 4294967295 => 203284081.95454158906409, 10000000000 => 455055614.58662307560953, 100000000000 => 4118066400.6216115150394, ); while (my($n, $lin) = each (%livals)) { cmp_closeto( LogarithmicIntegral($n), $lin, 0.00000001 * abs($lin), "li($n) ~= $lin"); } # Values from T. R. Nicely for comparison my %rvals = ( 1.01 => 1.0060697180622924796117, 2 => 1.5410090161871318832885, 10 => 4.5645831410050902398658, 1000 => 168.35944628116734806491, 1000000 => 78527.399429127704858870, 10000000 => 664667.44756474776798535, 4294967295 => 203280697.51326064541983, 10000000000 => 455050683.30684692446315, 18446744073709551615 => 4.25656284014012122706963685602e17, ); while (my($n, $rin) = each (%rvals)) { cmp_closeto( RiemannR($n), $rin, 0.00000001 * abs($rin), "R($n) ~= $rin"); } my %rzvals = ( 2 => 0.6449340668482264364724151666, 2.5 => 0.3414872572509171797567696934, 4.5 => 0.0547075107614542640229672890, 7 => 0.0083492773819228268397975498, 8.5 => 0.0028592508824156277133439825, 20.6 => 0.0000006293391573578212882457, ); while (my($n, $zin) = each (%rzvals)) { cmp_closeto( RiemannZeta($n), $zin, 0.00000001 * abs($zin), "Zeta($n) ~= $zin"); } sub cmp_closeto { my $got = shift; my $expect = shift; my $tolerance = shift; my $message = shift; cmp_ok( abs($got - $expect), '<=', $tolerance, $message ); } Math-Prime-Util-0.37/t/19-moebius.t0000644000076400007640000004654012270242116015251 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/moebius mertens euler_phi jordan_totient divisor_sum exp_mangoldt chebyshev_theta chebyshev_psi carmichael_lambda znorder liouville znprimroot znlog kronecker legendre_phi gcd lcm /; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; $use64 = 0 if $use64 && 18446744073709550592 == ~0; my @moeb_vals = (qw/ 1 -1 -1 0 -1 1 -1 0 0 1 -1 0 -1 1 1 0 -1 0 -1 0 /); my %mertens = ( 1 => 1, 2 => 0, 3 => -1, 4 => -1, 5 => -2, 10 => -1, 100 => 1, 1000 => 2, 10000 => -23, 8 => -2, 16 => -1, 32 => -4, 64 => -1, 128 => -2, 256 => -1, 512 => -4, 1024 => -4, 2048 => 7, 4096 => -19, 8192 => 22, ); my %big_mertens = ( 100000 => -48, 1000000 => 212, 10000000 => 1037, ); if (!$extra && !Math::Prime::Util::prime_get_config->{'xs'}) { delete $big_mertens{10000000}; } if ($extra && $use64) { %big_mertens = ( %big_mertens, 2 => 0, # A087987, mertens at primorials 6 => -1, 30 => -3, 210 => -1, 2310 => -1, 30030 => 16, 510510 => -25, 9699690 => 278, 223092870 => 3516, 6433477 => 900, # 30^2 109851909 => -4096, # A084235, 2^12 2**14 => -32, # A084236 2**15 => 26, 2**16 => 14, 2**17 => -20, 2**18 => 24, 2**19 => -125, 2**20 => 257, 2**21 => -362, 2**22 => 228, 2**23 => -10, 10**8 => 1928, # 10**9 => -222, # 1*10**10 => -33722, # From Deleglise and Rivat # 2*10**10 => -48723, # Too slow with current method ); } my %totients = ( 123456 => 41088, 123457 => 123456, 123456789 => 82260072, ); my @A000010 = (0,1,1,2,2,4,2,6,4,6,4,10,4,12,6,8,8,16,6,18,8,12,10,22,8,20,12,18,12,28,8,30,16,20,16,24,12,36,18,24,16,40,12,42,20,24,22,46,16,42,20,32,24,52,18,40,24,36,28,58,16,60,30,36,32,48,20,66,32,44); #@totients{0..$#A000010} = @A000010; my @A001615 = (1,3,4,6,6,12,8,12,12,18,12,24,14,24,24,24,18,36,20,36,32,36,24,48,30,42,36,48,30,72,32,48,48,54,48,72,38,60,56,72,42,96,44,72,72,72,48,96,56,90,72,84,54,108,72,96,80,90,60,144,62,96,96,96,84,144,68,108,96); my %jordan_totients = ( # A000010 1 => [1, 1, 2, 2, 4, 2, 6, 4, 6, 4, 10, 4, 12, 6, 8, 8, 16, 6, 18, 8, 12, 10, 22, 8, 20, 12, 18, 12, 28, 8, 30, 16, 20, 16, 24, 12, 36, 18, 24, 16, 40, 12, 42, 20, 24, 22, 46, 16, 42, 20, 32, 24, 52, 18, 40, 24, 36, 28, 58, 16, 60, 30, 36, 32, 48, 20, 66, 32, 44], # A007434 2 => [1, 3, 8, 12, 24, 24, 48, 48, 72, 72, 120, 96, 168, 144, 192, 192, 288, 216, 360, 288, 384, 360, 528, 384, 600, 504, 648, 576, 840, 576, 960, 768, 960, 864, 1152, 864, 1368, 1080, 1344, 1152, 1680, 1152, 1848, 1440, 1728, 1584, 2208, 1536], # A059376 3 => [1, 7, 26, 56, 124, 182, 342, 448, 702, 868, 1330, 1456, 2196, 2394, 3224, 3584, 4912, 4914, 6858, 6944, 8892, 9310, 12166, 11648, 15500, 15372, 18954, 19152, 24388, 22568, 29790, 28672, 34580, 34384, 42408, 39312, 50652, 48006, 57096], # A059377 4 => [1, 15, 80, 240, 624, 1200, 2400, 3840, 6480, 9360, 14640, 19200, 28560, 36000, 49920, 61440, 83520, 97200, 130320, 149760, 192000, 219600, 279840, 307200, 390000, 428400, 524880, 576000, 707280, 748800, 923520, 983040, 1171200], # A059378 5 => [1, 31, 242, 992, 3124, 7502, 16806, 31744, 58806, 96844, 161050, 240064, 371292, 520986, 756008, 1015808, 1419856, 1822986, 2476098, 3099008, 4067052, 4992550, 6436342, 7682048, 9762500, 11510052, 14289858, 16671552, 20511148, 23436248, 28629150, 32505856, 38974100, 44015536, 52501944, 58335552, 69343956, 76759038, 89852664, 99168256, 115856200, 126078612, 147008442, 159761600, 183709944, 199526602, 229345006, 245825536, 282458442, 302637500, 343605152, 368321664], # A069091 6 => [1, 63, 728, 4032, 15624, 45864, 117648, 258048, 530712, 984312, 1771560, 2935296, 4826808, 7411824, 11374272, 16515072, 24137568, 33434856, 47045880, 62995968, 85647744, 111608280, 148035888, 187858944, 244125000, 304088904, 386889048], # A069092 7 => [1, 127, 2186, 16256, 78124, 277622, 823542, 2080768, 4780782, 9921748, 19487170, 35535616, 62748516, 104589834, 170779064, 266338304, 410338672, 607159314, 893871738, 1269983744, 1800262812, 2474870590, 3404825446], ); my %sigmak = ( # A0000005 0 => [1,2,2,3,2,4,2,4,3,4,2,6,2,4,4,5,2,6,2,6,4,4,2,8,3,4,4,6,2,8,2,6,4,4,4,9,2,4,4,8,2,8,2,6,6,4,2,10,3,6,4,6,2,8,4,8,4,4,2,12,2,4,6,7,4,8,2,6,4,8,2,12,2,4,6,6,4,8,2,10,5,4,2,12,4,4,4,8,2,12,4,6,4,4,4,12,2,6,6,9,2,8,2,8], # A000203 1 => [1, 3, 4, 7, 6, 12, 8, 15, 13, 18, 12, 28, 14, 24, 24, 31, 18, 39, 20, 42, 32, 36, 24, 60, 31, 42, 40, 56, 30, 72, 32, 63, 48, 54, 48, 91, 38, 60, 56, 90, 42, 96, 44, 84, 78, 72, 48, 124, 57, 93, 72, 98, 54, 120, 72, 120, 80, 90, 60, 168, 62, 96, 104, 127, 84, 144, 68, 126, 96, 144], # A001157 2 => [1, 5, 10, 21, 26, 50, 50, 85, 91, 130, 122, 210, 170, 250, 260, 341, 290, 455, 362, 546, 500, 610, 530, 850, 651, 850, 820, 1050, 842, 1300, 962, 1365, 1220, 1450, 1300, 1911, 1370, 1810, 1700, 2210, 1682, 2500, 1850, 2562, 2366, 2650, 2210, 3410, 2451, 3255], # A001158 3 => [1, 9, 28, 73, 126, 252, 344, 585, 757, 1134, 1332, 2044, 2198, 3096, 3528, 4681, 4914, 6813, 6860, 9198, 9632, 11988, 12168, 16380, 15751, 19782, 20440, 25112, 24390, 31752, 29792, 37449, 37296, 44226, 43344, 55261, 50654, 61740, 61544], ); my @tau4 = (1,4,4,10,4,16,4,20,10,16,4,40,4,16,16,35,4,40,4,40,16,16,4,80,10,16,20,40,4,64,4,56,16,16,16,100,4,16,16,80,4,64,4,40,40,16,4,140,10,40,16,40,4,80,16,80,16,16,4,160,4,16,40,84,16,64,4,40,16,64,4,200,4,16,40,40,16); my %mangoldt = ( -13 => 1, 0 => 1, 1 => 1, 2 => 2, 3 => 3, 4 => 2, 5 => 5, 6 => 1, 7 => 7, 8 => 2, 9 => 3, 10 => 1, 11 => 11, 25 => 5, 27 => 3, 399981 => 1, 399982 => 1, 399983 => 399983, 823543 => 7, 83521 => 17, 130321 => 19, ); my %chebyshev1 = ( 0 => 0, 1 => 0, 2 => 0.693147180559945, 3 => 1.79175946922805, 4 => 1.79175946922805, 5 => 3.40119738166216, 243 => 226.593507136467, 123456 => 123034.091739914, ); my %chebyshev2 = ( 0 => 0, 1 => 0, 2 => 0.693147180559945, 3 => 1.79175946922805, 4 => 2.484906649788, 5 => 4.0943445622221, 243 => 245.274469978683, 123456 => 123435.148054491 ); if ($extra) { $chebyshev1{1234567} = 1233272.80087825; $chebyshev2{1234567} = 1234515.17962833; } if (!$usexs && !$extra) { delete $chebyshev1{$_} for grep { $_ > 50000 } keys %chebyshev1; delete $chebyshev2{$_} for grep { $_ > 50000 } keys %chebyshev2; } my @A002322 = (0,1,1,2,2,4,2,6,2,6,4,10,2,12,6,4,4,16,6,18,4,6,10,22,2,20,12,18,6,28,4,30,8,10,16,12,6,36,18,12,4,40,6,42,10,12,22,46,4,42,20,16,12,52,18,20,6,18,28,58,4,60,30,6,16,12,10,66,16,22,12,70,6,72,36,20,18,30,12,78,4,54,40,82,6,16,42,28,10,88,12,12,22,30,46,36,8,96,42,30,20,100,16,102,12,12,52,106,18,108,20,36,12,112,18,44,28,12,58,48,4,110,60,40,30,100,6,126,32,42,12,130,10,18,66,36,16,136,22,138,12,46,70,60,12,28,72,42,36,148,20,150,18,48,30,60,12,156,78,52,8,66,54,162,40,20,82,166,6,156,16,18,42,172,28,60,20,58,88,178,12,180,12,60,22,36,30,80,46,18,36,190,16,192,96,12,42,196,30,198,20); my @mult_orders = ( [1, 35, 1], [2, 35, 12], [4, 35, 6], [6, 35, 2], [7, 35], #[2,1000000000000031,81788975100], [1, 1, 1], [0, 0], [1, 0], [25, 0], [1, 1, 1], [19, 1, 1], [1, 19, 1], [2, 19, 18], [3, 20, 4], [57,1000000003,189618], [67,999999749,30612237], [22,999991815,69844], [10,2147475467,31448382], [141,2147475467,1655178], [7410,2147475467,39409], [31407,2147475467,266], ); my %primroots = ( -11 => 2, 0 => undef, 1 => 0, 2 => 1, 3 => 2, 4 => 3, 5 => 2, 6 => 5, 7 => 3, 8 => undef, 9 => 2, 10 => 3, # 3 is the smallest root. Pari gives the other root 7. 1729 => undef, # Pari goes into an infinite loop. 5109721 => 94, 17551561 => 97, 90441961 => 113, 1407827621 => 2, 1520874431 => 17, 1685283601 => 164, 100000001 => undef, # Without an early exit, this will essentially hang. ); if ($use64) { $primroots{2232881419280027} = 6; # factor divide goes to FP $primroots{14123555781055773271} = 6; # bmodpow hits RT 71548 $primroots{89637484042681} = 335; # smallest root is large } my @kroneckers = ( [ 109981, 737777, 1], [ 737779, 121080, -1], [-737779, 121080, 1], [ 737779,-121080, -1], [-737779,-121080, -1], [12345,331,-1], [1001,9907,-1], [19,45,1], [8,21,-1], [5,21,1], [5,1237,-1], [10, 49, 1], [123,4567,-1], [3,18,0], [3,-18,0], [-2, 0, 0], [-1, 0, 1], [ 0, 0, 0], [ 1, 0, 1], [ 2, 0, 0], [-2, 1, 1], [-1, 1, 1], [ 0, 1, 1], [ 1, 1, 1], [ 2, 1, 1], [-2,-1,-1], [-1,-1,-1], [ 0,-1, 1], [ 1,-1, 1], [ 2,-1, 1], # Some cases trying to make sure we're not turning UVs into IVs [ 3686556869, 428192857, 1], [-1453096827, 364435739, -1], [ 3527710253, -306243569, 1], [-1843526669, -332265377, 1], [ 321781679, 4095783323, -1], [ 454249403, -79475159, -1], ); if ($use64) { push @kroneckers, [17483840153492293897, 455592493, 1]; push @kroneckers, [-1402663995299718225, 391125073, 1]; push @kroneckers, [16715440823750591903, -534621209, -1]; push @kroneckers, [13106964391619451641,16744199040925208803, 1]; push @kroneckers, [11172354269896048081,10442187294190042188,-1]; push @kroneckers, [-5694706465843977004,9365273357682496999,-1]; } my @legendre_sums = ( [ 89, 4, 21 ], [ 46, 4, 11 ], [ 47, 4, 12 ], [ 48, 4, 12 ], [ 52, 4, 12 ], [ 53, 4, 13 ], [10000, 5, 2077], [526, 7, 95], [588, 6, 111], [100000, 5, 20779], [5882, 6, 1128], [100000, 7, 18053], [10000, 8, 1711], [1000000, 168, 78331], ); my @gcds = ( [ [], 0], [ [8], 8], [ [9,9], 9], [ [0,0], 0], [ [1, 0, 0], 1], [ [0, 0, 1], 1], [ [17,19], 1 ], [ [54,24], 6 ], [ [42,56], 14], [ [ 9,28], 1 ], [ [48,180], 12], [ [2705353758,2540073744,3512215098,2214052398], 18], [ [2301535282,3609610580,3261189640], 106], [ [694966514,510402262,195075284,609944479], 181], [ [294950648,651855678,263274296,493043500,581345426], 58 ], [ [-30,-90,90], 30], [ [-3,-9,-18], 3], ); my @lcms = ( [ [], 0], [ [8], 8], [ [9,9], 9], [ [0,0], 0], [ [1, 0, 0], 0], [ [0, 0, 1], 0], [ [17,19], 323 ], [ [54,24], 216 ], [ [42,56], 168], [ [ 9,28], 252 ], [ [48,180], 720], [ [36,45], 180], [ [-36,45], 180], [ [-36,-45], 180], [ [30,15,5], 30], [ [2,3,4,5], 60], [ [30245, 114552], 3464625240], [ [11926,78001,2211], 2790719778], [ [1426,26195,3289,8346], 4254749070], ); if ($use64) { push @gcds, [ [12848174105599691600,15386870946739346600,11876770906605497900], 700]; push @gcds, [ [9785375481451202685,17905669244643674637,11069209430356622337], 117]; push @lcms, [ [26505798,9658520,967043,18285904], 15399063829732542960]; push @lcms, [ [267220708,143775143,261076], 15015659316963449908]; } my @znlogs = ( [ [5,2,1019], 10], [ [2,4,17], undef], [ [7,3,8], undef], [ [3,3,8], 1], [ [10,2,101], 25], [ [2,55,101], 73], # 2 = 55^73 mod 101 [ [228,2,383], 110], [ [3061666278, 499998, 3332205179], 22], ); if ($usexs) { push @znlogs, [ [5678,5,10007], 8620]; # 5678 = 5^8620 mod 10007 } # These are slow with XS, and *really* slow with PP. if (!$usexs) { %big_mertens = map { $_ => $big_mertens{$_} } grep { $_ < 100000000 } keys %big_mertens; } my @liouville_pos = (qw/24 51 94 183 294 629 1488 3684 8006 8510 32539 57240 103138 238565 444456 820134 1185666 3960407 4429677 13719505 29191963 57736144 134185856 262306569 324235872 563441153 1686170713 2489885844/); my @liouville_neg = (qw/23 47 113 163 378 942 1669 2808 8029 9819 23863 39712 87352 210421 363671 562894 1839723 3504755 7456642 14807115 22469612 49080461 132842464 146060791 279256445 802149183 1243577750 3639860654/); if ($use64) { push @liouville_pos, (qw/1260238066729040 10095256575169232896/); push @liouville_neg, (qw/1807253903626380 12063177829788352512/); } plan tests => 0 + 1 + 1 # Small Moebius + 3*scalar(keys %mertens) + 1*scalar(keys %big_mertens) + 2 # Small Phi + 8 + scalar(keys %totients) + 1 # Small Carmichael Lambda + scalar(@kroneckers) + scalar(@gcds) + scalar(@lcms) + scalar(@mult_orders) + scalar(@znlogs) + scalar(@legendre_sums) + scalar(keys %primroots) + 2 + scalar(keys %jordan_totients) + 2 # Dedekind psi calculated two ways + 2 # Calculate J5 two different ways + 2 * $use64 # Jordan totient example + 1 + 2*scalar(keys %sigmak) + 3 + scalar(keys %mangoldt) + scalar(keys %chebyshev1) + scalar(keys %chebyshev2) + scalar(@liouville_pos) + scalar(@liouville_neg); ok(!eval { moebius(0); }, "moebius(0)"); { my @moebius = map { moebius($_) } (1 .. scalar @moeb_vals); is_deeply( \@moebius, \@moeb_vals, "moebius 1 .. " . scalar @moeb_vals ); } while (my($n, $mertens) = each (%mertens)) { my $M = 0; $M += moebius($_) for (1 .. $n); is( $M, $mertens, "sum(moebius(k) for k=1..$n) == $mertens" ); # Calculate using ranged moebius $M = 0; $M += $_ for moebius(1,$n); is( $M, $mertens, "sum(moebius(1..$n) == $mertens" ); # Now with mertens function is( mertens($n), $mertens, "mertens($n) == $mertens" ); } while (my($n, $mertens) = each (%big_mertens)) { is( mertens($n), $mertens, "mertens($n)" ); } { my @phi = map { euler_phi($_) } (0 .. $#A000010); is_deeply( \@phi, \@A000010, "euler_phi 0 .. $#A000010" ); } { my @phi = euler_phi(0, $#A000010); is_deeply( \@phi, \@A000010, "euler_phi with range: 0, $#A000010" ); } while (my($n, $phi) = each (%totients)) { is( euler_phi($n), $phi, "euler_phi($n) == $phi" ); } is_deeply( [euler_phi(0,0)], [0], "euler_phi(0,0)" ); is_deeply( [euler_phi(1,0)], [], "euler_phi with end < start" ); is_deeply( [euler_phi(0,1)], [0,1], "euler_phi 0-1" ); is_deeply( [euler_phi(1,2)], [1,1], "euler_phi 1-2" ); is_deeply( [euler_phi(1,3)], [1,1,2], "euler_phi 1-3" ); is_deeply( [euler_phi(2,3)], [1,2], "euler_phi 2-3" ); is_deeply( [euler_phi(10,20)], [4,10,4,12,6,8,8,16,6,18,8], "euler_phi 10-20" ); is_deeply( [euler_phi(1513,1537)], [qw/1408 756 800 756 1440 440 1260 576 936 760 1522 504 1200 648 1016 760 1380 384 1530 764 864 696 1224 512 1456/], "euler_phi(1513,1537)" ); ###### Jordan Totient while (my($k, $tref) = each (%jordan_totients)) { my @tlist = map { jordan_totient($k, $_) } 1 .. scalar @$tref; is_deeply( \@tlist, $tref, "Jordan's Totient J_$k" ); } { my @psi_viaj; my @psi_viamobius; foreach my $n (1 .. scalar @A001615) { push @psi_viaj, int(jordan_totient(2, $n) / jordan_totient(1, $n)); push @psi_viamobius, int($n * divisor_sum( $n, sub { moebius($_[0])**2 / $_[0] } ) + 0.5); } is_deeply( \@psi_viaj, \@A001615, "Dedikind psi(n) = J_2(n)/J_1(n)" ); is_deeply( \@psi_viamobius, \@A001615, "Dedikind psi(n) = divisor_sum(n, moebius(d)^2 / d)" ); } { my $J5 = $jordan_totients{5}; my @J5_jordan = map { jordan_totient(5, $_) } 1 .. scalar @$J5; is_deeply( \@J5_jordan, $J5, "Jordan totient 5, using jordan_totient"); my @J5_moebius = map { my $n = $_; divisor_sum($n, sub { my $d=shift; $d**5 * moebius($n/$d); }) } 1 .. scalar @$J5; is_deeply( \@J5_moebius, $J5, "Jordan totient 5, using divisor sum" ); } if ($use64) { is( jordan_totient(4, 12345), 22902026746060800, "J_4(12345)" ); # Apostal page 48, 17a. is( divisor_sum( 12345, sub { jordan_totient(4,$_[0]) } ), # was int(12345 ** 4), but Perl 5.8.2 gets it wrong. int(12345*12345*12345*12345), "n=12345, k=4 : n**k = divisor_sum(n, jordan_totient(k, d))" ); } ###### Divisor sum while (my($k, $sigmaref) = each (%sigmak)) { my @slist; foreach my $n (1 .. scalar @$sigmaref) { push @slist, divisor_sum( $n, sub { int($_[0] ** $k) } ); } is_deeply( \@slist, $sigmaref, "Sum of divisors to the ${k}th power: Sigma_$k" ); @slist = (); foreach my $n (1 .. scalar @$sigmaref) { push @slist, divisor_sum( $n, $k ); } is_deeply( \@slist, $sigmaref, "Sigma_$k using integer instead of sub" ); } # k=1 standard sum -- much faster { my @slist = map { divisor_sum($_) } 1 .. scalar @{$sigmak{1}}; is_deeply(\@slist, $sigmak{1}, "divisor_sum(n)"); } # tau two ways { my $len = scalar @{$sigmak{0}}; my @slist1 = map { divisor_sum($_, sub {1}) } 1 .. $len; my @slist2 = map { divisor_sum($_, 0 ) } 1 .. $len; is_deeply( \@slist1, $sigmak{0}, "tau as divisor_sum(n, sub {1})" ); is_deeply( \@slist2, $sigmak{0}, "tau as divisor_sum(n, 0)" ); } { # tau_4 A007426 my @t; foreach my $n (1 .. scalar @tau4) { push @t, divisor_sum($n, sub { divisor_sum($_[0],sub { divisor_sum($_[0],0) }) }); } is_deeply( \@t, \@tau4, "Tau4 (A007426), nested divisor sums" ); } ###### Exponential of von Mangoldt while (my($n, $em) = each (%mangoldt)) { is( exp_mangoldt($n), $em, "exp_mangoldt($n) == $em" ); } ###### first Chebyshev function while (my($n, $c1) = each (%chebyshev1)) { cmp_closeto( chebyshev_theta($n), $c1, 1e-9*abs($n), "chebyshev_theta($n)" ); } ###### second Chebyshev function while (my($n, $c2) = each (%chebyshev2)) { cmp_closeto( chebyshev_psi($n), $c2, 1e-9*abs($n), "chebyshev_psi($n)" ); } ###### Carmichael Lambda { my @lambda = map { carmichael_lambda($_) } (0 .. $#A002322); is_deeply( \@lambda, \@A002322, "carmichael_lambda with range: 0, $#A000010" ); } ###### kronecker foreach my $karg (@kroneckers) { my($a, $n, $exp) = @$karg; my $k = kronecker($a, $n); is( $k, $exp, "kronecker($a, $n) = $exp" ); } ###### gcd foreach my $garg (@gcds) { my($aref, $exp) = @$garg; my $gcd = gcd(@$aref); is( $gcd, $exp, "gcd(".join(",",@$aref).") = $exp" ); } ###### lcm foreach my $garg (@lcms) { my($aref, $exp) = @$garg; my $lcm = lcm(@$aref); is( $lcm, $exp, "lcm(".join(",",@$aref).") = $exp" ); } ###### znorder foreach my $moarg (@mult_orders) { my ($a, $n, $exp) = @$moarg; my $zn = znorder($a, $n); is( $zn, $exp, "znorder($a, $n) = " . ((defined $exp) ? $exp : "") ); } ###### znprimroot while (my($n, $root) = each (%primroots)) { is( znprimroot($n), $root, "znprimroot($n) == " . ((defined $root) ? $root : "") ); } is( znprimroot("-100000898"), 31, "znprimroot(\"-100000898\") == 31" ); is( znprimroot("+100000898"), 31, "znprimroot(\"+100000898\") == 31" ); ###### znlog foreach my $arg (@znlogs) { my($aref, $exp) = @$arg; my ($a, $g, $p) = @$aref; my $k = znlog($a,$g,$p); is( $k, $exp, "znlog($a,$g,$p) = " . ((defined $exp) ? $exp : "") ); } ###### liouville foreach my $i (@liouville_pos) { is( liouville($i), 1, "liouville($i) = 1" ); } foreach my $i (@liouville_neg) { is( liouville($i), -1, "liouville($i) = -1" ); } ###### Legendre phi foreach my $r (@legendre_sums) { my($x, $a, $exp) = @$r; is( legendre_phi($x, $a), $exp, "legendre_phi($x,$a) = $exp" ); } sub cmp_closeto { my $got = shift; my $expect = shift; my $tolerance = shift; my $message = shift; cmp_ok( abs($got - $expect), '<=', $tolerance, $message ); } Math-Prime-Util-0.37/t/50-factoring.t0000644000076400007640000001657112270242116015556 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/factor factor_exp all_factors divisor_sum is_prime/; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; if ($use64) { # Simple test: perl -e 'die if 18446744073709550592 == ~0' my $broken = (18446744073709550592 == ~0); if ($broken) { if ($] < 5.008) { diag "Perl pre-5.8.0 has broken 64-bit. Skipping 64-bit tests."; } else { diag "Eek! Your 64-bit Perl $] is **** BROKEN ****. Skipping 64-bit tests."; } $use64 = 0; } } my @testn = qw/0 1 2 3 4 5 6 7 8 16 57 64 377 9592 30107 78498 664579 5761455 114256942 2214143 999999929 50847534 455052511 2147483647 4118054813 30 210 2310 30030 510510 9699690 223092870 1363 989 779 629 403 547308031 808 2727 12625 34643 134431 221897 496213 692759 1228867 2231139 2463289 3008891 5115953 6961021 8030207 10486123 10893343 12327779 701737021 549900 10000142 /; my @testn64 = qw/37607912018 346065536839 600851475143 3204941750802 29844570422669 279238341033925 2623557157654233 24739954287740860 3369738766071892021 10023859281455311421 9007199254740991 9007199254740992 9007199254740993 6469693230 200560490130 7420738134810 304250263527210 13082761331670030 614889782588491410 440091295252541 5333042142001571 /; push @testn, @testn64 if $use64; push @testn, qw/9999986200004761 99999989237606677 999999866000004473/ if $use64 && $extra; # For time savings, trim these if we're pure Perl. if ( !$extra && !Math::Prime::Util::prime_get_config->{'xs'} && !Math::Prime::Util::prime_get_config->{'gmp'} ) { @testn = grep { $_ != 10023859281455311421 && $_ != 3369738766071892021 } @testn; } my %all_factors = ( 1234567890 => [1,2,3,5,6,9,10,15,18,30,45,90,3607,3803,7214,7606,10821,11409,18035,19015,21642,22818,32463,34227,36070,38030,54105,57045,64926,68454,108210,114090,162315,171135,324630,342270,13717421,27434842,41152263,68587105,82304526,123456789,137174210,205761315,246913578,411522630,617283945,1234567890], 1032924637 => [1,6469,159673,1032924637], 4567890 => [1,2,3,5,6,10,15,30,43,86,129,215,258,430,645,1290,3541,7082,10623,17705,21246,35410,53115,106230,152263,304526,456789,761315,913578,1522630,2283945,4567890], 456789 => [1,3,43,129,3541,10623,152263,456789], 123456 => [1,2,3,4,6,8,12,16,24,32,48,64,96,192,643,1286,1929,2572,3858,5144,7716,10288,15432,20576,30864,41152,61728,123456], 115553 => [1,115553], 30107 => [1,7,11,17,23,77,119,161,187,253,391,1309,1771,2737,4301,30107], 42 => [1,2,3,6,7,14,21,42], 16 => [1,2,4,8,16], 12 => [1,2,3,4,6,12], 10 => [1,2,5,10], 9 => [1,3,9], 8 => [1,2,4,8], 7 => [1,7], 6 => [1,2,3,6], 5 => [1,5], 4 => [1,2,4], 3 => [1,3], 2 => [1,2], 1 => [1], 0 => [0,1], ); my %prime_factors = ( 456789 => [3,43,3541], 123456 => [2,2,2,2,2,2,3,643], 115553 => [115553], 30107 => [7,11,17,23], 5 => [5], 4 => [2,2], 3 => [3], 2 => [2], 1 => [], 0 => [0], ); my %factor_exponents = ( 456789 => [[3,1],[43,1],[3541,1]], 123456 => [[2,6],[3,1],[643,1]], 115553 => [[115553,1]], 30107 => [[7,1],[11,1],[17,1],[23,1]], 5 => [[5,1]], 4 => [[2,2]], 3 => [[3,1]], 2 => [[2,1]], 1 => [], 0 => [[0,1]], ); plan tests => (3 * scalar @testn) + 2*scalar(keys %prime_factors) + 4*scalar(keys %all_factors) + 2*scalar(keys %factor_exponents) + 10*8 # 10 extra factoring tests * 8 algorithms + 8 + 1; foreach my $n (@testn) { my @f = factor($n); my $facstring = join(' * ',@f); # Do they multiply to the number? my $product = 1; $product *= $_ for @f; is( $product, $n, "$n = [ $facstring ]" ); # Are they all prime? my $isprime = 1; $isprime *= is_prime($_) for @f; if ($n < 1) { ok( !$isprime, " each factor is not prime" ); } else { ok( $isprime, " each factor is prime" ); } # Does factor_exp return the appropriate rearrangement? is_deeply( [factor_exp($n)], [linear_to_exp(@f)], " factor_exp looks right" ); } while (my($n, $factors) = each(%prime_factors)) { is_deeply( [factor($n)], $factors, "factors($n)" ); is( scalar factor($n), scalar @$factors, "scalar factors($n)" ); } while (my($n, $divisors) = each(%all_factors)) { is_deeply( [all_factors($n)], $divisors, "all_factors($n)" ); is( scalar all_factors($n), scalar @$divisors, "scalar all_factors($n)" ); is( divisor_sum($n,0), scalar @$divisors, "divisor_sum($n,0)" ); my $sum = 0; foreach my $f (@$divisors) { $sum += $f; } is( divisor_sum($n), $sum, "divisor_sum($n)" ); } while (my($n, $factors) = each(%factor_exponents)) { is_deeply( [factor_exp($n)], $factors, "factor_exp($n)" ); is( scalar factor_exp($n), scalar @$factors, "scalar factor_exp($n)" ); } extra_factor_test("trial_factor", sub {Math::Prime::Util::trial_factor(shift)}); extra_factor_test("fermat_factor", sub {Math::Prime::Util::fermat_factor(shift)}); extra_factor_test("holf_factor", sub {Math::Prime::Util::holf_factor(shift)}); extra_factor_test("squfof_factor", sub {Math::Prime::Util::squfof_factor(shift)}); extra_factor_test("pbrent_factor", sub {Math::Prime::Util::pbrent_factor(shift)}); extra_factor_test("prho_factor", sub {Math::Prime::Util::prho_factor(shift)}); extra_factor_test("pminus1_factor",sub {Math::Prime::Util::pminus1_factor(shift)}); extra_factor_test("pplus1_factor", sub {Math::Prime::Util::pplus1_factor(shift)}); # To hit some extra coverage is_deeply( [Math::Prime::Util::trial_factor(5514109)], [2203,2503], "trial factor 2203*2503" ); sub extra_factor_test { my $fname = shift; my $fsub = shift; is_deeply( [ sort {$a<=>$b} $fsub->(1) ], [], "$fname(1)" ); is_deeply( [ sort {$a<=>$b} $fsub->(4) ], [2, 2], "$fname(4)" ); is_deeply( [ sort {$a<=>$b} $fsub->(9) ], [3, 3], "$fname(9)" ); is_deeply( [ sort {$a<=>$b} $fsub->(11) ], [11], "$fname(11)" ); is_deeply( [ sort {$a<=>$b} $fsub->(25) ], [5, 5], "$fname(25)" ); is_deeply( [ sort {$a<=>$b} $fsub->(30) ], [2, 3, 5], "$fname(30)" ); is_deeply( [ sort {$a<=>$b} $fsub->(210) ], [2,3,5,7], "$fname(210)" ); is_deeply( [ sort {$a<=>$b} $fsub->(175) ], [5, 5, 7], "$fname(175)" ); is_deeply( [ sort {$a<=>$b} $fsub->(403) ], [13, 31], "$fname(403)" ); is_deeply( [ sort {$a<=>$b} $fsub->(549900) ], [2,2,3,3,5,5,13,47], "$fname(549900)" ); } # Factor in scalar context is( scalar factor(0), 1, "scalar factor(0) should be 1" ); is( scalar factor(1), 0, "scalar factor(1) should be 0" ); is( scalar factor(3), 1, "scalar factor(3) should be 1" ); is( scalar factor(4), 2, "scalar factor(4) should be 2" ); is( scalar factor(5), 1, "scalar factor(5) should be 1" ); is( scalar factor(6), 2, "scalar factor(6) should be 2" ); is( scalar factor(30107), 4, "scalar factor(30107) should be 4" ); is( scalar factor(174636000), 15, "scalar factor(174636000) should be 15" ); sub linear_to_exp { my %exponents; my @factors = grep { !$exponents{$_}++ } @_; return (map { [$_, $exponents{$_}] } @factors); } Math-Prime-Util-0.37/t/13-primecount.t0000644000076400007640000001445412270242116015764 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/prime_count prime_count_lower prime_count_upper prime_count_approx/; my $isxs = Math::Prime::Util::prime_get_config->{'xs'}; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; my $extra = 0+(defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}); # Powers of 2: http://oeis.org/A007053/b007053.txt # Powers of 10: http://oeis.org/A006880/b006880.txt my %pivals32 = ( 1 => 0, 10 => 4, 100 => 25, 1000 => 168, 10000 => 1229, 100000 => 9592, 1000000 => 78498, 10000000 => 664579, 100000000 => 5761455, 1000000000 => 50847534, 30239 => 3269, 30249 => 3270, 60067 => 6062, 65535 => 6542, 16777215 => 1077871, 2147483647 => 105097565, 4294967295 => 203280221, ); my %pivals64 = ( 10000000000 => 455052511, 100000000000 => 4118054813, 1000000000000 => 37607912018, 10000000000000 => 346065536839, 100000000000000 => 3204941750802, 1000000000000000 => 29844570422669, 10000000000000000 => 279238341033925, 100000000000000000 => 2623557157654233, 1000000000000000000 => 24739954287740860, 10000000000000000000 => 234057667276344607, 68719476735 => 2874398515, 1099511627775 => 41203088796, 17592186044415 => 597116381732, 281474976710655 => 8731188863470, 4503599627370495 => 128625503610475, 72057594037927935 => 1906879381028850, 1152921504606846975 => 28423094496953330, 18446744073709551615 => 425656284035217743, ); my %pivals_small = map { $_ => $pivals32{$_} } grep { ($_ <= 2000000) || $extra } keys %pivals32; # ./primesieve 1e10 -o2**32 -c1 # ./primesieve 24689 7973249 -c1 my %intervals = ( "868396 to 9478505" => 563275, "1118105 to 9961674" => 575195, "24689 to 7973249" => 535368, "1e10 +2**16" => 2821, "17 to 13" => 0, "0 to 1" => 0, "0 to 2" => 1, "1 to 3" => 2, "3 to 17" => 6, "4 to 17" => 5, "4 to 16" => 4, "191912783 +248" => 2, "191912784 +247" => 1, "191912783 +247" => 1, "191912784 +246" => 0, "1e14 +2**16" => 1973, "127976334671 +468" => 2, "127976334672 +467" => 1, "127976334671 +467" => 1, "127976334672 +466" => 0, ); delete @intervals{ grep { (parse_range($_))[1] > ~0 } keys %intervals }; plan tests => 0 + 1 + 3*scalar(keys %pivals32) + scalar(keys %pivals_small) + $use64 * 3 * scalar(keys %pivals64) + scalar(keys %intervals) + 1 + 5 + 2*$extra; # prime count specific methods ok( eval { prime_count(13); 1; }, "prime_count in void context"); while (my($n, $pin) = each (%pivals32)) { cmp_ok( prime_count_upper($n), '>=', $pin, "Pi($n) <= upper estimate" ); cmp_ok( prime_count_lower($n), '<=', $pin, "Pi($n) >= lower estimate" ); my $approx_range = abs($pin - prime_count_approx($n)); my $range_limit = ($n <= 100000000) ? 100 : 500; cmp_ok( $approx_range, '<=', $range_limit, "prime_count_approx($n) within $range_limit"); } while (my($n, $pin) = each (%pivals_small)) { is( prime_count($n), $pin, "Pi($n) = $pin" ); } if ($use64) { while (my($n, $pin) = each (%pivals64)) { cmp_ok( prime_count_upper($n), '>=', $pin, "Pi($n) <= upper estimate" ); cmp_ok( prime_count_lower($n), '<=', $pin, "Pi($n) >= lower estimate" ); my $approx = prime_count_approx($n); my $percent_limit = 0.0005; # This is the test we want: #cmp_ok( abs($pin - $approx) / $pin, '<=', $percent_limit/100.0, "prime_count_approx($n) within $percent_limit\% of Pi($n)"); # Math rearranged so we don't lose all precision. cmp_ok( abs($pin - $approx) * (100.0 / $percent_limit), '<=', $pin, "prime_count_approx($n) within $percent_limit\% of Pi($n)"); } } while (my($range, $expect) = each (%intervals)) { my($low,$high) = parse_range($range); is( prime_count($low,$high), $expect, "prime_count($range) = $expect"); } # Defect found in prime binary search is( prime_count(130066574), 7381740, "prime_count(130066574) = 7381740"); sub parse_range { my($range) = @_; my($low,$high); my $fixnum = sub { my $nstr = shift; $nstr =~ s/^(\d+)e(\d+)$/$1*(10**$2)/e; $nstr =~ s/^(\d+)\*\*(\d+)$/$1**$2/e; die "Unknown string in test" unless $nstr =~ /^\d+$/; $nstr; }; if ($range =~ /(\S+)\s+to\s+(\S+)/) { $low = $fixnum->($1); $high = $fixnum->($2); } elsif ($range =~ /(\S+)\s*\+\s*(\S+)/) { $low = $fixnum->($1); $high = $low + $fixnum->($2); } else { die "Can't parse test data"; } ($low,$high); } # TODO: intervals. From primesieve: # 155428406, // prime count 2^32 interval starting at 10^12 # 143482916, // prime count 2^32 interval starting at 10^13 # 133235063, // prime count 2^32 interval starting at 10^14 # 124350420, // prime count 2^32 interval starting at 10^15 # 116578809, // prime count 2^32 interval starting at 10^16 # 109726486, // prime count 2^32 interval starting at 10^17 # 103626726, // prime count 2^32 interval starting at 10^18 # 98169972}; // prime count 2^32 interval starting at 10^19 # Make sure each specific algorithm isn't broken. SKIP: { skip "Not XS -- skipping direct primecount tests", 2 unless $isxs; # This has to be above SIEVE_LIMIT in lehmer.c and lmo.c or nothing happens. #is(Math::Prime::Util::_XS_lehmer_pi (66123456),3903023,"XS Lehmer count"); #is(Math::Prime::Util::_XS_meissel_pi (66123456),3903023,"XS Meissel count"); #is(Math::Prime::Util::_XS_legendre_pi(66123456),3903023,"XS Legendre count"); #is(Math::Prime::Util::_XS_LMOS_pi (66123456),3903023,"XS LMOS count"); is(Math::Prime::Util::_XS_LMO_pi (66123456), 3903023,"XS LMO count"); is(Math::Prime::Util::_XS_segment_pi (66123456), 3903023,"XS segment count"); } require_ok 'Math::Prime::Util::PP'; is(Math::Prime::Util::PP::_lehmer_pi (1456789), 111119, "PP Lehmer count"); is(Math::Prime::Util::PP::_sieve_prime_count(145678), 13478, "PP sieve count"); if ($extra) { is(Math::Prime::Util::PP::_lehmer_pi (3456789), 247352, "PP Lehmer count"); is(Math::Prime::Util::PP::_sieve_prime_count(3456789), 247352, "PP sieve count"); } Math-Prime-Util-0.37/t/15-probprime.t0000644000076400007640000001173012270011421015563 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_prob_prime/; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; my $broken64 = (18446744073709550592 == ~0); my @small_primes = qw/ 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947 953 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069 1087 1091 1093 1097 1103 1109 1117 1123 1129 1151 1153 1163 1171 1181 1187 1193 1201 1213 1217 1223 1229 1231 1237 1249 1259 1277 1279 1283 1289 1291 1297 1301 1303 1307 1319 1321 1327 1361 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459 1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543 1549 1553 1559 1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627 1637 1657 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753 1759 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877 1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997 1999 2003 2011 2017 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089 2099 2111 2113 2129 2131 2137 2141 2143 2153 2161 2179 2203 2207 2213 2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 2297 2309 2311 2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 2399 2411 2417 2423 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 2543 2549 2551 2557 2579 2591 2593 2609 2617 2621 2633 2647 2657 2659 2663 2671 2677 2683 2687 2689 2693 2699 2707 2711 2713 2719 2729 2731 2741 2749 2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851 2857 2861 2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969 2971 2999 3001 3011 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089 3109 3119 3121 3137 3163 3167 3169 3181 3187 3191 3203 3209 3217 3221 3229 3251 3253 3257 3259 3271 3299 3301 3307 3313 3319 3323 3329 3331 3343 3347 3359 3361 3371 3373 3389 3391 3407 3413 3433 3449 3457 3461 3463 3467 3469 3491 3499 3511 3517 3527 3529 3533 3539 3541 3547 3557 3559 3571 /; my @composites = (qw/ 9 121 341 561 645 703 781 1105 1387 1541 1729 1891 1905 2047 2465 2701 2821 3277 3281 4033 4369 4371 4681 5461 5611 6601 7813 7957 8321 8401 8911 10585 12403 13021 14981 15751 15841 16531 18721 19345 23521 24211 25351 29341 29539 31621 38081 40501 41041 44287 44801 46657 47197 52633 53971 55969 62745 63139 63973 74593 75361 79003 79381 82513 87913 88357 88573 97567 101101 340561 488881 852841 1373653 1857241 6733693 9439201 17236801 23382529 25326001 34657141 56052361 146843929 216821881 3215031751 /); push @composites, (qw/ 2152302898747 3474749660383 341550071728321 341550071728321 3825123056546413051/) if $use64; my @primes = (qw/ 2 3 7 23 89 113 523 887 1129 1327 9551 15683 19609 31397 155921 5 11 29 97 127 541 907 1151 1361 9587 15727 19661 31469 156007 360749 370373 492227 1349651 1357333 2010881 4652507 17051887 20831533 47326913 122164969 189695893 191913031 387096383 436273291 1294268779 1453168433 2300942869 3842611109/); push @primes, (qw/ 4302407713 10726905041 20678048681 22367085353 25056082543 42652618807 127976334671 182226896239 241160624143 297501075799 303371455241 304599508537 416608695821 461690510011 614487453523 738832927927 1346294310749 1408695493609 1968188556461 2614941710599/) if $use64; # We're checking every integer from 0 to small_primes[-1], so don't bother # checking them twice. @composites = grep { $_ > $small_primes[-1] } @composites; @primes = grep { $_ > $small_primes[-1] } @primes; plan tests => 6 # range + 1 # powers of 2 + 1 # small numbers + scalar @composites + scalar @primes + 0; ok(!eval { is_prob_prime(undef); }, "is_prob_prime(undef)"); ok( is_prob_prime(2), '2 is prime'); ok(!is_prob_prime(1), '1 is not prime'); ok(!is_prob_prime(0), '0 is not prime'); ok(!is_prob_prime(-1), '-1 is not prime'); ok(!is_prob_prime(-2), '-2 is not prime'); { my @isprime = map { 0+!!is_prob_prime( int(2**$_) ) } (2..20); my @exprime = (0) x (20-2+1); is_deeply( \@isprime, \@exprime, "is_prob_prime powers of 2" ); } { my %small_primes = map { $_ => 1; } @small_primes; my @isprime = map { is_prob_prime($_) } (0..3572); my @exprime = map { $small_primes{$_} ? 2 : 0 } (0..3572); is_deeply( \@isprime, \@exprime, "is_prob_prime 0..3572" ); } foreach my $n (@composites) { is( is_prob_prime($n), 0, "$n is composite" ); } foreach my $n (@primes) { is( is_prob_prime($n), 2, "$n is definitely prime" ); } Math-Prime-Util-0.37/t/92-release-pod-coverage.t0000644000076400007640000000502012270244414017567 0ustar danadana#!/usr/bin/env perl use strict; use warnings; BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } #--------------------------------------------------------------------- use Test::More; eval "use Test::Pod::Coverage 1.08"; plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" if $@; my @modules = grep { $_ ne 'Math::Prime::Util::PPFE' } Test::Pod::Coverage::all_modules(); plan tests => scalar @modules; #my $ppsubclass = { trustme => [mpu_public_regex()] }; foreach my $m (@modules) { my $param = { also_private => [ qr/^(erat|segment|trial|sieve)_primes$/ ], }; $param->{trustme} = [mpu_public_regex(), mpu_factor_regex()] if $m eq 'Math::Prime::Util::PP'; pod_coverage_ok( $m, $param ); } sub mpu_public_regex { my @funcs = qw/ prime_get_config prime_set_config prime_precalc prime_memfree is_prime is_prob_prime is_provable_prime is_provable_prime_with_cert prime_certificate verify_prime is_pseudoprime is_strong_pseudoprime is_lucas_pseudoprime is_strong_lucas_pseudoprime is_extra_strong_lucas_pseudoprime is_almost_extra_strong_lucas_pseudoprime is_frobenius_underwood_pseudoprime is_aks_prime is_bpsw_prime miller_rabin miller_rabin_random lucas_sequence primes forprimes forcomposites fordivisors prime_iterator prime_iterator_object next_prime prev_prime prime_count prime_count_lower prime_count_upper prime_count_approx nth_prime nth_prime_lower nth_prime_upper nth_prime_approx random_prime random_ndigit_prime random_nbit_prime random_strong_prime random_proven_prime random_proven_prime_with_cert random_maurer_prime random_maurer_prime_with_cert primorial pn_primorial consecutive_integer_lcm gcd lcm factor factor_exp all_factors divisors moebius mertens euler_phi jordan_totient exp_mangoldt liouville partitions chebyshev_theta chebyshev_psi divisor_sum carmichael_lambda kronecker znorder znprimroot znlog legendre_phi ExponentialIntegral LogarithmicIntegral RiemannZeta RiemannR /; my $pattern = '^(' . join('|', @funcs) . ')$'; return qr/$pattern/; } sub mpu_factor_regex { my @funcs = qw/ ecm_factor fermat_factor holf_factor pbrent_factor pminus1_factor prho_factor squfof_factor trial_factor/; my $pattern = '^(' . join('|', @funcs) . ')$'; return qr/$pattern/; } Math-Prime-Util-0.37/t/01-load.t0000644000076400007640000000015411762663440014517 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 1; require_ok 'Math::Prime::Util'; Math-Prime-Util-0.37/t/10-isprime.t0000644000076400007640000001173112270011421015230 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_prime/; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; my $broken64 = (18446744073709550592 == ~0); my @small_primes = qw/ 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947 953 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069 1087 1091 1093 1097 1103 1109 1117 1123 1129 1151 1153 1163 1171 1181 1187 1193 1201 1213 1217 1223 1229 1231 1237 1249 1259 1277 1279 1283 1289 1291 1297 1301 1303 1307 1319 1321 1327 1361 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459 1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543 1549 1553 1559 1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627 1637 1657 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753 1759 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877 1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997 1999 2003 2011 2017 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089 2099 2111 2113 2129 2131 2137 2141 2143 2153 2161 2179 2203 2207 2213 2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 2297 2309 2311 2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 2399 2411 2417 2423 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 2543 2549 2551 2557 2579 2591 2593 2609 2617 2621 2633 2647 2657 2659 2663 2671 2677 2683 2687 2689 2693 2699 2707 2711 2713 2719 2729 2731 2741 2749 2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851 2857 2861 2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969 2971 2999 3001 3011 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089 3109 3119 3121 3137 3163 3167 3169 3181 3187 3191 3203 3209 3217 3221 3229 3251 3253 3257 3259 3271 3299 3301 3307 3313 3319 3323 3329 3331 3343 3347 3359 3361 3371 3373 3389 3391 3407 3413 3433 3449 3457 3461 3463 3467 3469 3491 3499 3511 3517 3527 3529 3533 3539 3541 3547 3557 3559 3571 /; my @composites = (qw/ 9 121 341 561 645 703 781 1105 1387 1541 1729 1891 1905 2047 2465 2701 2821 3277 3281 4033 4369 4371 4681 5461 5611 6601 7813 7957 8321 8401 8911 10585 12403 13021 14981 15751 15841 16531 18721 19345 23521 24211 25351 29341 29539 31621 38081 40501 41041 44287 44801 46657 47197 52633 53971 55969 62745 63139 63973 74593 75361 79003 79381 82513 87913 88357 88573 97567 101101 340561 488881 852841 1373653 1857241 6733693 9439201 17236801 23382529 25326001 34657141 56052361 146843929 216821881 3215031751 /); push @composites, (qw/ 2152302898747 3474749660383 341550071728321 341550071728321 3825123056546413051/) if $use64; my @primes = (qw/ 2 3 7 23 89 113 523 887 1129 1327 9551 15683 19609 31397 155921 5 11 29 97 127 541 907 1151 1361 9587 15727 19661 31469 156007 360749 370373 492227 1349651 1357333 2010881 4652507 17051887 20831533 47326913 122164969 189695893 191913031 387096383 436273291 1294268779 1453168433 2300942869 3842611109/); push @primes, (qw/ 4302407713 10726905041 20678048681 22367085353 25056082543 42652618807 127976334671 182226896239 241160624143 297501075799 303371455241 304599508537 416608695821 461690510011 614487453523 738832927927 1346294310749 1408695493609 1968188556461 2614941710599/) if $use64; #@large_primes = grep { $extra || $_ <= 4_000_000_000 } @large_primes; # We're checking every integer from 0 to small_primes[-1], so don't bother # checking them twice. @composites = grep { $_ > $small_primes[-1] } @composites; @primes = grep { $_ > $small_primes[-1] } @primes; plan tests => 6 # range + 1 # powers of 2 + 1 # small numbers + scalar @composites + scalar @primes + 0; ok(!eval { is_prime(undef); }, "is_prime(undef)"); ok( is_prime(2), '2 is prime'); ok(!is_prime(1), '1 is not prime'); ok(!is_prime(0), '0 is not prime'); ok(!is_prime(-1), '-1 is not prime'); ok(!is_prime(-2), '-2 is not prime'); { my @isprime = map { 0+!!is_prime( int(2**$_) ) } (2..20); my @exprime = (0) x (20-2+1); is_deeply( \@isprime, \@exprime, "is_prime powers of 2" ); } { my %small_primes = map { $_ => 1; } @small_primes; my @isprime = map { is_prime($_) } (0..3572); my @exprime = map { $small_primes{$_} ? 2 : 0 } (0..3572); is_deeply( \@isprime, \@exprime, "is_prime 0..3572" ); } foreach my $n (@composites) { is( is_prime($n), 0, "$n is composite" ); } foreach my $n (@primes) { is( is_prime($n), 2, "$n is definitely prime" ); } Math-Prime-Util-0.37/lmo.c0000644000076400007640000006732212270242116013663 0ustar danadana#include #include #include #include /***************************************************************************** * * Prime counts using the extended Lagarias-Miller-Odlyzko combinatorial method. * * Copyright (c) 2013 Dana Jacobsen (dana@acm.org) * This is free software; you can redistribute it and/or modify it under * the same terms as the Perl 5 programming language system itself. * * This file is part of the Math::Prime::Util Perl module, but it should * not be difficult to turn it into standalone code. * * The structure of the main routine is based on Christian Bau's earlier work. * * References: * - Christian Bau's paper and example implementation, 2003, Christian Bau * This was of immense help. References to "step #" refer to this preprint. * - "Computing Pi(x): the combinatorial method", 2006, Tomás Oliveira e Silva * - "Computing Pi(x): The Meissel, Lehmer, Lagarias, Miller, Odlyzko Method" * 1996, Deléglise and Rivat. * * Comparisons to the other prime counting implementations in this package: * * Sieve: Segmented, single threaded, thread-safe. Small table enhanced, * fastest for n < 60M. Bad growth rate (like all sieves will have). * Legendre:Simple. Recursive caching phi. * Meissel: Simple. Non-recursive phi, lots of memory. * Lehmer: Non-recursive phi, tries to restrict memory. * LMOS: Simple. Non-recursive phi, less memory than Lehmer above. * LMO: Sieve phi. Much faster and less memory than the others. * * Timing below is single core Haswell 4770K using Math::Prime::Util. * * | n | Legendre | Meissel | Lehmer | LMOS | LMO | * +-------+----------+----------+----------+----------+-----------+ * | 10^19 | | | | | 2493.4 | * | 10^18 | | | | | 498.16 | * | 10^17 |10459.3 | 4348.3 | 6109.7 | 3478.0 | 103.03 | * | 10^16 | 1354.6 | 510.8 | 758.6 | 458.4 | 21.64 | * | 10^15 | 171.2 | 97.1 | 106.4 | 68.11 | 4.707 | * | 10^14 | 23.56 | 18.59 | 16.51 | 10.44 | 1.032 | * | 10^13 | 3.783 | 3.552 | 2.803 | 1.845 | 0.237 | * | 10^12 | 0.755 | 0.697 | 0.505 | 0.378 | 54.9ms | * | 10^11 | 0.165 | 0.144 | 93.7ms| 81.6ms| 13.80ms| * | 10^10 | 35.9ms| 29.9ms| 19.9ms| 17.8ms| 3.64ms| * * Run with high memory limits: Meissel uses 1GB for 10^16, ~3GB for 10^17. * Lehmer is limited at high n values by sieving speed. It is much faster * using parallel primesieve, though cannot come close to LMO. */ /* Below this size, just sieve (with table speedup). */ #define SIEVE_LIMIT 60000000 /* Adjust to get best performance. Alpha from TOS paper. */ #define M_FACTOR(n) (UV) ((double)n * (log(n)/log(5.2)) * (log(log(n))-1.4)) /* Size of segment used for previous primes, must be >= 21 */ #define PREV_SIEVE_SIZE 512 /* Phi sieve multiplier, adjust for best performance and memory use. */ #define PHI_SIEVE_MULT 13 #define FUNC_isqrt 1 #define FUNC_icbrt 1 #include "lmo.h" #include "util.h" #include "cache.h" #include "sieve.h" #ifdef _MSC_VER typedef unsigned __int8 uint8; typedef unsigned __int16 uint16; typedef unsigned __int32 uint32; #else typedef unsigned char uint8; typedef unsigned short uint16; typedef uint32_t uint32; #endif /* UV is either uint32 or uint64 depending on Perl. We use this native size * for the basic unit of the phi sieve. It can be easily overridden here. */ typedef UV sword_t; #define SWORD_BITS BITS_PER_WORD #define SWORD_ONES UV_MAX #define SWORD_MASKBIT(bits) (UVCONST(1) << ((bits) % SWORD_BITS)) #define SWORD_CLEAR(s,bits) s[bits/SWORD_BITS] &= ~SWORD_MASKBIT(bits) /* GCC 3.4 - 4.1 has broken 64-bit popcount. * GCC 4.2+ can generate awful code when it doesn't have asm (GCC bug 36041). * When the asm is present (e.g. compile with -march=native on a platform that * has them, like Nahelem+), then it is almost as fast as the direct asm. */ #if SWORD_BITS == 64 #if defined(__POPCNT__) && defined(__GNUC__) && (__GNUC__> 4 || (__GNUC__== 4 && __GNUC_MINOR__> 1)) #define bitcount(b) __builtin_popcountll(b) #else static sword_t bitcount(sword_t b) { b -= (b >> 1) & 0x5555555555555555; b = (b & 0x3333333333333333) + ((b >> 2) & 0x3333333333333333); b = (b + (b >> 4)) & 0x0f0f0f0f0f0f0f0f; return (b * 0x0101010101010101) >> 56; } #endif #else /* An 8-bit table version is usually a little faster, but this is simpler. */ static sword_t bitcount(sword_t b) { b -= (b >> 1) & 0x55555555; b = (b & 0x33333333) + ((b >> 2) & 0x33333333); b = (b + (b >> 4)) & 0x0f0f0f0f; return (b * 0x01010101) >> 24; } #endif /* Create array of small primes: 0,2,3,5,...,prev_prime(n+1) */ static uint32_t* make_primelist(uint32 n, uint32* number_of_primes) { uint32 i = 0; uint32_t* plist; double logn = log(n); uint32 max_index = (n < 67) ? 18 : (n < 355991) ? 15+(n/(logn-1.09)) : (n/logn) * (1.0+1.0/logn+2.51/(logn*logn)); *number_of_primes = 0; New(0, plist, max_index+1, uint32_t); plist[0] = 0; /* We could do a simple SoE here. This is not time critical. */ START_DO_FOR_EACH_PRIME(2, n) { plist[++i] = p; } END_DO_FOR_EACH_PRIME; *number_of_primes = i; return plist; } #if 0 /* primesieve 5.0 example */ #include static uint32_t* make_primelist(uint32 n, uint32* number_of_primes) { uint32_t plist; uint32_t* psprimes = generate_primes(2, n, number_of_primes, UINT_PRIMES); New(0, plist, *number_of_primes + 1, uint32_t); plist[0] = 0; memcpy(plist+1, psprimes, *number_of_primes * sizeof(uint32_t)); primesieve_free(psprimes); return plist; } #endif /* Given a max prime in small prime list, return max prev prime input */ static uint32 prev_sieve_max(UV maxprime) { UV limit = maxprime*maxprime - (maxprime*maxprime % (16*PREV_SIEVE_SIZE)) - 1; return (limit > U32_CONST(4294967295)) ? U32_CONST(4294967295) : limit; } /* Simple SoE filling a segment */ static void _prev_sieve_fill(UV start, uint8* sieve, const uint32_t* primes) { UV i, j, p; memset( sieve, 0xFF, PREV_SIEVE_SIZE ); for (i = 2, p = 3; p*p < start + (16*PREV_SIEVE_SIZE); p = primes[++i]) for (j = (start == 0) ? p*p/2 : (p-1) - ((start+(p-1))/2) % p; j < (8*PREV_SIEVE_SIZE); j += p) sieve[j/8] &= ~(1U << (j%8)); } /* Calculate previous prime using small segment */ static uint32 prev_sieve_prime(uint32 n, uint8* sieve, uint32* segment_start, uint32 sieve_max, const uint32_t* primes) { uint32 sieve_start, bit_offset; if (n <= 3) return (n == 3) ? 2 : 0; if (n > sieve_max) croak("ps overflow\n"); /* If n > 3 && n <= sieve_max, then there is an odd prime we can find. */ n -= 2; bit_offset = n % (16*PREV_SIEVE_SIZE); sieve_start = n - bit_offset; bit_offset >>= 1; while (1) { if (sieve_start != *segment_start) { /* Fill sieve if necessary */ _prev_sieve_fill(sieve_start, sieve, primes); *segment_start = sieve_start; } do { /* Look for a set bit in sieve */ if (sieve[bit_offset / 8] & (1u << (bit_offset % 8))) return sieve_start + 2*bit_offset + 1; } while (bit_offset-- > 0); sieve_start -= (16 * PREV_SIEVE_SIZE); bit_offset = ((16 * PREV_SIEVE_SIZE) - 1) / 2; } } /* Create factor table. * In lehmer.c we create mu and lpf arrays. Here we use Christian Bau's * method, which is slightly more memory efficient and also a bit faster than * the code there (which does not use our fast ranged moebius). It makes * very little difference -- mainly using this table is more convenient. * * In a uint16 we have stored: * 0 moebius(n) = 0 * even moebius(n) = 1 * odd moebius(n) = -1 (last bit indicates even/odd number of factors) * v smallest odd prime factor of n is v&1 * 65535 large prime */ static uint16* ft_create(uint32 max) { uint16* factor_table; uint32 i; uint32 tableLimit = max + 338 + 1; /* At least one more prime */ uint32 tableSize = tableLimit/2; uint32 max_prime = (tableLimit - 1) / 3 + 1; New(0, factor_table, tableSize, uint16); /* Set all values to 65535 (a large prime), set 0 to 65534. */ factor_table[0] = 65534; for (i = 1; i < tableSize; ++i) factor_table[i] = 65535; /* Process each odd. */ for (i = 1; i < tableSize; ++i) { uint32 factor, max_factor; uint32 p = i*2+1; if (factor_table[i] != 65535) /* Already marked. */ continue; if (p < 65535) /* p is a small prime, so set the number. */ factor_table[i] = p; if (p >= max_prime) /* No multiples will be in the table */ continue; max_factor = (tableLimit - 1) / p + 1; /* Look for odd multiples of the prime p. */ for (factor = 3; factor < max_factor; factor += 2) { uint32 index = (p*factor)/2; if (factor_table[index] == 65535) /* p is smallest factor */ factor_table[index] = p; else if (factor_table[index] > 0) /* Change number of factors */ factor_table[index] ^= 0x01; } /* Change all odd multiples of p*p to 0 to indicate non-square-free. */ for (factor = p; factor < max_factor; factor += 2*p) factor_table[ (p*factor) / 2] = 0; } return factor_table; } #define PHIC 6 /* static const uint8_t _s0[ 1] = {0}; static const uint8_t _s1[ 2] = {0,1}; static const uint8_t _s2[ 6] = {0,1,1,1,1,2}; */ static const uint8_t _s3[30] = {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}; static const uint8_t _s4[210]= {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}; static UV tablephi(UV x, uint32 a) { switch (a) { case 0: return x; case 1: return x-x/2; case 2: return x-x/2-x/3+x/6; case 3: return (x/ 30U) * 8U + _s3[x % 30U]; case 4: return (x/ 210U) * 48U + _s4[x % 210U]; case 5: { UV xp = x / 11U; return ((x /210) * 48 + _s4[x % 210]) - ((xp/210) * 48 + _s4[xp % 210]); } case 6: default:{ UV xp = x / 11U; UV x2 = x / 13U; UV x2p = x2 / 11U; return ((x /210) * 48 + _s4[x % 210]) - ((xp /210) * 48 + _s4[xp % 210]) - ((x2 /210) * 48 + _s4[x2 % 210]) + ((x2p/210) * 48 + _s4[x2p% 210]); } /* case 7: return tablephi(x,a-1)-tablephi(x/17,a-1); */ /* Hack hack */ } } /****************************************************************************/ /* Legendre Phi. Not used by LMO, but exported. */ /****************************************************************************/ /* * Choices include: * 1) recursive, memory-less. We use this for small values. * 2) recursive, caching. We use a this for larger values w/ 32MB cache. * 3) a-walker sorted list. lehmer.c has this implementation. It is * faster for some values, but big and memory intensive. */ static UV _phi_recurse(UV x, UV a) { UV i, c = (a > PHIC) ? PHIC : a; UV sum = tablephi(x, c); if (a > c) { UV p = nth_prime(c); UV pa = nth_prime(a); for (i = c+1; i <= a; i++) { UV xp; p = next_prime(p); xp = x/p; if (xp < p) { while (x < pa) { a--; pa = prev_prime(pa); } return (sum - a + i - 1); } sum -= legendre_phi(xp, i-1); } } return sum; } #define PHICACHEA 256 #define PHICACHEX 65536 #define PHICACHE_EXISTS(x,a) \ ((x < PHICACHEX && a < PHICACHEA) ? cache[a*PHICACHEX+x] : 0) static IV _phi(UV x, UV a, int sign, const uint32_t* const primes, const uint32_t lastidx, uint16_t* cache) { IV sum; if (PHICACHE_EXISTS(x,a)) return sign * cache[a*PHICACHEX+x]; else if (a <= PHIC) return sign * tablephi(x, a); else if (x < primes[a+1]) sum = sign; else { /* sum = _phi(x, a-1, sign, primes, lastidx, cache) + */ /* _phi(x/primes[a], a-1, -sign, primes, lastidx, cache); */ UV a2, iters = (a*a > x) ? _XS_prime_count(2,isqrt(x)) : a; UV c = (iters > PHIC) ? PHIC : iters; IV phixc = PHICACHE_EXISTS(x,c) ? cache[a*PHICACHEX+x] : tablephi(x,c); sum = sign * (iters - a + phixc); for (a2 = c+1; a2 <= iters; a2++) sum += _phi(x/primes[a2], a2-1, -sign, primes, lastidx, cache); } if (x < PHICACHEX && a < PHICACHEA && sign*sum <= SHRT_MAX) cache[a*PHICACHEX+x] = sign * sum; return sum; } UV legendre_phi(UV x, UV a) { /* TODO: tune these */ if ( (x > PHIC && a > 200) || (x > 1000000000 && a > 30) ) { uint16_t* cache; uint32_t* primes; uint32_t lastidx; UV res, max_cache_a = (a >= PHICACHEA) ? PHICACHEA : a+1; Newz(0, cache, PHICACHEX * max_cache_a, uint16_t); primes = make_primelist(nth_prime(a+1), &lastidx); res = (UV) _phi(x, a, 1, primes, lastidx, cache); Safefree(primes); Safefree(cache); return res; } return _phi_recurse(x, a); } /****************************************************************************/ typedef struct { sword_t *sieve; /* segment bit mask */ uint8 *word_count; /* bit count in each 64-bit word */ uint32 *word_count_sum; /* cumulative sum of word_count */ UV *totals; /* total bit count for all phis at index */ uint32 *prime_index; /* index of prime where phi(n/p/p(k+1))=1 */ uint32 *first_bit_index; /* offset relative to start for this prime */ uint8 *multiplier; /* mod-30 wheel of each prime */ UV start; /* x value of first bit of segment */ UV phi_total; /* cumulative bit count before removal */ uint32 size; /* segment size in bits */ uint32 first_prime; /* index of first prime in segment */ uint32 last_prime; /* index of last prime in segment */ uint32 last_prime_to_remove; /* index of last prime p, p^2 in segment */ } sieve_t; /* Size of phi sieve in words. Multiple of 3*5*7*11 words. */ #define PHI_SIEVE_WORDS (1155 * PHI_SIEVE_MULT) /* Bit counting using cumulative sums. A bit slower than using a running sum, * but a little simpler and can be run in parallel. */ static uint32 make_sieve_sums(uint32 sieve_size, const uint8* sieve_word_count, uint32* sieve_word_count_sum) { uint32 i, bc, words = (sieve_size + 2*SWORD_BITS-1) / (2*SWORD_BITS); sieve_word_count_sum[0] = 0; for (i = 0, bc = 0; i+7 < words; i += 8) { const uint8* cntptr = sieve_word_count + i; uint32* sumptr = sieve_word_count_sum + i; sumptr[1] = bc += cntptr[0]; sumptr[2] = bc += cntptr[1]; sumptr[3] = bc += cntptr[2]; sumptr[4] = bc += cntptr[3]; sumptr[5] = bc += cntptr[4]; sumptr[6] = bc += cntptr[5]; sumptr[7] = bc += cntptr[6]; sumptr[8] = bc += cntptr[7]; } for (; i < words; i++) sieve_word_count_sum[i+1] = sieve_word_count_sum[i] + sieve_word_count[i]; return sieve_word_count_sum[words]; } static UV _sieve_phi(UV segment_x, const sword_t* sieve, const uint32* sieve_word_count_sum) { uint32 bits = (segment_x + 1) / 2; uint32 words = bits / SWORD_BITS; uint32 sieve_sum = sieve_word_count_sum[words]; sieve_sum += bitcount( sieve[words] & ~(SWORD_ONES << (bits % SWORD_BITS)) ); return sieve_sum; } /* Erasing primes from the sieve is done using Christian Bau's * case statement walker. It's not pretty, but it is short, fast, * clever, and does the job. */ #define sieve_zero(sieve, si, wordcount) \ { uint32 index = si/SWORD_BITS; \ sword_t mask = SWORD_MASKBIT(si); \ if (sieve[index] & mask) { \ sieve[index] &= ~mask; \ wordcount[index]--; \ } } #define sieve_case_zero(casenum, skip, si, p, size, mult, sieve, wordcount) \ case casenum: sieve_zero(sieve, si, wordcount); \ si += skip * p; \ mult = (casenum+1) % 8; \ if (si >= size) break; static void remove_primes(uint32 index, uint32 last_index, sieve_t* s, const uint32_t* primes) { uint32 size = (s->size + 1) / 2; sword_t *sieve = s->sieve; uint8 *word_count = s->word_count; s->phi_total = s->totals[last_index]; for ( ;index <= last_index; index++) { if (index >= s->first_prime && index <= s->last_prime) { uint32 b = (primes[index] - (uint32) s->start - 1) / 2; sieve_zero(sieve, b, word_count); } if (index <= s->last_prime_to_remove) { uint32 b = s->first_bit_index[index]; if (b < size) { uint32 p = primes[index]; uint32 mult = s->multiplier[index]; switch (mult) { reloop: ; sieve_case_zero(0, 3, b, p, size, mult, sieve, word_count); sieve_case_zero(1, 2, b, p, size, mult, sieve, word_count); sieve_case_zero(2, 1, b, p, size, mult, sieve, word_count); sieve_case_zero(3, 2, b, p, size, mult, sieve, word_count); sieve_case_zero(4, 1, b, p, size, mult, sieve, word_count); sieve_case_zero(5, 2, b, p, size, mult, sieve, word_count); sieve_case_zero(6, 3, b, p, size, mult, sieve, word_count); sieve_case_zero(7, 1, b, p, size, mult, sieve, word_count); goto reloop; } s->multiplier[index] = mult; } s->first_bit_index[index] = b - size; } } s->totals[last_index] += make_sieve_sums(s->size, s->word_count, s->word_count_sum); } static void word_tile (sword_t* source, uint32 from, uint32 to) { while (from < to) { uint32 words = (2*from > to) ? to-from : from; memcpy(source+from, source, sizeof(sword_t)*words); from += words; } } static void init_segment(sieve_t* s, UV segment_start, uint32 size, uint32 start_prime_index, uint32 sieve_last, const uint32_t* primes) { uint32 i, words; sword_t* sieve = s->sieve; uint8* word_count = s->word_count; s->start = segment_start; s->size = size; if (segment_start == 0) { s->last_prime = 0; s->last_prime_to_remove = 0; } s->first_prime = s->last_prime + 1; while (s->last_prime < sieve_last) { uint32 p = primes[s->last_prime + 1]; if (p >= segment_start + size) break; s->last_prime++; } while (s->last_prime_to_remove < sieve_last) { UV p = primes[s->last_prime_to_remove + 1]; UV p2 = p*p; if (p2 >= segment_start + size) break; s->last_prime_to_remove++; s->first_bit_index[s->last_prime_to_remove] = (p2 - segment_start - 1) / 2; s->multiplier[s->last_prime_to_remove] = (uint8) ((p % 30) * 8 / 30); } memset(sieve, 0xFF, 3*sizeof(sword_t)); /* Set first 3 words to all 1 bits */ if (start_prime_index >= 3) /* Remove multiples of 3. */ for (i = 3/2; i < 3 * SWORD_BITS; i += 3) SWORD_CLEAR(sieve, i); word_tile(sieve, 3, 15); /* Copy to first 15 = 3*5 words */ if (start_prime_index >= 3) /* Remove multiples of 5. */ for (i = 5/2; i < 15 * SWORD_BITS; i += 5) SWORD_CLEAR(sieve, i); word_tile(sieve, 15, 105); /* Copy to first 105 = 3*5*7 words */ if (start_prime_index >= 4) /* Remove multiples of 7. */ for (i = 7/2; i < 105 * SWORD_BITS; i += 7) SWORD_CLEAR(sieve, i); word_tile(sieve, 105, 1155); /* Copy to first 1155 = 3*5*7*11 words */ if (start_prime_index >= 5) /* Remove multiples of 11. */ for (i = 11/2; i < 1155 * SWORD_BITS; i += 11) SWORD_CLEAR(sieve, i); size = (size+1) / 2; /* size to odds */ words = (size + SWORD_BITS-1) / SWORD_BITS; /* sieve size in words */ word_tile(sieve, 1155, words); /* Copy first 1155 words to rest */ /* Zero all unused bits and words */ if (size % SWORD_BITS) sieve[words-1] &= ~(SWORD_ONES << (size % SWORD_BITS)); memset(sieve + words, 0x00, sizeof(sword_t)*(PHI_SIEVE_WORDS+2 - words)); /* Create counts, remove primes (updating counts and sums). */ for (i = 0; i < words; i++) word_count[i] = (uint8) bitcount(sieve[i]); remove_primes(6, start_prime_index, s, primes); } /* However we want to handle reduced prime counts */ #define simple_pi(n) _XS_LMO_pi(n) /* Macros to hide all the variables being passed */ #define prev_sieve_prime(n) \ prev_sieve_prime(n, &prev_sieve[0], &ps_start, ps_max, primes) #define sieve_phi(x) \ ss.phi_total + _sieve_phi((x) - ss.start, ss.sieve, ss.word_count_sum) UV _XS_LMO_pi(UV n) { UV N2, N3, K2, K3, M, sum1, sum2, phi_value; UV sieve_start, sieve_end, least_divisor, step7_max, last_phi_sieve; uint32 j, k, piM, KM, end, prime, prime_index; uint32 ps_start, ps_max, smallest_divisor, nprimes; uint8 prev_sieve[PREV_SIEVE_SIZE]; uint32_t *primes; uint16 *factor_table; sieve_t ss; const uint32 c = PHIC; /* We can use our fast function for this */ /* For "small" n, use our table+segment sieve. */ if (n < SIEVE_LIMIT || n < 10000) return _XS_prime_count(2, n); /* n should now be reasonably sized (not tiny). */ N2 = isqrt(n); /* floor(N^1/2) */ N3 = icbrt(n); /* floor(N^1/3) */ K2 = simple_pi(N2); /* Pi(N2) */ K3 = simple_pi(N3); /* Pi(N3) */ /* M is N^1/3 times a tunable performance factor. */ M = (N3 > 500) ? M_FACTOR(N3) : N3+N3/2; if (M >= N2) M = N2 - 1; /* M must be smaller than N^1/2 */ if (M < N3) M = N3; /* M must be at least N^1/3 */ /* Create the array of small primes, and least-prime-factor/moebius table */ primes = make_primelist( M + 500, &nprimes ); factor_table = ft_create( M ); /* Create other arrays */ New(0, ss.sieve, PHI_SIEVE_WORDS + 2, sword_t); New(0, ss.word_count, PHI_SIEVE_WORDS + 2, uint8); New(0, ss.word_count_sum, PHI_SIEVE_WORDS + 2, uint32); New(0, ss.totals, K3+2, UV); New(0, ss.prime_index, K3+2, uint32); New(0, ss.first_bit_index, K3+2, uint32); New(0, ss.multiplier, K3+2, uint8); if (ss.sieve == 0 || ss.word_count == 0 || ss.word_count_sum == 0 || ss.totals == 0 || ss.prime_index == 0 || ss.first_bit_index == 0 || ss.multiplier == 0) croak("Allocation failure in LMO Pi\n"); /* Variables for fast prev_prime using small segment sieves (up to M^2) */ ps_max = prev_sieve_max( primes[nprimes] ); ps_start = U32_CONST(0xFFFFFFFF); /* Look for the smallest divisor: the smallest number > M which is * square-free and not divisible by any prime covered by our Mapes * small-phi case. The largest value we will look up in the phi * sieve is n/smallest_divisor. */ for (j = (M+1)/2; factor_table[j] <= primes[c]; j++) /* */; smallest_divisor = 2*j+1; /* largest_divisor = (N2 > (UV)M * (UV)M) ? N2 : (UV)M * (UV)M; */ M = smallest_divisor - 1; /* Increase M if possible */ piM = simple_pi(M); if (piM < c) croak("N too small for LMO\n"); last_phi_sieve = n / smallest_divisor + 1; /* KM = smallest k, c <= k <= piM, s.t. primes[k+1] * primes[k+2] > M. */ for (KM = c; primes[KM+1] * primes[KM+2] <= M && KM < piM; KM++) /* */; if (K3 < KM) K3 = KM; /* Ensure K3 >= KM */ /* Start calculating Pi(n). Steps 4-10 from Bau. */ sum1 = (K2 - 1) + (UV) (piM - K3 - 1) * (UV) (piM - K3) / 2; sum2 = 0; end = (M+1)/2; /* Start at index K2, which is the prime preceeding N^1/2 */ prime = prev_sieve_prime( (N2 >= ps_start) ? ps_start : N2+1 ); prime_index = K2 - 1; step7_max = K3; /* Step 4: For 1 <= x <= M where x is square-free and has no * factor <= primes[c], sum phi(n / x, c). */ for (j = 0; j < end; j++) { uint32 lpf = factor_table[j]; if (lpf > primes[c]) { phi_value = tablephi(n / (2*j+1), c); /* x = 2j+1 */ if (lpf & 0x01) sum2 += phi_value; else sum1 += phi_value; } } /* Step 5: For 1+M/primes[c+1] <= x <= M, x square-free and * has no factor <= primes[c+1], sum phi(n / (x*primes[c+1]), c). */ if (c < piM) { UV pc_1 = primes[c+1]; for (j = (1+M/pc_1)/2; j < end; j++) { uint32 lpf = factor_table[j]; if (lpf > pc_1) { phi_value = tablephi(n / (pc_1 * (2*j+1)), c); /* x = 2j+1 */ if (lpf & 0x01) sum1 += phi_value; else sum2 += phi_value; } } } for (k = 0; k <= K3; k++) ss.totals[k] = 0; for (k = 0; k < KM; k++) ss.prime_index[k] = end; /* Instead of dividing by all primes up to pi(M), once a divisor is large * enough then phi(n / (p*primes[k+1]), k) = 1. */ { uint32 last_prime = piM; for (k = KM; k < K3; k++) { UV pk = primes[k+1]; while (last_prime > k+1 && pk * pk * primes[last_prime] > n) last_prime--; ss.prime_index[k] = last_prime; sum1 += piM - last_prime; } } for (sieve_start = 0; sieve_start < last_phi_sieve; sieve_start = sieve_end) { /* This phi segment goes from sieve_start to sieve_end. */ sieve_end = ((sieve_start + 2*SWORD_BITS*PHI_SIEVE_WORDS) < last_phi_sieve) ? sieve_start + 2*SWORD_BITS*PHI_SIEVE_WORDS : last_phi_sieve; /* Only divisors s.t. sieve_start <= N / divisor < sieve_end considered. */ least_divisor = n / sieve_end; /* Initialize the sieve segment and all associated variables. */ init_segment(&ss, sieve_start, sieve_end - sieve_start, c, K3, primes); /* Step 6: For c < k < KM: For 1+M/primes[k+1] <= x <= M, x square-free * and has no factor <= primes[k+1], sum phi(n / (x*primes[k+1]), k). */ for (k = c+1; k < KM; k++) { UV pk = primes[k+1]; uint32 start = (least_divisor >= pk * U32_CONST(0xFFFFFFFE)) ? U32_CONST(0xFFFFFFFF) : (least_divisor / pk + 1)/2; remove_primes(k, k, &ss, primes); for (j = ss.prime_index[k] - 1; j >= start; j--) { uint32 lpf = factor_table[j]; if (lpf > pk) { phi_value = sieve_phi(n / (pk * (2*j+1))); if (lpf & 0x01) sum1 += phi_value; else sum2 += phi_value; } } if (start < ss.prime_index[k]) ss.prime_index[k] = start; } /* Step 7: For KM <= K < Pi_M: For primes[k+2] <= x <= M, sum * phi(n / (x*primes[k+1]), k). The inner for loop can be parallelized. */ for (; k < step7_max; k++) { remove_primes(k, k, &ss, primes); j = ss.prime_index[k]; if (j >= k+2) { UV pk = primes[k+1]; UV endj = j; while (endj > 7 && endj-7 >= k+2 && pk*primes[endj-7] > least_divisor) endj -= 8; while ( endj >= k+2 && pk*primes[endj ] > least_divisor) endj--; /* Now that we know how far to go, do the summations */ for ( ; j > endj; j--) sum1 += sieve_phi(n / (pk*primes[j])); ss.prime_index[k] = endj; } } /* Restrict work for the above loop when we know it will be empty. */ while (step7_max > KM && ss.prime_index[step7_max-1] < (step7_max-1)+2) step7_max--; /* Step 8: For KM <= K < K3, sum -phi(n / primes[k+1], k) */ remove_primes(k, K3, &ss, primes); /* Step 9: For K3 <= k < K2, sum -phi(n / primes[k+1], k) + (k-K3). */ while (prime > least_divisor && prime_index >= piM) { sum1 += prime_index - K3; sum2 += sieve_phi(n / prime); prime_index--; prime = prev_sieve_prime(prime); } } Safefree(ss.sieve); Safefree(ss.word_count); Safefree(ss.word_count_sum); Safefree(ss.totals); Safefree(ss.prime_index); Safefree(ss.first_bit_index); Safefree(ss.multiplier); Safefree(factor_table); Safefree(primes); return sum1 - sum2; } Math-Prime-Util-0.37/XS.xs0000644000076400007640000010771212270624726013647 0ustar danadana #define PERL_NO_GET_CONTEXT 1 /* Define at top for more efficiency. */ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "multicall.h" /* only works in 5.6 and newer */ #define NEED_sv_2pv_flags #include "ppport.h" #include "ptypes.h" #include "cache.h" #include "sieve.h" #define FUNC_gcd_ui 1 #include "util.h" #include "primality.h" #include "factor.h" #include "lehmer.h" #include "lmo.h" #include "aks.h" #include "constants.h" #if BITS_PER_WORD == 64 #if defined(_MSC_VER) #include #define strtoull _strtoui64 #define strtoll _strtoi64 #endif #define PSTRTOULL(str, end, base) strtoull (str, end, base) #define PSTRTOLL(str, end, base) strtoll (str, end, base) #else #define PSTRTOULL(str, end, base) strtoul (str, end, base) #define PSTRTOLL(str, end, base) strtol (str, end, base) #endif #if PERL_REVISION <= 5 && PERL_VERSION <= 6 && BITS_PER_WORD == 64 /* Workaround perl 5.6 UVs and bigints */ #define my_svuv(sv) PSTRTOULL(SvPV_nolen(sv), NULL, 10) #define my_sviv(sv) PSTRTOLL(SvPV_nolen(sv), NULL, 10) #elif PERL_REVISION <= 5 && PERL_VERSION < 14 && BITS_PER_WORD == 64 /* Workaround RT 49569 in Math::BigInt::FastCalc (pre 5.14.0) */ #define my_svuv(sv) ( (!SvROK(sv)) ? SvUV(sv) : PSTRTOULL(SvPV_nolen(sv),NULL,10) ) #define my_sviv(sv) ( (!SvROK(sv)) ? SvIV(sv) : PSTRTOLL(SvPV_nolen(sv),NULL,10) ) #else #define my_svuv(sv) SvUV(sv) #define my_sviv(sv) SvIV(sv) #endif /* multicall compatibility stuff */ #if (PERL_REVISION <= 5 && PERL_VERSION < 7) || !defined(dMULTICALL) # define USE_MULTICALL 0 /* Too much trouble to work around it */ #else # define USE_MULTICALL 1 #endif #if PERL_VERSION < 13 || (PERL_VERSION == 13 && PERL_SUBVERSION < 9) # define FIX_MULTICALL_REFCOUNT \ if (CvDEPTH(multicall_cv) > 1) SvREFCNT_inc(multicall_cv); #else # define FIX_MULTICALL_REFCOUNT #endif #ifndef CvISXSUB # define CvISXSUB(cv) CvXSUB(cv) #endif /* Not right, but close */ #if !defined cxinc && ( (PERL_VERSION == 8 && PERL_SUBVERSION >= 2) || (PERL_VERSION == 10 && PERL_SUBVERSION <= 1) ) # define cxinc() Perl_cxinc(aTHX) #endif #if PERL_VERSION < 17 || (PERL_VERSION == 17 && PERL_SUBVERSION < 7) # define SvREFCNT_dec_NN(sv) SvREFCNT_dec(sv) #endif #if BITS_PER_WORD == 32 static const unsigned int uvmax_maxlen = 10; static const unsigned int ivmax_maxlen = 10; static const char uvmax_str[] = "4294967295"; static const char ivmax_str[] = "2147483648"; #else static const unsigned int uvmax_maxlen = 20; static const unsigned int ivmax_maxlen = 19; static const char uvmax_str[] = "18446744073709551615"; static const char ivmax_str[] = "9223372036854775808"; #endif #define MY_CXT_KEY "Math::Prime::Util::API_guts" typedef struct { SV* const_int[4]; /* -1, 0, 1, 2 */ HV* MPUroot; HV* MPUGMP; HV* MPUPP; } my_cxt_t; START_MY_CXT /* Is this a pedantically valid integer? * Croaks if undefined or invalid. * Returns 0 if it is an object or a string too large for a UV. * Returns 1 if it is good to process by XS. */ static int _validate_int(pTHX_ SV* n, int negok) { const char* maxstr; char* ptr; STRLEN i, len, maxlen; int ret, isbignum = 0, isneg = 0; /* TODO: magic, grok_number, etc. */ if ((SvFLAGS(n) & (SVf_IOK | #if PERL_REVISION >=5 && PERL_VERSION >= 9 && PERL_SUBVERSION >= 4 SVf_ROK | #else SVf_AMAGIC | #endif SVs_GMG )) == SVf_IOK) { /* If defined as number, use it */ if (SvIsUV(n) || SvIVX(n) >= 0) return 1; /* The normal case */ if (negok) return -1; else croak("Parameter '%" SVf "' must be a positive integer", n); } if (SvROK(n)) { if (sv_isa(n, "Math::BigInt") || sv_isa(n, "Math::BigFloat") || sv_isa(n, "Math::Pari") || sv_isa(n, "Math::GMP") || sv_isa(n, "Math::GMPz") ) isbignum = 1; else return 0; } /* Without being very careful, don't process magic variables here */ if (SvGAMAGIC(n) && !isbignum) return 0; if (!SvOK(n)) croak("Parameter must be defined"); ptr = SvPV_nomg(n, len); /* Includes stringifying bigints */ if (len == 0 || ptr == 0) croak("Parameter must be a positive integer"); if (ptr[0] == '-' && negok) { isneg = 1; ptr++; len--; /* Read negative sign */ } else if (ptr[0] == '+') { ptr++; len--; /* Allow a single plus sign */ } if (len == 0 || !isDIGIT(ptr[0])) croak("Parameter '%" SVf "' must be a positive integer", n); while (len > 0 && *ptr == '0') /* Strip all leading zeros */ { ptr++; len--; } if (len > uvmax_maxlen) /* Huge number, don't even look at it */ return 0; for (i = 0; i < len; i++) /* Ensure all characters are digits */ if (!isDIGIT(ptr[i])) croak("Parameter '%" SVf "' must be a positive integer", n); if (isneg == 1) /* Negative number (ignore overflow) */ return -1; ret = isneg ? -1 : 1; maxlen = isneg ? ivmax_maxlen : uvmax_maxlen; maxstr = isneg ? ivmax_str : uvmax_str; if (len < maxlen) /* Valid small integer */ return ret; for (i = 0; i < maxlen; i++) { /* Check if in range */ if (ptr[i] < maxstr[i]) return ret; if (ptr[i] > maxstr[i]) return 0; } return ret; /* value = UV_MAX/UV_MIN. That's ok */ } #define VCALL_ROOT 0x0 #define VCALL_PP 0x1 #define VCALL_GMP 0x2 /* Call a Perl sub to handle work for us. */ static int _vcallsubn(pTHX_ I32 flags, I32 stashflags, const char* name, int nargs) { GV* gv = NULL; dMY_CXT; Size_t namelen = strlen(name); /* If given a GMP function, and GMP enabled, and function exists, use it. */ int use_gmp = stashflags & VCALL_GMP && _XS_get_callgmp(); assert(!(stashflags & ~(VCALL_PP|VCALL_GMP))); if (use_gmp) { GV ** gvp = (GV**)hv_fetch(MY_CXT.MPUGMP,name,namelen,0); if (gvp) gv = *gvp; } if (!gv && (stashflags & VCALL_PP)) perl_require_pv("Math/Prime/Util/PP.pm"); if (!gv) { GV ** gvp = (GV**)hv_fetch(stashflags & VCALL_PP? MY_CXT.MPUPP : MY_CXT.MPUroot, name,namelen,0); if (gvp) gv = *gvp; } /* use PL_stack_sp in PUSHMARK macro directly it will be read after the possible mark stack extend */ PUSHMARK(PL_stack_sp-nargs); /* no PUTBACK bc we didn't move global SP */ return call_sv((SV*)gv, flags); } #define _vcallsub(func) (void)_vcallsubn(aTHX_ G_SCALAR, VCALL_ROOT, func, items) #define _vcallsub_with_gmp(func) (void)_vcallsubn(aTHX_ G_SCALAR, VCALL_GMP|VCALL_PP, func, items) #define _vcallsub_with_pp(func) (void)_vcallsubn(aTHX_ G_SCALAR, VCALL_PP, func, items) /* In my testing, this constant return works fine with threads, but to be * correct (see perlxs) one has to make a context, store separate copies in * each one, then retrieve them from a struct using a hash index. This * defeats the purpose if only done once. */ #define RETURN_NPARITY(ret) \ do { int r_ = ret; \ dMY_CXT; \ if (r_ >= -1 && r_ <= 2) { ST(0) = MY_CXT.const_int[r_+1]; XSRETURN(1); } \ else { XSRETURN_IV(r_); } \ } while (0) #define PUSH_NPARITY(ret) \ do { int r_ = ret; \ if (r_ >= -1 && r_ <= 2) { PUSHs( MY_CXT.const_int[r_+1] ); } \ else { PUSHs(sv_2mortal(newSViv(r_))); } \ } while (0) MODULE = Math::Prime::Util PACKAGE = Math::Prime::Util PROTOTYPES: ENABLE BOOT: { SV * sv = newSViv(BITS_PER_WORD); HV * stash = gv_stashpv("Math::Prime::Util", TRUE); newCONSTSUB(stash, "_XS_prime_maxbits", sv); { int i; MY_CXT_INIT; MY_CXT.MPUroot = stash; for (i = 0; i <= 3; i++) { MY_CXT.const_int[i] = newSViv(i-1); SvREADONLY_on(MY_CXT.const_int[i]); } MY_CXT.MPUGMP = gv_stashpv("Math::Prime::Util::GMP", TRUE); MY_CXT.MPUPP = gv_stashpv("Math::Prime::Util::PP", TRUE); } } #if defined(USE_ITHREADS) && defined(MY_CXT_KEY) void CLONE(...) PREINIT: int i; PPCODE: { MY_CXT_CLONE; /* possible declaration */ for (i = 0; i <= 3; i++) { MY_CXT.const_int[i] = newSViv(i-1); SvREADONLY_on(MY_CXT.const_int[i]); } MY_CXT.MPUroot = gv_stashpv("Math::Prime::Util", TRUE); MY_CXT.MPUGMP = gv_stashpv("Math::Prime::Util::GMP", TRUE); MY_CXT.MPUPP = gv_stashpv("Math::Prime::Util::PP", TRUE); } return; /* skip implicit PUTBACK, returning @_ to caller, more efficient*/ #endif void END(...) PREINIT: dMY_CXT; int i; PPCODE: for (i = 0; i <= 3; i++) { SV * const sv = MY_CXT.const_int[i]; MY_CXT.const_int[i] = NULL; SvREFCNT_dec_NN(sv); } /* stashes are owned by stash tree, no refcount on them in MY_CXT */ MY_CXT.MPUroot = NULL; MY_CXT.MPUGMP = NULL; MY_CXT.MPUPP = NULL; _prime_memfreeall(); return; /* skip implicit PUTBACK, returning @_ to caller, more efficient*/ void prime_memfree() ALIAS: _XS_get_verbose = 1 _XS_get_callgmp = 2 _get_prime_cache_size = 3 PREINIT: UV ret; PPCODE: switch (ix) { case 0: prime_memfree(); goto return_nothing; case 1: ret = _XS_get_verbose(); break; case 2: ret = _XS_get_callgmp(); break; case 3: default: ret = get_prime_cache(0,0); break; } XSRETURN_UV(ret); return_nothing: void prime_precalc(IN UV n) ALIAS: _XS_set_verbose = 1 _XS_set_callgmp = 2 PPCODE: PUTBACK; /* SP is never used again, the 3 next func calls are tailcall friendly since this XSUB has nothing to do after the 3 calls return */ switch (ix) { case 0: prime_precalc(n); break; case 1: _XS_set_verbose(n); break; default: _XS_set_callgmp(n); break; } return; /* skip implicit PUTBACK */ void prime_count(IN SV* svlo, ...) ALIAS: _XS_segment_pi = 1 PREINIT: int lostatus, histatus; UV lo, hi; PPCODE: lostatus = _validate_int(aTHX_ svlo, 0); histatus = (items == 1 || _validate_int(aTHX_ ST(1), 0)); if (lostatus == 1 && histatus == 1) { UV count = 0; if (items == 1) { lo = 2; hi = my_svuv(svlo); } else { lo = my_svuv(svlo); hi = my_svuv(ST(1)); } if (lo <= hi) { if (ix == 1 || (hi / (hi-lo+1)) > 100) { count = _XS_prime_count(lo, hi); } else { count = _XS_LMO_pi(hi); if (lo > 2) count -= _XS_LMO_pi(lo-1); } } XSRETURN_UV(count); } _vcallsubn(aTHX_ GIMME_V, VCALL_ROOT, "_generic_prime_count", items); return; /* skip implicit PUTBACK */ UV _XS_LMO_pi(IN UV n) ALIAS: _XS_legendre_pi = 1 _XS_meissel_pi = 2 _XS_lehmer_pi = 3 _XS_LMOS_pi = 4 PREINIT: UV ret; CODE: switch (ix) { case 0: ret = _XS_LMO_pi(n); break; case 1: ret = _XS_legendre_pi(n); break; case 2: ret = _XS_meissel_pi(n); break; case 3: ret = _XS_lehmer_pi(n); break; default:ret = _XS_LMOS_pi(n); break; } RETVAL = ret; OUTPUT: RETVAL void sieve_primes(IN UV low, IN UV high) ALIAS: trial_primes = 1 erat_primes = 2 segment_primes = 3 PREINIT: AV* av; PPCODE: av = newAV(); { SV * retsv = sv_2mortal(newRV_noinc( (SV*) av )); PUSHs(retsv); PUTBACK; SP = NULL; /* never use SP again, poison */ } if ((low <= 2) && (high >= 2)) { av_push(av, newSVuv( 2 )); } if ((low <= 3) && (high >= 3)) { av_push(av, newSVuv( 3 )); } if ((low <= 5) && (high >= 5)) { av_push(av, newSVuv( 5 )); } if (low < 7) low = 7; if (low <= high) { if (ix == 0) { /* Sieve with primary cache */ START_DO_FOR_EACH_PRIME(low, high) { av_push(av,newSVuv(p)); } END_DO_FOR_EACH_PRIME } else if (ix == 1) { /* Trial */ for (low = next_prime(low-1); low <= high && low != 0; low = next_prime(low) ) { av_push(av,newSVuv(low)); } } else if (ix == 2) { /* Erat with private memory */ unsigned char* sieve = sieve_erat30(high); START_DO_FOR_EACH_SIEVE_PRIME( sieve, low, high ) { av_push(av,newSVuv(p)); } END_DO_FOR_EACH_SIEVE_PRIME Safefree(sieve); } else if (ix == 3) { /* Segment */ unsigned char* segment; UV seg_base, seg_low, seg_high; void* ctx = start_segment_primes(low, high, &segment); while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_low - seg_base, seg_high - seg_base ) av_push(av,newSVuv( seg_base + p )); END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } } return; /* skip implicit PUTBACK */ void trial_factor(IN UV n, ...) ALIAS: fermat_factor = 1 holf_factor = 2 squfof_factor = 3 prho_factor = 4 pplus1_factor = 5 pbrent_factor = 6 pminus1_factor = 7 PREINIT: UV arg1, arg2; static const UV default_arg1[] = {0, 64000000, 8000000, 4000000, 4000000, 200, 4000000, 1000000}; /* Trial, Fermat, Holf, SQUFOF, PRHO, P+1, Brent, P-1 */ PPCODE: if (n == 0) XSRETURN_UV(0); /* Must read arguments before pushing anything */ arg1 = (items >= 2) ? my_svuv(ST(1)) : default_arg1[ix]; arg2 = (items >= 3) ? my_svuv(ST(2)) : 0; /* Small factors */ while ( (n% 2) == 0 ) { n /= 2; XPUSHs(sv_2mortal(newSVuv( 2 ))); } while ( (n% 3) == 0 ) { n /= 3; XPUSHs(sv_2mortal(newSVuv( 3 ))); } while ( (n% 5) == 0 ) { n /= 5; XPUSHs(sv_2mortal(newSVuv( 5 ))); } if (n == 1) { /* done */ } else if (_XS_is_prime(n)) { XPUSHs(sv_2mortal(newSVuv( n ))); } else { UV factors[MPU_MAX_FACTORS+1]; int i, nfactors = 0; switch (ix) { case 0: nfactors = trial_factor (n, factors, arg1); break; case 1: nfactors = fermat_factor (n, factors, arg1); break; case 2: nfactors = holf_factor (n, factors, arg1); break; case 3: nfactors = squfof_factor (n, factors, arg1); break; case 4: nfactors = prho_factor (n, factors, arg1); break; case 5: nfactors = pplus1_factor (n, factors, arg1); break; case 6: if (items < 3) arg2 = 1; nfactors = pbrent_factor (n, factors, arg1, arg2); break; case 7: default: if (items < 3) arg2 = 10*arg1; nfactors = pminus1_factor(n, factors, arg1, arg2); break; } EXTEND(SP, nfactors); for (i = 0; i < nfactors; i++) PUSHs(sv_2mortal(newSVuv( factors[i] ))); } void is_strong_pseudoprime(IN SV* svn, ...) PREINIT: int c, status = 1; PPCODE: if (items < 2) croak("No bases given to miller_rabin"); /* Check all arguments */ for (c = 0; c < items && status == 1; c++) if (_validate_int(aTHX_ ST(c), 0) != 1) status = 0; if (status == 1) { UV n = my_svuv(svn); int b, ret = 1; if (n < 4) { ret = (n >= 2); } /* 0,1 composite; 2,3 prime */ else if ((n % 2) == 0) { ret = 0; } /* evens composite */ else { UV bases[32]; for (c = 1; c < items && ret == 1; ) { for (b = 0; b < 32 && c < items; c++) bases[b++] = my_svuv(ST(c)); ret = _XS_miller_rabin(n, bases, b); } } RETURN_NPARITY(ret); } _vcallsub_with_gmp("is_strong_pseudoprime"); return; /* skip implicit PUTBACK */ void gcd(...) PROTOTYPE: @ ALIAS: lcm = 1 PREINIT: int i, status = 1; UV ret, nullv, n; PPCODE: /* For each arg, while valid input, validate+gcd/lcm. Shortcut stop. */ if (ix == 0) { ret = 0; nullv = 1; } else { ret = (items == 0) ? 0 : 1; nullv = 0; } for (i = 0; i < items && ret != nullv && status != 0; i++) { status = _validate_int(aTHX_ ST(i), 2); if (status == 0) break; n = status * my_svuv(ST(i)); /* n = abs(arg) */ if (i == 0) { ret = n; } else { UV gcd = gcd_ui(ret, n); if (ix == 0) { ret = gcd; } else { n /= gcd; if (n <= (UV_MAX / ret) ) ret *= n; else status = 0; /* Overflow */ } } } if (status != 0) XSRETURN_UV(ret); switch (ix) { case 0: _vcallsub_with_gmp("gcd"); break; case 1: default:_vcallsub_with_gmp("lcm"); break; } return; /* skip implicit PUTBACK */ void _XS_lucas_sequence(IN UV n, IN IV P, IN IV Q, IN UV k) PREINIT: UV U, V, Qk; PPCODE: lucas_seq(&U, &V, &Qk, n, P, Q, k); PUSHs(sv_2mortal(newSVuv( U ))); /* 4 args in, 3 out, no EXTEND needed */ PUSHs(sv_2mortal(newSVuv( V ))); PUSHs(sv_2mortal(newSVuv( Qk ))); void is_prime(IN SV* svn, ...) ALIAS: is_prob_prime = 1 is_bpsw_prime = 2 is_lucas_pseudoprime = 3 is_strong_lucas_pseudoprime = 4 is_extra_strong_lucas_pseudoprime = 5 is_frobenius_underwood_pseudoprime = 6 is_aks_prime = 7 is_pseudoprime = 8 is_almost_extra_strong_lucas_pseudoprime = 9 PREINIT: int status; PPCODE: status = _validate_int(aTHX_ svn, 1); if (status != 0) { int ret = 0; if (status == 1) { UV n = my_svuv(svn); UV a = (items == 1) ? 0 : my_svuv(ST(1)); switch (ix) { case 0: case 1: ret = _XS_is_prime(n); break; case 2: ret = _XS_BPSW(n); break; case 3: ret = _XS_is_lucas_pseudoprime(n, 0); break; case 4: ret = _XS_is_lucas_pseudoprime(n, 1); break; case 5: ret = _XS_is_lucas_pseudoprime(n, 2); break; case 6: ret = _XS_is_frobenius_underwood_pseudoprime(n); break; case 7: ret = _XS_is_aks_prime(n); break; case 8: ret = _XS_is_pseudoprime(n, (items == 1) ? 2 : a); break; case 9: default: ret = _XS_is_almost_extra_strong_lucas_pseudoprime (n, (items == 1) ? 1 : a); break; } } RETURN_NPARITY(ret); } switch (ix) { case 0: _vcallsub_with_gmp("is_prime"); break; case 1: _vcallsub_with_gmp("is_prob_prime"); break; case 2: _vcallsub_with_gmp("is_bpsw_prime"); break; case 3: _vcallsub_with_gmp("is_lucas_pseudoprime"); break; case 4: _vcallsub_with_gmp("is_strong_lucas_pseudoprime"); break; case 5: _vcallsub_with_gmp("is_extra_strong_lucas_pseudoprime"); break; case 6: _vcallsub_with_gmp("is_frobenius_underwood_pseudoprime"); break; case 7: _vcallsub_with_gmp("is_aks_prime"); break; case 8: _vcallsub_with_gmp("is_pseudoprime"); break; case 9: default:_vcallsub_with_gmp("is_almost_extra_strong_lucas_pseudoprime"); break; } return; /* skip implicit PUTBACK */ void next_prime(IN SV* svn) ALIAS: prev_prime = 1 nth_prime = 2 nth_prime_upper = 3 nth_prime_lower = 4 nth_prime_approx = 5 prime_count_upper = 6 prime_count_lower = 7 prime_count_approx = 8 PPCODE: if (_validate_int(aTHX_ svn, 0)) { UV n = my_svuv(svn); if ( (n >= MPU_MAX_PRIME && ix == 0) || (n >= MPU_MAX_PRIME_IDX && (ix==2 || ix==3 || ix==4 || ix==5)) ) { /* Out of range. Fall through to Perl. */ } else { UV ret; switch (ix) { case 0: ret = next_prime(n); break; case 1: ret = (n < 3) ? 0 : prev_prime(n); break; case 2: ret = nth_prime(n); break; case 3: ret = nth_prime_upper(n); break; case 4: ret = nth_prime_lower(n); break; case 5: ret = nth_prime_approx(n); break; case 6: ret = prime_count_upper(n); break; case 7: ret = prime_count_lower(n); break; case 8: default:ret = prime_count_approx(n); break; } XSRETURN_UV(ret); } } switch (ix) { case 0: _vcallsub("_generic_next_prime"); break; case 1: _vcallsub("_generic_prev_prime"); break; case 2: _vcallsub_with_pp("nth_prime"); break; case 3: _vcallsub_with_pp("nth_prime_upper"); break; case 4: _vcallsub_with_pp("nth_prime_lower"); break; case 5: _vcallsub_with_pp("nth_prime_approx"); break; case 6: _vcallsub_with_pp("prime_count_upper"); break; case 7: _vcallsub_with_pp("prime_count_lower"); break; case 8: default: _vcallsub_with_pp("prime_count_approx"); break; } return; /* skip implicit PUTBACK */ void factor(IN SV* svn) ALIAS: factor_exp = 1 divisors = 2 PREINIT: U32 gimme_v; int status, i, nfactors; PPCODE: gimme_v = GIMME_V; status = _validate_int(aTHX_ svn, 0); if (status == 1) { UV factors[MPU_MAX_FACTORS+1]; UV exponents[MPU_MAX_FACTORS+1]; UV n = my_svuv(svn); if (gimme_v == G_SCALAR) { switch (ix) { case 0: nfactors = factor(n, factors); break; case 1: nfactors = factor_exp(n, factors, 0); break; default: nfactors = divisor_sum(n, 0); break; } PUSHs(sv_2mortal(newSVuv( nfactors ))); } else if (gimme_v == G_ARRAY) { switch (ix) { case 0: nfactors = factor(n, factors); EXTEND(SP, nfactors); for (i = 0; i < nfactors; i++) PUSHs(sv_2mortal(newSVuv( factors[i] ))); break; case 1: nfactors = factor_exp(n, factors, exponents); /* if (n == 1) XSRETURN_EMPTY; */ EXTEND(SP, nfactors); for (i = 0; i < nfactors; i++) { AV* av = newAV(); av_push(av, newSVuv(factors[i])); av_push(av, newSVuv(exponents[i])); PUSHs( sv_2mortal(newRV_noinc( (SV*) av )) ); } break; default: { UV ndivisors; UV* divs = _divisor_list(n, &ndivisors); EXTEND(SP, ndivisors); for (i = 0; (UV)i < ndivisors; i++) PUSHs(sv_2mortal(newSVuv( divs[i] ))); Safefree(divs); } break; } } } else { switch (ix) { case 0: _vcallsubn(aTHX_ gimme_v, VCALL_ROOT, "_generic_factor", 1); break; case 1: _vcallsubn(aTHX_ gimme_v, VCALL_ROOT, "_generic_factor_exp", 1); break; default: _vcallsubn(aTHX_ gimme_v, VCALL_GMP|VCALL_PP, "divisors", 1); break; } return; /* skip implicit PUTBACK */ } void divisor_sum(IN SV* svn, ...) PREINIT: SV* svk; int nstatus, kstatus; PPCODE: svk = (items > 1) ? ST(1) : 0; nstatus = _validate_int(aTHX_ svn, 0); kstatus = (items == 1 || (SvIOK(svk) && SvIV(svk))) ? 1 : 0; if (nstatus == 1 && kstatus == 1) { UV n = my_svuv(svn); UV k = (items > 1) ? my_svuv(svk) : 1; UV sigma = divisor_sum(n, k); if (sigma != 0) XSRETURN_UV(sigma); /* sigma 0 means overflow */ } _vcallsub_with_gmp("divisor_sum"); return; /* skip implicit PUTBACK */ void znorder(IN SV* sva, IN SV* svn) ALIAS: jordan_totient = 1 legendre_phi = 2 PREINIT: int astatus, nstatus; PPCODE: astatus = _validate_int(aTHX_ sva, 0); nstatus = _validate_int(aTHX_ svn, 0); if (astatus == 1 && nstatus == 1) { UV a = my_svuv(sva); UV n = my_svuv(svn); UV ret; switch (ix) { case 0: ret = znorder(a, n); if (ret == 0) XSRETURN_UNDEF; /* not defined */ break; case 1: ret = jordan_totient(a, n); if (ret == 0 && n > 1) goto overflow; break; case 2: default: ret = legendre_phi(a, n); break; } XSRETURN_UV(ret); } overflow: switch (ix) { case 0: _vcallsub_with_gmp("znorder"); break; case 1: _vcallsub_with_pp("jordan_totient"); break; case 2: default: _vcallsub_with_pp("legendre_phi"); break; } return; /* skip implicit PUTBACK */ void znlog(IN SV* sva, IN SV* svg, IN SV* svp) PREINIT: int astatus, gstatus, pstatus; PPCODE: astatus = _validate_int(aTHX_ sva, 0); gstatus = _validate_int(aTHX_ svg, 0); pstatus = _validate_int(aTHX_ svp, 0); if (astatus == 1 && gstatus == 1 && pstatus == 1) { UV a = my_svuv(sva), g = my_svuv(svg), p = my_svuv(svp); UV ret = znlog(a, g, p); if (ret == 0 && a > 1) XSRETURN_UNDEF; XSRETURN_UV(ret); } _vcallsub_with_gmp("znlog"); return; /* skip implicit PUTBACK */ void kronecker(IN SV* sva, IN SV* svb) PREINIT: int astatus, bstatus, abpositive, abnegative; PPCODE: astatus = _validate_int(aTHX_ sva, 2); bstatus = _validate_int(aTHX_ svb, 2); /* Are both a and b positive? */ abpositive = astatus == 1 && bstatus == 1; /* Will both fit in IVs? We should use a bitmask return. */ abnegative = !abpositive && (astatus != 0 && SvIOK(sva) && !SvIsUV(sva)) && (bstatus != 0 && SvIOK(svb) && !SvIsUV(svb)); if (abpositive || abnegative) { UV a = my_svuv(sva); UV b = my_svuv(svb); int k = (abpositive) ? kronecker_uu(a,b) : kronecker_ss(a,b); RETURN_NPARITY(k); } _vcallsub_with_gmp("kronecker"); return; /* skip implicit PUTBACK */ NV _XS_ExponentialIntegral(IN SV* x) ALIAS: _XS_LogarithmicIntegral = 1 _XS_RiemannZeta = 2 _XS_RiemannR = 3 PREINIT: NV nv, ret; CODE: nv = SvNV(x); switch (ix) { case 0: ret = (NV) _XS_ExponentialIntegral(nv); break; case 1: ret = (NV) _XS_LogarithmicIntegral(nv); break; case 2: ret = (NV) ld_riemann_zeta(nv); break; case 3: default:ret = (NV) _XS_RiemannR(nv); break; } RETVAL = ret; OUTPUT: RETVAL void euler_phi(IN SV* svlo, ...) ALIAS: moebius = 1 PREINIT: int lostatus, histatus; PPCODE: lostatus = _validate_int(aTHX_ svlo, 2); histatus = (items == 1 || _validate_int(aTHX_ ST(1), 0)); if (items == 1 && lostatus != 0) { /* input is a single value and in UV/IV range */ if (ix == 0) { UV n = (lostatus == -1) ? 0 : my_svuv(svlo); XSRETURN_UV(totient(n)); } else { UV n = (lostatus == -1) ? (UV)(-(my_sviv(svlo))) : my_svuv(svlo); RETURN_NPARITY(moebius(n)); } } else if (items == 2 && lostatus == 1 && histatus == 1) { /* input is a range and both lo and hi are non-negative */ UV lo = my_svuv(svlo); UV hi = my_svuv(ST(1)); if (lo <= hi) { UV i; EXTEND(SP, hi-lo+1); if (ix == 0) { UV* totients = _totient_range(lo, hi); for (i = lo; i <= hi; i++) PUSHs(sv_2mortal(newSVuv(totients[i-lo]))); Safefree(totients); } else { signed char* mu = _moebius_range(lo, hi); dMY_CXT; for (i = lo; i <= hi; i++) PUSH_NPARITY(mu[i-lo]); Safefree(mu); } } } else { /* Whatever we didn't handle above */ U32 gimme_v = GIMME_V; switch (ix) { case 0: _vcallsubn(aTHX_ gimme_v, VCALL_PP, "euler_phi", items);break; case 1: default: _vcallsubn(aTHX_ gimme_v, VCALL_PP, "moebius", items); break; } return; } void carmichael_lambda(IN SV* svn) ALIAS: mertens = 1 liouville = 2 chebyshev_theta = 3 chebyshev_psi = 4 exp_mangoldt = 5 znprimroot = 6 PREINIT: int status; PPCODE: status = _validate_int(aTHX_ svn, (ix >= 5) ? 1 : 0); switch (ix) { case 0: if (status == 1) XSRETURN_UV(carmichael_lambda(my_svuv(svn))); _vcallsub_with_gmp("carmichael_lambda"); break; case 1: if (status == 1) XSRETURN_IV(mertens(my_svuv(svn))); _vcallsub_with_pp("mertens"); break; case 2: if (status == 1) { UV factors[MPU_MAX_FACTORS+1]; int nfactors = factor(my_svuv(svn), factors); RETURN_NPARITY( (nfactors & 1) ? -1 : 1 ); } _vcallsub_with_gmp("liouville"); break; case 3: if (status == 1) XSRETURN_NV(chebyshev_function(my_svuv(svn),0)); _vcallsub_with_pp("chebyshev_theta"); break; case 4: if (status == 1) XSRETURN_NV(chebyshev_function(my_svuv(svn),1)); _vcallsub_with_pp("chebyshev_psi"); break; case 5: if (status != 0) XSRETURN_UV( (status == -1) ? 1 : exp_mangoldt(my_svuv(svn)) ); _vcallsub_with_gmp("exp_mangoldt"); break; case 6: default:if (status != 0) { UV r, n = my_svuv(svn); if (status == -1) n = -(IV)n; r = znprimroot(n); if (r == 0 && n != 1) XSRETURN_UNDEF; /* No root, return undef */ else XSRETURN_UV(r); } _vcallsub_with_gmp("znprimroot"); break; } return; /* skip implicit PUTBACK */ bool _validate_num(SV* svn, ...) PREINIT: SV* sv1; SV* sv2; CODE: /* Internal function. Emulate the PP version of this: * $is_valid = _validate_num( $n [, $min [, $max] ] ) * Return 0 if we're befuddled by the input. * Otherwise croak if n isn't >= 0 and integer, n < min, or n > max. * Small bigints will be converted to scalars. */ RETVAL = FALSE; if (_validate_int(aTHX_ svn, 0)) { if (SvROK(svn)) { /* Convert small Math::BigInt object into scalar */ UV n = my_svuv(svn); #if PERL_REVISION <= 5 && PERL_VERSION < 8 && BITS_PER_WORD == 64 sv_setpviv(svn, n); #else sv_setuv(svn, n); #endif } if (items > 1 && ((sv1 = ST(1)), SvOK(sv1))) { UV n = my_svuv(svn); UV min = my_svuv(sv1); if (n < min) croak("Parameter '%"UVuf"' must be >= %"UVuf, n, min); if (items > 2 && ((sv2 = ST(2)), SvOK(sv2))) { UV max = my_svuv(sv2); if (n > max) croak("Parameter '%"UVuf"' must be <= %"UVuf, n, max); MPUassert( items <= 3, "_validate_num takes at most 3 parameters"); } } RETVAL = TRUE; } OUTPUT: RETVAL void forprimes (SV* block, IN SV* svbeg, IN SV* svend = 0) PROTOTYPE: &$;$ PREINIT: GV *gv; HV *stash; SV* svarg; CV *cv; unsigned char* segment; UV beg, end, seg_base, seg_low, seg_high; PPCODE: cv = sv_2cv(block, &stash, &gv, 0); if (cv == Nullcv) croak("Not a subroutine reference"); if (!_validate_int(aTHX_ svbeg, 0) || (items >= 3 && !_validate_int(aTHX_ svend,0))) { _vcallsubn(aTHX_ G_VOID|G_DISCARD, VCALL_ROOT, "_generic_forprimes", items); return; } if (items < 3) { beg = 2; end = my_svuv(svbeg); } else { beg = my_svuv(svbeg); end = my_svuv(svend); } SAVESPTR(GvSV(PL_defgv)); svarg = newSVuv(0); GvSV(PL_defgv) = svarg; /* Handle early part */ while (beg < 6) { beg = (beg <= 2) ? 2 : (beg <= 3) ? 3 : 5; if (beg <= end) { sv_setuv(svarg, beg); PUSHMARK(SP); call_sv((SV*)cv, G_VOID|G_DISCARD); } beg += 1 + (beg > 2); } #if USE_MULTICALL if (!CvISXSUB(cv) && beg <= end) { dMULTICALL; I32 gimme = G_VOID; PUSH_MULTICALL(cv); if ( #if BITS_PER_WORD == 64 (beg >= UVCONST( 100000000000000) && end-beg < 100000) || (beg >= UVCONST( 10000000000000) && end-beg < 40000) || (beg >= UVCONST( 1000000000000) && end-beg < 17000) || #endif ((end-beg) < 500) ) { /* MULTICALL next prime */ for (beg = next_prime(beg-1); beg <= end && beg != 0; beg = next_prime(beg)) { sv_setuv(svarg, beg); MULTICALL; } } else { /* MULTICALL segment sieve */ void* ctx = start_segment_primes(beg, end, &segment); while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_low - seg_base, seg_high - seg_base ) { sv_setuv(svarg, seg_base + p); MULTICALL; } END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } FIX_MULTICALL_REFCOUNT; POP_MULTICALL; } else #endif if (beg <= end) { /* NO-MULTICALL segment sieve */ void* ctx = start_segment_primes(beg, end, &segment); while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_low - seg_base, seg_high - seg_base ) { sv_setuv(svarg, seg_base + p); PUSHMARK(SP); call_sv((SV*)cv, G_VOID|G_DISCARD); } END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } SvREFCNT_dec(svarg); void forcomposites (SV* block, IN SV* svbeg, IN SV* svend = 0) PROTOTYPE: &$;$ PREINIT: UV beg, end; GV *gv; HV *stash; SV* svarg; /* We use svarg to prevent clobbering $_ outside the block */ CV *cv; PPCODE: cv = sv_2cv(block, &stash, &gv, 0); if (cv == Nullcv) croak("Not a subroutine reference"); if (!_validate_int(aTHX_ svbeg, 0) || (items >= 3 && !_validate_int(aTHX_ svend,0))) { _vcallsubn(aTHX_ G_VOID|G_DISCARD, VCALL_ROOT, "_generic_forcomposites", items); return; } if (items < 3) { beg = 4; end = my_svuv(svbeg); } else { beg = my_svuv(svbeg); end = my_svuv(svend); } SAVESPTR(GvSV(PL_defgv)); svarg = newSVuv(0); GvSV(PL_defgv) = svarg; #if USE_MULTICALL if (!CvISXSUB(cv) && (end-beg) > 200) { unsigned char* segment; UV seg_base, seg_low, seg_high, c, cbeg, cend, prevprime, nextprime; void* ctx; dMULTICALL; I32 gimme = G_VOID; PUSH_MULTICALL(cv); if (beg <= 4) { /* sieve starts at 7, so handle this here */ sv_setuv(svarg, 4); MULTICALL; beg = 6; } /* Find the two primes that bound their interval. */ /* If beg or end are >= max_prime, then this will die. */ prevprime = prev_prime(beg); nextprime = next_prime(end); ctx = start_segment_primes(beg, nextprime, &segment); while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_low - seg_base, seg_high - seg_base ) { cbeg = prevprime+1; if (cbeg < beg) cbeg = beg; prevprime = seg_base + p; cend = prevprime-1; if (cend > end) cend = end; for (c = cbeg; c <= cend; c++) { sv_setuv(svarg, c); MULTICALL; } } END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); MPUassert( nextprime >= end, "composite sieve skipped end numbers" ); FIX_MULTICALL_REFCOUNT; POP_MULTICALL; } else #endif if (beg <= end) { beg = (beg <= 4) ? 3 : beg-1; while (beg++ < end) { if (!is_prob_prime(beg)) { sv_setuv(svarg, beg); PUSHMARK(SP); call_sv((SV*)cv, G_VOID|G_DISCARD); } } } SvREFCNT_dec(svarg); void fordivisors (SV* block, IN SV* svn) PROTOTYPE: &$ PREINIT: UV i, n, ndivisors; UV *divs; GV *gv; HV *stash; SV* svarg; /* We use svarg to prevent clobbering $_ outside the block */ CV *cv; PPCODE: cv = sv_2cv(block, &stash, &gv, 0); if (cv == Nullcv) croak("Not a subroutine reference"); if (!_validate_int(aTHX_ svn, 0)) { _vcallsubn(aTHX_ G_VOID|G_DISCARD, VCALL_ROOT, "_generic_fordivisors", 2); return; } n = my_svuv(svn); divs = _divisor_list(n, &ndivisors); SAVESPTR(GvSV(PL_defgv)); svarg = newSVuv(0); GvSV(PL_defgv) = svarg; #if USE_MULTICALL if (!CvISXSUB(cv)) { dMULTICALL; I32 gimme = G_VOID; PUSH_MULTICALL(cv); for (i = 0; i < ndivisors; i++) { sv_setuv(svarg, divs[i]); MULTICALL; } FIX_MULTICALL_REFCOUNT; POP_MULTICALL; } else #endif { for (i = 0; i < ndivisors; i++) { sv_setuv(svarg, divs[i]); PUSHMARK(SP); call_sv((SV*)cv, G_VOID|G_DISCARD); } } SvREFCNT_dec(svarg); Safefree(divs); Math-Prime-Util-0.37/lib/0000755000076400007640000000000012271163661013474 5ustar danadanaMath-Prime-Util-0.37/lib/Math/0000755000076400007640000000000012271163661014365 5ustar danadanaMath-Prime-Util-0.37/lib/Math/Prime/0000755000076400007640000000000012271163661015441 5ustar danadanaMath-Prime-Util-0.37/lib/Math/Prime/Util/0000755000076400007640000000000012271163661016356 5ustar danadanaMath-Prime-Util-0.37/lib/Math/Prime/Util/MemFree.pm0000644000076400007640000000411312270242116020223 0ustar danadanapackage Math::Prime::Util::MemFree; use strict; use warnings; BEGIN { $Math::Prime::Util::MemFree::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::MemFree::VERSION = '0.37'; } use base qw( Exporter ); our @EXPORT_OK = qw( ); our %EXPORT_TAGS = (all => [ @EXPORT_OK ]); use Math::Prime::Util; use Carp qw/carp croak confess/; my $memfree_instances = 0; sub new { my $self = bless {}, shift; $memfree_instances++; return $self; } sub DESTROY { my $self = shift; confess "instances count mismatch" unless $memfree_instances > 0; Math::Prime::Util::prime_memfree if --$memfree_instances == 0; return; } 1; __END__ # ABSTRACT: An auto-free object for Math::Prime::Util =pod =head1 NAME Math::Prime::Util::MemFree - An auto-free object for Math::Prime::Util =head1 VERSION Version 0.37 =head1 SYNOPSIS use Math::Prime::Util; { my $mf = Math::Prime::Util::MemFree->new; ... do things with Math::Prime::Util ... } # When the last object leaves scope, prime_memfree is called. =head1 DESCRIPTION This is a more robust way of making sure any cached memory is freed, as it will be handled by the last C object leaving scope. This means if your routines were inside an eval that died, things will still get cleaned up. If you call another function that uses a MemFree object, the cache will stay in place because you still have an object. =head1 FUNCTIONS =head2 new Creates a new auto-free object. This object has no methods and has no data. When it leaves scope it will call C, thereby releasing any extra memory that the L module may have allocated. Memory is not freed until the last object goes out of scope. C may always be called manually. All memory is freed at C time, so this is mainly for long running programs that want extra control over memory use. =head1 AUTHORS Dana Jacobsen Edana@acm.orgE =head1 COPYRIGHT Copyright 2012 by Dana Jacobsen Edana@acm.orgE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Math-Prime-Util-0.37/lib/Math/Prime/Util/PP.pm0000644000076400007640000032622312270624726017246 0ustar danadanapackage Math::Prime::Util::PP; use strict; use warnings; use Carp qw/carp croak confess/; BEGIN { $Math::Prime::Util::PP::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::PP::VERSION = '0.37'; } BEGIN { do { require Math::BigInt; Math::BigInt->import(try=>"GMP,Pari"); } unless defined $Math::BigInt::VERSION; } # The Pure Perl versions of all the Math::Prime::Util routines. # # Some of these will be relatively similar in performance, some will be # very slow in comparison. # # Most of these are pretty simple. Also, you really should look at the C # code for more detailed comments, including references to papers. BEGIN { use constant OLD_PERL_VERSION=> $] < 5.008; use constant MPU_MAXBITS => (~0 == 4294967295) ? 32 : 64; use constant MPU_64BIT => MPU_MAXBITS == 64; use constant MPU_32BIT => MPU_MAXBITS == 32; #use constant MPU_MAXPARAM => MPU_32BIT ? 4294967295 : 18446744073709551615; #use constant MPU_MAXDIGITS => MPU_32BIT ? 10 : 20; use constant MPU_MAXPRIME => MPU_32BIT ? 4294967291 : 18446744073709551557; use constant MPU_MAXPRIMEIDX => MPU_32BIT ? 203280221 : 425656284035217743; use constant MPU_HALFWORD => MPU_32BIT ? 65536 : OLD_PERL_VERSION ? 33554432 : 4294967296; use constant UVPACKLET => MPU_32BIT ? 'L' : 'Q'; use constant MPU_INFINITY => (65535 > 0+'inf') ? 20**20**20 : 0+'inf'; use constant CONST_EULER => '0.577215664901532860606512090082402431042159335939923598805767'; use constant CONST_LI2 => '1.04516378011749278484458888919461313652261557815120157583290914407501320521'; use constant BZERO => Math::BigInt->bzero; use constant BONE => Math::BigInt->bone; use constant BTWO => Math::BigInt->new(2); use constant B_PRIM759 => Math::BigInt->new("64092011671807087969"); use constant B_PRIM235 => Math::BigInt->new("30"); use constant PI_TIMES_8 => 25.13274122871834590770114707; } { my $_have_MPFR = -1; sub _MPFR_available { if ($_have_MPFR < 0) { $_have_MPFR = 0; $_have_MPFR = 1 if (!defined $ENV{MPU_NO_MPFR} || $ENV{MPU_NO_MPFR} != 1) && eval { require Math::MPFR; $Math::MPFR::VERSION>=2.03; }; } return $_have_MPFR; } } my $_precalc_size = 0; sub prime_precalc { my($n) = @_; croak "Input must be a positive integer" unless _is_positive_int($n); $_precalc_size = $n if $n > $_precalc_size; } sub prime_memfree { $_precalc_size = 0; } sub _get_prime_cache_size { $_precalc_size } sub _prime_memfreeall { prime_memfree; } sub _is_positive_int { ((defined $_[0]) && $_[0] ne '' && ($_[0] !~ tr/0123456789//c)); } sub _bigint_to_int { return (OLD_PERL_VERSION) ? unpack(UVPACKLET,pack(UVPACKLET,"$_[0]")) : int("$_[0]"); } sub _upgrade_to_float { do { require Math::BigFloat; Math::BigFloat->import(); } if !defined $Math::BigFloat::VERSION; return Math::BigFloat->new($_[0]); } # Get the accuracy of variable x, or the max default from BigInt/BigFloat # One might think to use ref($x)->accuracy() but numbers get upgraded and # downgraded willy-nilly, and it will do the wrong thing from the user's # perspective. sub _find_big_acc { my($x) = @_; $b = $x->accuracy(); return $b if defined $b; my ($i,$f) = (Math::BigInt->accuracy(), Math::BigFloat->accuracy()); return (($i > $f) ? $i : $f) if defined $i && defined $f; return $i if defined $i; return $f if defined $f; ($i,$f) = (Math::BigInt->div_scale(), Math::BigFloat->div_scale()); return (($i > $f) ? $i : $f) if defined $i && defined $f; return $i if defined $i; return $f if defined $f; return 18; } sub _validate_num { my($n, $min, $max) = @_; croak "Parameter must be defined" if !defined $n; return 0 if ref($n); croak "Parameter must be a positive integer" if $n eq ''; croak "Parameter '$n' must be a positive integer" if $n =~ tr/0123456789//c && $n !~ /^\+\d+$/; croak "Parameter '$n' must be >= $min" if defined $min && $n < $min; croak "Parameter '$n' must be <= $max" if defined $max && $n > $max; substr($_[0],0,1,'') if substr($n,0,1) eq '+'; return 0 unless $n < ~0 || int($n) eq ''.~0; 1; } sub _validate_positive_integer { my($n, $min, $max) = @_; croak "Parameter must be defined" if !defined $n; if (ref($n) eq 'CODE') { $_[0] = $_[0]->(); $n = $_[0]; } if (ref($n) eq 'Math::BigInt') { croak "Parameter '$n' must be a positive integer" if $n->sign() ne '+' || !$n->is_int(); $_[0] = _bigint_to_int($_[0]) if $n <= (OLD_PERL_VERSION ? 562949953421312 : ''.~0); } else { my $strn = "$n"; croak "Parameter '$strn' must be a positive integer" if $strn =~ tr/0123456789//c && $strn !~ /^\+?\d+$/; if ($n <= (OLD_PERL_VERSION ? 562949953421312 : ''.~0)) { $_[0] = $strn if ref($n); } else { $_[0] = Math::BigInt->new($strn) } } $_[0]->upgrade(undef) if ref($_[0]) && $_[0]->upgrade(); croak "Parameter '$_[0]' must be >= $min" if defined $min && $_[0] < $min; croak "Parameter '$_[0]' must be <= $max" if defined $max && $_[0] > $max; 1; } my @_primes_small = ( 0,2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97, 101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191, 193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283, 293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401, 409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,509); my @_prime_next_small = ( 2,2,3,5,5,7,7,11,11,11,11,13,13,17,17,17,17,19,19,23,23,23,23, 29,29,29,29,29,29,31,31,37,37,37,37,37,37,41,41,41,41,43,43,47, 47,47,47,53,53,53,53,53,53,59,59,59,59,59,59,61,61,67,67,67,67,67,67,71); # For wheel-30 my @_prime_indices = (1, 7, 11, 13, 17, 19, 23, 29); 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); 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); sub _tiny_prime_count { my($n) = @_; return if $n >= $_primes_small[-1]; my $j = $#_primes_small; my $i = 1 + ($n >> 4); while ($i < $j) { my $mid = ($i+$j)>>1; if ($_primes_small[$mid] <= $n) { $i = $mid+1; } else { $j = $mid; } } return $i-1; } sub _is_prime7 { # n must not be divisible by 2, 3, or 5 my($n) = @_; if (ref($n) eq 'Math::BigInt') { return 0 unless Math::BigInt::bgcd($n, B_PRIM759)->is_one; return 0 unless _miller_rabin_2($n); my $is_esl_prime = is_extra_strong_lucas_pseudoprime($n); return ($is_esl_prime) ? (($n <= "18446744073709551615") ? 2 : 1) : 0; } if ($n < 61*61) { foreach my $i (qw/7 11 13 17 19 23 29 31 37 41 43 47 53 59/) { return 2 if $i*$i > $n; return 0 if !($n % $i); } return 2; } return 0 if !($n % 7) || !($n % 11) || !($n % 13) || !($n % 17) || !($n % 19) || !($n % 23) || !($n % 29) || !($n % 31) || !($n % 37) || !($n % 41) || !($n % 43) || !($n % 47) || !($n % 53) || !($n % 59); if ($n <= 1_000_000) { $n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt'; my $limit = int(sqrt($n)); my $i = 61; while (($i+30) <= $limit) { return 0 if !($n % $i); $i += 6; return 0 if !($n % $i); $i += 4; return 0 if !($n % $i); $i += 2; return 0 if !($n % $i); $i += 4; return 0 if !($n % $i); $i += 2; return 0 if !($n % $i); $i += 4; return 0 if !($n % $i); $i += 6; return 0 if !($n % $i); $i += 2; } while (1) { last if $i > $limit; return 0 if !($n % $i); $i += 6; last if $i > $limit; return 0 if !($n % $i); $i += 4; last if $i > $limit; return 0 if !($n % $i); $i += 2; last if $i > $limit; return 0 if !($n % $i); $i += 4; last if $i > $limit; return 0 if !($n % $i); $i += 2; last if $i > $limit; return 0 if !($n % $i); $i += 4; last if $i > $limit; return 0 if !($n % $i); $i += 6; last if $i > $limit; return 0 if !($n % $i); $i += 2; } return 2; } if ($n < 47636622961201) { # BPSW seems to be faster after this # Deterministic set of Miller-Rabin tests. If the MR routines can handle # bases greater than n, then this can be simplified. my @bases; # n > 1_000_000 because of the previous block. if ($n < 19471033) { @bases = ( 2, 299417); } elsif ($n < 38010307) { @bases = ( 2, 9332593); } elsif ($n < 316349281) { @bases = ( 11000544, 31481107); } elsif ($n < 4759123141) { @bases = ( 2, 7, 61); } elsif ($n < 154639673381) { @bases = ( 15, 176006322, 4221622697); } elsif ($n < 47636622961201) { @bases = ( 2, 2570940, 211991001, 3749873356); } elsif ($n < 3770579582154547) { @bases = ( 2, 2570940, 880937, 610386380, 4130785767); } else { @bases = ( 2, 325, 9375, 28178, 450775, 9780504, 1795265022); } return is_strong_pseudoprime($n, @bases) ? 2 : 0; } # Inlined BPSW return 0 unless _miller_rabin_2($n); return is_almost_extra_strong_lucas_pseudoprime($n) ? 2 : 0; } sub is_prime { my($n) = @_; return 0 if int($n) < 0; _validate_positive_integer($n); if (ref($n) eq 'Math::BigInt') { return 0 unless Math::BigInt::bgcd($n, B_PRIM235)->is_one; } else { if ($n < 7) { return ($n == 2) || ($n == 3) || ($n == 5) ? 2 : 0; } return 0 if !($n % 2) || !($n % 3) || !($n % 5); } return _is_prime7($n); } # is_prob_prime is the same thing for us. *is_prob_prime = \&is_prime; # BPSW probable prime. No composites are known to have passed this test # since it was published in 1980, though we know infinitely many exist. # It has also been verified that no 64-bit composite will return true. # Slow since it's all in PP and uses bigints. sub is_bpsw_prime { my($n) = @_; _validate_positive_integer($n); return 0 unless _miller_rabin_2($n); if ($n <= 18446744073709551615) { return is_almost_extra_strong_lucas_pseudoprime($n) ? 2 : 0; } return is_extra_strong_lucas_pseudoprime($n) ? 1 : 0; } # Possible sieve storage: # 1) vec with mod-30 wheel: 8 bits / 30 # 2) vec with mod-2 wheel : 15 bits / 30 # 3) str with mod-30 wheel: 8 bytes / 30 # 4) str with mod-2 wheel : 15 bytes / 30 # # It looks like using vecs is about 2x slower than strs, and the strings also # let us do some fast operations on the results. E.g. # Count all primes: # $count += $$sieveref =~ tr/0//; # Loop over primes: # foreach my $s (split("0", $$sieveref, -1)) { # $n += 2 + 2 * length($s); # .. do something with the prime $n # } # # We're using method 4, though sadly it is memory intensive relative to the # other methods. I will point out that it is 30-60x less memory than sieves # using an array, and the performance of this function is over 10x that # of naive sieves like found on RosettaCode. sub _sieve_erat_string { my($end) = @_; $end-- if ($end & 1) == 0; my $s_end = $end >> 1; my $whole = int( $s_end / 15); # Prefill with 3 and 5 already marked. croak "Sieve too large" if $whole > 1_145_324_612; # ~32 GB string my $sieve = "100010010010110" . "011010010010110" x $whole; substr($sieve, $s_end+1) = ''; # Ensure we don't make too many entries my ($n, $limit) = ( 7, int(sqrt($end)) ); while ( $n <= $limit ) { for (my $s = ($n*$n) >> 1; $s <= $s_end; $s += $n) { substr($sieve, $s, 1) = '1'; } do { $n += 2 } while substr($sieve, $n>>1, 1); } return \$sieve; } # TODO: this should be plugged into precalc, memfree, etc. just like the C code { my $primary_size_limit = 15000; my $primary_sieve_size = 0; my $primary_sieve_ref; sub _sieve_erat { my($end) = @_; return _sieve_erat_string($end) if $end > $primary_size_limit; if ($primary_sieve_size == 0) { $primary_sieve_size = $primary_size_limit; $primary_sieve_ref = _sieve_erat_string($primary_sieve_size); } my $sieve = substr($$primary_sieve_ref, 0, ($end+1)>>1); return \$sieve; } } sub _sieve_segment { my($beg,$end) = @_; croak "Internal error: segment beg is even" if ($beg % 2) == 0; croak "Internal error: segment end is even" if ($end % 2) == 0; croak "Internal error: segment end < beg" if $end < $beg; croak "Internal error: segment beg should be >= 3" if $beg < 3; my $range = int( ($end - $beg) / 2 ) + 1; # Prefill with 3 and 5 already marked, and offset to the segment start. my $whole = int( ($range+14) / 15); my $startp = ($beg % 30) >> 1; my $sieve = substr("011010010010110", $startp) . "011010010010110" x $whole; # Set 3 and 5 to prime if we're sieving them. substr($sieve,0,2) = "00" if $beg == 3; substr($sieve,0,1) = "0" if $beg == 5; # Get rid of any extra we added. substr($sieve, $range) = ''; # If the end value is below 7^2, then the pre-sieve is all we needed. return \$sieve if $end < 49; my $limit = int(sqrt($end)) + 1; # For large value of end, it's a huge win to just walk primes. my $primesieveref = _sieve_erat($limit); my $p = 7-2; foreach my $s (split("0", substr($$primesieveref, 3), -1)) { $p += 2 + 2 * length($s); my $p2 = $p*$p; if ($p2 < $beg) { my $f = 1+int(($beg-1)/$p); $p2 = $p * ($f + !($f & 1)); } elsif ($p2 > $end) { last; } # With large bases and small segments, it's common to find we don't hit # the segment at all. Skip all the setup if we find this now. if ($p2 <= $end) { # Inner loop marking multiples of p # (everything is divided by 2 to keep inner loop simpler) my $filter_end = ($end - $beg) >> 1; my $filter_p2 = ($p2 - $beg) >> 1; while ($filter_p2 <= $filter_end) { substr($sieve, $filter_p2, 1) = "1"; $filter_p2 += $p; } } } \$sieve; } sub trial_primes { my($low,$high) = @_; if (!defined $high) { $high = $low; $low = 2; } _validate_positive_integer($low); _validate_positive_integer($high); return if $low > $high; my @primes; $low-- if $low >= 2; my $curprime = next_prime($low); while ($curprime <= $high) { push @primes, $curprime; $curprime = next_prime($curprime); } return \@primes; } sub primes { my($low,$high) = @_; if (scalar @_ > 1) { _validate_positive_integer($low); _validate_positive_integer($high); } else { ($low,$high) = (2, $low); _validate_positive_integer($high); } my $sref = []; return $sref if ($low > $high) || ($high < 2); # At some point even the pretty-fast pure perl sieve is going to be a # dog, and we should move to trials. This is typical with a small range # on a large base. More thought on the switchover should be done. return trial_primes($low, $high) if ref($low) eq 'Math::BigInt' || ref($high) eq 'Math::BigInt' || ($low > 1_000_000_000_000 && ($high-$low) < int($low/1_000_000)); push @$sref, 2 if ($low <= 2) && ($high >= 2); push @$sref, 3 if ($low <= 3) && ($high >= 3); push @$sref, 5 if ($low <= 5) && ($high >= 5); $low = 7 if $low < 7; $low++ if ($low % 2) == 0; $high-- if ($high % 2) == 0; return $sref if $low > $high; if ($low == 7) { my $sieveref = _sieve_erat($high); my $n = $low - 2; foreach my $s (split("0", substr($$sieveref, 3), -1)) { $n += 2 + 2 * length($s); push @$sref, $n if $n <= $high; } } else { my $sieveref = _sieve_segment($low,$high); my $n = $low - 2; foreach my $s (split("0", $$sieveref, -1)) { $n += 2 + 2 * length($s); push @$sref, $n if $n <= $high; } } $sref; } sub next_prime { my($n) = @_; _validate_positive_integer($n); return $_prime_next_small[$n] if $n <= $#_prime_next_small; $n = Math::BigInt->new(''.$_[0]) if ref($n) ne 'Math::BigInt' && $n >= MPU_MAXPRIME; #$n = ($n+1) | 1; #while ( !($n%3) || !($n%5) || !($n%7) || !($n%11) || !($n%13) # || !_is_prime7($n) ) { # $n += 2; #} my $m = $n % 30; my $d = ($n - $m) / 30; if ($m == 29) { $d++; $m = 1;} else { $m = $_nextwheel30[$m]; } $n = $d*30+$m; while ( !($n%7) || !_is_prime7($n) ) { $m = $_nextwheel30[$m]; $d++ if $m == 1; $n = $d*30+$m; } return $n; } sub prev_prime { my($n) = @_; _validate_positive_integer($n); if ($n <= 11) { return ($n <= 2) ? 0 : ($n <= 3) ? 2 : ($n <= 5) ? 3 : ($n <= 7) ? 5 : 7; } #$n++ if ($n % 2) == 0; #do { # $n -= 2; #} while ( (($n % 3) == 0) || (($n % 5) == 0) || (!_is_prime7($n)) ); #return $n; $n -= ($n & 1) ? 2 : 1; my $nmod6 = $n % 6; if ($nmod6 == 5) { return $n if ($n % 5) != 0 && ($n % 7) != 0 && _is_prime7($n); $n -= 4; } elsif ($nmod6 == 3) { $n -= 2; } while (1) { return $n if ($n % 5) != 0 && ($n % 7) != 0 && _is_prime7($n); $n -= 2; return $n if ($n % 5) != 0 && ($n % 7) != 0 && _is_prime7($n); $n -= 4; } return $n; # This is faster for larger intervals, slower for short ones. #my $base = 30 * int($n/30); #my $in = 0; $in++ while ($n - $base) > $_prime_indices[$in]; #if (--$in < 0) { $base -= 30; $in = 7; } #$n = $base + $_prime_indices[$in]; #while (!_is_prime7($n)) { # if (--$in < 0) { $base -= 30; $in = 7; } # $n = $base + $_prime_indices[$in]; #} #$n; #my $m = $n % 30; #my $d = int( ($n - $m) / 30 ); #do { # $m = $_prevwheel30[$m]; # $d-- if $m == 29; #} while (!_is_prime7($d*30+$m)); #$d*30+$m; } sub partitions { my $n = shift; my $d = int(sqrt($n+1)); my @pent = (1, map { (($_*(3*$_+1))>>1, (($_+1)*(3*$_+2))>>1) } 1 .. $d); my @part = (Math::BigInt->bone); foreach my $j (scalar @part .. $n) { my ($psum1, $psum2, $k) = (Math::BigInt->bzero, Math::BigInt->bzero, 1); foreach my $p (@pent) { last if $p > $j; if ((++$k) & 2) { $psum1->badd( $part[ $j - $p ] ); } else { $psum2->badd( $part[ $j - $p ] ); } } $part[$j] = $psum1 - $psum2; } return $part[$n]; } sub primorial { my $n = shift; my $max = (MPU_32BIT) ? 29 : (OLD_PERL_VERSION) ? 43 : 53; my $pn = (ref($_[0]) eq 'Math::BigInt') ? $_[0]->copy->bone() : ($n >= $max) ? Math::BigInt->bone() : 1; if (ref($pn) eq 'Math::BigInt') { my $start = 2; if ($n >= 97) { $start = 101; $pn->bdec->badd(Math::BigInt->new("2305567963945518424753102147331756070")); } my @plist = @{primes($start,$n)}; while (@plist > 2 && $plist[2] < 1625) { $pn->bmul( Math::BigInt->new(shift(@plist)*shift(@plist)*shift(@plist)) ); } while (@plist > 1 && $plist[1] < 65536) { $pn->bmul( Math::BigInt->new(shift(@plist)*shift(@plist)) ); } $pn->bmul($_) for @plist; } else { foreach my $p (@{primes($n)}) { $pn *= $p; } } return $pn; } sub consecutive_integer_lcm { my $n = shift; my $max = (MPU_32BIT) ? 22 : (OLD_PERL_VERSION) ? 37 : 46; my $pn = ref($n) ? ref($n)->new(1) : ($n >= $max) ? Math::BigInt->bone() : 1; for (my $p = 2; $p <= $n; $p = next_prime($p)) { my($p_power, $pmin) = ($p, int($n/$p)); $p_power *= $p while $p_power <= $pmin; $pn *= $p_power; } $pn = _bigint_to_int($pn) if $pn <= ''.~0; return $pn; } sub jordan_totient { my($k, $n) = @_; return ($n == 1) ? 1 : 0 if $k == 0; return euler_phi($n) if $k == 1; return 0 if $n < 0; return ($n == 1) ? 1 : 0 if $n <= 1; my @pe = Math::Prime::Util::factor_exp($n); $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my $totient = BONE->copy; foreach my $f (@pe) { my ($p, $e) = @$f; $p = Math::BigInt->new("$p") unless ref($p) eq 'Math::BigInt'; $p->bpow($k); $totient->bmul($p->copy->bdec()); $totient->bmul($p) for 2 .. $e; } $totient = _bigint_to_int($totient) if $totient->bacmp(''.~0) <= 0; return $totient; } sub euler_phi { return euler_phi_range(@_) if scalar @_ > 1; my($n) = @_; return 0 if $n < 0; return $n if $n <= 1; my @pe = Math::Prime::Util::factor_exp($n); my $totient = $n - $n + 1; if (ref($n) ne 'Math::BigInt') { foreach my $f (@pe) { my ($p, $e) = @$f; $totient *= $p - 1; $totient *= $p for 2 .. $e; } } else { my $zero = $n->copy->bzero; foreach my $f (@pe) { my ($p, $e) = @$f; $p = $zero->copy->badd("$p"); $totient->bmul($p->copy->bdec()); $totient->bmul($p) for 2 .. $e; } } return $totient; } sub euler_phi_range { my($n, $nend) = @_; return () if $nend < $n; return euler_phi($n) if $n == $nend; my @totients; if ($nend > 2**30) { while ($n < $nend) { push @totients, euler_phi($n++); } } else { @totients = (0 .. $nend); foreach my $i (2 .. $nend) { next unless $totients[$i] == $i; $totients[$i] = $i-1; foreach my $j (2 .. int($nend / $i)) { $totients[$i*$j] -= $totients[$i*$j]/$i; } } splice(@totients, 0, $n) if $n > 0; } return @totients; } sub moebius { return moebius_range(@_) if scalar @_ > 1; my($n) = @_; return ($n == 1) ? 1 : 0 if $n <= 1; return 0 if ($n >= 49) && (!($n % 4) || !($n % 9) || !($n % 25) || !($n%49) ); my @factors = Math::Prime::Util::factor($n); foreach my $i (1 .. $#factors) { return 0 if $factors[$i] == $factors[$i-1]; } return ((scalar @factors) % 2) ? -1 : 1; } sub moebius_range { my($lo, $hi) = @_; return () if $hi < $lo; return moebius($lo) if $lo == $hi; if ($hi > 2**32) { my @mu; while ($lo < $hi) { push @mu, moebius($lo++); } return @mu; } my @mu = map { 1 } $lo .. $hi; $mu[0] = 0 if $lo == 0; my($p, $sqrtn) = (2, int(sqrt($hi)+0.5)); while ($p <= $sqrtn) { my $i = $p * $p; $i = $i * int($lo/$i) + (($lo % $i) ? $i : 0) if $i < $lo; while ($i <= $hi) { $mu[$i-$lo] = 0; $i += $p * $p; } $i = $p; $i = $i * int($lo/$i) + (($lo % $i) ? $i : 0) if $i < $lo; while ($i <= $hi) { $mu[$i-$lo] *= -$p; $i += $p; } $p = next_prime($p); } foreach my $i ($lo .. $hi) { my $m = $mu[$i-$lo]; $m *= -1 if abs($m) != $i; $mu[$i-$lo] = ($m>0) - ($m<0); } return @mu; } sub mertens { my($n) = @_; # This is the most basic Deléglise and Rivat algorithm. u = n^1/2 # and no segmenting is done. Their algorithm uses u = n^1/3, breaks # the summation into two parts, and calculates those in segments. Their # computation time growth is half of this code. return $n if $n <= 1; my $u = int(sqrt($n)); my @mu = (0, Math::Prime::Util::moebius(1, $u)); # Hold values of mu for 0-u my $musum = 0; my @M = map { $musum += $_; } @mu; # Hold values of M for 0-u my $sum = $M[$u]; foreach my $m (1 .. $u) { next if $mu[$m] == 0; my $inner_sum = 0; my $lower = int($u/$m) + 1; my $last_nmk = int($n/($m*$lower)); my ($denom, $this_k, $next_k) = ($m, 0, int($n/($m*1))); for my $nmk (1 .. $last_nmk) { $denom += $m; $this_k = int($n/$denom); next if $this_k == $next_k; ($this_k, $next_k) = ($next_k, $this_k); $inner_sum += $M[$nmk] * ($this_k - $next_k); } $sum -= $mu[$m] * $inner_sum; } return $sum; } sub liouville { my($n) = @_; my $l = (-1) ** scalar factor($n); return $l; } # Exponential of Mangoldt function (A014963). # Return p if n = p^m [p prime, m >= 1], 1 otherwise. sub exp_mangoldt { my($n) = @_; return 1 if defined $n && $n <= 1; # n <= 1 return 2 if ($n & ($n-1)) == 0; # n power of 2 return 1 unless $n & 1; # even n can't be p^m my @pe = Math::Prime::Util::factor_exp($n); return 1 if scalar @pe > 1; return $pe[0]->[0]; } sub carmichael_lambda { my($n) = @_; return euler_phi($n) if $n < 8; # = phi(n) for n < 8 return euler_phi($n)/2 if ($n & ($n-1)) == 0; # = phi(n)/2 for 2^k, k>2 my @pe = Math::Prime::Util::factor_exp($n); $pe[0]->[1]-- if $pe[0]->[0] == 2 && $pe[0]->[1] > 2; my $lcm = Math::BigInt::blcm( map { $_->[0]->copy->bpow($_->[1]->copy->bdec)->bmul($_->[0]->copy->bdec) } map { [ map { Math::BigInt->new("$_") } @$_ ] } @pe ); $lcm = _bigint_to_int($lcm) if $lcm->bacmp(''.~0) <= 0; return $lcm; } my @_ds_overflow = # We'll use BigInt math if the input is larger than this. (~0 > 4294967295) ? (124, 3000000000000000000, 3000000000, 2487240, 64260, 7026) : ( 50, 845404560, 52560, 1548, 252, 84); sub divisor_sum { my($n, $k) = @_; return 1 if $n == 1; if (defined $k && ref($k) eq 'CODE') { my $sum = $n-$n; my $refn = ref($n); foreach my $d (Math::Prime::Util::divisors($n)) { $sum += $k->( $refn ? $refn->new("$d") : $d ); } return $sum; } croak "Second argument must be a code ref or number" unless !defined $k || _validate_num($k) || _validate_positive_integer($k); $k = 1 if !defined $k; my $will_overflow = ($k == 0) ? (length($n) >= $_ds_overflow[0]) : ($k <= 5) ? ($n >= $_ds_overflow[$k]) : 1; # The standard way is: # my $pk = $f ** $k; $product *= ($pk ** ($e+1) - 1) / ($pk - 1); # But we get less overflow using: # my $pk = $f ** $k; $product *= $pk**E for E in 0 .. e # Also separate BigInt and do fiddly bits for better performance. my $product = 1; if (!$will_overflow) { foreach my $f (Math::Prime::Util::factor_exp($n)) { my ($p, $e) = @$f; if ($k == 0) { $product *= ($e+1); } else { my $pk = $p ** $k; my $fmult = $pk + 1; foreach my $E (2 .. $e) { $fmult += $pk**$E } $product *= $fmult; } } } else { $product = Math::BigInt->bone; my $bik = Math::BigInt->new("$k"); foreach my $f (Math::Prime::Util::factor_exp($n)) { my ($p, $e) = @$f; my $pk = Math::BigInt->new("$p")->bpow($bik); if ($e == 1) { $pk->binc(); $product->bmul($pk); } elsif ($e == 2) { $pk->badd($pk*$pk)->binc(); $product->bmul($pk); } else { my $fmult = $pk; foreach my $E (2 .. $e) { $fmult += $pk->copy->bpow($E) } $fmult->binc(); $product *= $fmult; } } } return $product; } ############################################################################# # Lehmer prime count # #my @_s0 = (0); #my @_s1 = (0,1); #my @_s2 = (0,1,1,1,1,2); 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); 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); sub _tablephi { my($x, $a) = @_; if ($a == 0) { return $x; } elsif ($a == 1) { return $x-int($x/2); } elsif ($a == 2) { return $x-int($x/2) - int($x/3) + int($x/6); } elsif ($a == 3) { return 8 * int($x / 30) + $_s3[$x % 30]; } elsif ($a == 4) { return 48 * int($x / 210) + $_s4[$x % 210]; } elsif ($a == 5) { my $xp = int($x/11); return ( (48 * int($x / 210) + $_s4[$x % 210]) - (48 * int($xp / 210) + $_s4[$xp % 210]) ); } else { my ($xp,$x2) = (int($x/11),int($x/13)); my $x2p = int($x2/11); return ( (48 * int($x / 210) + $_s4[$x % 210]) - (48 * int($xp / 210) + $_s4[$xp % 210]) - (48 * int($x2 / 210) + $_s4[$x2 % 210]) + (48 * int($x2p / 210) + $_s4[$x2p % 210]) ); } } sub legendre_phi { my ($x, $a, $primes) = @_; return _tablephi($x,$a) if $a <= 6; $primes = primes(Math::Prime::Util::nth_prime_upper($a+1)) unless defined $primes; return ($x > 0 ? 1 : 0) if $x < $primes->[$a]; my $sum = 0; my %vals = ( $x => 1 ); while ($a > 6) { my $primea = $primes->[$a-1]; my %newvals; while (my($v,$c) = each %vals) { my $sval = int($v / $primea); if ($sval < $primea) { $sum -= $c; } else { $newvals{$sval} -= $c; } } # merge newvals into vals while (my($v,$c) = each %newvals) { $vals{$v} += $c; delete $vals{$v} if $vals{$v} == 0; } $a--; } while (my($v,$c) = each %vals) { $sum += $c * _tablephi($v, $a); } return $sum; } sub _sieve_prime_count { my $high = shift; return (0,0,1,2,2,3,3)[$high] if $high < 7; $high-- unless ($high & 1); return 1 + ${_sieve_erat($high)} =~ tr/0//; } sub _count_with_sieve { my ($sref, $low, $high) = @_; ($low, $high) = (2, $low) if !defined $high; my $count = 0; if ($low < 3) { $low = 3; $count++; } else { $low |= 1; } $high-- unless ($high & 1); return $count if $low > $high; my $sbeg = $low >> 1; my $send = $high >> 1; if ( !defined $sref || $send >= length($$sref) ) { # outside our range, so call the segment siever. my $seg_ref = _sieve_segment($low, $high); return $count + $$seg_ref =~ tr/0//; } return $count + substr($$sref, $sbeg, $send-$sbeg+1) =~ tr/0//; } sub _lehmer_pi { my $x = shift; return _sieve_prime_count($x) if $x < 1_000; my $z = (ref($x) ne 'Math::BigInt') ? int(sqrt($x+0.5)) : int(Math::BigFloat->new($x)->badd(0.5)->bsqrt->bfloor->bstr); my $a = _lehmer_pi(int(sqrt($z)+0.5)); my $b = _lehmer_pi($z); my $c = _lehmer_pi(int( (ref($x) ne 'Math::BigInt') ? $x**(1/3)+0.5 : Math::BigFloat->new($x)->broot(3)->badd(0.5)->bfloor )); ($z, $a, $b, $c) = map { (ref($_) =~ /^Math::Big/) ? _bigint_to_int($_) : $_ } ($z, $a, $b, $c); # Generate at least b primes. my $bth_prime_upper = ($b <= 10) ? 29 : int($b*(log($b) + log(log($b)))) + 1; my $primes = primes( $bth_prime_upper ); my $sum = int(($b + $a - 2) * ($b - $a + 1) / 2); $sum += legendre_phi($x, $a, $primes); # Get a big sieve for our primecounts. The C code compromises with either # b*10 or x^3/5, as that cuts out all the inner loop sieves and about half # of the big outer loop counts. # Our sieve count isn't nearly as optimized here, so error on the side of # more primes. This uses a lot more memory but saves a lot of time. my $sref = _sieve_erat( int($x / $primes->[$a] / 5) ); my ($lastw, $lastwpc) = (0,0); foreach my $i (reverse $a+1 .. $b) { my $w = int($x / $primes->[$i-1]); $lastwpc += _count_with_sieve($sref,$lastw+1, $w); $lastw = $w; $sum -= $lastwpc; #$sum -= _count_with_sieve($sref,$w); if ($i <= $c) { my $bi = _count_with_sieve($sref,int(sqrt($w)+0.5)); foreach my $j ($i .. $bi) { $sum = $sum - _count_with_sieve($sref,int($w / $primes->[$j-1])) + $j - 1; } } } $sum; } ############################################################################# sub prime_count { my($low,$high) = @_; if (!defined $high) { $high = $low; $low = 2; } _validate_positive_integer($low); _validate_positive_integer($high); my $count = 0; $count++ if ($low <= 2) && ($high >= 2); # Count 2 $low = 3 if $low < 3; $low++ if ($low % 2) == 0; # Make low go to odd number. $high-- if ($high % 2) == 0; # Make high go to odd number. return $count if $low > $high; if ( ref($low) eq 'Math::BigInt' || ref($high) eq 'Math::BigInt' || ($high-$low) < 10 || ($high-$low) < int($low/100_000_000_000) ) { # Trial primes seems best. Needs some tuning. my $curprime = next_prime($low-1); while ($curprime <= $high) { $count++; $curprime = next_prime($curprime); } return $count; } # TODO: Needs tuning if ($high > 50_000) { if ( ($high / ($high-$low+1)) < 100 ) { $count += _lehmer_pi($high); $count -= ($low == 3) ? 1 : _lehmer_pi($low-1); return $count; } } return (_sieve_prime_count($high) - 1 + $count) if $low == 3; my $sieveref = _sieve_segment($low,$high); $count += $$sieveref =~ tr/0//; return $count; } sub nth_prime { my($n) = @_; _validate_positive_integer($n); return $_primes_small[$n] if $n <= $#_primes_small; if ($n > MPU_MAXPRIMEIDX && ref($n) ne 'Math::BigFloat') { do { require Math::BigFloat; Math::BigFloat->import(); } if !defined $Math::BigFloat::VERSION; $n = Math::BigFloat->new("$n") } my $prime = 0; my $count = 1; my $start = 3; my $logn = log($n); my $loglogn = log($logn); my $nth_prime_upper = ($n <= 10) ? 29 : int($n*($logn + $loglogn)) + 1; if ($nth_prime_upper > 100000) { # Use fast Lehmer prime count combined with lower bound to get close. my $nth_prime_lower = int($n * ($logn + $loglogn - 1.0 + (($loglogn-2.10)/$logn))); $nth_prime_lower-- unless $nth_prime_lower % 2; $count = _lehmer_pi($nth_prime_lower); $start = $nth_prime_lower + 2; } { # Make sure incr is an even number. my $incr = ($n < 1000) ? 1000 : ($n < 10000) ? 10000 : 100000; my $sieveref; while (1) { $sieveref = _sieve_segment($start, $start+$incr); my $segcount = $$sieveref =~ tr/0//; last if ($count + $segcount) >= $n; $count += $segcount; $start += $incr+2; } # Our count is somewhere in this segment. Need to look for it. $prime = $start - 2; while ($count < $n) { $prime += 2; $count++ if !substr($$sieveref, ($prime-$start)>>1, 1); } } $prime; } # The nth prime will be less or equal to this number sub nth_prime_upper { my($n) = @_; _validate_positive_integer($n); return $_primes_small[$n] if $n <= $#_primes_small; $n = _upgrade_to_float($n) if $n > MPU_MAXPRIMEIDX || $n > 2**45; my $flogn = log($n); my $flog2n = log($flogn); # Note distinction between log_2(n) and log^2(n) my $upper; if ($n >= 688383) { # Dusart 2010 page 2 $upper = $n * ( $flogn + $flog2n - 1.0 + (($flog2n-2.00)/$flogn) ); } elsif ($n >= 178974) { # Dusart 2010 page 7 $upper = $n * ( $flogn + $flog2n - 1.0 + (($flog2n-1.95)/$flogn) ); } elsif ($n >= 39017) { # Dusart 1999 page 14 $upper = $n * ( $flogn + $flog2n - 0.9484 ); } elsif ($n >= 6) { # Modified Robin 1983, for 6-39016 only $upper = $n * ( $flogn + 0.6000 * $flog2n ); } else { $upper = $n * ( $flogn + $flog2n ); } return int($upper + 1.0); } # The nth prime will be greater than or equal to this number sub nth_prime_lower { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); return $_primes_small[$n] if $n <= $#_primes_small; $n = _upgrade_to_float($n) if $n > MPU_MAXPRIMEIDX || $n > 2**45; my $flogn = log($n); my $flog2n = log($flogn); # Note distinction between log_2(n) and log^2(n) # Dusart 1999 page 14, for all n >= 2 #my $lower = $n * ($flogn + $flog2n - 1.0 + (($flog2n-2.25)/$flogn)); # Dusart 2010 page 2, for all n >= 3 my $lower = $n * ($flogn + $flog2n - 1.0 + (($flog2n-2.10)/$flogn)); return int($lower); } sub nth_prime_approx { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); return $_primes_small[$n] if $n <= $#_primes_small; $n = _upgrade_to_float($n) if ref($n) eq 'Math::BigInt' || $n >= MPU_MAXPRIMEIDX; my $flogn = log($n); my $flog2n = log($flogn); # Cipolla 1902: # m=0 fn * ( flogn + flog2n - 1 ); # m=1 + ((flog2n - 2)/flogn) ); # m=2 - (((flog2n*flog2n) - 6*flog2n + 11) / (2*flogn*flogn)) # + O((flog2n/flogn)^3) # # Shown in Dusart 1999 page 12, as well as other sources such as: # http://www.emis.de/journals/JIPAM/images/153_02_JIPAM/153_02.pdf # where the main issue you run into is that you're doing polynomial # interpolation, so it oscillates like crazy with many high-order terms. # Hence I'm leaving it at m=2. my $approx = $n * ( $flogn + $flog2n - 1 + (($flog2n - 2)/$flogn) - ((($flog2n*$flog2n) - 6*$flog2n + 11) / (2*$flogn*$flogn)) ); # Apply a correction to help keep values close. my $order = $flog2n/$flogn; $order = $order*$order*$order * $n; if ($n < 259) { $approx += 10.4 * $order; } elsif ($n < 775) { $approx += 7.52* $order; } elsif ($n < 1271) { $approx += 5.6 * $order; } elsif ($n < 2000) { $approx += 5.2 * $order; } elsif ($n < 4000) { $approx += 4.3 * $order; } elsif ($n < 12000) { $approx += 3.0 * $order; } elsif ($n < 150000) { $approx += 2.1 * $order; } elsif ($n < 200000000) { $approx += 0.0 * $order; } else { $approx += -0.010 * $order; } # $approx = -0.025 is better for the last, but it gives problems with some # other code that always wants the asymptotic approximation to be >= actual. return int($approx + 0.5); } ############################################################################# sub prime_count_approx { my($x) = @_; _validate_num($x) || _validate_positive_integer($x); # Turn on high precision FP if they gave us a big number. $x = _upgrade_to_float($x) if ref($_[0]) eq 'Math::BigInt'; # Method 10^10 %error 10^19 %error # ----------------- ------------ ------------ # n/(log(n)-1) .22% .06% # average bounds .01% .0002% # li(n) .0007% .00000004% # li(n)-li(n^.5)/2 .0004% .00000001% # R(n) .0004% .00000001% # # Also consider: http://trac.sagemath.org/sage_trac/ticket/8135 # my $result = int( (prime_count_upper($x) + prime_count_lower($x)) / 2); # my $result = int( LogarithmicIntegral($x) ); # my $result = int(LogarithmicIntegral($x) - LogarithmicIntegral(sqrt($x))/2); # my $result = RiemannR($x) + 0.5; # Sadly my Perl RiemannR function is really slow for big values. If MPFR # is available, then use it -- it rocks. Otherwise, switch to LiCorr for # very big values. This is hacky and shouldn't be necessary. my $result; if ( $x < 1e36 || _MPFR_available() ) { if (ref($x) eq 'Math::BigFloat') { # Make sure we get enough accuracy, and also not too much more than needed $x->accuracy(length($x->bfloor->bstr())+2); } $result = RiemannR($x) + 0.5; } else { $result = int(LogarithmicIntegral($x) - LogarithmicIntegral(sqrt($x))/2); } return Math::BigInt->new($result->bfloor->bstr()) if ref($result) eq 'Math::BigFloat'; return int($result); } sub prime_count_lower { my($x) = @_; _validate_num($x) || _validate_positive_integer($x); return _tiny_prime_count($x) if $x < $_primes_small[-1]; $x = _upgrade_to_float($x) if ref($x) eq 'Math::BigInt' || ref($_[0]) eq 'Math::BigInt'; my $flogx = log($x); # Chebyshev: 1*x/logx x >= 17 # Rosser & Schoenfeld: x/(logx-1/2) x >= 67 # Dusart 1999: x/logx*(1+1/logx+1.8/logxlogx) x >= 32299 # Dusart 2010: x/logx*(1+1/logx+2.0/logxlogx) x >= 88783 # The Dusart (1999 or 2010) bounds are far, far better than the others. my $result; if ($x > 1000_000_000_000 && Math::Prime::Util::prime_get_config()->{'assume_rh'}) { # Schoenfeld bound my $lix = LogarithmicIntegral($x); my $sqx = sqrt($x); if (ref($x) eq 'Math::BigFloat') { my $xdigits = _find_big_acc($x); $result = $lix - (($sqx*$flogx) / (Math::BigFloat->bpi($xdigits)*8)); } else { $result = $lix - (($sqx*$flogx) / PI_TIMES_8); } } elsif ($x < 599) { $result = $x / ($flogx - 0.7); # For smaller numbers this works out well. } else { my $a; # Hand tuned for small numbers (< 60_000M) if ($x < 2700) { $a = 0.30; } elsif ($x < 5500) { $a = 0.90; } elsif ($x < 19400) { $a = 1.30; } elsif ($x < 32299) { $a = 1.60; } elsif ($x < 176000) { $a = 1.80; } elsif ($x < 315000) { $a = 2.10; } elsif ($x < 1100000) { $a = 2.20; } elsif ($x < 4500000) { $a = 2.31; } elsif ($x < 233000000) { $a = 2.36; } elsif ($x < 5433800000) { $a = 2.32; } elsif ($x <60000000000) { $a = 2.15; } else { $a = 2.00; } # Dusart 2010, page 2 $result = ($x/$flogx) * (1.0 + 1.0/$flogx + $a/($flogx*$flogx)); } return Math::BigInt->new($result->bfloor->bstr()) if ref($result) eq 'Math::BigFloat'; return int($result); } sub prime_count_upper { my($x) = @_; _validate_num($x) || _validate_positive_integer($x); # Give an exact answer for what we have in our little table. return _tiny_prime_count($x) if $x < $_primes_small[-1]; $x = _upgrade_to_float($x) if ref($x) eq 'Math::BigInt' || ref($_[0]) eq 'Math::BigInt'; # Chebyshev: 1.25506*x/logx x >= 17 # Rosser & Schoenfeld: x/(logx-3/2) x >= 67 # Dusart 1999: x/logx*(1+1/logx+2.51/logxlogx) x >= 355991 # Dusart 2010: x/logx*(1+1/logx+2.334/logxlogx) x >= 2_953_652_287 # As with the lower bounds, Dusart bounds are best by far. # Another possibility here for numbers under 3000M is to use Li(x) # minus a correction. my $flogx = log($x); my $result; if ($x > 10000_000_000_000 && Math::Prime::Util::prime_get_config()->{'assume_rh'}) { # Schoenfeld bound my $lix = LogarithmicIntegral($x); my $sqx = sqrt($x); if (ref($x) eq 'Math::BigFloat') { my $xdigits = _find_big_acc($x); $result = $lix + (($sqx*$flogx) / (Math::BigFloat->bpi($xdigits)*8)); } else { $result = $lix + (($sqx*$flogx) / PI_TIMES_8); } } elsif ($x < 1621) { $result = ($x / ($flogx - 1.048)) + 1.0; } elsif ($x < 5000) { $result = ($x / ($flogx - 1.071)) + 1.0; } elsif ($x < 15900) { $result = ($x / ($flogx - 1.098)) + 1.0; } else { my $a; # Hand tuned for small numbers (< 60_000M) if ($x < 24000) { $a = 2.30; } elsif ($x < 59000) { $a = 2.48; } elsif ($x < 350000) { $a = 2.52; } elsif ($x < 355991) { $a = 2.54; } elsif ($x < 356000) { $a = 2.51; } elsif ($x < 3550000) { $a = 2.50; } elsif ($x < 3560000) { $a = 2.49; } elsif ($x < 5000000) { $a = 2.48; } elsif ($x < 8000000) { $a = 2.47; } elsif ($x < 13000000) { $a = 2.46; } elsif ($x < 18000000) { $a = 2.45; } elsif ($x < 31000000) { $a = 2.44; } elsif ($x < 41000000) { $a = 2.43; } elsif ($x < 48000000) { $a = 2.42; } elsif ($x < 119000000) { $a = 2.41; } elsif ($x < 182000000) { $a = 2.40; } elsif ($x < 192000000) { $a = 2.395; } elsif ($x < 213000000) { $a = 2.390; } elsif ($x < 271000000) { $a = 2.385; } elsif ($x < 322000000) { $a = 2.380; } elsif ($x < 400000000) { $a = 2.375; } elsif ($x < 510000000) { $a = 2.370; } elsif ($x < 682000000) { $a = 2.367; } elsif ($x < 2953652287) { $a = 2.362; } else { $a = 2.334; } # Dusart 2010, page 2 #elsif ($x <60000000000) { $a = 2.362; } #else { $a = 2.51; } # Dusart 1999, page 14 # Old versions of Math::BigFloat will do the Wrong Thing with this. $result = ($x/$flogx) * (1.0 + 1.0/$flogx + $a/($flogx*$flogx)) + 1.0; } return Math::BigInt->new($result->bfloor->bstr()) if ref($result) eq 'Math::BigFloat'; return int($result); } ############################################################################# sub _mulmod { my($x, $y, $n) = @_; return (($x * $y) % $n) if ($x|$y) < MPU_HALFWORD; #return (($x * $y) % $n) if ($x|$y) < MPU_HALFWORD || $y == 0 || $x < int(~0/$y); my $r = 0; $x %= $n if $x >= $n; $y %= $n if $y >= $n; ($x,$y) = ($y,$x) if $x < $y; if ($n <= (~0 >> 1)) { while ($y > 1) { if ($y & 1) { $r += $x; $r -= $n if $r >= $n; } $y >>= 1; $x += $x; $x -= $n if $x >= $n; } if ($y & 1) { $r += $x; $r -= $n if $r >= $n; } } else { while ($y > 1) { if ($y & 1) { $r = $n-$r; $r = ($x >= $r) ? $x-$r : $n-$r+$x; } $y >>= 1; $x = ($x > ($n - $x)) ? ($x - $n) + $x : $x + $x; } if ($y & 1) { $r = $n-$r; $r = ($x >= $r) ? $x-$r : $n-$r+$x; } } $r; } # Note that Perl 5.6.2 with largish 64-bit numbers will break. As usual. sub _native_powmod { my($n, $power, $m) = @_; my $t = 1; $n = $n % $m; while ($power) { $t = ($t * $n) % $m if ($power & 1); $power >>= 1; $n = ($n * $n) % $m if $power; } $t; } sub _powmod { my($n, $power, $m) = @_; my $t = 1; $n %= $m if $n >= $m; if ($m < MPU_HALFWORD) { while ($power) { $t = ($t * $n) % $m if ($power & 1); $power >>= 1; $n = ($n * $n) % $m if $power; } } else { while ($power) { $t = _mulmod($t, $n, $m) if ($power & 1); $power >>= 1; $n = _mulmod($n, $n, $m) if $power; } } $t; } # Make sure to work around RT71548 here, and correct lcm semantics. sub gcd { my $gcd = Math::BigInt::bgcd( map { my $v = ($_ < 2147483647 || ref($_) eq 'Math::BigInt') ? $_ : "$_"; $v; } @_ ); $gcd = _bigint_to_int($gcd) if $gcd->bacmp(''.~0) <= 0; return $gcd; } sub lcm { my $lcm = Math::BigInt::blcm( map { my $v = ($_ < 2147483647 || ref($_) eq 'Math::BigInt') ? $_ : "$_"; return 0 if $v == 0; $v = -$v if $v < 0; $v; } @_ ); $lcm = _bigint_to_int($lcm) if $lcm->bacmp(''.~0) <= 0; return $lcm; } # no validation, x is allowed to be negative, y must be >= 0 sub _gcd_ui { my($x, $y) = @_; if ($y < $x) { ($x, $y) = ($y, $x); } elsif ($x < 0) { $x = -$x; } while ($y > 0) { # y1 <- x0 % y0 ; x1 <- y0 my $t = $y; $y = $x % $y; $x = $t; } $x; } sub _is_perfect_power { my $n = shift; return 0 if $n <= 3 || $n != int($n); return 1 if ($n & ($n-1)) == 0; # Power of 2 $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; # Perl 5.6.2 chokes on this, so do it via as_bin # my $log2n = 0; { my $num = $n; $log2n++ while $num >>= 1; } my $log2n = length($n->as_bin) - 2; for (my $e = 2; $e <= $log2n; $e = next_prime($e)) { return 1 if $n->copy()->broot($e)->bpow($e) == $n; } 0; } sub is_pseudoprime { my($n, $base) = @_; return 0 if int($n) < 0; _validate_positive_integer($n); if ($n < 5) { return ($n == 2) || ($n == 3) ? 1 : 0; } croak "Base $base is invalid" if $base < 2; if ($base >= $n) { $base = $base % $n; return 1 if $base <= 1 || $base == $n-1; } my $x = (ref($n) eq 'Math::BigInt') ? $n->copy->bzero->badd($base)->bmodpow($n-1,$n) : _powmod($base, $n-1, $n); return ($x == 1) ? 1 : 0; } sub _miller_rabin_2 { my($n, $nm1, $s, $d) = @_; if ( ref($n) eq 'Math::BigInt' ) { if (!defined $nm1) { $nm1 = $n->copy->bdec(); $s = 0; $d = $nm1->copy; do { $s++; $d->brsft(BONE); } while $d->is_even; } my $x = BTWO->copy->bmodpow($d,$n); return 1 if $x->is_one || $x->bcmp($nm1) == 0; foreach my $r (1 .. $s-1) { $x->bmul($x)->bmod($n); last if $x->is_one; return 1 if $x->bcmp($nm1) == 0; } } else { if (!defined $nm1) { $nm1 = $n-1; $s = 0; $d = $nm1; while ( ($d & 1) == 0 ) { $s++; $d >>= 1; } } if ($n < MPU_HALFWORD) { my $x = _native_powmod(2, $d, $n); return 1 if $x == 1 || $x == $nm1; foreach my $r (1 .. $s-1) { $x = ($x*$x) % $n; last if $x == 1; return 1 if $x == $n-1; } } else { my $x = _powmod(2, $d, $n); return 1 if $x == 1 || $x == $nm1; foreach my $r (1 .. $s-1) { $x = ($x < MPU_HALFWORD) ? ($x*$x) % $n : _mulmod($x, $x, $n); last if $x == 1; return 1 if $x == $n-1; } } } 0; } sub is_strong_pseudoprime { my($n, @bases) = @_; return 0 if int($n) < 0; _validate_positive_integer($n); return 0+($n >= 2) if $n < 4; return 0 if ($n % 2) == 0; if ($bases[0] == 2) { return 0 unless _miller_rabin_2($n); shift @bases; return 1 unless @bases; } # Die on invalid bases foreach my $base (@bases) { croak "Base $base is invalid" if $base < 2 } # Make sure we handle big bases ok. @bases = grep { $_ > 1 } map { ($_ >= $n) ? $_ % $n : $_ } @bases; if ( ref($n) eq 'Math::BigInt' ) { my $nminus1 = $n->copy->bdec(); my $s = 0; my $d = $nminus1->copy; do { # n is > 3 and odd, so n-1 must be even $s++; $d->brsft(BONE); } while $d->is_even; # Different way of doing the above. Fewer function calls, slower on ave. #my $dbin = $nminus1->as_bin; #my $last1 = rindex($dbin, '1'); #my $s = length($dbin)-2-$last1+1; #my $d = $nminus1->copy->brsft($s); foreach my $ma (@bases) { my $x = $n->copy->bzero->badd($ma)->bmodpow($d,$n); next if $x->is_one || $x->bcmp($nminus1) == 0; foreach my $r (1 .. $s-1) { $x->bmul($x); $x->bmod($n); return 0 if $x->is_one; do { $ma = 0; last; } if $x->bcmp($nminus1) == 0; } return 0 if $ma != 0; } } else { my $s = 0; my $d = $n - 1; while ( ($d & 1) == 0 ) { $s++; $d >>= 1; } if ($n < MPU_HALFWORD) { foreach my $ma (@bases) { my $x = _native_powmod($ma, $d, $n); next if ($x == 1) || ($x == ($n-1)); foreach my $r (1 .. $s-1) { $x = ($x*$x) % $n; return 0 if $x == 1; last if $x == $n-1; } return 0 if $x != $n-1; } } else { foreach my $ma (@bases) { my $x = _powmod($ma, $d, $n); next if ($x == 1) || ($x == ($n-1)); foreach my $r (1 .. $s-1) { $x = ($x < MPU_HALFWORD) ? ($x*$x) % $n : _mulmod($x, $x, $n); return 0 if $x == 1; last if $x == $n-1; } return 0 if $x != $n-1; } } } 1; } # Calculate Kronecker symbol (a|b). Cohen Algorithm 1.4.10. # Extension of the Jacobi symbol, itself an extension of the Legendre symbol. sub kronecker { my($a, $b) = @_; return (abs($a) == 1) ? 1 : 0 if $b == 0; my $k = 1; if ($b % 2 == 0) { return 0 if $a % 2 == 0; my $v = 0; do { $v++; $b /= 2; } while $b % 2 == 0; $k = -$k if $v % 2 == 1 && ($a % 8 == 3 || $a % 8 == 5); } if ($b < 0) { $b = -$b; $k = -$k if $a < 0; } if ($a < 0) { $a = -$a; $k = -$k if $b % 4 == 3; } # Now: b > 0, b odd, a >= 0 while ($a != 0) { if ($a % 2 == 0) { my $v = 0; do { $v++; $a /= 2; } while $a % 2 == 0; $k = -$k if $v % 2 == 1 && ($b % 8 == 3 || $b % 8 == 5); } $k = -$k if $a % 4 == 3 && $b % 4 == 3; ($a, $b) = ($b % $a, $a); # If a,b are bigints and now small enough, finish as native. if ( ref($a) eq 'Math::BigInt' && $a <= ''.~0 && ref($b) eq 'Math::BigInt' && $b <= ''.~0) { return $k * kronecker(_bigint_to_int($a),_bigint_to_int($b)); } } return ($b == 1) ? $k : 0; } sub _is_perfect_square { my($n) = @_; if (ref($n) eq 'Math::BigInt') { my $mc = _bigint_to_int($n & 31); if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) { my $sq = $n->copy->bsqrt->bfloor; $sq->bmul($sq); return 1 if $sq == $n; } } else { my $mc = $n & 31; if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) { my $sq = int(sqrt($n)); return 1 if ($sq*$sq) == $n; } } 0; } sub znorder { my($a, $n) = @_; return if $n <= 0; return (undef,1)[$a] if $a <= 1; return 1 if $n == 1; # Sadly, Calc/FastCalc are horrendously slow for this function. return if Math::BigInt::bgcd($a, $n) > 1; # The answer is one of the divisors of phi(n) and lambda(n). my $lambda = Math::Prime::Util::carmichael_lambda($n); $a = Math::BigInt->new("$a") unless ref($a) eq 'Math::BigInt'; # This is easy and usually fast, but can bog down with too many divisors. if ($lambda <= 2**64) { foreach my $k (Math::Prime::Util::divisors($lambda)) { return $k if $a->copy->bmodpow("$k", $n)->is_one; } return; } # Algorithm 1.7 from A. Das applied to Carmichael Lambda. $lambda = Math::BigInt->new("$lambda") unless ref($lambda) eq 'Math::BigInt'; my $k = Math::BigInt->bone; foreach my $f (Math::Prime::Util::factor_exp($lambda)) { my($pi, $ei, $enum) = (Math::BigInt->new("$f->[0]"), $f->[1], 0); my $phidiv = $lambda / ($pi**$ei); my $b = $a->copy->bmodpow($phidiv, $n); while ($b != 1) { return if $enum++ >= $ei; $b = $b->copy->bmodpow($pi, $n); $k *= $pi; } } $k = _bigint_to_int($k) if $k->bacmp(''.~0) <= 0; return $k; } # This is just a stupid brute force search. sub znlog { my ($a,$g,$p) = map { ref($_) eq 'Math::BigInt' ? $_ : Math::BigInt->new("$_") } @_; for (my $k = BONE->copy; $k < $p; $k->binc) { my $t = $g->copy->bmodpow($k, $p); if ($t == $a) { $k = _bigint_to_int($k) if $k->bacmp(''.~0) <= 0; return $k; } } return; } sub znprimroot { my($n) = @_; $n = -$n if $n < 0; if ($n <= 4) { return if $n == 0; return $n-1; } return if $n % 4 == 0; my $a = 1; my $phi = euler_phi($n); # Check that a primitive root exists. return if !is_prob_prime($n) && $phi != Math::Prime::Util::carmichael_lambda($n); my @exp = map { Math::BigInt->new("$_") } map { int($phi/$_->[0]) } Math::Prime::Util::factor_exp($phi); #print "phi: $phi factors: ", join(",",factor($phi)), "\n"; #print " exponents: ", join(",", @exp), "\n"; my $bign = (ref($n) eq 'Math::BigInt') ? $n : Math::BigInt->new("$n"); while (1) { my $fail = 0; do { $a++ } while kronecker($a,$n) == 0; return if $a >= $n; foreach my $f (@exp) { if ( Math::BigInt->new($a)->bmodpow($f, $bign)->is_one ) { $fail = 1; last; } } return $a if !$fail; } } # Find first D in sequence (5,-7,9,-11,13,-15,...) where (D|N) == -1 sub _lucas_selfridge_params { my($n) = @_; # D is typically quite small: 67 max for N < 10^19. However, it is # theoretically possible D could grow unreasonably. I'm giving up at 4000M. my $d = 5; my $sign = 1; while (1) { my $gcd = (ref($n) eq 'Math::BigInt') ? Math::BigInt::bgcd($d, $n) : _gcd_ui($d, $n); return (0,0,0) if $gcd > 1 && $gcd != $n; # Found divisor $d my $j = kronecker($d * $sign, $n); last if $j == -1; $d += 2; croak "Could not find Jacobi sequence for $n" if $d > 4_000_000_000; $sign = -$sign; } my $D = $sign * $d; my $P = 1; my $Q = int( (1 - $D) / 4 ); ($P, $Q, $D) } sub _lucas_extrastrong_params { my($n, $increment) = @_; $increment = 1 unless defined $increment; my ($P, $Q, $D) = (3, 1, 5); while (1) { my $gcd = (ref($n) eq 'Math::BigInt') ? Math::BigInt::bgcd($D, $n) : _gcd_ui($D, $n); return (0,0,0) if $gcd > 1 && $gcd != $n; # Found divisor $d last if kronecker($D, $n) == -1; $P += $increment; croak "Could not find Jacobi sequence for $n" if $P > 65535; $D = $P*$P - 4; } ($P, $Q, $D); } # returns U_k, V_k, Q_k all mod n sub lucas_sequence { my($n, $P, $Q, $k) = @_; croak "lucas_sequence: n must be >= 2" if $n < 2; croak "lucas_sequence: k must be >= 0" if $k < 0; croak "lucas_sequence: P out of range" if $P < 0 || $P >= $n; croak "lucas_sequence: Q out of range" if $Q >= $n; $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my $ZERO = $n->copy->bzero; $P = $ZERO+$P unless ref($P) eq 'Math::BigInt'; $Q = $ZERO+$Q unless ref($Q) eq 'Math::BigInt'; my $D = $P*$P - BTWO*BTWO*$Q; croak "lucas_sequence: D is zero" if $D->is_zero; my $U = BONE->copy; my $V = $P->copy; my $Qk = $Q->copy; return (BZERO->copy, BTWO->copy) if $k == 0; $k = Math::BigInt->new("$k") unless ref($k) eq 'Math::BigInt'; my $kstr = substr($k->as_bin, 2); my $bpos = 0; if ($Q->is_one) { my $Dinverse = $D->copy->bmodinv($n); if ($P > BTWO && !$Dinverse->is_nan) { # Calculate V_k with U=V_{k+1} $U = $P->copy->bmul($P)->bsub(BTWO)->bmod($n); while (++$bpos < length($kstr)) { if (substr($kstr,$bpos,1)) { $V->bmul($U)->bsub($P )->bmod($n); $U->bmul($U)->bsub(BTWO)->bmod($n); } else { $U->bmul($V)->bsub($P )->bmod($n); $V->bmul($V)->bsub(BTWO)->bmod($n); } } # Crandall and Pomerance eq 3.13: U_n = D^-1 (2V_{n+1} - PV_n) $U = $Dinverse * (BTWO*$U - $P*$V); } else { while (++$bpos < length($kstr)) { $U->bmul($V)->bmod($n); $V->bmul($V)->bsub(BTWO)->bmod($n); if (substr($kstr,$bpos,1)) { my $T1 = $U->copy->bmul($D); $U->bmul($P)->badd( $V); $U->badd($n) if $U->is_odd; $U->brsft(BONE); $V->bmul($P)->badd($T1); $V->badd($n) if $V->is_odd; $V->brsft(BONE); } } } } else { my $qsign = ($Q == -1) ? -1 : 0; while (++$bpos < length($kstr)) { $U->bmul($V)->bmod($n); if ($qsign == 1) { $V->bmul($V)->bsub(BTWO)->bmod($n); } elsif ($qsign == -1) { $V->bmul($V)->badd(BTWO)->bmod($n); } else { $V->bmul($V)->bsub($Qk->copy->blsft(BONE))->bmod($n); } if (substr($kstr,$bpos,1)) { my $T1 = $U->copy->bmul($D); $U->bmul($P)->badd( $V); $U->badd($n) if $U->is_odd; $U->brsft(BONE); $V->bmul($P)->badd($T1); $V->badd($n) if $V->is_odd; $V->brsft(BONE); if ($qsign != 0) { $qsign = -1; } else { $Qk->bmul($Qk)->bmul($Q)->bmod($n); } } else { if ($qsign != 0) { $qsign = 1; } else { $Qk->bmul($Qk)->bmod($n); } } } if ($qsign == 1) { $Qk->bneg; } elsif ($qsign == -1) { $Qk = $n->copy->bdec; } } $U->bmod($n); $V->bmod($n); return ($U, $V, $Qk); } sub is_lucas_pseudoprime { my($n) = @_; return 0+($n >= 2) if $n < 4; return 0 if ($n % 2) == 0 || _is_perfect_square($n); my ($P, $Q, $D) = _lucas_selfridge_params($n); return 0 if $D == 0; # We found a divisor in the sequence die "Lucas parameter error: $D, $P, $Q\n" if ($D != $P*$P - 4*$Q); my($U, $V, $Qk) = lucas_sequence($n, $P, $Q, $n+1); return $U->is_zero ? 1 : 0; } sub is_strong_lucas_pseudoprime { my($n) = @_; return 0+($n >= 2) if $n < 4; return 0 if ($n % 2) == 0 || _is_perfect_square($n); my ($P, $Q, $D) = _lucas_selfridge_params($n); return 0 if $D == 0; # We found a divisor in the sequence die "Lucas parameter error: $D, $P, $Q\n" if ($D != $P*$P - 4*$Q); my $m = $n+1; my($s, $k) = (0, $m); while ( $k > 0 && !($k % 2) ) { $s++; $k >>= 1; } my($U, $V, $Qk) = lucas_sequence($n, $P, $Q, $k); return 1 if $U->is_zero; foreach my $r (0 .. $s-1) { return 1 if $V->is_zero; if ($r < ($s-1)) { $V->bmul($V)->bsub(BTWO*$Qk)->bmod($n); $Qk->bmul($Qk)->bmod($n); } } return 0; } sub is_extra_strong_lucas_pseudoprime { my($n) = @_; return 0+($n >= 2) if $n < 4; return 0 if ($n % 2) == 0 || _is_perfect_square($n); my ($P, $Q, $D) = _lucas_extrastrong_params($n); return 0 if $D == 0; # We found a divisor in the sequence die "Lucas parameter error: $D, $P, $Q\n" if ($D != $P*$P - 4*$Q); # We have to convert n to a bigint or Math::BigInt::GMP's stupid set_si bug # (RT 71548) will hit us and make the test $V == $n-2 always return false. $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my($s, $k) = (0, $n->copy->binc); while ($k->is_even && !$k->is_zero) { $s++; $k->brsft(BONE); } my($U, $V, $Qk) = lucas_sequence($n, $P, $Q, $k); return 1 if $U->is_zero && ($V == BTWO || $V == ($n - BTWO)); foreach my $r (0 .. $s-2) { return 1 if $V->is_zero; $V->bmul($V)->bsub(BTWO)->bmod($n); } return 0; } sub is_almost_extra_strong_lucas_pseudoprime { my($n, $increment) = @_; $increment = 1 unless defined $increment; return 0+($n >= 2) if $n < 4; return 0 if ($n % 2) == 0 || _is_perfect_square($n); my ($P, $Q, $D) = _lucas_extrastrong_params($n, $increment); return 0 if $D == 0; # We found a divisor in the sequence die "Lucas parameter error: $D, $P, $Q\n" if ($D != $P*$P - 4*$Q); $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my $ZERO = $n->copy->bzero; my $TWO = $ZERO->copy->binc->binc; my $V = $ZERO + $P; # V_{k} my $W = $ZERO + $P*$P-$TWO; # V_{k+1} my $kstr = substr($n->copy->binc()->as_bin, 2); $kstr =~ s/(0*)$//; my $s = length($1); my $bpos = 0; while (++$bpos < length($kstr)) { if (substr($kstr,$bpos,1)) { $V->bmul($W)->bsub($P )->bmod($n); $W->bmul($W)->bsub($TWO)->bmod($n); } else { $W->bmul($V)->bsub($P )->bmod($n); $V->bmul($V)->bsub($TWO)->bmod($n); } } return 1 if $V == 2 || $V == ($n-$TWO); foreach my $r (0 .. $s-2) { return 1 if $V->is_zero; $V->bmul($V)->bsub($TWO)->bmod($n); } return 0; } sub is_frobenius_underwood_pseudoprime { my($n) = @_; return 0+($n >= 2) if $n < 4; return 0 if ($n % 2) == 0 || _is_perfect_square($n); $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my $ZERO = $n->copy->bzero; my $ONE = $ZERO->copy->binc; my $fa = $ZERO + 1; my $fb = $ZERO + 2; my ($x, $t, $np1, $na) = (0, -1, $n+1, undef); while ( kronecker($t, $n) != -1 ) { $x++; $t = $x*$x - 4; } my $len = length($np1->as_bin) - 2; my $result = $x+$x+5; my $multiplier = $x+2; $result %= $n if $result > $n; $multiplier %= $n if $multiplier > $n; foreach my $bit (reverse 0 .. $len-2) { $na = ($fa * $x) + ($fb + $fb); $t = $fb + $fa; $fb->bsub($fa)->bmul($t)->bmod($n); $fa->bmul($na)->bmod($n); #if ( ($np1 >> $bit) & 1 ) { if ( $np1->copy->brsft($bit)->is_odd ) { $t = $fb->copy; $fb->badd($fb)->bsub($fa); $fa->bmul($multiplier)->badd($t); } } $fa->bmod($n); $fb->bmod($n); return ($fa == 0 && $fb == $result) ? 1 : 0; } my $_poly_bignum; sub _poly_new { my @poly = @_; push @poly, 0 unless scalar @poly; if ($_poly_bignum) { @poly = map { (ref $_ eq 'Math::BigInt') ? $_->copy : Math::BigInt->new("$_"); } @poly; } return \@poly; } #sub _poly_print { # my($poly) = @_; # carp "poly has null top degree" if $#$poly > 0 && !$poly->[-1]; # foreach my $d (reverse 1 .. $#$poly) { # my $coef = $poly->[$d]; # print "", ($coef != 1) ? $coef : "", ($d > 1) ? "x^$d" : "x", " + " # if $coef; # } # my $p0 = $poly->[0] || 0; # print "$p0\n"; #} sub _poly_mod_mul { my($px, $py, $r, $n) = @_; my $px_degree = $#$px; my $py_degree = $#$py; my @res = map { $_poly_bignum ? Math::BigInt->bzero : 0 } 0 .. $r-1; # convolve(px, py) mod (X^r-1,n) my @indices_y = grep { $py->[$_] } (0 .. $py_degree); foreach my $ix (0 .. $px_degree) { my $px_at_ix = $px->[$ix]; next unless $px_at_ix; if ($_poly_bignum) { foreach my $iy (@indices_y) { my $rindex = ($ix + $iy) % $r; # reduce mod X^r-1 $res[$rindex]->badd($px_at_ix->copy->bmul($py->[$iy]))->bmod($n); } } else { foreach my $iy (@indices_y) { my $rindex = ($ix + $iy) % $r; # reduce mod X^r-1 $res[$rindex] = ($res[$rindex] + $px_at_ix * $py->[$iy]) % $n; } } } # In case we had upper terms go to zero after modulo, reduce the degree. pop @res while !$res[-1]; return \@res; } sub _poly_mod_pow { my($pn, $power, $r, $mod) = @_; my $res = _poly_new(1); my $p = $power; while ($p) { $res = _poly_mod_mul($res, $pn, $r, $mod) if ($p & 1); $p >>= 1; $pn = _poly_mod_mul($pn, $pn, $r, $mod) if $p; } return $res; } sub _test_anr { my($a, $n, $r) = @_; my $pp = _poly_mod_pow(_poly_new($a, 1), $n, $r, $n); $pp->[$n % $r] = (($pp->[$n % $r] || 0) - 1) % $n; # subtract X^(n%r) $pp->[ 0] = (($pp->[ 0] || 0) - $a) % $n; # subtract a return 0 if scalar grep { $_ } @$pp; 1; } sub is_aks_prime { my $n = shift; return 0 if $n < 2 || _is_perfect_power($n); my($log2n, $limit); if ($n > 2**48) { do { require Math::BigFloat; Math::BigFloat->import(); } if !defined $Math::BigFloat::VERSION; # limit = floor( log2(n) * log2(n) ). o_r(n) must be larger than this my $floatn = Math::BigFloat->new("$n"); #my $sqrtn = _bigint_to_int($floatn->copy->bsqrt->bfloor); # The following line seems to trigger a memory leak in Math::BigFloat::blog # (the part where $MBI is copied to $int) if $n is a Math::BigInt::GMP. $log2n = $floatn->copy->blog(2); $limit = _bigint_to_int( ($log2n * $log2n)->bfloor ); } else { $log2n = log($n)/log(2) + 0.0001; # Error on large side. $limit = int( $log2n*$log2n + 0.0001 ); } my $r = next_prime($limit); foreach my $f (@{primes(0,$r-1)}) { return 1 if $f == $n; return 0 if !($n % $f); } while ($r < $n) { return 0 if !($n % $r); #return 1 if $r >= $sqrtn; last if znorder($r, $n) > $limit; $r = next_prime($r); } return 1 if $r >= $n; # Since r is a prime, phi(r) = r-1 my $rlimit = (ref($log2n) eq 'Math::BigFloat') ? _bigint_to_int( Math::BigFloat->new("$r")->bdec() ->bsqrt->bmul($log2n)->bfloor) : int( (sqrt(($r-1)) * $log2n) + 0.001 ); $_poly_bignum = 1; if ( $n < (MPU_HALFWORD-1) ) { $_poly_bignum = 0; #$n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt'; } else { $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; } for (my $a = 1; $a <= $rlimit; $a++) { return 0 unless _test_anr($a, $n, $r); } return 1; } sub _basic_factor { # MODIFIES INPUT SCALAR return ($_[0] == 1) ? () : ($_[0]) if $_[0] < 4; my @factors; if (ref($_[0]) ne 'Math::BigInt') { while ( !($_[0] % 2) ) { push @factors, 2; $_[0] = int($_[0] / 2); } while ( !($_[0] % 3) ) { push @factors, 3; $_[0] = int($_[0] / 3); } while ( !($_[0] % 5) ) { push @factors, 5; $_[0] = int($_[0] / 5); } } else { # Without this, the bdivs will try to convert the results to BigFloat # and lose precision. $_[0]->upgrade(undef) if ref($_[0]) && $_[0]->upgrade(); if (!Math::BigInt::bgcd($_[0], B_PRIM235)->is_one) { while ( $_[0]->is_even) { push @factors, 2; $_[0]->brsft(BONE); } foreach my $div (3, 5) { my ($q, $r) = $_[0]->copy->bdiv($div); while ($r->is_zero) { push @factors, $div; $_[0] = $q; ($q, $r) = $_[0]->copy->bdiv($div); } } } $_[0] = _bigint_to_int($_[0]) if $_[0] <= ''.~0; } if ( ($_[0] > 1) && _is_prime7($_[0]) ) { push @factors, $_[0]; $_[0] = 1; } @factors; } sub trial_factor { my($n, $maxlim) = @_; $maxlim = $n unless defined $maxlim; # Don't use _basic_factor here -- they want a trial forced. my @factors; if ($n < 4) { @factors = ($n == 1) ? () : ($n); return @factors; } if (ref($n) ne 'Math::BigInt' || !Math::BigInt::bgcd($n, 30030)->is_one) { while ( !($n % 2) ) { push @factors, 2; $n = int($n / 2); } while ( !($n % 3) ) { push @factors, 3; $n = int($n / 3); } while ( !($n % 5) ) { push @factors, 5; $n = int($n / 5); } while ( !($n % 7) ) { push @factors, 7; $n = int($n / 7); } while ( !($n %11) ) { push @factors,11; $n = int($n /11); } while ( !($n %13) ) { push @factors,13; $n = int($n /13); } } $n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt' && $n <= ''.~0; return @factors if $n < 4; my $limit = int(sqrt($n) + 0.001); $limit = $maxlim if $limit > $maxlim; if (ref($n) eq 'Math::BigInt') { my $f = Math::BigInt->new(17); $limit = Math::BigInt->new("$limit"); my @incs = map { Math::BigInt->new($_) } (2, 4, 6, 2, 6, 4, 2, 4); SEARCH: while ($f <= $limit) { foreach my $finc (@incs) { if ($n->copy->bmod($f)->is_zero && $f->bacmp($limit) <= 0) { my $sf = ($f <= ''.~0) ? _bigint_to_int($f) : $f; do { push @factors, $sf; $n = int($n/$f); } while (($n % $f) == 0); last SEARCH if $n->is_one; $limit = int( sqrt($n) + 0.001); $limit = $maxlim if $limit > $maxlim; $limit = Math::BigInt->new("$limit"); } $f->badd($finc); } } } else { my $f = 17; SEARCH: while ($f <= $limit) { foreach my $finc (2, 4, 6, 2, 6, 4, 2, 4) { if ( (($n % $f) == 0) && ($f <= $limit) ) { do { push @factors, $f; $n = int($n/$f); } while (($n % $f) == 0); last SEARCH if $n == 1; $limit = int( sqrt($n) + 0.001); $limit = $maxlim if $limit > $maxlim; } $f += $finc; } } } push @factors, $n if $n > 1; @factors; } my $_holf_r; my @_fsublist = ( sub { prho_factor (shift, 8*1024, 3) }, sub { pminus1_factor(shift, 10_000); }, sub { pbrent_factor (shift, 32*1024, 1) }, sub { pminus1_factor(shift, 1_000_000); }, sub { pbrent_factor (shift, 512*1024, 7) }, sub { ecm_factor (shift, 1_000, 5_000, 10) }, sub { pminus1_factor(shift, 4_000_000); }, sub { pbrent_factor (shift, 512*1024, 11) }, sub { ecm_factor (shift, 10_000, 50_000, 10) }, sub { holf_factor (shift, 256*1024, $_holf_r); $_holf_r += 256*1024; }, sub { pminus1_factor(shift,20_000_000); }, sub { ecm_factor (shift, 100_000, 800_000, 10) }, sub { holf_factor (shift, 512*1024, $_holf_r); $_holf_r += 512*1024; }, sub { pbrent_factor (shift, 2048*1024, 13) }, sub { holf_factor (shift, 2048*1024, $_holf_r); $_holf_r += 2048*1024; }, sub { ecm_factor (shift, 1_000_000, 1_000_000, 10) }, sub { pminus1_factor(shift, 100_000_000, 500_000_000); }, ); sub factor { my($n) = @_; _validate_positive_integer($n); return trial_factor($n) if $n < 1_000_000; $n = $n->copy if ref($n) eq 'Math::BigInt'; my @factors; # Use 'n=int($n/7)' instead of 'n/=7' to not "upgrade" n to a Math::BigFloat. if (ref($n) eq 'Math::BigInt') { while ($n->is_even) { push @factors, 2; $n->brsft(BONE); } if (!Math::BigInt::bgcd($n, "3234846615")->is_one) { foreach my $div (3, 5, 7, 11, 13, 17, 19, 23, 29) { my ($q, $r) = $n->copy->bdiv($div); while ($r->is_zero) { push @factors, $div; $n = $q; ($q, $r) = $n->copy->bdiv($div); } } } } else { while (($n % 2) == 0) { push @factors, 2; $n = int($n / 2); } while (($n % 3) == 0) { push @factors, 3; $n = int($n / 3); } while (($n % 5) == 0) { push @factors, 5; $n = int($n / 5); } while (($n % 7) == 0) { push @factors, 7; $n = int($n / 7); } while (($n % 11) == 0) { push @factors, 11; $n = int($n / 11); } while (($n % 13) == 0) { push @factors, 13; $n = int($n / 13); } while (($n % 17) == 0) { push @factors, 17; $n = int($n / 17); } while (($n % 19) == 0) { push @factors, 19; $n = int($n / 19); } while (($n % 23) == 0) { push @factors, 23; $n = int($n / 23); } while (($n % 29) == 0) { push @factors, 29; $n = int($n / 29); } } if ($n < (31*31)) { push @factors, $n if $n != 1; return @factors; } my @nstack = ($n); while (@nstack) { $n = pop @nstack; # Don't use bignum on $n if it has gotten small enough. $n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt' && $n <= ''.~0; #print "Looking at $n with stack ", join(",",@nstack), "\n"; while ( ($n >= (31*31)) && !_is_prime7($n) ) { my @ftry; $_holf_r = 1; foreach my $sub (@_fsublist) { last if scalar @ftry >= 2; @ftry = $sub->($n); } if (scalar @ftry > 1) { #print " split into ", join(",",@ftry), "\n"; $n = shift @ftry; $n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt' && $n <= ''.~0; push @nstack, @ftry; } else { #warn "trial factor $n\n"; push @factors, trial_factor($n); #print " trial into ", join(",",@factors), "\n"; $n = 1; last; } } push @factors, $n if $n != 1; } @factors = sort {$a<=>$b} @factors; return @factors; } sub _found_factor { my($f, $n, $what, @factors) = @_; if ($f == 1 || $f == $n) { push @factors, $n; } else { # Perl 5.6.2 needs things spelled out for it. my $f2 = (ref($n) eq 'Math::BigInt') ? $n->copy->bdiv($f)->as_int : int($n/$f); push @factors, $f; push @factors, $f2; croak "internal error in $what" unless $f * $f2 == $n; # MPU::GMP prints this type of message if verbose, so do the same. print "$what found factor $f\n" if Math::Prime::Util::prime_get_config()->{'verbose'} > 0; } @factors; } # TODO: sub squfof_factor { trial_factor(@_) } sub prho_factor { my($n, $rounds, $pa) = @_; $rounds = 4*1024*1024 unless defined $rounds; $pa = 3 unless defined $pa; my @factors = _basic_factor($n); return @factors if $n < 4; my $inloop = 0; my $U = 7; my $V = 7; if ( ref($n) eq 'Math::BigInt' ) { $pa = Math::BigInt->new("$pa"); $U = $n->copy->bzero->badd($U); $V = $n->copy->bzero->badd($V); for my $i (1 .. $rounds) { # Would use bmuladd here, but old Math::BigInt's barf with scalar $pa. $U->bmul($U)->badd($pa)->bmod($n); $V->bmul($V)->badd($pa); $V->bmul($V)->badd($pa)->bmod($n); my $f = Math::BigInt::bgcd($U-$V, $n); if ($f->bacmp($n) == 0) { last if $inloop++; # We've been here before } elsif (!$f->is_one) { return _found_factor($f, $n, "prho", @factors); } } } elsif ($n < MPU_HALFWORD) { for my $i (1 .. $rounds) { $U = ($U * $U + $pa) % $n; $V = ($V * $V + $pa) % $n; $V = ($V * $V + $pa) % $n; my $f = _gcd_ui( $U-$V, $n ); if ($f == $n) { last if $inloop++; # We've been here before } elsif ($f != 1) { return _found_factor($f, $n, "prho", @factors); } } } else { for my $i (1 .. $rounds) { if ($n <= (~0 >> 1)) { $U = _mulmod($U, $U, $n); $U += $pa; $U -= $n if $U >= $n; $V = _mulmod($V, $V, $n); $V += $pa; # Let the mulmod handle it $V = _mulmod($V, $V, $n); $V += $pa; $V -= $n if $V >= $n; } else { $U = _mulmod($U, $U, $n); $U=$n-$U; $U = ($pa>=$U) ? $pa-$U : $n-$U+$pa; $V = _mulmod($V, $V, $n); $V=$n-$V; $V = ($pa>=$V) ? $pa-$V : $n-$V+$pa; $V = _mulmod($V, $V, $n); $V=$n-$V; $V = ($pa>=$V) ? $pa-$V : $n-$V+$pa; } my $f = _gcd_ui( $U-$V, $n ); if ($f == $n) { last if $inloop++; # We've been here before } elsif ($f != 1) { return _found_factor($f, $n, "prho", @factors); } } } push @factors, $n; @factors; } sub pbrent_factor { my($n, $rounds, $pa) = @_; $rounds = 4*1024*1024 unless defined $rounds; $pa = 3 unless defined $pa; my @factors = _basic_factor($n); return @factors if $n < 4; my $Xi = 2; my $Xm = 2; if ( ref($n) eq 'Math::BigInt' ) { # Same code as the GMP version, but runs *much* slower. Even with # Math::BigInt::GMP it's >200x slower. With the default Calc backend # it's thousands of times slower. my $inner = 256; my $zero = $n->copy->bzero; my $saveXi; my $f; $Xi = $zero->copy->badd($Xi); $Xm = $zero->copy->badd($Xm); my $r = 1; while ($rounds > 0) { my $rleft = ($r > $rounds) ? $rounds : $r; while ($rleft > 0) { my $dorounds = ($rleft > $inner) ? $inner : $rleft; my $m = $zero->copy->bone; $saveXi = $Xi->copy; foreach my $i (1 .. $dorounds) { $Xi->bmul($Xi)->badd($pa)->bmod($n); $m->bmul($Xi - $Xm); } $rleft -= $dorounds; $rounds -= $dorounds; $m->bmod($n); $f = Math::BigInt::bgcd( $m, $n); last if $f != 1; } if ($f == 1) { $r *= 2; $Xm = $Xi->copy; next; } if ($f == $n) { # back up to determine the factor $Xi = $saveXi->copy; do { $Xi->bmul($Xi)->badd($pa)->bmod($n); $f = Math::BigInt::bgcd($Xm-$Xi, $n); } while ($f != 1 && $r-- != 0); last if $f == 1 || $f == $n; } return _found_factor($f, $n, "pbrent", @factors); } } elsif ($n < MPU_HALFWORD) { for my $i (1 .. $rounds) { $Xi = ($Xi * $Xi + $pa) % $n; my $f = _gcd_ui($Xm-$Xi, $n); return _found_factor($f, $n, "pbrent", @factors) if $f != 1 && $f != $n; $Xm = $Xi if ($i & ($i-1)) == 0; # i is a power of 2 } } else { for my $i (1 .. $rounds) { # Xi^2+a % n $Xi = _mulmod($Xi, $Xi, $n); $Xi = (($n-$Xi) > $pa) ? $Xi+$pa : $Xi+$pa-$n; my $f = _gcd_ui($Xm-$Xi, $n); return _found_factor($f, $n, "pbrent", @factors) if $f != 1 && $f != $n; $Xm = $Xi if ($i & ($i-1)) == 0; # i is a power of 2 } } push @factors, $n; @factors; } sub pminus1_factor { my($n, $B1, $B2) = @_; my @factors = _basic_factor($n); return @factors if $n < 4; if ( ref($n) ne 'Math::BigInt' ) { # Stage 1 only $B1 = 10_000_000 unless defined $B1; my $pa = 2; my $f = 1; my($pc_beg, $pc_end, @bprimes); $pc_beg = 2; $pc_end = $pc_beg + 100_000; my $sqrtb1 = int(sqrt($B1)); while (1) { $pc_end = $B1 if $pc_end > $B1; @bprimes = @{ primes($pc_beg, $pc_end) }; foreach my $q (@bprimes) { my $k = $q; if ($q <= $sqrtb1) { my $kmin = int($B1 / $q); while ($k <= $kmin) { $k *= $q; } } $pa = _powmod($pa, $k, $n); if ($pa == 0) { push @factors, $n; return @factors; } my $f = _gcd_ui( $pa-1, $n ); return _found_factor($f, $n, "pminus1", @factors) if $f != 1; } last if $pc_end >= $B1; $pc_beg = $pc_end+1; $pc_end += 500_000; } push @factors, $n; return @factors; } # Stage 2 isn't really any faster than stage 1 for the examples I've tried. # Perl's overhead is greater than the savings of multiply vs. powmod if (!defined $B1) { for my $mul (1, 100, 1000, 10_000, 100_000, 1_000_000) { $B1 = 1000 * $mul; $B2 = 1*$B1; #warn "Trying p-1 with $B1 / $B2\n"; my @nf = pminus1_factor($n, $B1, $B2); if (scalar @nf > 1) { push @factors, @nf; return @factors; } } push @factors, $n; return @factors; } $B2 = 1*$B1 unless defined $B2; my $one = $n->copy->bone; my ($j, $q, $saveq) = (32, 2, 2); my $t = $one->copy; my $pa = $one->copy->binc(); my $savea = $pa->copy; my $f = $one->copy; my($pc_beg, $pc_end, @bprimes); $pc_beg = 2; $pc_end = $pc_beg + 100_000; while (1) { $pc_end = $B1 if $pc_end > $B1; @bprimes = @{ primes($pc_beg, $pc_end) }; foreach my $q (@bprimes) { my($k, $kmin) = ($q, int($B1 / $q)); while ($k <= $kmin) { $k *= $q; } $t *= $k; # accumulate powers for a if ( ($j++ % 64) == 0) { next if $pc_beg > 2 && ($j-1) % 256; $pa->bmodpow($t, $n); $t = $one->copy; if ($pa == 0) { push @factors, $n; return @factors; } $f = Math::BigInt::bgcd( $pa-1, $n ); last if $f == $n; return _found_factor($f, $n, "pminus1", @factors) unless $f->is_one; $saveq = $q; $savea = $pa->copy; } } $q = $bprimes[-1]; last if !$f->is_one || $pc_end >= $B1; $pc_beg = $pc_end+1; $pc_end += 500_000; } undef @bprimes; $pa->bmodpow($t, $n); if ($pa == 0) { push @factors, $n; return @factors; } $f = Math::BigInt::bgcd( $pa-1, $n ); if ($f == $n) { $q = $saveq; $pa = $savea->copy; while ($q <= $B1) { my ($k, $kmin) = ($q, int($B1 / $q)); while ($k <= $kmin) { $k *= $q; } $pa->bmodpow($k, $n); my $f = Math::BigInt::bgcd( $pa-1, $n ); if ($f == $n) { push @factors, $n; return @factors; } last if !$f->is_one; $q = next_prime($q); } } # STAGE 2 if ($f->is_one && $B2 > $B1) { my $bm = $pa->copy; my $b = $one->copy; my @precomp_bm; $precomp_bm[0] = ($bm * $bm) % $n; foreach my $j (1..19) { $precomp_bm[$j] = ($precomp_bm[$j-1] * $bm * $bm) % $n; } $pa->bmodpow($q, $n); my $j = 1; $pc_beg = $q+1; $pc_end = $pc_beg + 100_000; while (1) { $pc_end = $B2 if $pc_end > $B2; @bprimes = @{ primes($pc_beg, $pc_end) }; foreach my $i (0 .. $#bprimes) { my $diff = $bprimes[$i] - $q; $q = $bprimes[$i]; my $qdiff = ($diff >> 1) - 1; if (!defined $precomp_bm[$qdiff]) { $precomp_bm[$qdiff] = $bm->copy->bmodpow($diff, $n); } $pa->bmul($precomp_bm[$qdiff])->bmod($n); if ($pa == 0) { push @factors, $n; return @factors; } $b->bmul($pa-1); if (($j++ % 128) == 0) { $b->bmod($n); $f = Math::BigInt::bgcd( $b, $n ); last if !$f->is_one; } } last if !$f->is_one || $pc_end >= $B2; $pc_beg = $pc_end+1; $pc_end += 500_000; } $f = Math::BigInt::bgcd( $b, $n ); } return _found_factor($f, $n, "pminus1", @factors); } sub holf_factor { my($n, $rounds, $startrounds) = @_; $rounds = 64*1024*1024 unless defined $rounds; $startrounds = 1 unless defined $startrounds; $startrounds = 1 if $startrounds < 1; my @factors = _basic_factor($n); return @factors if $n < 4; if ( ref($n) eq 'Math::BigInt' ) { for my $i ($startrounds .. $rounds) { my $ni = $n->copy->bmul($i); my $s = $ni->copy->bsqrt->bfloor->as_int; if ($s * $s == $ni) { # s^2 = n*i, so m = s^2 mod n = 0. Hence f = GCD(n, s) = GCD(n, n*i) my $f = Math::BigInt::bgcd($ni, $n); return _found_factor($f, $n, "HOLF", @factors); } $s->binc; my $m = ($s * $s) - $ni; # Check for perfect square my $mc = _bigint_to_int($m & 31); next unless $mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25; my $f = $m->copy->bsqrt->bfloor->as_int; next unless ($f*$f) == $m; $f = Math::BigInt::bgcd( ($s > $f) ? $s-$f : $f-$s, $n); return _found_factor($f, $n, "HOLF ($i rounds)", @factors); } } else { for my $i ($startrounds .. $rounds) { my $s = int(sqrt($n * $i)); $s++ if ($s * $s) != ($n * $i); my $m = ($s < MPU_HALFWORD) ? ($s*$s) % $n : _mulmod($s, $s, $n); # Check for perfect square my $mc = $m & 31; next unless $mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25; my $f = int(sqrt($m)); next unless $f*$f == $m; $f = _gcd_ui($s - $f, $n); return _found_factor($f, $n, "HOLF ($i rounds)", @factors); } } push @factors, $n; @factors; } sub fermat_factor { my($n, $rounds) = @_; $rounds = 64*1024*1024 unless defined $rounds; my @factors = _basic_factor($n); return @factors if $n < 4; if ( ref($n) eq 'Math::BigInt' ) { my $pa = $n->copy->bsqrt->bfloor->as_int; return _found_factor($pa, $n, "Fermat", @factors) if $pa*$pa == $n; $pa++; my $b2 = $pa*$pa - $n; my $lasta = $pa + $rounds; while ($pa <= $lasta) { my $mc = _bigint_to_int($b2 & 31); if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) { my $s = $b2->copy->bsqrt->bfloor->as_int; if ($s*$s == $b2) { my $i = $pa-($lasta-$rounds)+1; return _found_factor($pa - $s, $n, "Fermat ($i rounds)", @factors); } } $pa++; $b2 = $pa*$pa-$n; } } else { my $pa = int(sqrt($n)); return _found_factor($pa, $n, "Fermat", @factors) if $pa*$pa == $n; $pa++; my $b2 = $pa*$pa - $n; my $lasta = $pa + $rounds; while ($pa <= $lasta) { my $mc = $b2 & 31; if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) { my $s = int(sqrt($b2)); if ($s*$s == $b2) { my $i = $pa-($lasta-$rounds)+1; return _found_factor($pa - $s, $n, "Fermat ($i rounds)", @factors); } } $pa++; $b2 = $pa*$pa-$n; } } push @factors, $n; @factors; } sub ecm_factor { my($n, $B1, $B2, $ncurves) = @_; my @factors = _basic_factor($n); return @factors if $n < 4; $ncurves = 10 unless defined $ncurves; if (!defined $B1) { for my $mul (1, 10, 100, 1000, 10_000, 100_000, 1_000_000) { $B1 = 100 * $mul; $B2 = 10*$B1; #warn "Trying ecm with $B1 / $B2\n"; my @nf = ecm_factor($n, $B1, $B2, $ncurves); if (scalar @nf > 1) { push @factors, @nf; return @factors; } } push @factors, $n; return @factors; } $B2 = 10*$B1 unless defined $B2; my $sqrt_b1 = int(sqrt($B1)+1); # Affine code. About 3x slower than the projective, and no stage 2. # #if (!defined $Math::Prime::Util::ECAffinePoint::VERSION) { # eval { require Math::Prime::Util::ECAffinePoint; 1; } # or do { croak "Cannot load Math::Prime::Util::ECAffinePoint"; }; #} #my @bprimes = @{ primes(2, $B1) }; #my $irandf = Math::Prime::Util::_get_rand_func(); #foreach my $curve (1 .. $ncurves) { # my $a = $irandf->($n-1); # my $b = 1; # my $ECP = Math::Prime::Util::ECAffinePoint->new($a, $b, $n, 0, 1); # foreach my $q (@bprimes) { # my $k = $q; # if ($k < $sqrt_b1) { # my $kmin = int($B1 / $q); # while ($k <= $kmin) { $k *= $q; } # } # $ECP->mul($k); # my $f = $ECP->f; # if ($f != 1) { # last if $f == $n; # warn "ECM found factors with B1 = $B1 in curve $curve\n"; # return _found_factor($f, $n, "ECM B1=$B1 curve $curve", @factors); # } # last if $ECP->is_infinity; # } #} require Math::Prime::Util::ECProjectivePoint; require Math::Prime::Util::RandomPrimes; # With multiple curves, it's better to get all the primes at once. # The downside is this can kill memory with a very large B1. my @bprimes = @{ primes(3, $B1) }; foreach my $q (@bprimes) { last if $q > $sqrt_b1; my($k,$kmin) = ($q, int($B1/$q)); while ($k <= $kmin) { $k *= $q; } $q = $k; } my @b2primes = ($B2 > $B1) ? @{primes($B1+1, $B2)} : (); my $irandf = Math::Prime::Util::RandomPrimes::get_randf(); foreach my $curve (1 .. $ncurves) { my $sigma = $irandf->($n-1-6) + 6; my ($u, $v) = ( ($sigma*$sigma - 5) % $n, (4 * $sigma) % $n ); my ($x, $z) = ( ($u*$u*$u) % $n, ($v*$v*$v) % $n ); my $cb = (4 * $x * $v) % $n; my $ca = ( (($v-$u)**3) * (3*$u + $v) ) % $n; my $f = Math::BigInt::bgcd( $cb, $n ); $f = Math::BigInt::bgcd( $z, $n ) if $f == 1; next if $f == $n; return _found_factor($f,$n, "ECM B1=$B1 curve $curve", @factors) if $f != 1; $cb = Math::BigInt->new("$cb") unless ref($cb) eq 'Math::BigInt'; $u = $cb->copy->bmodinv($n); $ca = (($ca*$u) - 2) % $n; my $ECP = Math::Prime::Util::ECProjectivePoint->new($ca, $n, $x, $z); my $fm = $n-$n+1; my $i = 15; for (my $q = 2; $q < $B1; $q *= 2) { $ECP->double(); } foreach my $k (@bprimes) { $ECP->mul($k); $fm = ($fm * $ECP->x() ) % $n; if ($i++ % 32 == 0) { $f = Math::BigInt::bgcd($fm, $n); last if $f != 1; } } $f = Math::BigInt::bgcd($fm, $n); next if $f == $n; if ($f == 1 && $B2 > $B1) { # BEGIN STAGE 2 my $D = int(sqrt($B2/2)); $D++ if $D % 2; my $one = $n - $n + 1; my $g = $one; my $S2P = $ECP->copy->normalize; $f = $S2P->f; if ($f != 1) { next if $f == $n; #warn "ECM S2 normalize f=$f\n" if $f != 1; return _found_factor($f, $n, "ECM S2 B1=$B1 curve $curve"); } my $S2x = $S2P->x; my $S2d = $S2P->d; my @nqx = ($n-$n, $S2x); foreach my $i (2 .. 2*$D) { my($x2, $z2); if ($i % 2) { ($x2, $z2) = Math::Prime::Util::ECProjectivePoint::_addx($nqx[($i-1)/2], $nqx[($i+1)/2], $S2x, $n); } else { ($x2, $z2) = Math::Prime::Util::ECProjectivePoint::_double($nqx[$i/2], $one, $n, $S2d); } $nqx[$i] = $x2; #($f, $u, undef) = _extended_gcd($z2, $n); $f = Math::BigInt::bgcd( $z2, $n ); last if $f != 1; $u = $z2->copy->bmodinv($n); $nqx[$i] = ($x2 * $u) % $n; } if ($f != 1) { next if $f == $n; #warn "ECM S2 1: B1 $B1 B2 $B2 curve $curve f=$f\n"; return _found_factor($f, $n, "ECM S2 B1=$B1 curve $curve", @factors); } $x = $nqx[2*$D-1]; my $m = 1; while ($m < ($B2+$D)) { if ($m != 1) { my $oldx = $S2x; my ($x1, $z1) = Math::Prime::Util::ECProjectivePoint::_addx($nqx[2*$D], $S2x, $x, $n); $f = Math::BigInt::bgcd( $z1, $n ); last if $f != 1; $u = $z1->copy->bmodinv($n); $S2x = ($x1 * $u) % $n; $x = $oldx; last if $f != 1; } if ($m+$D > $B1) { my @p = grep { $_ >= $m-$D && $_ <= $m+$D } @b2primes; foreach my $i (@p) { last if $i >= $m; $g = ($g * ($S2x - $nqx[$m+$D-$i])) % $n; } foreach my $i (@p) { next unless $i > $m; next if $i > ($m+$m) || is_prime($m+$m-$i); $g = ($g * ($S2x - $nqx[$i-$m])) % $n; } $f = Math::BigInt::bgcd($g, $n); #warn "ECM S2 3: found $f in stage 2\n" if $f != 1; last if $f != 1; } $m += 2*$D; } } # END STAGE 2 next if $f == $n; if ($f != 1) { #warn "ECM found factors with B1 = $B1 in curve $curve\n"; return _found_factor($f, $n, "ECM B1=$B1 curve $curve", @factors); } # end of curve loop } push @factors, $n; @factors; } sub divisors { my($n) = @_; _validate_positive_integer($n); # In scalar context, returns sigma_0(n). Very fast. return Math::Prime::Util::divisor_sum($n,0) unless wantarray; return ($n == 0) ? (0,1) : (1) if $n <= 1; my %all_factors; my @factors = Math::Prime::Util::factor($n); return (1,$n) if scalar @factors == 1; if (ref($n) eq 'Math::BigInt') { foreach my $f1 (@factors) { my $big_f1 = Math::BigInt->new("$f1"); my @to_add = map { ($_ <= ''.~0) ? _bigint_to_int($_) : $_ } grep { $_ < $n } map { $big_f1 * $_ } keys %all_factors; undef @all_factors{ $f1, @to_add }; } } else { foreach my $f1 (@factors) { my @to_add = grep { $_ < $n } map { $f1 * $_ } keys %all_factors; undef @all_factors{ $f1, @to_add }; } } # Add 1 and n undef $all_factors{1}; undef $all_factors{$n}; my @divisors = sort {$a<=>$b} keys %all_factors; return @divisors; } sub chebyshev_theta { my($n) = @_; my $sum = 0.0; for (my $p = 2; $p <= $n; $p = next_prime($p)) { $sum += log($p); } return $sum; } sub chebyshev_psi { my($n) = @_; return 0 if $n <= 1; my ($sum, $p, $logn, $sqrtn) = (0.0, 2, log($n), int(sqrt($n))); for ( ; $p <= $sqrtn; $p = next_prime($p)) { my $logp = log($p); $sum += $logp * int($logn/$logp+1e-15); } for ( ; $p <= $n; $p = next_prime($p)) { $sum += log($p); } return $sum; } sub ExponentialIntegral { my($x) = @_; return - MPU_INFINITY if $x == 0; return 0 if $x == - MPU_INFINITY; return MPU_INFINITY if $x == MPU_INFINITY; # Gotcha -- MPFR decided to make negative inputs return NaN. Grrr. if ($x > 0 && _MPFR_available()) { my $wantbf = 0; my $xdigits = 17; if (defined $bignum::VERSION || ref($x) =~ /^Math::Big/) { do { require Math::BigFloat; Math::BigFloat->import(); } if !defined $Math::BigFloat::VERSION; $x = Math::BigFloat->new("$x") if ref($x) ne 'Math::BigFloat'; $wantbf = _find_big_acc($x); $xdigits = $wantbf; } my $rnd = 0; # MPFR_RNDN; my $bit_precision = int($xdigits * 3.322) + 4; my $rx = Math::MPFR->new(); Math::MPFR::Rmpfr_set_prec($rx, $bit_precision); Math::MPFR::Rmpfr_set_str($rx, "$x", 10, $rnd); my $eix = Math::MPFR->new(); Math::MPFR::Rmpfr_set_prec($eix, $bit_precision); Math::MPFR::Rmpfr_eint($eix, $rx, $rnd); my $strval = Math::MPFR::Rmpfr_get_str($eix, 10, 0, $rnd); return ($wantbf) ? Math::BigFloat->new($strval,$wantbf) : 0.0 + $strval; } $x = Math::BigFloat->new("$x") if defined $bignum::VERSION && ref($x) ne 'Math::BigFloat'; my $tol = 1e-16; my $sum = 0.0; my($y, $t); my $c = 0.0; my $val; # The result from one of the four methods if ($x < -1) { # Continued fraction my $lc = 0; my $ld = 1 / (1 - $x); $val = $ld * (-exp($x)); for my $n (1 .. 100000) { $lc = 1 / (2*$n + 1 - $x - $n*$n*$lc); $ld = 1 / (2*$n + 1 - $x - $n*$n*$ld); my $old = $val; $val *= $ld/$lc; last if abs($val - $old) <= ($tol * abs($val)); } } elsif ($x < 0) { # Rational Chebyshev approximation my @C6p = ( -148151.02102575750838086, 150260.59476436982420737, 89904.972007457256553251, 15924.175980637303639884, 2150.0672908092918123209, 116.69552669734461083368, 5.0196785185439843791020); my @C6q = ( 256664.93484897117319268, 184340.70063353677359298, 52440.529172056355429883, 8125.8035174768735759866, 750.43163907103936624165, 40.205465640027706061433, 1.0000000000000000000000); my $sumn = $C6p[0]-$x*($C6p[1]-$x*($C6p[2]-$x*($C6p[3]-$x*($C6p[4]-$x*($C6p[5]-$x*$C6p[6]))))); my $sumd = $C6q[0]-$x*($C6q[1]-$x*($C6q[2]-$x*($C6q[3]-$x*($C6q[4]-$x*($C6q[5]-$x*$C6q[6]))))); $val = log(-$x) - ($sumn / $sumd); } elsif ($x < -log($tol)) { # Convergent series my $fact_n = 1; $y = CONST_EULER-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; $y = log($x)-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; for my $n (1 .. 200) { $fact_n *= $x/$n; my $term = $fact_n / $n; $y = $term-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; last if $term < $tol; } $val = $sum; } else { # Asymptotic divergent series my $invx = 1.0 / $x; my $term = $invx; $sum = 1.0 + $term; for my $n (2 .. 200) { my $last_term = $term; $term *= $n * $invx; last if $term < $tol; if ($term < $last_term) { $y = $term-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; } else { $y = (-$last_term/3)-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; last; } } $val = exp($x) * $invx * $sum; } $val; } sub LogarithmicIntegral { my($x) = @_; return 0 if $x == 0; return - MPU_INFINITY if $x == 1; return MPU_INFINITY if $x == MPU_INFINITY; croak "Invalid input to LogarithmicIntegral: x must be > 0" if $x <= 0; # Remember MPFR eint doesn't handle negative inputs if ($x >= 1 && _MPFR_available()) { my $wantbf = 0; my $xdigits = 18; if (defined $bignum::VERSION || ref($x) =~ /^Math::Big/) { $wantbf = _find_big_acc($x); $xdigits = $wantbf; } $xdigits += length(int(log(0.0+"$x"))) + 1; my $rnd = 0; # MPFR_RNDN; my $bit_precision = int($xdigits * 3.322) + 4; my $rx = Math::MPFR->new(); Math::MPFR::Rmpfr_set_prec($rx, $bit_precision); Math::MPFR::Rmpfr_set_str($rx, "$x", 10, $rnd); Math::MPFR::Rmpfr_log($rx, $rx, $rnd); my $lix = Math::MPFR->new(); Math::MPFR::Rmpfr_set_prec($lix, $bit_precision); Math::MPFR::Rmpfr_eint($lix, $rx, $rnd); my $strval = Math::MPFR::Rmpfr_get_str($lix, 10, 0, $rnd); return ($wantbf) ? Math::BigFloat->new($strval,$wantbf) : 0.0 + $strval; } if ($x == 2) { my $li2const = (ref($x) eq 'Math::BigFloat') ? Math::BigFloat->new(CONST_LI2) : 0.0+CONST_LI2; return $li2const; } $x = Math::BigFloat->new("$x") if defined $bignum::VERSION && ref($x) ne 'Math::BigFloat'; # Do divergent series here for big inputs. Common for big pc approximations. # Why is this here? # 1) exp(log(x)) results in a lot of lost precision # 2) exp(x) with lots of precision turns out to be really slow, and in # this case it was unnecessary. my $tol = 1e-16; my $xdigits = 0; my $finalacc = 0; if (ref($x) =~ /^Math::Big/) { $xdigits = _find_big_acc($x); my $xlen = length($x->bfloor->bstr()); $xdigits = $xlen if $xdigits < $xlen; $finalacc = $xdigits; $xdigits += length(int(log(0.0+"$x"))) + 1; $tol = Math::BigFloat->new(10)->bpow(-$xdigits); $x->accuracy($xdigits); } my $logx = $xdigits ? $x->copy->blog(undef,$xdigits) : log($x); if ($x > 1e16) { my $invx = 1.0 / $logx; # n = 0 => 0!/(logx)^0 = 1/1 = 1 # n = 1 => 1!/(logx)^1 = 1/logx my $term = $invx; my $sum = 1.0 + $term; for my $n (2 .. 200) { my $last_term = $term; $term *= $n * $invx; last if $term < $tol; if ($term < $last_term) { $sum += $term; } else { $sum -= ($last_term/3); last; } $term->bround($xdigits) if $xdigits; } my $val = $x * $invx * $sum; $val->accuracy($finalacc) if $xdigits; return $val; } # Convergent series. if ($x >= 1) { my $fact_n = 1.0; my $nfac = 1.0; my $sum = 0.0; for my $n (1 .. 200) { $fact_n *= $logx/$n; my $term = $fact_n / $n; $sum += $term; last if $term < $tol; $term->bround($xdigits) if $xdigits; } my $eulerconst = (ref($x) eq 'Math::BigFloat') ? Math::BigFloat->new(CONST_EULER) : 0.0+CONST_EULER; my $val = $eulerconst + log($logx) + $sum; $val->accuracy($finalacc) if $xdigits; return $val; } ExponentialIntegral($logx); } # Riemann Zeta function for native integers. my @_Riemann_Zeta_Table = ( 0.6449340668482264364724151666460251892, # zeta(2) - 1 0.2020569031595942853997381615114499908, 0.0823232337111381915160036965411679028, 0.0369277551433699263313654864570341681, 0.0173430619844491397145179297909205279, 0.0083492773819228268397975498497967596, 0.0040773561979443393786852385086524653, 0.0020083928260822144178527692324120605, 0.0009945751278180853371459589003190170, 0.0004941886041194645587022825264699365, 0.0002460865533080482986379980477396710, 0.0001227133475784891467518365263573957, 0.0000612481350587048292585451051353337, 0.0000305882363070204935517285106450626, 0.0000152822594086518717325714876367220, 0.0000076371976378997622736002935630292, 0.0000038172932649998398564616446219397, 0.0000019082127165539389256569577951013, 0.0000009539620338727961131520386834493, 0.0000004769329867878064631167196043730, 0.0000002384505027277329900036481867530, 0.0000001192199259653110730677887188823, 0.0000000596081890512594796124402079358, 0.0000000298035035146522801860637050694, 0.0000000149015548283650412346585066307, 0.0000000074507117898354294919810041706, 0.0000000037253340247884570548192040184, 0.0000000018626597235130490064039099454, 0.0000000009313274324196681828717647350, 0.0000000004656629065033784072989233251, 0.0000000002328311833676505492001455976, 0.0000000001164155017270051977592973835, 0.0000000000582077208790270088924368599, 0.0000000000291038504449709968692942523, 0.0000000000145519218910419842359296322, 0.0000000000072759598350574810145208690, 0.0000000000036379795473786511902372363, 0.0000000000018189896503070659475848321, 0.0000000000009094947840263889282533118, ); sub RiemannZeta { my($x) = @_; # Use MPFR if possible. if (_MPFR_available()) { my $wantbf = 0; my $xdigits = 17; if (defined $bignum::VERSION || ref($x) =~ /^Math::Big/) { do { require Math::BigFloat; Math::BigFloat->import(); } if !defined $Math::BigFloat::VERSION; if (ref($x) eq 'Math::BigInt') { my $xacc = $x->accuracy(); $x = Math::BigFloat->new($x); $x->accuracy($xacc) if $xacc; } $x = Math::BigFloat->new("$x") if ref($x) ne 'Math::BigFloat'; $wantbf = _find_big_acc($x); $xdigits = $wantbf; } my $rnd = 0; # MPFR_RNDN; my $bit_precision = int($xdigits * 3.322) + 7; my $rx = Math::MPFR->new(); Math::MPFR::Rmpfr_set_prec($rx, $bit_precision); Math::MPFR::Rmpfr_set_str($rx, "$x", 10, $rnd); my $zetax = Math::MPFR->new(); # Add more bits to account for the leading zeros. my $extra_bits = int(abs($x)); Math::MPFR::Rmpfr_set_prec($zetax, $bit_precision + $extra_bits); Math::MPFR::Rmpfr_zeta($zetax, $rx, $rnd); Math::MPFR::Rmpfr_sub_ui($zetax, $zetax, 1, $rnd); my $strval = Math::MPFR::Rmpfr_get_str($zetax, 10, $xdigits, $rnd); return ($wantbf) ? Math::BigFloat->new($strval,$wantbf) : 0.0 + $strval; } if (defined $bignum::VERSION || ref($x) =~ /^Math::Big/) { # No MPFR, BigFloat require Math::Prime::Util::ZetaBigFloat; return Math::Prime::Util::ZetaBigFloat::RiemannZeta($x); } # No MPFR, no BigFloat. return 0.0 + $_Riemann_Zeta_Table[int($x)-2] if $x == int($x) && defined $_Riemann_Zeta_Table[int($x)-2]; my $tol = 1.11e-16; # Series based on (2n)! / B_2n. # This is a simplification of the Cephes zeta function. my @A = ( 12.0, -720.0, 30240.0, -1209600.0, 47900160.0, -1892437580.3183791606367583212735166426, 74724249600.0, -2950130727918.1642244954382084600497650, 116467828143500.67248729113000661089202, -4597978722407472.6105457273596737891657, 181521054019435467.73425331153534235290, -7166165256175667011.3346447367083352776, 282908877253042996618.18640556532523927, ); my $s = 0.0; my $rb = 0.0; foreach my $i (2 .. 10) { $rb = $i ** -$x; $s += $rb; return $s if abs($rb/$s) < $tol; } my $w = 10.0; $s = $s + $rb*$w/($x-1.0) - 0.5*$rb; my $ra = 1.0; foreach my $i (0 .. 12) { my $k = 2*$i; $ra *= $x + $k; $rb /= $w; my $t = $ra*$rb/$A[$i]; $s += $t; $t = abs($t/$s); last if $t < $tol; $ra *= $x + $k + 1.0; $rb /= $w; } return $s; } # Riemann R function sub RiemannR { my($x) = @_; croak "Invalid input to ReimannR: x must be > 0" if $x <= 0; # Use MPFR if possible. if (_MPFR_available()) { my $wantbf = 0; my $xdigits = 17; if (defined $bignum::VERSION || ref($x) =~ /^Math::Big/) { do { require Math::BigFloat; Math::BigFloat->import(); } if !defined $Math::BigFloat::VERSION; if (ref($x) eq 'Math::BigInt') { my $xacc = $x->accuracy(); $x = Math::BigFloat->new($x); $x->accuracy($xacc) if $xacc; } $x = Math::BigFloat->new("$x") if ref($x) ne 'Math::BigFloat'; $wantbf = _find_big_acc($x); $xdigits = $wantbf; } my $rnd = 0; # MPFR_RNDN; my $bit_precision = int($xdigits * 3.322) + 8; # Add some extra my $rlogx = Math::MPFR->new(); Math::MPFR::Rmpfr_set_prec($rlogx, $bit_precision); Math::MPFR::Rmpfr_set_str($rlogx, "$x", 10, $rnd); Math::MPFR::Rmpfr_log($rlogx, $rlogx, $rnd); my $rpart_term = Math::MPFR->new(); Math::MPFR::Rmpfr_set_prec($rpart_term, $bit_precision); Math::MPFR::Rmpfr_set_str($rpart_term, "1", 10, $rnd); my $rzeta = Math::MPFR->new(); Math::MPFR::Rmpfr_set_prec($rzeta, $bit_precision); my $rterm = Math::MPFR->new(); Math::MPFR::Rmpfr_set_prec($rterm, $bit_precision); my $rsum = Math::MPFR->new(); Math::MPFR::Rmpfr_set_prec($rsum, $bit_precision); Math::MPFR::Rmpfr_set_str($rsum, "1", 10, $rnd); my $rstop = Math::MPFR->new(); Math::MPFR::Rmpfr_set_prec($rstop, $bit_precision); Math::MPFR::Rmpfr_set_str($rstop, "1e-$xdigits", 10, $rnd); for my $k (1 .. 10000) { Math::MPFR::Rmpfr_mul($rpart_term, $rpart_term, $rlogx, $rnd); Math::MPFR::Rmpfr_div_ui($rpart_term, $rpart_term, $k, $rnd); Math::MPFR::Rmpfr_zeta_ui($rzeta, $k+1, $rnd); Math::MPFR::Rmpfr_sub_ui($rzeta, $rzeta, 1, $rnd); Math::MPFR::Rmpfr_mul_ui($rzeta, $rzeta, $k, $rnd); Math::MPFR::Rmpfr_add_ui($rzeta, $rzeta, $k, $rnd); Math::MPFR::Rmpfr_div($rterm, $rpart_term, $rzeta, $rnd); last if Math::MPFR::Rmpfr_less_p($rterm, $rstop); Math::MPFR::Rmpfr_add($rsum, $rsum, $rterm, $rnd); } my $strval = Math::MPFR::Rmpfr_get_str($rsum, 10, $xdigits, $rnd); return ($wantbf) ? Math::BigFloat->new($strval,$wantbf) : 0.0 + $strval; } if (defined $bignum::VERSION || ref($x) =~ /^Math::Big/) { require Math::Prime::Util::ZetaBigFloat; return Math::Prime::Util::ZetaBigFloat::RiemannR($x); } my $tol = 1e-16; my $sum = 0.0; my($y, $t); my $c = 0.0; $y = 1.0-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; my $flogx = log($x); my $part_term = 1.0; for my $k (1 .. 10000) { # Small k from table, larger k from function my $zeta = ($k <= $#_Riemann_Zeta_Table) ? $_Riemann_Zeta_Table[$k+1-2] : RiemannZeta($k+1); $part_term *= $flogx / $k; my $term = $part_term / ($k + $k * $zeta); $y = $term-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; last if $term < ($tol * $sum); } return $sum; } 1; __END__ # ABSTRACT: Pure Perl version of Math::Prime::Util =pod =encoding utf8 =head1 NAME Math::Prime::Util::PP - Pure Perl version of Math::Prime::Util =head1 VERSION Version 0.37 =head1 SYNOPSIS The functionality is basically identical to L, as this module is just the Pure Perl implementation. This documentation will only note differences. # Normally you would just import the functions you are using. # Nothing is exported by default. use Math::Prime::Util ':all'; =head1 DESCRIPTION Pure Perl implementations of prime number utilities that are normally handled with XS or GMP. Having the Perl implementations (1) provides examples, (2) allows the functions to run even if XS isn't available, and (3) gives big number support if L isn't available. This is a subset of L's functionality. All routines should work with native integers or multi-precision numbers. To enable big numbers, use bigint or bignum: use bigint; say prime_count_approx(1000000000000000000000000)' # says 18435599767347543283712 This is still experimental, and some functions will be very slow. The L module has much faster versions of many of these functions. Alternately, L has a lot of these types of functions. =head1 FUNCTIONS =head2 euler_phi Takes a I integer input and returns the Euler totient. =head2 euler_phi_range Takes two values defining a range C to C and returns an array with the totient of each value in the range, inclusive. =head2 moebius Takes a I integer input and returns the Moebius function. =head2 moebius_range Takes two values defining a range C to C and returns an array with the Moebius function of each value in the range, inclusive. =head1 LIMITATIONS The SQUFOF and Fermat factoring algorithms are not implemented yet. Some of the prime methods use more memory than they should, as the segmented sieve is not properly used in C and C. =head1 PERFORMANCE Performance compared to the XS/C code is quite poor for many operations. Some operations that are relatively close for small and medium-size values: next_prime / prev_prime is_prime / is_prob_prime is_strong_pseudoprime ExponentialIntegral / LogarithmicIntegral / RiemannR primearray Operations that are slower include: primes random_prime / random_ndigit_prime factor / factor_exp / divisors nth_prime prime_count is_aks_prime Performance improvement in this code is still possible. The prime sieve is over 2x faster than anything I was able to find online, but it is still has room for improvement. L offers C support for most of the important functions, and will be vastly faster for most operations. If you install that module, L will load it automatically, meaning you should not have to think about what code is actually being used (C, GMP, or Perl). Memory use will generally be higher for the PP code, and in some cases B higher. Some of this may be addressed in a later release. For small values (e.g. primes and prime counts under 10M) most of this will not matter. =head1 SEE ALSO L L =head1 AUTHORS Dana Jacobsen Edana@acm.orgE =head1 COPYRIGHT Copyright 2012-2014 by Dana Jacobsen Edana@acm.orgE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Math-Prime-Util-0.37/lib/Math/Prime/Util/PPFE.pm0000644000076400007640000002533612270244414017452 0ustar danadanapackage Math::Prime::Util::PPFE; use strict; use warnings; use Math::Prime::Util::PP; use Carp qw/carp croak confess/; # The PP front end, only loaded if XS is not used. # It is intended to load directly into the MPU namespace. package Math::Prime::Util; *_validate_num = \&Math::Prime::Util::PP::_validate_num; *_prime_memfreeall = \&Math::Prime::Util::PP::_prime_memfreeall; *prime_memfree = \&Math::Prime::Util::PP::prime_memfree; *prime_precalc = \&Math::Prime::Util::PP::prime_precalc; sub moebius { if (scalar @_ <= 1) { my($n) = @_; return 0 if defined $n && $n < 0; _validate_num($n) || _validate_positive_integer($n); return Math::Prime::Util::PP::moebius($n); } my($lo, $hi) = @_; _validate_num($lo) || _validate_positive_integer($lo); _validate_num($hi) || _validate_positive_integer($hi); return Math::Prime::Util::PP::moebius_range($lo, $hi); } sub euler_phi { if (scalar @_ <= 1) { my($n) = @_; return 0 if defined $n && $n < 0; _validate_num($n) || _validate_positive_integer($n); return Math::Prime::Util::PP::euler_phi($n); } my($lo, $hi) = @_; _validate_num($lo) || _validate_positive_integer($lo); _validate_num($hi) || _validate_positive_integer($hi); return Math::Prime::Util::PP::euler_phi_range($lo, $hi); } sub jordan_totient { my($k, $n) = @_; _validate_positive_integer($k); return 0 if defined $n && $n < 0; _validate_positive_integer($n); return Math::Prime::Util::PP::jordan_totient($k, $n); } sub carmichael_lambda { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::carmichael_lambda($n); } sub mertens { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::mertens($n); } sub liouville { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::liouville($n); } sub exp_mangoldt { my($n) = @_; return 1 if defined $n && $n <= 1; _validate_positive_integer($n); return Math::Prime::Util::PP::exp_mangoldt($n); } sub nth_prime { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::nth_prime($n); } sub nth_prime_lower { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::nth_prime_lower($n); } sub nth_prime_upper { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::nth_prime_upper($n); } sub nth_prime_approx { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::nth_prime_approx($n); } sub prime_count_lower { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::prime_count_lower($n); } sub prime_count_upper { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::prime_count_upper($n); } sub prime_count_approx { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::prime_count_approx($n); } sub is_prime { my($n) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); return Math::Prime::Util::PP::is_prime($n); } sub is_prob_prime { my($n) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); return Math::Prime::Util::PP::is_prob_prime($n); } sub is_pseudoprime { my($n, $base) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); _validate_positive_integer($base); return Math::Prime::Util::PP::is_pseudoprime($n, $base); } sub is_strong_pseudoprime { my($n, @bases) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); croak "No bases given to miller_rabin" unless @bases; return Math::Prime::Util::PP::is_strong_pseudoprime($n, @bases); } sub is_lucas_pseudoprime { my($n) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); return Math::Prime::Util::PP::is_lucas_pseudoprime($n); } sub is_strong_lucas_pseudoprime { my($n) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); return Math::Prime::Util::PP::is_strong_lucas_pseudoprime($n); } sub is_extra_strong_lucas_pseudoprime { my($n) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); return Math::Prime::Util::PP::is_extra_strong_lucas_pseudoprime($n); } sub is_almost_extra_strong_lucas_pseudoprime { my($n, $increment) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); if (defined $increment) { _validate_positive_integer($increment, 1, 256); } else { $increment = 1; } return Math::Prime::Util::PP::is_almost_extra_strong_lucas_pseudoprime($n, $increment); } sub is_frobenius_underwood_pseudoprime { my($n) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); return Math::Prime::Util::PP::is_frobenius_underwood_pseudoprime($n); } sub is_aks_prime { my($n) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); return Math::Prime::Util::PP::is_aks_prime($n); } sub kronecker { my($a, $b) = @_; my ($va, $vb) = ($a, $b); $va = -$va if defined $va && $va < 0; $vb = -$vb if defined $vb && $vb < 0; _validate_positive_integer($va); _validate_positive_integer($vb); return Math::Prime::Util::PP::kronecker(@_); } sub znorder { my($a, $n) = @_; _validate_positive_integer($a); _validate_positive_integer($n); return Math::Prime::Util::PP::znorder($a, $n); } sub znlog { my($a, $g, $p) = @_; _validate_positive_integer($a); _validate_positive_integer($g); _validate_positive_integer($p); return Math::Prime::Util::PP::znlog($a, $g, $p); } sub znprimroot { my($n) = @_; $n = -$n if defined $n && $n =~ /^-\d+/; # TODO: fix this for string bigints _validate_positive_integer($n); return Math::Prime::Util::PP::znprimroot($n); } sub trial_factor { my($n, $maxlim) = @_; _validate_positive_integer($n); if (defined $maxlim) { _validate_positive_integer($maxlim); return Math::Prime::Util::PP::trial_factor($n, $maxlim); } return Math::Prime::Util::PP::trial_factor($n); } sub fermat_factor { my($n, $rounds) = @_; _validate_positive_integer($n); if (defined $rounds) { _validate_positive_integer($rounds); return Math::Prime::Util::PP::fermat_factor($n, $rounds); } return Math::Prime::Util::PP::fermat_factor($n); } sub holf_factor { my($n, $rounds) = @_; _validate_positive_integer($n); if (defined $rounds) { _validate_positive_integer($rounds); return Math::Prime::Util::PP::holf_factor($n, $rounds); } return Math::Prime::Util::PP::holf_factor($n); } sub squfof_factor { my($n, $rounds) = @_; _validate_positive_integer($n); if (defined $rounds) { _validate_positive_integer($rounds); return Math::Prime::Util::PP::squfof_factor($n, $rounds); } return Math::Prime::Util::PP::squfof_factor($n); } sub pbrent_factor { my($n, $rounds, $pa) = @_; _validate_positive_integer($n); if (defined $rounds) { _validate_positive_integer($rounds); } else { $rounds = 4*1024*1024; } if (defined $pa ) { _validate_positive_integer($pa); } else { $pa = 3; } return Math::Prime::Util::PP::pbrent_factor($n, $rounds, $pa); } sub prho_factor { my($n, $rounds, $pa) = @_; _validate_positive_integer($n); if (defined $rounds) { _validate_positive_integer($rounds); } else { $rounds = 4*1024*1024; } if (defined $pa ) { _validate_positive_integer($pa); } else { $pa = 3; } return Math::Prime::Util::PP::prho_factor($n, $rounds, $pa); } sub pminus1_factor { my($n, $B1, $B2) = @_; _validate_positive_integer($n); _validate_positive_integer($B1) if defined $B1; _validate_positive_integer($B2) if defined $B2; Math::Prime::Util::PP::pminus1_factor($n, $B1, $B2); } *pplus1_factor = \&pminus1_factor; sub ecm_factor { my($n, $B1, $B2, $ncurves) = @_; _validate_positive_integer($n); _validate_positive_integer($B1) if defined $B1; _validate_positive_integer($B2) if defined $B2; _validate_positive_integer($ncurves) if defined $ncurves; Math::Prime::Util::PP::ecm_factor($n, $B1, $B2, $ncurves); } sub divisors { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::divisors($n); } sub divisor_sum { my($n, $k) = @_; _validate_positive_integer($n); _validate_positive_integer($k) if defined $k && ref($k) ne 'CODE'; return Math::Prime::Util::PP::divisor_sum($n, $k); } sub gcd { return Math::Prime::Util::PP::gcd(@_); } sub lcm { return Math::Prime::Util::PP::lcm(@_); } sub legendre_phi { my($x, $a) = @_; _validate_positive_integer($x); _validate_positive_integer($a); return Math::Prime::Util::PP::legendre_phi($x, $a); } sub chebyshev_theta { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::chebyshev_theta($n); } sub chebyshev_psi { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::chebyshev_psi($n); } ############################################################################# sub forprimes (&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) my($sub, $beg, $end) = @_; if (!defined $end) { $end = $beg; $beg = 2; } _validate_num($beg) || _validate_positive_integer($beg); _validate_num($end) || _validate_positive_integer($end); $beg = 2 if $beg < 2; { my $pp; local *_ = \$pp; for (my $p = next_prime($beg-1); $p <= $end; $p = next_prime($p)) { $pp = $p; $sub->(); } } } sub forcomposites(&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) my($sub, $beg, $end) = @_; if (!defined $end) { $end = $beg; $beg = 4; } _validate_num($beg) || _validate_positive_integer($beg); _validate_num($end) || _validate_positive_integer($end); $beg = 4 if $beg < 4; $end = Math::BigInt->new(''.~0) if ref($end) ne 'Math::BigInt' && $end == ~0; { my $pp; local *_ = \$pp; for ( ; $beg <= $end ; $beg++ ) { if (!is_prime($beg)) { $pp = $beg; $sub->(); } } } } sub fordivisors (&$) { ## no critic qw(ProhibitSubroutinePrototypes) my($sub, $n) = @_; _validate_num($n) || _validate_positive_integer($n); my @divisors = divisors($n); { my $pp; local *_ = \$pp; foreach my $d (@divisors) { $pp = $d; $sub->(); } } } 1; __END__ =pod =head1 NAME Math::Prime::Util::PPFE - PP front end for Math::Prime::Util =head1 SYNOPSIS This loads the PP code and adds input validation front ends. It is only meant to be used when XS is not used. =head1 DESCRIPTION Loads PP module and implements PP front-end functions for all XS code. This is used only if the XS code is not loaded. =head1 SEE ALSO L L =head1 AUTHORS Dana Jacobsen Edana@acm.orgE =head1 COPYRIGHT Copyright 2014 by Dana Jacobsen Edana@acm.orgE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Math-Prime-Util-0.37/lib/Math/Prime/Util/PrimeIterator.pm0000644000076400007640000001525212270242116021477 0ustar danadanapackage Math::Prime::Util::PrimeIterator; use strict; use warnings; BEGIN { $Math::Prime::Util::PrimeIterator::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::PrimeIterator::VERSION = '0.37'; } use base qw( Exporter ); our @EXPORT_OK = qw( ); our %EXPORT_TAGS = (all => [ @EXPORT_OK ]); use Math::Prime::Util qw/next_prime prev_prime is_prime prime_count nth_prime/; # We're going to use a scalar rather than a hash because there is currently # only one data object (the current value) and this makes it little faster. sub new { my ($class, $start) = @_; my $p = 2; my $self = bless \$p, $class; $self->rewind($start) if defined $start; return $self; } # To make Iterator::Simple happy. sub __iter__ { my $self = shift; require Iterator::Simple; return Iterator::Simple::iterator(sub { $self->iterate }); $self; } sub value { ${$_[0]}; } sub next { #my $self = shift; $$self = next_prime($$self); return $self; ${$_[0]} = next_prime(${$_[0]}); return $_[0]; } sub prev { my $self = shift; my $p = $$self; $$self = ($p <= 2) ? 2 : prev_prime($p); return $self; } sub iterate { #my $self = shift; my $p = $$self; $$self = next_prime($p); return $p; my $p = ${$_[0]}; ${$_[0]} = next_prime(${$_[0]}); return $p; } sub rewind { my ($self, $start) = @_; $$self = 2; if (defined $start && $start ne '2') { Math::Prime::Util::_validate_num($start) || Math::Prime::Util::_validate_positive_integer($start); $$self = next_prime($start-1) if $start > 2; } return $self; } sub peek { return next_prime(${$_[0]}); } # Some methods to match Math::NumSeq sub tell_i { return prime_count(${$_[0]}); } sub pred { my($self, $n) = @_; return is_prime($n); } sub ith { my($self, $n) = @_; return nth_prime($n); } sub seek_to_i { my($self, $n) = @_; $self->rewind( nth_prime($n) ); } sub seek_to_value { my($self, $n) = @_; $self->rewind($n); } sub value_to_i { my($self, $n) = @_; return unless is_prime($n); return prime_count($n); } sub value_to_i_ceil { my($self, $n) = @_; return prime_count(next_prime($n-1)); } sub value_to_i_floor { my($self, $n) = @_; return prime_count($n); } sub value_to_i_estimate { my($self, $n) = @_; return Math::Prime::Util::prime_count_approx($n); } sub i_start { 1 } sub description { "The prime numbers 2, 3, 5, 7, 11, 13, 17, etc." } sub values_min { 2 } sub values_max { undef } sub oeis_anum { "A000040" } 1; __END__ # ABSTRACT: An object iterator for primes =pod =for stopwords prev pred ith i'th =head1 NAME Math::Prime::Util::PrimeIterator - An object iterator for primes =head1 VERSION Version 0.37 =head1 SYNOPSIS use Math::Prime::Util::PrimeIterator; my $it = Math::Prime::Util::PrimeIterator->new(); # Simple use: return current value and move forward. $sum += $it->iterate() for 1..10000; # Methods my $v = $it->value(); # Return current value $it->next(); # Move to next prime (returns self) $it->prev(); # Move to prev prime (returns self) my $v = $it->iterate(); # Returns current value; moves to next prime $it->rewind(); # Resets position to 2 $it->rewind($n); # Resets position to next_prime($n-1) # Methods similar to Math::NumSeq, do not change iterator $it->tell_i(); # Returns the index of the current position $it->pred($n); # Returns true if $n is prime $it->ith($i); # Returns the $ith prime $it->value_to_i($n) # Returns the index of the first prime >= $n $it->value_to_i_estimate($n) # Approx index of value $n # Methods similar to Math::NumSeq, changes iterator $it->seek_to_i($i); # Resets position to the $ith prime $it->seek_to_value($i); # Resets position to next_prime($i-1) =head1 DESCRIPTION An iterator over the primes. L returns an iterator object and takes an optional starting position (the initial value will be the least prime greater than or equal to the argument). BigInt objects will be returned if the value overflows a Perl unsigned integer value. =head1 METHODS =head2 new Creates an iterator object with initial value of 2. If an argument is given, the initial value will be the least prime greater than or equal to the argument. =head2 value Returns the value at the current position. Will always be a prime. If the value is greater than ~0, it will be a L object. =head2 next Moves the current position to the next prime. Returns self so calls can be chained. =head2 prev Moves the current position to the previous prime, unless the current value is 2, in which case the value remains 2. Returns self so calls can be chained. =head2 iterate Returns the value at the current position and also moves the position to the next prime. =head2 rewind Resets the current position to either 2 or, if given an integer argument, the least prime not less than the argument. =head2 peek Returns the value at the next position without moving the iterator. =head2 tell_i Returns the index of the current position, starting at 1 (corresponding to the value 2). The iterator is unchanged after this call. =head2 pred Returns true if the argument is a prime, false otherwise. The iterator is unchanged after this call. =head2 ith Returns the i'th prime, where the first prime is 2. The iterator is unchanged after this call. =head2 value_to_i_estimate Returns an estimate of the index corresponding to the argument. That is, given a value C, we expect a prime approximately equal to C to occur at this index. The estimate is performed using L, which uses the estimates of Dusart 2010 (or better for small values). =head2 value_to_i If the argument is prime, returns the corresponding index, such that: ith( value_to_i( $n ) ) == $n Returns C if the argument is not prime. =head2 value_to_i_floor =head2 value_to_i_ceil Returns the index corresponding to the first prime less than or equal to the argument, or greater than or equal to the argument, respectively. =head2 seek_to_i Resets the position to the prime corresponding to the given index. =head2 seek_to_value An alias for L. =head2 i_start =head2 description =head2 values_min =head2 values_max =head2 oeis_anum Methods to match Math::NumSeq::Primes. =head1 SEE ALSO L L L L L L =head1 AUTHORS Dana Jacobsen Edana@acm.orgE =head1 COPYRIGHT Copyright 2013 by Dana Jacobsen Edana@acm.orgE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Math-Prime-Util-0.37/lib/Math/Prime/Util/ZetaBigFloat.pm0000644000076400007640000006241412270242116021226 0ustar danadanapackage Math::Prime::Util::ZetaBigFloat; use strict; use warnings; BEGIN { $Math::Prime::Util::ZetaBigFloat::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::ZetaBigFloat::VERSION = '0.37'; } BEGIN { do { require Math::BigInt; Math::BigInt->import(try=>"GMP,Pari"); } unless defined $Math::BigInt::VERSION; use Math::BigFloat; } # Riemann Zeta($k) for integer $k. # So many terms and digits are used so we can quickly do bignum R. my @_Riemann_Zeta_Table = ( '0.64493406684822643647241516664602518921894990', # zeta(2) - 1 '0.20205690315959428539973816151144999076498629', '0.082323233711138191516003696541167902774750952', '0.036927755143369926331365486457034168057080920', '0.017343061984449139714517929790920527901817490', '0.0083492773819228268397975498497967595998635606', '0.0040773561979443393786852385086524652589607906', '0.0020083928260822144178527692324120604856058514', '0.00099457512781808533714595890031901700601953156', '0.00049418860411946455870228252646993646860643576', '0.00024608655330804829863799804773967096041608846', '0.00012271334757848914675183652635739571427510590', '0.000061248135058704829258545105135333747481696169', '0.000030588236307020493551728510645062587627948707', '0.000015282259408651871732571487636722023237388990', '0.0000076371976378997622736002935630292130882490903', '0.0000038172932649998398564616446219397304546972190', '0.0000019082127165539389256569577951013532585711448', '0.00000095396203387279611315203868344934594379418741', '0.00000047693298678780646311671960437304596644669478', '0.00000023845050272773299000364818675299493504182178', '0.00000011921992596531107306778871888232638725499778', '0.000000059608189051259479612440207935801227503918837', '0.000000029803503514652280186063705069366011844730920', '0.000000014901554828365041234658506630698628864788168', '0.0000000074507117898354294919810041706041194547190319', '0.0000000037253340247884570548192040184024232328930593', '0.0000000018626597235130490064039099454169480616653305', '0.00000000093132743241966818287176473502121981356795514', '0.00000000046566290650337840729892332512200710626918534', '0.00000000023283118336765054920014559759404950248298228', '0.00000000011641550172700519775929738354563095165224717', '0.000000000058207720879027008892436859891063054173122605', '0.000000000029103850444970996869294252278840464106981987', '0.000000000014551921891041984235929632245318420983808894', '0.0000000000072759598350574810145208690123380592648509256', '0.0000000000036379795473786511902372363558732735126460284', '0.0000000000018189896503070659475848321007300850305893096', '0.00000000000090949478402638892825331183869490875386000099', '0.00000000000045474737830421540267991120294885703390452991', '0.00000000000022737368458246525152268215779786912138298220', '0.00000000000011368684076802278493491048380259064374359028', '0.000000000000056843419876275856092771829675240685530571589', '0.000000000000028421709768893018554550737049426620743688265', '0.000000000000014210854828031606769834307141739537678698606', '0.0000000000000071054273952108527128773544799568000227420436', '0.0000000000000035527136913371136732984695340593429921456555', '0.0000000000000017763568435791203274733490144002795701555086', '0.00000000000000088817842109308159030960913863913863256088715', '0.00000000000000044408921031438133641977709402681213364596031', '0.00000000000000022204460507980419839993200942046539642366543', '0.00000000000000011102230251410661337205445699213827024832229', '0.000000000000000055511151248454812437237365905094302816723551', '0.000000000000000027755575621361241725816324538540697689848904', '0.000000000000000013877787809725232762839094906500221907718625', '0.0000000000000000069388939045441536974460853262498092748358742', '0.0000000000000000034694469521659226247442714961093346219504706', '0.0000000000000000017347234760475765720489729699375959074780545', '0.00000000000000000086736173801199337283420550673429514879071415', '0.00000000000000000043368086900206504874970235659062413612547801', '0.00000000000000000021684043449972197850139101683209845761574010', '0.00000000000000000010842021724942414063012711165461382589364744', '0.000000000000000000054210108624566454109187004043886337150634224', '0.000000000000000000027105054312234688319546213119497764318887282', '0.000000000000000000013552527156101164581485233996826928328981877', '0.0000000000000000000067762635780451890979952987415566862059812586', '0.0000000000000000000033881317890207968180857031004508368340311585', '0.0000000000000000000016940658945097991654064927471248619403036418', '0.00000000000000000000084703294725469983482469926091821675222838642', '0.00000000000000000000042351647362728333478622704833579344088109717', '0.00000000000000000000021175823681361947318442094398180025869417612', '0.00000000000000000000010587911840680233852265001539238398470699902', '0.000000000000000000000052939559203398703238139123029185055866375629', '0.000000000000000000000026469779601698529611341166842038715592556134', '0.000000000000000000000013234889800848990803094510250944989684323826', '0.0000000000000000000000066174449004244040673552453323082200147137975', '0.0000000000000000000000033087224502121715889469563843144048092764894', '0.0000000000000000000000016543612251060756462299236771810488297723589', '0.00000000000000000000000082718061255303444036711056167440724040096811', '0.00000000000000000000000041359030627651609260093824555081412852575873', '0.00000000000000000000000020679515313825767043959679193468950443365312', '0.00000000000000000000000010339757656912870993284095591745860911079606', '0.000000000000000000000000051698788284564313204101332166355512893608164', '0.000000000000000000000000025849394142282142681277617708450222269121159', '0.000000000000000000000000012924697071141066700381126118331865309299779', '0.0000000000000000000000000064623485355705318034380021611221670660356864', '0.0000000000000000000000000032311742677852653861348141180266574173608296', '0.0000000000000000000000000016155871338926325212060114057052272720509148', '0.00000000000000000000000000080779356694631620331587381863408997398684847', '0.00000000000000000000000000040389678347315808256222628129858130379479700', '0.00000000000000000000000000020194839173657903491587626465673047518903728', '0.00000000000000000000000000010097419586828951533619250700091044144538432', '0.000000000000000000000000000050487097934144756960847711725486604360898735', '0.000000000000000000000000000025243548967072378244674341937966175648398693', '0.000000000000000000000000000012621774483536189043753999660777148710632765', '0.0000000000000000000000000000063108872417680944956826093943332037500694712', '0.0000000000000000000000000000031554436208840472391098412184847972814371270', '0.0000000000000000000000000000015777218104420236166444327830159601782237092', '0.00000000000000000000000000000078886090522101180735205378276604136878962534', '0.00000000000000000000000000000039443045261050590335263935513575963608141044', '0.00000000000000000000000000000019721522630525295156852383215213909988473843', '0.000000000000000000000000000000098607613152626475748329967604159218377505181', '0.000000000000000000000000000000049303806576313237862187667644776975622245754', '0.000000000000000000000000000000024651903288156618927101395103287812527732549', '0.000000000000000000000000000000012325951644078309462219884645277065145764150', '0.0000000000000000000000000000000061629758220391547306663380205162648609383631', '0.0000000000000000000000000000000030814879110195773651853009095507130250105264', '0.0000000000000000000000000000000015407439555097886825433610878728841686496904', '0.00000000000000000000000000000000077037197775489434125525075496895150086398231', '0.00000000000000000000000000000000038518598887744717062214878116197893873445220', '0.00000000000000000000000000000000019259299443872358530924885847349054449873362', '0.000000000000000000000000000000000096296497219361792654015918534245633717541108', '0.000000000000000000000000000000000048148248609680896326805122366289604787579935', '0.000000000000000000000000000000000024074124304840448163334948882867065229914248', '0.000000000000000000000000000000000012037062152420224081644937008007620275295506', '0.0000000000000000000000000000000000060185310762101120408149560261951727031681191', '0.0000000000000000000000000000000000030092655381050560204049738538280405431094080', '0.0000000000000000000000000000000000015046327690525280102016522071575050028177934', '0.00000000000000000000000000000000000075231638452626400510054786365991407868525313', '0.00000000000000000000000000000000000037615819226313200255018118519034423181524371', '0.00000000000000000000000000000000000018807909613156600127505967704863451341028548', '0.000000000000000000000000000000000000094039548065783000637519533342138055875645097', '0.000000000000000000000000000000000000047019774032891500318756331610342627662060287', '0.000000000000000000000000000000000000023509887016445750159377020784929180405960294', '0.000000000000000000000000000000000000011754943508222875079688128719050545728002924', '0.0000000000000000000000000000000000000058774717541114375398439371350539247056872356', '0.0000000000000000000000000000000000000029387358770557187699219261593698463000750878', '0.0000000000000000000000000000000000000014693679385278593849609489436325511324487536', '0.00000000000000000000000000000000000000073468396926392969248046975979881822702829326', '0.00000000000000000000000000000000000000036734198463196484624023330922692333378216377', '0.00000000000000000000000000000000000000018367099231598242312011613105596640698043218', '0.000000000000000000000000000000000000000091835496157991211560057891008818116853335663', '0.000000000000000000000000000000000000000045917748078995605780028887331354029547708393', '0.000000000000000000000000000000000000000022958874039497802890014424274658671814201226', '0.000000000000000000000000000000000000000011479437019748901445007205673656554920549667', '0.0000000000000000000000000000000000000000057397185098744507225036006822706837980911955', '0.0000000000000000000000000000000000000000028698592549372253612517996229494773449843879', '0.0000000000000000000000000000000000000000014349296274686126806258995720794504878051247', '0.00000000000000000000000000000000000000000071746481373430634031294970624129584900687276', '0.00000000000000000000000000000000000000000035873240686715317015647482652117145953820656', '0.00000000000000000000000000000000000000000017936620343357658507823740439409357478069335', '0.000000000000000000000000000000000000000000089683101716788292539118699241549402394210037', '0.000000000000000000000000000000000000000000044841550858394146269559348635608906198392806', '0.000000000000000000000000000000000000000000022420775429197073134779673989415854766292332', '0.000000000000000000000000000000000000000000011210387714598536567389836885245061272178142', '0.0000000000000000000000000000000000000000000056051938572992682836949184061349085990997301', '0.0000000000000000000000000000000000000000000028025969286496341418474591909049136205534180', '0.0000000000000000000000000000000000000000000014012984643248170709237295913982765839445600', '0.00000000000000000000000000000000000000000000070064923216240853546186479434774488319489698', '0.00000000000000000000000000000000000000000000035032461608120426773093239672340797200498749', '0.00000000000000000000000000000000000000000000017516230804060213386546619821154916280500674', '0.000000000000000000000000000000000000000000000087581154020301066932733099055722973670007705', '0.000000000000000000000000000000000000000000000043790577010150533466366549511177617590838630', '0.000000000000000000000000000000000000000000000021895288505075266733183274750027519047364241', '0.000000000000000000000000000000000000000000000010947644252537633366591637373159996274330429', '0.0000000000000000000000000000000000000000000000054738221262688166832958186859620770540479841', '0.0000000000000000000000000000000000000000000000027369110631344083416479093427750648326515819', '0.0000000000000000000000000000000000000000000000013684555315672041708239546713188745182016542', '0.00000000000000000000000000000000000000000000000068422776578360208541197733563655129305944821', '0.00000000000000000000000000000000000000000000000034211388289180104270598866781064699118259780', '0.00000000000000000000000000000000000000000000000017105694144590052135299433390278061047559013', '0.000000000000000000000000000000000000000000000000085528470722950260676497166950542676865892145', '0.000000000000000000000000000000000000000000000000042764235361475130338248583474988795642311765', '0.000000000000000000000000000000000000000000000000021382117680737565169124291737400216890944447', '0.000000000000000000000000000000000000000000000000010691058840368782584562145868668714802068411', '0.0000000000000000000000000000000000000000000000000053455294201843912922810729343238928532329351', '0.0000000000000000000000000000000000000000000000000026727647100921956461405364671584582440160440', '0.0000000000000000000000000000000000000000000000000013363823550460978230702682335780663944745475', '0.00000000000000000000000000000000000000000000000000066819117752304891153513411678864562139278223', '0.00000000000000000000000000000000000000000000000000033409558876152445576756705839419361874822728', '0.00000000000000000000000000000000000000000000000000016704779438076222788378352919705374539139236', '0.000000000000000000000000000000000000000000000000000083523897190381113941891764598512518034789088', '0.000000000000000000000000000000000000000000000000000041761948595190556970945882299251474130425513', '0.000000000000000000000000000000000000000000000000000020880974297595278485472941149624142102889746', '0.000000000000000000000000000000000000000000000000000010440487148797639242736470574811539397337203', '0.0000000000000000000000000000000000000000000000000000052202435743988196213682352874055924806327115', '0.0000000000000000000000000000000000000000000000000000026101217871994098106841176437027371676377257', '0.0000000000000000000000000000000000000000000000000000013050608935997049053420588218513488929259862', '0.00000000000000000000000000000000000000000000000000000065253044679985245267102941092566788283203421', ); # Convert to BigFloat objects. @_Riemann_Zeta_Table = map { Math::BigFloat->new($_) } @_Riemann_Zeta_Table; # for k = 1 .. n : (1 / (zeta(k+1) * k + k) # Makes RiemannR run about twice as fast. my @_Riemann_Zeta_Premult; my $_Riemann_Zeta_Premult_accuracy; # Select n = 55, good for 46ish digits of accuracy. my $_Borwein_n = 55; my @_Borwein_dk = ( '1', '6051', '6104451', '2462539971', '531648934851', '71301509476803', '6504925195108803', '429144511928164803', '21392068013887742403', '832780518854440804803', '25977281563850106233283', '662753606729324750201283', '14062742362385399866745283', '251634235316509414702211523', '3841603462178827861104812483', '50535961819850087101900022211', '577730330374203014014104003011', '5782012706584553297863989289411', '50984922488525881477588707205571', '398333597655022403279683908035011', '2770992240330783259897072664469955', '17238422988353715312442126057365955', '96274027751337344115352100618133955', '484350301573059857715727453968687555', '2201794236784087151947175826243477955', '9068765987529892610841571032285864387', '33926582279822401059328069515697217987', '115535262182820447663793177744255246787', '358877507711760077538925500462137369027', '1018683886695854101193095537014797787587', '2646951832121008166346437186541363159491', '6306464665572570713623910486640730071491', '13799752848354341643763498672558481367491', '27780237373991939435100856211039992177091', '51543378762608611361377523633779417047491', '88324588911945720951614452340280439890371', '140129110249040241501243929391690331218371', '206452706984942815385219764876242498642371', '283527707823296964404071683165658912154051', '364683602811933600833512164561308162744771', '441935796522635816776473230396154031661507', '508231717051242054487234759342047053767107', '559351463001010719709990637083458540691907', '594624787018881191308291683229515933311427', '616297424973434835299724300924272199623107', '628083443816135918099559567176252011864515', '633714604276098212796088600263676671320515', '636056734158553360761837806887547188568515', '636894970116484676875895417679248215794115', '637149280289288581322870186196318041432515', '637213397278310656625865036925470191411651', '637226467136294189739463288384528579584451', '637228536449134002301138291602841035366851', '637228775173095037281299181461988671775171', '637228793021615488494769154535569803469251', '637228793670652595811622608101881844621763', ); # "An Efficient Algorithm for the Riemann Zeta Function", Borwein, 1991. # About 1.3n terms are needed for n digits of accuracy. sub _Recompute_Dk { my $nterms = shift; $_Borwein_n = $nterms; @_Borwein_dk = (); foreach my $k (0 .. $nterms) { my $n = Math::BigInt->new($nterms-1)->bfac; my $d = Math::BigInt->new($nterms)->bfac; my ($sum_n, $sum_d) = (Math::BigInt->bone, Math::BigInt->bone); my $gcd; foreach my $i (0 .. $k) { # ad + cb / bd $sum_n->bmul($d)->badd( $sum_d->copy->bmul($n) ); $sum_d->bmul($d); $gcd = Math::BigInt::bgcd($sum_n, $sum_d); do { $sum_n = int($sum_n / $gcd); $sum_d = int($sum_d / $gcd); } unless $gcd->is_one; my $dmul = (2*$i+1) * (2*$i+2); $n->bmul($nterms+$i)->blsft(2); $d->bdiv($nterms-$i)->bmul($dmul); } $_Borwein_dk[$k] = $sum_n->bmul($nterms)->bdiv($sum_d); } } sub RiemannZeta { my($ix) = @_; my $x = (ref($ix) eq 'Math::BigFloat') ? $ix->copy : Math::BigFloat->new("$ix"); my $xdigits = $x->accuracy || Math::BigFloat->accuracy() || Math::BigFloat->div_scale(); if ($x == int($x) && $xdigits <= 44 && (int($x)-2) <= $#_Riemann_Zeta_Table) { my $izeta = $_Riemann_Zeta_Table[int($x)-2]->copy; $izeta->bround($xdigits); return $izeta; } my $extra_acc = 7; if ($x > 50) { $extra_acc = 10; } elsif ($x > 30) { $extra_acc = 28; } elsif ($x > 15) { $extra_acc = 15; } $xdigits += $extra_acc; $x->accuracy($xdigits); my $zero= $x->copy->bzero; my $one = $x->copy->bone; my $two = $one->copy->binc; my $tol = $one->copy->brsft($xdigits-1, 10); # Note: with bignum on, $d1->bpow($one-$x) doesn't change d1 ! # Trying to work around Math::BigFloat bugs RT 43692 and RT 77105 which make # a right mess of things. Watch this: # my $n = Math::BigFloat->new(11); $n->accuracy(64); say $n**1.1; # 13.98 # my $n = Math::BigFloat->new(11); $n->accuracy(67); say $n**1.1; # 29.98 # We can fix some issues with large exponents (e.g. 6^-40.5) by turning it # into (6^-(40.5/4))^4 (assuming the base is positive). Without that hack, # none of this would work at all. # There is a fix for the defect in the RT. my $superx = Math::BigInt->bone; my $subx = $x->copy; while ($subx > 1) { $superx->blsft(1); $subx /= $two; } # Go with the basic formula for large x, as it best works around the mess, # though is unfortunately much slower. if ($x > 50) { my $negsubx = $subx->copy->bneg; my $sum = $zero->copy; my $k = $two->copy->binc; while ($k->binc <= 1000) { my $term = $k->copy->bpow($negsubx)->bpow($superx); $sum->badd($term); last if $term < ($sum*$tol); } $sum->badd( $two->copy->binc->bpow($negsubx)->bpow($superx) ); $sum->badd( $two->copy ->bpow($negsubx)->bpow($superx) ); $sum->bround($xdigits-$extra_acc); return $sum; } #if ($x > 25) { # my $sum = 0.0; # my $divisor = 1.0 - ((2 ** -$subx) ** $superx); # for my $k (2 .. 1000) { # my $term = ( (2*$k+1) ** -$subx ) ** $superx; # $sum += $term; # last if $term < ($tol*$divisor); # } # $sum += (3 ** -$subx) ** $superx; # my $t = 1.0 / $divisor; # $sum *= $t; # $sum += ($t - 1.0); # return $sum; #} { my $dig = int($_Borwein_n / 1.3)+1; _Recompute_Dk( int($xdigits * 1.3) + 4 ) if $dig < $xdigits; } if (ref $_Borwein_dk[0] ne 'Math::BigInt') { @_Borwein_dk = map { Math::BigInt->new("$_") } @_Borwein_dk; } my $n = $_Borwein_n; my $d1 = $two ** ($one - $x); my $divisor = $one->copy->bsub($d1)->bmul(-$_Borwein_dk[$n]); $tol = $divisor->copy->bmul($tol)->babs(); my ($sum, $bigk) = ($zero->copy, $one->copy); foreach my $k (1 .. $n-1) { my $den = $bigk->binc()->copy->bpow($subx,$xdigits)->bpow($superx,$xdigits); my $term = ($k % 2) ? $zero->copy->badd($_Borwein_dk[$n])->bsub($_Borwein_dk[$k]) : $zero->copy->badd($_Borwein_dk[$k])->bsub($_Borwein_dk[$n]); $term->bdiv($den); $sum->badd($term); last if $term->copy->babs() < $tol; } $sum->badd($one->copy->bsub($_Borwein_dk[$n])); # term k=0 $sum->bdiv($divisor,$xdigits)->bdec; $sum->bround($xdigits-$extra_acc); return $sum; } # Riemann R function sub RiemannR { my($x) = @_; if (ref($x) eq 'Math::BigInt') { my $xacc = $x->accuracy(); $x = Math::BigFloat->new($x); $x->accuracy($xacc) if $xacc; } $x = Math::BigFloat->new("$x") if ref($x) ne 'Math::BigFloat'; my $xdigits = $x->accuracy || Math::BigFloat->accuracy() || Math::BigFloat->div_scale(); my $tol = 0.0 + "1e-$xdigits"; # TODO: The default table is only 44 digits. if ( (scalar @_Riemann_Zeta_Premult == 0) || ($_Riemann_Zeta_Premult_accuracy < $xdigits) ) { $_Riemann_Zeta_Premult_accuracy = $xdigits; @_Riemann_Zeta_Premult = map { my $v = Math::BigFloat->bone; $v->accuracy($xdigits); $v / ($_Riemann_Zeta_Table[$_-1] * $_ + $_) } (1 .. @_Riemann_Zeta_Table); } my $sum = Math::BigFloat->bone; my $flogx = log($x); my $part_term = Math::BigFloat->bone; for my $k (1 .. 10000) { my $zeta_term = $_Riemann_Zeta_Premult[$k-1]; if (!defined $zeta_term) { my $zeta = $_Riemann_Zeta_Table[$k-1]; if (!defined $zeta) { my $kz = Math::BigFloat->new($k+1); $kz->accuracy($xdigits); if ($kz >= 100 && $xdigits <= 40) { # For this accuracy level, two terms are more than enough. Also, # we should be able to miss the Math::BigFloat accuracy bug. If we # try to do this for higher accuracy, things will go very bad. $zeta = Math::BigFloat->new(3)->bpow(-$kz) + Math::BigFloat->new(2)->bpow(-$kz); } else { $zeta = Math::Prime::Util::ZetaBigFloat::RiemannZeta( $kz ); } } $zeta_term = Math::BigFloat->bone / ($zeta * $k + $k); } $part_term *= $flogx / $k; my $term = $part_term * $zeta_term; #warn "k = $k term = $term sum = $sum\n"; $sum += $term; last if $term < ($tol*$sum); } return $sum; } 1; __END__ # ABSTRACT: Perl Big Float versions of Riemann Zeta and R functions =pod =encoding utf8 =head1 NAME Math::Prime::Util::ZetaBigFloat - Perl Big Float versions of Riemann Zeta and R functions =head1 VERSION Version 0.37 =head1 SYNOPSIS Math::BigFloat versions`of the Riemann Zeta and Riemann R functions. These are kept in a separate module because they use a lot of big tables that we'd prefer to only load if needed. =head1 DESCRIPTION Pure Perl implementations of Riemann Zeta and Riemann R using Math::BigFloat. These functions are used if: =over 4 =item The input is a BigInt, a BigFloat, or the bignum module has been loaded. =item The Math::MPFR module is not available. =back If you use these functions a lot, I B recommend you install L, which the main L functions will find. These give B better performance, and better accuracy. You can also use L for the Riemann Zeta function. =head1 FUNCTIONS =head2 RiemannZeta my $z = RiemannZeta($s); Given a floating point input C where C= 0.5>, returns the floating point value of ζ(s)-1, where ζ(s) is the Riemann zeta function. One is subtracted to ensure maximum precision for large values of C. The zeta function is the sum from k=1 to infinity of C<1 / k^s> Results are calculated using either Borwein (1991) algorithm 2, or the basic series. Full input accuracy is attempted, but there are defects in Math::BigFloat with high accuracy computations that make this difficult. =head2 RiemannR my $r = RiemannR($x); Given a positive non-zero floating point input, returns the floating point value of Riemann's R function. Riemann's R function gives a very close approximation to the prime counting function. Accuracy should be about 35 digits. =head1 LIMITATIONS Bugs in Math::BigFloat (RT 43692, RT 77105) cause many problems with this code. I've attempted to work around them, but it is possible there are cases they miss. The accuracy goals (35 digits) are sometimes missed by a digit or two. =head1 PERFORMANCE Performance is quite bad. =head1 SEE ALSO L L L =head1 AUTHORS Dana Jacobsen Edana@acm.orgE =head1 COPYRIGHT Copyright 2012 by Dana Jacobsen Edana@acm.orgE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Math-Prime-Util-0.37/lib/Math/Prime/Util/PrimalityProving.pm0000644000076400007640000007613612270244414022243 0ustar danadanapackage Math::Prime::Util::PrimalityProving; use strict; use warnings; use Carp qw/carp croak confess/; use Math::Prime::Util qw/is_prob_prime is_strong_pseudoprime is_provable_prime_with_cert lucas_sequence factor prime_get_config /; BEGIN { $Math::Prime::Util::PrimalityProving::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::PrimalityProving::VERSION = '0.37'; } BEGIN { do { require Math::BigInt; Math::BigInt->import(try=>"GMP,Pari"); } unless defined $Math::BigInt::VERSION; } my $_smallval = Math::BigInt->new("18446744073709551615"); ############################################################################### # Pure Perl proofs ############################################################################### my @_fsublist = ( sub { Math::Prime::Util::PP::prho_factor (shift, 8*1024, 3) }, sub { Math::Prime::Util::PP::pminus1_factor(shift, 10_000) }, sub { Math::Prime::Util::PP::pbrent_factor (shift, 32*1024, 1) }, sub { Math::Prime::Util::PP::pminus1_factor(shift, 1_000_000) }, sub { Math::Prime::Util::PP::pbrent_factor (shift, 512*1024, 7) }, sub { Math::Prime::Util::PP::ecm_factor (shift, 1_000, 5_000, 10) }, sub { Math::Prime::Util::PP::pminus1_factor(shift, 4_000_000) }, sub { Math::Prime::Util::PP::pbrent_factor (shift, 512*1024, 11) }, sub { Math::Prime::Util::PP::ecm_factor (shift, 10_000, 50_000, 10) }, sub { Math::Prime::Util::PP::pminus1_factor(shift,20_000_000) }, sub { Math::Prime::Util::PP::ecm_factor (shift, 100_000, 800_000, 10) }, sub { Math::Prime::Util::PP::pbrent_factor (shift, 2048*1024, 13) }, sub { Math::Prime::Util::PP::ecm_factor (shift, 1_000_000, 1_000_000, 20)}, sub { Math::Prime::Util::PP::pminus1_factor(shift, 100_000_000, 500_000_000)}, ); sub _small_cert { my $n = shift; return '' unless is_prob_prime($n); return join "\n", "[MPU - Primality Certificate]", "Version 1.0", "", "Proof for:", "N $n", "", "Type Small", "N $n", ""; } # For stripping off the header on certificates so they can be combined. sub _strip_proof_header { my $proof = shift; $proof =~ s/^\[MPU - Primality Certificate\]\nVersion \S+\n+Proof for:\nN (\d+)\n+//ms; return $proof; } sub primality_proof_lucas { my ($n) = shift; my @composite = (0, ''); # Since this can take a very long time with a composite, try some easy cuts return @composite if !defined $n || $n < 2; return (2, _small_cert($n)) if $n < 4; return @composite if is_strong_pseudoprime($n,2,15,325) == 0; my $nm1 = $n-1; my @factors = factor($nm1); { # remove duplicate factors and make a sorted array of bigints my %uf; undef @uf{@factors}; @factors = sort {$a<=>$b} map { Math::BigInt->new("$_") } keys %uf; } my $cert = "[MPU - Primality Certificate]\nVersion 1.0\n\nProof for:\nN $n\n\n"; $cert .= "Type Lucas\nN $n\n"; foreach my $i (1 .. scalar @factors) { $cert .= "Q[$i] " . $factors[$i-1] . "\n"; } for (my $a = 2; $a < $nm1; $a++) { my $ap = Math::BigInt->new("$a"); # 1. a must be coprime to n next unless Math::BigInt::bgcd($ap, $n) == 1; # 2. a^(n-1) = 1 mod n. next unless $ap->copy->bmodpow($nm1, $n) == 1; # 3. a^((n-1)/f) != 1 mod n for all f. next if (scalar grep { $_ == 1 } map { $ap->copy->bmodpow(int($nm1/$_),$n); } @factors) > 0; # Verify each factor and add to proof my @fac_proofs; foreach my $f (@factors) { my ($isp, $fproof) = Math::Prime::Util::is_provable_prime_with_cert($f); if ($isp != 2) { carp "could not prove primality of $n.\n"; return (1, ''); } push @fac_proofs, _strip_proof_header($fproof) if $f > $_smallval; } $cert .= "A $a\n"; foreach my $proof (@fac_proofs) { $cert .= "\n$proof"; } return (2, $cert); } return @composite; } sub primality_proof_bls75 { my ($n) = shift; my @composite = (0, ''); # Since this can take a very long time with a composite, try some easy tests return @composite if !defined $n || $n < 2; return (2, _small_cert($n)) if $n < 4; return @composite if ($n & 1) == 0; return @composite if is_strong_pseudoprime($n,2,15,325) == 0; require Math::Prime::Util::PP; $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my $nm1 = $n->copy->bdec; my $ONE = $nm1->copy->bone; my $TWO = $ONE->copy->binc; my $A = $ONE->copy; # factored part my $B = $nm1->copy; # unfactored part my @factors = ($TWO); croak "BLS75 error: n-1 not even" unless $nm1->is_even(); { while ($B->is_even) { $B->bdiv($TWO); $A->bmul($TWO); } my @tf; if ($B <= ''.~0 && prime_get_config->{'xs'}) { @tf = Math::Prime::Util::trial_factor($B, 20000); pop @tf if $tf[-1] > 20000; } else { @tf = Math::Prime::Util::PP::trial_factor($B, 500); pop @tf if $tf[-1] > 500; } foreach my $f (@tf) { next if $f == $factors[-1]; push @factors, $f; while (($B % $f) == 0) { $B /= $f; $A *= $f; } } } my @nstack; # nstack should only hold composites if ($B->is_one) { # Completely factored. Nothing. } elsif (is_prob_prime($B)) { push @factors, $B; $A *= $B; $B /= $B; # completely factored already } else { push @nstack, $B; } while (@nstack) { my ($s,$r) = $B->copy->bdiv($A->copy->bmul($TWO)); my $fpart = ($A+$ONE) * ($TWO*$A*$A + ($r-$ONE) * $A + $ONE); last if $n < $fpart; my $m = pop @nstack; # Don't use bignum if it has gotten small enough. $m = int($m->bstr) if ref($m) eq 'Math::BigInt' && $m <= ''.~0; # Try to find factors of m, using the default set of factor subs. my @ftry; foreach my $sub (@_fsublist) { @ftry = $sub->($m); last if scalar @ftry >= 2; } # If we couldn't find a factor, skip it. next unless scalar @ftry > 1; # Process each factor foreach my $f (@ftry) { croak "Invalid factoring: B=$B m=$m f=$f" if $f == 1 || $f == $m || !$B->copy->bmod($f)->is_zero; if (is_prob_prime($f)) { push @factors, $f; do { $B /= $f; $A *= $f; } while $B->copy->bmod($f)->is_zero; } else { push @nstack, $f; } } } { # remove duplicate factors and make a sorted array of bigints my %uf = map { $_ => 1 } @factors; @factors = sort {$a<=>$b} map { Math::BigInt->new("$_") } keys %uf; } # Just in case: foreach my $f (@factors) { while ($B->copy->bmod($f)->is_zero) { $B /= $f; $A *= $f; } } # Did we factor enough? my ($s,$r) = $B->copy->bdiv($A->copy->bmul($TWO)); my $fpart = ($A+$ONE) * ($TWO*$A*$A + ($r-$ONE) * $A + $ONE); return (1,'') if $n >= $fpart; # Check we didn't mess up croak "BLS75 error: $A * $B != $nm1" unless $A*$B == $nm1; croak "BLS75 error: $A not even" unless $A->is_even(); croak "BLS75 error: A and B not coprime" unless Math::BigInt::bgcd($A, $B)->is_one; my $rtest = $r*$r - 8*$s; my $rtestroot = $rtest->copy->bsqrt; return @composite if $s != 0 && ($rtestroot*$rtestroot) == $rtest; my $cert = "[MPU - Primality Certificate]\nVersion 1.0\n\nProof for:\nN $n\n\n"; $cert .= "Type BLS5\nN $n\n"; my $qnum = 0; my $atext = ''; my @fac_proofs; foreach my $f (@factors) { my $success = 0; if ($qnum == 0) { die "BLS5 Perl proof: Internal error, first factor not 2" unless $f == 2; } else { $cert .= "Q[$qnum] $f\n"; } my $nm1_div_f = $nm1 / $f; foreach my $a (2 .. 10000) { my $ap = Math::BigInt->new($a); next unless $ap->copy->bmodpow($nm1, $n)->is_one; next unless Math::BigInt::bgcd($ap->copy->bmodpow($nm1_div_f, $n)->bdec, $n)->is_one; $atext .= "A[$qnum] $a\n" unless $a == 2; $success = 1; last; } $qnum++; return @composite unless $success; my ($isp, $fproof) = is_provable_prime_with_cert($f); if ($isp != 2) { carp "could not prove primality of $n.\n"; return (1, ''); } push @fac_proofs, _strip_proof_header($fproof) if $f > $_smallval; } $cert .= $atext; $cert .= "----\n"; foreach my $proof (@fac_proofs) { $cert .= "\n$proof"; } return (2, $cert); } ############################################################################### # Convert certificates from old array format to new string format ############################################################################### sub _convert_cert { my $pdata = shift; # pdata is a ref return '' if scalar @$pdata == 0; my $n = shift @$pdata; if (length($n) == 1) { return "Type Small\nN $n\n" if $n =~ /^[2357]$/; return ''; } $n = Math::BigInt->new("$n") if ref($n) ne 'Math::BigInt'; return '' if $n->is_even; my $method = (scalar @$pdata > 0) ? shift @$pdata : 'BPSW'; if ($method eq 'BPSW') { return '' if $n > $_smallval; return '' if is_prob_prime($n) != 2; return "Type Small\nN $n\n"; } if ($method eq 'Pratt' || $method eq 'Lucas') { if (scalar @$pdata != 2 || ref($$pdata[0]) ne 'ARRAY' || ref($$pdata[1]) eq 'ARRAY') { carp "verify_prime: incorrect Pratt format, must have factors and a value\n"; return ''; } my @factors = @{shift @$pdata}; my $a = shift @$pdata; my $cert = "Type Lucas\nN $n\n"; foreach my $i (0 .. $#factors) { my $f = (ref($factors[$i]) eq 'ARRAY') ? $factors[$i]->[0] : $factors[$i]; $cert .= sprintf("Q[%d] %s\n", $i+1, $f); } $cert .= "A $a\n\n"; foreach my $farray (@factors) { if (ref($farray) eq 'ARRAY') { $cert .= _convert_cert($farray); } } return $cert; } if ($method eq 'n-1') { if (scalar @$pdata == 3 && ref($$pdata[0]) eq 'ARRAY' && $$pdata[0]->[0] =~ /^(B|T7|Theorem\s*7)$/i) { croak "Unsupported BLS7 proof in conversion"; } if (scalar @$pdata != 2 || ref($$pdata[0]) ne 'ARRAY' || ref($$pdata[1]) ne 'ARRAY') { carp "verify_prime: incorrect n-1 format, must have factors and a values\n"; return ''; } my @factors = @{shift @$pdata}; my @as = @{shift @$pdata}; if (scalar @factors != scalar @as) { carp "verify_prime: incorrect n-1 format, must have a value for each factor\n"; return ''; } # Make sure 2 is at the top foreach my $i (1 .. $#factors) { my $f = (ref($factors[$i]) eq 'ARRAY') ? $factors[$i]->[0] : $factors[$i]; if ($f == 2) { my $tf = $factors[0]; $factors[0] = $factors[$i]; $factors[$i] = $tf; my $ta = $as[0]; $as[0] = $as[$i]; $as[$i] = $ta; } } return '' unless $factors[0] == 2; my $cert = "Type BLS5\nN $n\n"; foreach my $i (1 .. $#factors) { my $f = (ref($factors[$i]) eq 'ARRAY') ? $factors[$i]->[0] : $factors[$i]; $cert .= sprintf("Q[%d] %s\n", $i, $f); } foreach my $i (0 .. $#as) { $cert .= sprintf("A[%d] %s\n", $i, $as[$i]) if $as[$i] != 2; } $cert .= "----\n\n"; foreach my $farray (@factors) { if (ref($farray) eq 'ARRAY') { $cert .= _convert_cert($farray); } } return $cert; } if ($method eq 'ECPP' || $method eq 'AGKM') { if (scalar @$pdata < 1) { carp "verify_prime: incorrect AGKM format\n"; return ''; } my $cert = ''; my $q = $n; foreach my $block (@$pdata) { if (ref($block) ne 'ARRAY' || scalar @$block != 6) { carp "verify_prime: incorrect AGKM block format\n"; return ''; } my($ni, $a, $b, $m, $qval, $P) = @$block; if (Math::BigInt->new("$ni") != Math::BigInt->new("$q")) { carp "verify_prime: incorrect AGKM block format: block n != q\n"; return ''; } $q = ref($qval) eq 'ARRAY' ? $qval->[0] : $qval; if (ref($P) ne 'ARRAY' || scalar @$P != 2) { carp "verify_prime: incorrect AGKM block point format\n"; return ''; } my ($x, $y) = @{$P}; $cert .= "Type ECPP\nN $ni\nA $a\nB $b\nM $m\nQ $q\nX $x\nY $y\n\n"; if (ref($qval) eq 'ARRAY') { $cert .= _convert_cert($qval); } } return $cert; } carp "verify_prime: Unknown method: '$method'.\n"; return ''; } sub convert_array_cert_to_string { my @pdata = @_; # Convert reference input to array @pdata = @{$pdata[0]} if scalar @pdata == 1 && ref($pdata[0]) eq 'ARRAY'; return '' if scalar @pdata == 0; my $n = $pdata[0]; my $header = "[MPU - Primality Certificate]\nVersion 1.0\n\nProof for:\nN $n\n\n"; my $cert = _convert_cert(\@pdata); return '' if $cert eq ''; return $header . $cert; } ############################################################################### # Verify certificate ############################################################################### sub _primality_error ($) { ## no critic qw(ProhibitSubroutinePrototypes) print "primality fail: $_[0]\n" if prime_get_config->{'verbose'}; return; # error in certificate } sub _pfail ($) { ## no critic qw(ProhibitSubroutinePrototypes) print "primality fail: $_[0]\n" if prime_get_config->{'verbose'}; return; # Failed a condition } sub _read_vars { my $lines = shift; my $type = shift; my %vars = map { $_ => 1 } @_; my %return; while (scalar keys %vars) { my $line = shift @$lines; return _primality_error("end of file during type $type") unless defined $line; # Skip comments and blank lines next if $line =~ /^\s*#/ or $line =~ /^\s*$/; chomp($line); return _primality_error("Still missing values in type $type") if $line =~ /^Type /; if ($line =~ /^(\S+)\s+(-?\d+)/) { my ($var, $val) = ($1, $2); $var =~ tr/a-z/A-Z/; return _primality_error("Type $type: repeated or inappropriate var: $line") unless defined $vars{$var}; $return{$var} = $val; delete $vars{$var}; } else { return _primality_error("Unrecognized line: $line"); } } # Now return them in the order given, turned into bigints. return map { Math::BigInt->new("$return{$_}") } @_; } sub _is_perfect_square { my($n) = @_; if (ref($n) eq 'Math::BigInt') { my $mc = int(($n & 31)->bstr); if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) { my $sq = $n->copy->bsqrt->bfloor; $sq->bmul($sq); return 1 if $sq == $n; } } else { my $mc = $n & 31; if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) { my $sq = int(sqrt($n)); return 1 if ($sq*$sq) == $n; } } 0; } # Calculate Jacobi symbol (M|N) sub _jacobi { my($n, $m) = @_; return 0 if $m <= 0 || ($m % 2) == 0; my $j = 1; if ($n < 0) { $n = -$n; $j = -$j if ($m % 4) == 3; } # Split loop so we can reduce n/m to non-bigints after first iteration. if ($n != 0) { while (($n % 2) == 0) { $n >>= 1; $j = -$j if ($m % 8) == 3 || ($m % 8) == 5; } ($n, $m) = ($m, $n); $j = -$j if ($n % 4) == 3 && ($m % 4) == 3; $n = $n % $m; $n = int($n->bstr) if ref($n) eq 'Math::BigInt' && $n <= ''.~0; $m = int($m->bstr) if ref($m) eq 'Math::BigInt' && $m <= ''.~0; } while ($n != 0) { while (($n % 2) == 0) { $n >>= 1; $j = -$j if ($m % 8) == 3 || ($m % 8) == 5; } ($n, $m) = ($m, $n); $j = -$j if ($n % 4) == 3 && ($m % 4) == 3; $n = $n % $m; } return ($m == 1) ? $j : 0; } # Proof handlers (parse input and call verification) sub _prove_ecpp { _verify_ecpp( _read_vars($_[0], 'ECPP', qw/N A B M Q X Y/) ); } sub _prove_ecpp3 { _verify_ecpp3( _read_vars($_[0], 'ECPP3', qw/N S R A B T/) ); } sub _prove_ecpp4 { _verify_ecpp4( _read_vars($_[0], 'ECPP4', qw/N S R J T/) ); } sub _prove_bls15 { _verify_bls15( _read_vars($_[0], 'BLS15', qw/N Q LP LQ/) ); } sub _prove_bls3 { _verify_bls3( _read_vars($_[0], 'BLS3', qw/N Q A/) ); } sub _prove_pock { _verify_pock( _read_vars($_[0], 'POCKLINGTON', qw/N Q A/) ); } sub _prove_small { _verify_small( _read_vars($_[0], 'Small', qw/N/) ); } sub _prove_bls5 { my $lines = shift; # No good way to do this using read_vars my ($n, @Q, @A); my $index = 0; $Q[0] = Math::BigInt->new(2); # 2 is implicit while (1) { my $line = shift @$lines; return _primality_error("end of file during type BLS5") unless defined $line; # Skip comments and blank lines next if $line =~ /^\s*#/ or $line =~ /^\s*$/; # Stop when we see a line starting with -. last if $line =~ /^-/; chomp($line); if ($line =~ /^N\s+(\d+)/) { return _primality_error("BLS5: N redefined") if defined $n; $n = Math::BigInt->new("$1"); } elsif ($line =~ /^Q\[(\d+)\]\s+(\d+)/) { $index++; return _primality_error("BLS5: Invalid index: $1") unless $1 == $index; $Q[$1] = Math::BigInt->new("$2"); } elsif ($line =~ /^A\[(\d+)\]\s+(\d+)/) { return _primality_error("BLS5: Invalid index: A[$1]") unless $1 >= 0 && $1 <= $index; $A[$1] = Math::BigInt->new("$2"); } else { return _primality_error("Unrecognized line: $line"); } } _verify_bls5($n, \@Q, \@A); } sub _prove_lucas { my $lines = shift; # No good way to do this using read_vars my ($n, @Q, $a); my $index = 0; while (1) { my $line = shift @$lines; return _primality_error("end of file during type Lucas") unless defined $line; # Skip comments and blank lines next if $line =~ /^\s*#/ or $line =~ /^\s*$/; chomp($line); if ($line =~ /^N\s+(\d+)/) { return _primality_error("Lucas: N redefined") if defined $n; $n = Math::BigInt->new("$1"); } elsif ($line =~ /^Q\[(\d+)\]\s+(\d+)/) { $index++; return _primality_error("Lucas: Invalid index: $1") unless $1 == $index; $Q[$1] = Math::BigInt->new("$2"); } elsif ($line =~ /^A\s+(\d+)/) { $a = Math::BigInt->new("$1"); last; } else { return _primality_error("Unrecognized line: $line"); } } _verify_lucas($n, \@Q, $a); } # Verification routines sub _verify_ecpp { my ($n, $a, $b, $m, $q, $x, $y) = @_; return unless defined $n; $a %= $n if $a < 0; $b %= $n if $b < 0; return _pfail "ECPP: $n failed N > 0" unless $n > 0; return _pfail "ECPP: $n failed gcd(N, 6) = 1" unless Math::BigInt::bgcd($n, 6) == 1; return _pfail "ECPP: $n failed gcd(4*a^3 + 27*b^2, N) = 1" unless Math::BigInt::bgcd(4*$a*$a*$a+27*$b*$b,$n) == 1; return _pfail "ECPP: $n failed Y^2 = X^3 + A*X + B mod N" unless ($y*$y) % $n == ($x*$x*$x + $a*$x + $b) % $n; return _pfail "ECPP: $n failed M >= N - 2*sqrt(N) + 1" unless $m >= $n + 1 - $n->copy->bmul(4)->bsqrt(); return _pfail "ECPP: $n failed M <= N + 2*sqrt(N) + 1" unless $m <= $n + 1 + $n->copy->bmul(4)->bsqrt(); return _pfail "ECPP: $n failed Q > (N^(1/4)+1)^2" unless $q > $n->copy->broot(4)->badd(1)->bpow(2); return _pfail "ECPP: $n failed Q < N" unless $q < $n; return _pfail "ECPP: $n failed M != Q" unless $m != $q; my ($mdivq, $rem) = $m->copy->bdiv($q); return _pfail "ECPP: $n failed Q divides M" unless $rem == 0; # Now verify the elliptic curve my $correct_point = 0; if (prime_get_config->{'gmp'} && defined &Math::Prime::Util::GMP::_validate_ecpp_curve) { $correct_point = Math::Prime::Util::GMP::_validate_ecpp_curve($a, $b, $n, $x, $y, $m, $q); } else { if (!defined $Math::Prime::Util::ECAffinePoint::VERSION) { eval { require Math::Prime::Util::ECAffinePoint; 1; } or do { die "Cannot load Math::Prime::Util::ECAffinePoint"; }; } my $ECP = Math::Prime::Util::ECAffinePoint->new($a, $b, $n, $x, $y); # Compute U = (m/q)P, check U != point at infinity $ECP->mul( $m->copy->bdiv($q)->as_int ); if (!$ECP->is_infinity) { # Compute V = qU, check V = point at infinity $ECP->mul( $q ); $correct_point = 1 if $ECP->is_infinity; } } return _pfail "ECPP: $n failed elliptic curve conditions" unless $correct_point; ($n, $q); } sub _verify_ecpp3 { my ($n, $s, $r, $a, $b, $t) = @_; return unless defined $n; return _pfail "ECPP3: $n failed |A| <= N/2" unless abs($a) <= $n/2; return _pfail "ECPP3: $n failed |B| <= N/2" unless abs($b) <= $n/2; return _pfail "ECPP3: $n failed T >= 0" unless $t >= 0; return _pfail "ECPP3: $n failed T < N" unless $t < $n; my $l = ($t*$t*$t + $a*$t + $b) % $n; _verify_ecpp( $n, ($a * $l*$l) % $n, ($b * $l*$l*$l) % $n, $r*$s, $r, ($t*$l) % $n, ($l*$l) % $n ); } sub _verify_ecpp4 { my ($n, $s, $r, $j, $t) = @_; return unless defined $n; return _pfail "ECPP4: $n failed |J| <= N/2" unless abs($j) <= $n/2; return _pfail "ECPP4: $n failed T >= 0" unless $t >= 0; return _pfail "ECPP4: $n failed T < N" unless $t < $n; my $a = 3 * $j * (1728 - $j); my $b = 2 * $j * (1728 - $j) * (1728 - $j); my $l = ($t*$t*$t + $a*$t + $b) % $n; _verify_ecpp( $n, ($a * $l*$l) % $n, ($b * $l*$l*$l) % $n, $r*$s, $r, ($t*$l) % $n, ($l*$l) % $n ); } sub _verify_bls15 { my ($n, $q, $lp, $lq) = @_; return unless defined $n; return _pfail "BLS15: $n failed Q odd" unless $q->is_odd(); return _pfail "BLS15: $n failed Q > 2" unless $q > 2; my ($m, $rem) = ($n+1)->copy->bdiv($q); return _pfail "BLS15: $n failed Q divides N+1" unless $rem == 0; return _pfail "BLS15: $n failed MQ-1 = N" unless $m*$q-1 == $n; return _pfail "BLS15: $n failed M > 0" unless $m > 0; return _pfail "BLS15: $n failed 2Q-1 > sqrt(N)" unless 2*$q-1 > $n->copy->bsqrt(); my $D = $lp*$lp - 4*$lq; return _pfail "BLS15: $n failed D != 0" unless $D != 0; return _pfail "BLS15: $n failed jacobi(D,N) = -1" unless _jacobi($D,$n) == -1; return _pfail "BLS15: $n failed V_{m/2} mod N != 0" unless (lucas_sequence($n, $lp, $lq, $m/2))[1] != 0; return _pfail "BLS15: $n failed V_{(N+1)/2} mod N == 0" unless (lucas_sequence($n, $lp, $lq, ($n+1)/2))[1] == 0; ($n, $q); } sub _verify_bls3 { my ($n, $q, $a) = @_; return unless defined $n; return _pfail "BLS3: $n failed Q odd" unless $q->is_odd(); return _pfail "BLS3: $n failed Q > 2" unless $q > 2; my ($m, $rem) = ($n-1)->copy->bdiv($q); return _pfail "BLS3: $n failed Q divides N-1" unless $rem == 0; return _pfail "BLS3: $n failed MQ+1 = N" unless $m*$q+1 == $n; return _pfail "BLS3: $n failed M > 0" unless $m > 0; return _pfail "BLS3: $n failed 2Q+1 > sqrt(n)" unless 2*$q+1 > $n->copy->bsqrt(); return _pfail "BLS3: $n failed A^((N-1)/2) = N-1 mod N" unless $a->copy->bmodpow(($n-1)/2, $n) == $n-1; return _pfail "BLS3: $n failed A^(M/2) != N-1 mod N" unless $a->copy->bmodpow($m/2,$n) != $n-1; ($n, $q); } sub _verify_pock { my ($n, $q, $a) = @_; return unless defined $n; my ($m, $rem) = ($n-1)->copy->bdiv($q); return _pfail "Pocklington: $n failed Q divides N-1" unless $rem == 0; return _pfail "Pocklington: $n failed M is even" unless $m->is_even(); return _pfail "Pocklington: $n failed M > 0" unless $m > 0; return _pfail "Pocklington: $n failed M < Q" unless $m < $q; return _pfail "Pocklington: $n failed MQ+1 = N" unless $m*$q+1 == $n; return _pfail "Pocklington: $n failed A > 1" unless $a > 1; return _pfail "Pocklington: $n failed A^(N-1) mod N = 1" unless $a->copy->bmodpow($n-1, $n) == 1; return _pfail "Pocklington: $n failed gcd(A^M - 1, N) = 1" unless Math::BigInt::bgcd($a->copy->bmodpow($m, $n)-1, $n) == 1; ($n, $q); } sub _verify_small { my ($n) = @_; return unless defined $n; return _pfail "Small n $n is > 2^64\n" if $n > $_smallval; return _pfail "Small n $n does not pass BPSW" unless is_prob_prime($n); ($n); } sub _verify_bls5 { my ($n, $Qr, $Ar) = @_; return unless defined $n; my @Q = @{$Qr}; my @A = @{$Ar}; my $nm1 = $n - 1; my $F = Math::BigInt->bone; my $R = $nm1->copy; my $index = $#Q; foreach my $i (0 .. $index) { return _primality_error "BLS5: $n failed Q[$i] doesn't exist" unless defined $Q[$i]; $A[$i] = Math::BigInt->new(2) unless defined $A[$i]; return _pfail "BLS5: $n failed Q[$i] > 1" unless $Q[$i] > 1; return _pfail "BLS5: $n failed Q[$i] < N-1" unless $Q[$i] < $nm1; return _pfail "BLS5: $n failed A[$i] > 1" unless $A[$i] > 1; return _pfail "BLS5: $n failed A[$i] < N" unless $A[$i] < $n; return _pfail "BLS5: $n failed Q[$i] divides N-1" unless ($nm1 % $Q[$i]) == 0; while (($R % $Q[$i]) == 0) { $F *= $Q[$i]; $R /= $Q[$i]; } } die "BLS5: Internal error R != (N-1)/F\n" unless $R == $nm1/$F; return _pfail "BLS5: $n failed F is even" unless $F->is_even(); return _pfail "BLS5: $n failed gcd(F, R) = 1\n" unless Math::BigInt::bgcd($F,$R) == 1; my ($s, $r) = $R->copy->bdiv(2*$F); my $P = ($F+1) * (2 * $F * $F + ($r-1)*$F + 1); return _pfail "BLS5: $n failed n < P" unless $n < $P; return _pfail "BLS5: $n failed s=0 OR r^2-8s not a perfect square" unless $s == 0 or !_is_perfect_square($r*$r - 8*$s); foreach my $i (0 .. $index) { my $a = $A[$i]; my $q = $Q[$i]; return _pfail "BLS5: $n failed A[i]^(N-1) mod N = 1" unless $a->copy->bmodpow($nm1, $n)->is_one; return _pfail "BLS5: $n failed gcd(A[i]^((N-1)/Q[i])-1, N) = 1" unless Math::BigInt::bgcd($a->copy->bmodpow($nm1/$q, $n)->bdec, $n)->is_one; } ($n, @Q); } sub _verify_lucas { my ($n, $Qr, $a) = @_; return unless defined $n; my @Q = @{$Qr}; my $index = $#Q; return _pfail "Lucas: $n failed A > 1" unless $a > 1; return _pfail "Lucas: $n failed A < N" unless $a < $n; my $nm1 = $n - 1; my $F = Math::BigInt->bone; my $R = $nm1->copy; return _pfail "Lucas: $n failed A^(N-1) mod N = 1" unless $a->copy->bmodpow($nm1, $n) == 1; foreach my $i (1 .. $index) { return _primality_error "Lucas: $n failed Q[$i] doesn't exist" unless defined $Q[$i]; return _pfail "Lucas: $n failed Q[$i] > 1" unless $Q[$i] > 1; return _pfail "Lucas: $n failed Q[$i] < N-1" unless $Q[$i] < $nm1; return _pfail "Lucas: $n failed Q[$i] divides N-1" unless ($nm1 % $Q[$i]) == 0; return _pfail "Lucas: $n failed A^((N-1)/Q[$i]) mod N != 1" unless $a->copy->bmodpow($nm1/$Q[$i], $n) != 1; while (($R % $Q[$i]) == 0) { $F *= $Q[$i]; $R /= $Q[$i]; } } return _pfail("Lucas: $n failed N-1 has only factors Q") unless $R == 1 && $F == $nm1; shift @Q; # Remove Q[0] ($n, @Q); } sub verify_cert { my $cert = shift; $cert = convert_array_cert_to_string($cert) if ref($cert) eq 'ARRAY'; my %parts; # Map of "N is prime if Q is prime" my %proof_funcs = ( ECPP => \&_prove_ecpp, # Standard ECPP proof ECPP3 => \&_prove_ecpp3, # Primo type 3 ECPP4 => \&_prove_ecpp4, # Primo type 4 BLS15 => \&_prove_bls15, # basic n+1, includes Primo type 2 BLS3 => \&_prove_bls3, # basic n-1 BLS5 => \&_prove_bls5, # much better n-1 SMALL => \&_prove_small, # n <= 2^64 POCKLINGTON => \&_prove_pock, # simple n-1, Primo type 1 LUCAS => \&_prove_lucas, # n-1 completely factored ); my $base = 10; my $cert_type = 'Unknown'; my $N; my @lines = split /^/, $cert; my $lines = \@lines; while (@$lines) { my $line = shift @$lines; next if $line =~ /^\s*#/ or $line =~ /^\s*$/; # Skip comments / blank lines chomp($line); if ($line =~ /^\[(\S+) - Primality Certificate\]/) { if ($1 ne 'MPU') { return _primality_error "Unknown certificate type: $1"; } $cert_type = $1; next; } if ( ($cert_type eq 'PRIMO' && $line =~ /^\[Candidate\]/) || ($cert_type eq 'MPU' && $line =~ /^Proof for:/) ) { return _primality_error "Certificate with multiple N values" if defined $N; ($N) = _read_vars($lines, 'Proof for', qw/N/); if (!is_prob_prime($N)) { _pfail "N '$N' does not look prime."; return 0; } next; } if ($line =~ /^Base (\d+)/) { $base = $1; return _primality_error "Only base 10 supported, sorry" unless $base == 10; next; } if ($line =~ /^Type (.*?)\s*$/) { return _primality_error("Starting type without telling me the N value!") unless defined $N; my $type = $1; $type =~ tr/a-z/A-Z/; error("Unknown type: $type") unless defined $proof_funcs{$type}; my ($n, @q) = $proof_funcs{$type}->($lines); return 0 unless defined $n; $parts{$n} = [@q]; } } return _primality_error("No N") unless defined $N; my @qs = ($N); while (@qs) { my $q = shift @qs; # Check that this q has a chain if (!defined $parts{$q}) { if ($q > $_smallval) { _primality_error "q value $q has no proof\n"; return 0; } if (!is_prob_prime($q)) { _pfail "Small n $q does not pass BPSW"; return 0; } } else { die "Internal error: Invalid parts entry" if ref($parts{$q}) ne 'ARRAY'; # q is prime if all it's chains are prime. push @qs, @{$parts{$q}}; } } 1; } 1; __END__ # ABSTRACT: Primality proving =pod =encoding utf8 =for stopwords mul =head1 NAME Math::Prime::Util::PrimalityProving - Primality proofs and certificates =head1 VERSION Version 0.37 =head1 SYNOPSIS =head1 DESCRIPTION Routines to support primality proofs and certificate verification. =head1 FUNCTIONS =head2 primality_proof_lucas Given a positive number C as input, performs a full factorization of C, then attempts a Lucas test on the result. A Pratt-style certificate is returned. Note that if the input is composite, this will take a B long time to return. =head2 primality_proof_bls75 Given a positive number C as input, performs a partial factorization of C, then attempts a proof using theorem 5 of Brillhart, Lehmer, and Selfridge's 1975 paper. This can take a long time to return if given a composite, though it should not be anywhere near as long as the Lucas test. =head2 convert_array_cert_to_string Takes as input a Perl structure certificate, used by Math::Prime::Util from version 0.26 through 0.29, and converts it to a multi-line text certificate starting with "[MPU - Primality Certificate]". This is the new format produced and processed by Math::Prime::Util, Math::Prime::Util::GMP, and associated tools. =head2 verify_cert Takes a MPU primality certificate and verifies that it does prove the primality of the number it represents (the N after the "Proof for:" line). For backwards compatibility, if given an old-style Perl structure, it will be converted then verified. The return value will be C<0> (failed to verify) or C<1> (verified). A result of C<0> does I indicate the number is composite; it only indicates the proof given is not sufficient. If the certificate is malformed, the routine will carp a warning in addition to returning 0. If the C option is set (see L) then if the validation fails, the reason for the failure is printed in addition to returning 0. If the C option is set to 2 or higher, then a message indicating success and the certificate type is also printed. A later release may add support for L certificates, as all the method verifications are coded. =head1 SEE ALSO L =head1 AUTHORS Dana Jacobsen Edana@acm.orgE =head1 COPYRIGHT Copyright 2012-2013 by Dana Jacobsen Edana@acm.orgE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Math-Prime-Util-0.37/lib/Math/Prime/Util/RandomPrimes.pm0000644000076400007640000011414612270244414021316 0ustar danadanapackage Math::Prime::Util::RandomPrimes; use strict; use warnings; use Carp qw/carp croak confess/; use Math::Prime::Util qw/ prime_get_config verify_prime is_provable_prime_with_cert primorial prime_count nth_prime is_prob_prime is_strong_pseudoprime next_prime prev_prime /; BEGIN { $Math::Prime::Util::RandomPrimes::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::RandomPrimes::VERSION = '0.37'; } BEGIN { do { require Math::BigInt; Math::BigInt->import(try=>"GMP,Pari"); } unless defined $Math::BigInt::VERSION; use constant OLD_PERL_VERSION=> $] < 5.008; use constant MPU_MAXBITS => (~0 == 4294967295) ? 32 : 64; use constant MPU_64BIT => MPU_MAXBITS == 64; use constant MPU_32BIT => MPU_MAXBITS == 32; use constant MPU_MAXPARAM => MPU_32BIT ? 4294967295 : 18446744073709551615; use constant MPU_MAXDIGITS => MPU_32BIT ? 10 : 20; use constant MPU_USE_XS => prime_get_config->{'xs'}; use constant MPU_USE_GMP => prime_get_config->{'gmp'}; *_bigint_to_int = \&Math::Prime::Util::_bigint_to_int; } ################################################################################ # These are much faster than straightforward trial division when n is big. # You'll want to first do a test up to and including 23. my @_big_gcd; my $_big_gcd_top = 20046; my $_big_gcd_use = -1; sub _make_big_gcds { return if $_big_gcd_use >= 0; if (prime_get_config->{'gmp'}) { $_big_gcd_use = 0; return; } if (Math::BigInt->config()->{lib} !~ /^Math::BigInt::(GMP|Pari)/) { $_big_gcd_use = 0; return; } $_big_gcd_use = 1; my $p0 = primorial(Math::BigInt->new( 520)); my $p1 = primorial(Math::BigInt->new(2052)); my $p2 = primorial(Math::BigInt->new(6028)); my $p3 = primorial(Math::BigInt->new($_big_gcd_top)); $_big_gcd[0] = $p0->bdiv(223092870)->bfloor->as_int; $_big_gcd[1] = $p1->bdiv($p0)->bfloor->as_int; $_big_gcd[2] = $p2->bdiv($p1)->bfloor->as_int; $_big_gcd[3] = $p3->bdiv($p2)->bfloor->as_int; } ################################################################################ # Returns a function that will get a uniform random number # between 0 and $max inclusive. $max can be a bigint. my $_IRANDF; my $_BRS; my $_RANDF; my $_RANDF_NBIT; sub _set_randf { # First define a function $irandf that returns a 32-bit integer. This # corresponds to the irand function of many CPAN modules: # Math::Random::MT # Math::Random::ISAAC # Math::Random::Xorshift # Math::Random::Secure # (but not Math::Random::MT::Auto which will return 64-bits) my $irandf = prime_get_config->{'irand'}; if ( ( defined $_IRANDF && !defined $irandf) || (!defined $_IRANDF && defined $irandf) || ( defined $_IRANDF && defined $irandf && $_IRANDF != $irandf) ) { undef $_RANDF; undef $_RANDF_NBIT; $_IRANDF = $irandf; } return if defined $_RANDF; if (!defined $_IRANDF) { # Default irand: BRS nonblocking require Bytes::Random::Secure; $_BRS = Bytes::Random::Secure->new(NonBlocking=>1) unless defined $_BRS; $_RANDF_NBIT = sub { my($bits) = int("$_[0]"); return 0 if $bits <= 0; return ($_BRS->irand() >> (32-$bits)) if $bits <= 32; return ( (($_BRS->irand() << 32) + $_BRS->irand()) >> (64-$bits) ) if $bits <= 64 && ~0 > 4294967295; my $bytes = int(($bits+7)/8); my $n = Math::BigInt->from_hex('0x' . $_BRS->bytes_hex($bytes)); $n->brsft( 8*$bytes - $bits ) unless ($bits % 8) == 0; return $n; }; $_RANDF = sub { my($max) = @_; my $range = $max+1; my $U; if (ref($range) eq 'Math::BigInt') { my $bits = length($range->as_bin) - 2; # bits in range my $bytes = 1 + int(($bits+7)/8); # extra byte to reduce ave. loops my $rmax = Math::BigInt->bone->blsft($bytes*8)->bdec(); my $overflow = $rmax - ($rmax % $range); do { $U = Math::BigInt->from_hex('0x' . $_BRS->bytes_hex($bytes)); } while $U >= $overflow; } elsif ($range <= 4294967295) { my $overflow = (OLD_PERL_VERSION) ? 4294967295-(4294967295.0%$range) : 4294967295-(4294967295 % $range); do { $U = $_BRS->irand(); } while $U >= $overflow; } else { croak "randf given max out of bounds: $max" if $range > ~0; my $overflow = 18446744073709551615 - (18446744073709551615 % $range); do { $U = ($_BRS->irand() << 32) + $_BRS->irand(); } while $U >= $overflow; } return $U % $range; }; } else { # Custom irand $_RANDF_NBIT = sub { my($bits) = int("$_[0]"); return 0 if $bits <= 0; return ($_IRANDF->() >> (32-$bits)) if $bits <= 32; return ((($_IRANDF->() << 32) + $_IRANDF->()) >> (64-$bits)) if $bits <= 64 && MPU_64BIT; my $words = int(($bits+31)/32); my $n = Math::BigInt->from_hex ("0x" . join '', map { sprintf("%08X", $_IRANDF->()) } 1 .. $words ); $n->brsft( 32*$words - $bits ) unless ($bits % 32) == 0; return $n; }; $_RANDF = sub { my($max) = @_; return 0 if $max <= 0; my $range = $max+1; my $U; if (ref($range) eq 'Math::BigInt') { my $zero = $range->copy->bzero; my $rbits = length($range->as_bin) - 2; # bits in range my $rwords = int($rbits/32) + (($rbits % 32) ? 1 : 0); my $rmax = Math::BigInt->bone->blsft($rwords*32)->bdec(); my $overflow = $rmax - ($rmax % $range); do { $U = $range->copy->from_hex ("0x" . join '', map { sprintf("%08X", $_IRANDF->()) } 1 .. $rwords); } while $U >= $overflow; } elsif ($range <= 4294967295) { my $overflow = 4294967295 - (4294967295 % $range); do { $U = $_IRANDF->(); } while $U >= $overflow; } else { croak "randf given max out of bounds: $max" if $range > ~0; my $overflow = 18446744073709551615 - (18446744073709551615 % $range); do { $U = ($_IRANDF->() << 32) + $_IRANDF->(); } while $U >= $overflow; } return $U % $range; }; } } sub get_randf { _set_randf(); return $_RANDF; } sub get_randf_nbit { _set_randf(); return $_RANDF_NBIT; } ################################################################################ # For random primes, there are two good papers that should be examined: # # "Fast Generation of Prime Numbers and Secure Public-Key # Cryptographic Parameters" by Ueli M. Maurer, 1995 # http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.26.2151 # related discussions: # http://www.daimi.au.dk/~ivan/provableprimesproject.pdf # Handbook of Applied Cryptography by Menezes, et al. # # "Close to Uniform Prime Number Generation With Fewer Random Bits" # by Pierre-Alain Fouque and Mehdi Tibouchi, 2011 # http://eprint.iacr.org/2011/481 # # Some things to note: # # 1) Joye and Paillier have patents on their methods. Never use them. # # 2) The easy method of next_prime(random number), known as PRIMEINC, is # fast but gives a terrible distribution. It has a positive bias and # most importantly the probability for a prime is proportional to its # gap, which makes a terrible distribution (some numbers in the range # will be thousands of times more likely than others). # # We use: # TRIVIAL range within native integer size (2^32 or 2^64) # FTA1 random_nbit_prime with 65+ bits # INVA1 other ranges with 65+ bit range # where # TRIVIAL = monte-carlo method or equivalent, perfect uniformity. # FTA1 = Fouque/Tibouchi A1, very close to uniform # INVA1 = inverted FTA1, less uniform but works with arbitrary ranges # # The random_maurer_prime function uses Maurer's FastPrime algorithm. # # If Math::Prime::Util::GMP is installed, these functions will be many times # faster than other methods (e.g. Math::Pari monte-carlo or Crypt::Primes). # # Timings on x86_64, with Math::BigInt::GMP and Math::Random::ISAAC::XS. # # random_nbit_prime random_maurer_prime # n-bits no GMP w/ MPU::GMP no GMP w/ MPU::GMP # ---------- -------- ----------- -------- ----------- # 24-bit 22uS same same same # 64-bit 94uS same same same # 128-bit 0.017s 0.0020s 0.098s 0.056s # 256-bit 0.033s 0.0033s 0.25s 0.15s # 512-bit 0.066s 0.0093s 0.65s 0.30s # 1024-bit 0.16s 0.060s 1.3s 0.94s # 2048-bit 0.83s 0.5s 3.2s 3.1s # 4096-bit 6.6s 4.0s 23s 12.0s # # Writing these entirely in GMP has a problem, which is that we want to use # a user-supplied rand function, which means a lot of callbacks. One # possibility is to, if they do not supply a rand function, use the GMP MT # function with an appropriate seed. # # Random timings for 10M calls: # 1.92 system rand # 2.62 Math::Random::MT::Auto # 12.0 Math::Random::Secure w/ISAAC::XS # 12.6 Bytes::Random::Secure OO w/ISAAC::XS <==== our # 31.1 Bytes::Random::Secure OO <==== default # 44.5 Bytes::Random::Secure function w/ISAAC::XS # 44.8 Math::Random::Secure # 71.5 Bytes::Random::Secure function # 1840 Crypt::Random # # time perl -E 'sub irand {int(rand(4294967296));} irand() for 1..10000000;' # time perl -E 'use Math::Random::MT::Auto qw/irand/; irand() for 1..10000000;' # time perl -E 'use Math::Random::Secure qw/irand/; irand() for 1..10000000;' # time perl -E 'use Bytes::Random::Secure qw/random_bytes/; sub irand {return unpack("L",random_bytes(4));} irand() for 1..10000000;' # time perl -E 'use Bytes::Random::Secure; my $rng = Bytes::Random::Secure->new(); sub irand {return $rng->irand;} irand() for 1..10000000;' # time perl -E 'use Crypt::Random qw/makerandom/; sub irand {makerandom(Size=>32, Uniform=>1, Strength=>0)} irand() for 1..100_000;' # > haveged daemon running to stop /dev/random blocking # > Both BRS and CR have more features that this isn't measuring. # # To verify distribution: # perl -Iblib/lib -Iblib/arch -MMath::Prime::Util=:all -E 'my %freq; $n=1000000; $freq{random_nbit_prime(6)}++ for (1..$n); printf("%4d %6.3f%%\n", $_, 100.0*$freq{$_}/$n) for sort {$a<=>$b} keys %freq;' # perl -Iblib/lib -Iblib/arch -MMath::Prime::Util=:all -E 'my %freq; $n=1000000; $freq{random_prime(1260437,1260733)}++ for (1..$n); printf("%4d %6.3f%%\n", $_, 100.0*$freq{$_}/$n) for sort {$a<=>$b} keys %freq;' # Sub to call with low and high already primes and verified range. my $_random_prime = sub { my($low,$high) = @_; my $prime; _set_randf(); #{ my $bsize = 100; my @bins; my $counts = 10000000; # for my $c (1..$counts) { $bins[ $_IRANDF->($bsize-1) ]++; } # for my $b (0..$bsize) {printf("%4d %8.5f%%\n", $b, $bins[$b]/$counts);} } # low and high are both odds, and low < high. # This is fast for small values, low memory, perfectly uniform, and # consumes the minimum amount of randomness needed. But it isn't feasible # with large values. Also note that low must be a prime. if ($high <= 262144 && MPU_USE_XS) { my $li = prime_count(2, $low); my $irange = prime_count($low, $high); my $rand = $_RANDF->($irange-1); return nth_prime($li + $rand); } $low-- if $low == 2; # Low of 2 becomes 1 for our program. # Math::BigInt::GMP's RT 71548 will wreak havoc if we don't do this. $low = Math::BigInt->new("$low") if ref($high) eq 'Math::BigInt'; confess "Invalid _random_prime parameters: $low, $high" if ($low % 2) == 0 || ($high % 2) == 0; # We're going to look at the odd numbers only. my $oddrange = (($high - $low) >> 1) + 1; croak "Large random primes not supported on old Perl" if OLD_PERL_VERSION && MPU_64BIT && $oddrange > 4294967295; # If $low is large (e.g. >10 digits) and $range is small (say ~10k), it # would be fastest to call primes in the range and randomly pick one. I'm # not implementing it now because it seems like a rare case. # If the range is reasonably small, generate using simple Monte Carlo # method (aka the 'trivial' method). Completely uniform. if ($oddrange < MPU_MAXPARAM) { my $loop_limit = 2000 * 1000; # To protect against broken rand if ($low > 11) { while ($loop_limit-- > 0) { $prime = $low + 2 * $_RANDF->($oddrange-1); next if !($prime % 3) || !($prime % 5) || !($prime % 7) || !($prime % 11); return $prime if is_prob_prime($prime); } } else { while ($loop_limit-- > 0) { $prime = $low + 2 * $_RANDF->($oddrange-1); next if $prime > 11 && (!($prime % 3) || !($prime % 5) || !($prime % 7) || !($prime % 11)); return 2 if $prime == 1; # Remember the special case for 2. return $prime if is_prob_prime($prime); } } croak "Random function broken?"; } # We have an ocean of range, and a teaspoon to hold randomness. # Since we have an arbitrary range and not a power of two, I don't see how # Fouque's algorithm A1 could be used (where we generate lower bits and # generate random sets of upper). Similarly trying to simply generate # upper bits is full of ways to trip up and get non-uniform results. # # What I'm doing here is: # # 1) divide the range into semi-evenly sized partitions, where each part # is as close to $rand_max_val as we can. # 2) randomly select one of the partitions. # 3) iterate choosing random values within the partition. # # The downside is that we're skewing a _lot_ farther from uniformity than # we'd like. Imagine we started at 0 with 1e18 partitions of size 100k # each. # Probability of '5' being returned = # 1.04e-22 = 1e-18 (chose first partition) * 1/9592 (chose '5') # Probability of '100003' being returned = # 1.19e-22 = 1e-18 (chose second partition) * 1/8392 (chose '100003') # Probability of '99999999999999999999977' being returned = # 5.20e-22 = 1e-18 (chose last partition) * 1/1922 (chose '99...77') # So the primes in the last partition will show up 5x more often. # The partitions are selected uniformly, and the primes within are selected # uniformly, but the number of primes in each bucket is _not_ uniform. # Their individual probability of being selected is the probability of the # partition (uniform) times the probability of being selected inside the # partition (uniform with respect to all other primes in the same # partition, but each partition is different and skewed). # # Partitions are typically much larger than 100k, but with a huge range # we still see this (e.g. ~3x from 0-10^30, ~10x from 0-10^100). # # When selecting n-bit or n-digit primes, this effect is MUCH smaller, as # the skew becomes approx lg(2^n) / lg(2^(n-1)) which is pretty close to 1. # # # Another idea I'd like to try sometime is: # pclo = prime_count_lower(low); # pchi = prime_count_upper(high); # do { # $nth = random selection between pclo and pchi # $prguess = nth_prime_approx($nth); # } while ($prguess >= low) && ($prguess <= high); # monte carlo select a prime in $prguess-2**24 to $prguess+2**24 # which accounts for the prime distribution. my($binsize, $nparts); my $rand_part_size = 1 << (MPU_64BIT ? 32 : 31); if (ref($oddrange) eq 'Math::BigInt') { # Go to some trouble here because some systems are wonky, such as # giving us +a/+b = -r. Also note the quotes for the bigint argument. # Without that, Math::BigInt::GMP can return garbage. my($nbins, $rem); ($nbins, $rem) = $oddrange->copy->bdiv( "$rand_part_size" ); $nbins++ if $rem > 0; $nbins = $nbins->as_int(); ($binsize,$rem) = $oddrange->copy->bdiv($nbins); $binsize++ if $rem > 0; $binsize = $binsize->as_int(); $nparts = $oddrange->copy->bdiv($binsize)->as_int(); $low = $high->copy->bzero->badd($low) if ref($low) ne 'Math::BigInt'; } else { my $nbins = int($oddrange / $rand_part_size); $nbins++ if $nbins * $rand_part_size != $oddrange; $binsize = int($oddrange / $nbins); $binsize++ if $binsize * $nbins != $oddrange; $nparts = int($oddrange/$binsize); } $nparts-- if ($nparts * $binsize) == $oddrange; my $rpart = $_RANDF->($nparts); my $primelow = $low + 2 * $binsize * $rpart; my $partsize = ($rpart < $nparts) ? $binsize : $oddrange - ($nparts * $binsize); $partsize = _bigint_to_int($partsize) if ref($partsize) eq 'Math::BigInt'; #warn "range $oddrange = $nparts * $binsize + ", $oddrange - ($nparts * $binsize), "\n"; #warn " chose part $rpart size $partsize\n"; #warn " primelow is $low + 2 * $binsize * $rpart = $primelow\n"; #die "Result could be too large" if ($primelow + 2*($partsize-1)) > $high; # Generate random numbers in the interval until one is prime. my $loop_limit = 2000 * 1000; # To protect against broken rand # Simply things for non-bigints. if (ref($low) ne 'Math::BigInt') { while ($loop_limit-- > 0) { my $rand = $_RANDF->($partsize-1); $prime = $primelow + $rand + $rand; croak "random prime failure, $prime > $high" if $prime > $high; if ($prime <= 23) { $prime = 2 if $prime == 1; # special case for low = 2 next unless (0,0,1,1,0,1,0,1,0,0,0,1,0,1,0,0,0,1,0,1,0,0,0,1)[$prime]; return $prime; } next if !($prime % 3) || !($prime % 5) || !($prime % 7) || !($prime % 11); # It looks promising. Check it. next unless is_prob_prime($prime); return $prime; } croak "Random function broken?"; } # By checking a wheel 30 mod, we can skip anything that would be a multiple # of 2, 3, or 5, without even having to create the bigint prime. my @w30 = (1,0,5,4,3,2,1,0,3,2,1,0,1,0,3,2,1,0,1,0,3,2,1,0,5,4,3,2,1,0); my $primelow30 = $primelow % 30; $primelow30 = _bigint_to_int($primelow30) if ref($primelow30) eq 'Math::BigInt'; # Big GCD's are hugely fast with GMP or Pari, but super slow with Calc. _make_big_gcds() if $_big_gcd_use < 0; while ($loop_limit-- > 0) { my $rand = $_RANDF->($partsize-1); # Check wheel-30 mod my $rand30 = $rand % 30; next if $w30[($primelow30 + 2*$rand30) % 30] && ($rand > 3 || $primelow > 5); # Construct prime $prime = $primelow + $rand + $rand; croak "random prime failure, $prime > $high" if $prime > $high; if ($prime <= 23) { $prime = 2 if $prime == 1; # special case for low = 2 next unless (0,0,1,1,0,1,0,1,0,0,0,1,0,1,0,0,0,1,0,1,0,0,0,1)[$prime]; return $prime; } # With GMP, the fastest thing to do is check primality. if (MPU_USE_GMP) { next unless Math::Prime::Util::GMP::is_prime($prime); return $prime; } # No MPU:GMP, so primality checking is slow. Skip some composites here. next unless Math::BigInt::bgcd($prime, 7436429) == 1; if ($_big_gcd_use && $prime > $_big_gcd_top) { next unless Math::BigInt::bgcd($prime, $_big_gcd[0]) == 1; next unless Math::BigInt::bgcd($prime, $_big_gcd[1]) == 1; next unless Math::BigInt::bgcd($prime, $_big_gcd[2]) == 1; next unless Math::BigInt::bgcd($prime, $_big_gcd[3]) == 1; } # It looks promising. Check it. next unless is_prob_prime($prime); return $prime; } croak "Random function broken?"; }; # Cache of tight bounds for each digit. Helps performance a lot. my @_random_ndigit_ranges = (undef, [2,7], [11,97] ); my @_random_nbit_ranges = (undef, undef, [2,3],[5,7] ); my %_random_cache_small; # For fixed small ranges with XS, e.g. 6-digit, 18-bit sub _random_xscount_prime { my($low,$high) = @_; my($istart, $irange); my $cachearef = $_random_cache_small{$low,$high}; if (defined $cachearef) { ($istart, $irange) = @$cachearef; } else { my $beg = ($low <= 2) ? 2 : next_prime($low-1); my $end = ($high < ~0) ? prev_prime($high + 1) : prev_prime($high); ($istart, $irange) = ( prime_count(2, $beg), prime_count($beg, $end) ); $_random_cache_small{$low,$high} = [$istart, $irange]; } _set_randf(); my $rand = $_RANDF->($irange-1); return nth_prime($istart + $rand); } sub random_prime { my($low,$high) = @_; # Tighten the range to the nearest prime. $low = ($low <= 2) ? 2 : next_prime($low-1); # TODO: if high is bigint, we should do high++? $high = ($high < ~0) ? prev_prime($high + 1) : prev_prime($high); return $low if ($low == $high) && is_prob_prime($low); return if $low >= $high; # At this point low and high are both primes, and low < high. return $_random_prime->($low, $high); } sub random_ndigit_prime { my($digits) = @_; croak "random_ndigit_prime, digits must be >= 1" unless $digits >= 1; return _random_xscount_prime( int(10 ** ($digits-1)), int(10 ** $digits) ) if $digits <= 6 && MPU_USE_XS; my $bigdigits = $digits >= MPU_MAXDIGITS; if ($bigdigits && prime_get_config->{'nobigint'}) { croak "random_ndigit_prime with -nobigint, digits out of range" if $digits > MPU_MAXDIGITS; # Special case for nobigint and threshold digits if (!defined $_random_ndigit_ranges[$digits]) { my $low = int(10 ** ($digits-1)); my $high = ~0; $_random_ndigit_ranges[$digits] = [next_prime($low),prev_prime($high)]; } } if (!defined $_random_ndigit_ranges[$digits]) { if ($bigdigits) { my $low = Math::BigInt->new('10')->bpow($digits-1); my $high = Math::BigInt->new('10')->bpow($digits); # Just pull the range in to the nearest odd. $_random_ndigit_ranges[$digits] = [$low+1, $high-1]; } else { my $low = int(10 ** ($digits-1)); my $high = int(10 ** $digits); # Note: Perl 5.6.2 cannot represent 10**15 as an integer, so things # will crash all over the place if you try. We can stringify it, but # will just fail tests later. $_random_ndigit_ranges[$digits] = [next_prime($low),prev_prime($high)]; } } my ($low, $high) = @{$_random_ndigit_ranges[$digits]}; return $_random_prime->($low, $high); } my @_random_nbit_m; my @_random_nbit_lambda; my @_random_nbit_arange; sub random_nbit_prime { my($bits) = @_; croak "random_nbit_prime, bits must be >= 2" unless $bits >= 2; $bits = int("$bits"); _set_randf(); # Very small size, use the nth-prime method if ($bits <= 18 && MPU_USE_XS) { if ($bits <= 4) { return (2,3)[$_RANDF_NBIT->(1)] if $bits == 2; return (5,7)[$_RANDF_NBIT->(1)] if $bits == 3; return (11,13)[$_RANDF_NBIT->(1)] if $bits == 4; } return _random_xscount_prime( 1 << ($bits-1), 1 << $bits ); } croak "Mid-size random primes not supported on broken old Perl" if OLD_PERL_VERSION && MPU_64BIT && $bits > 49 && $bits <= 64; # Fouque and Tibouchi (2011) Algorithm 1 (basic) # Modified to make sure the nth bit is always set. # # Example for random_nbit_prime(512) on 64-bit Perl: # p: 1aaaaaaaabbbbbbbbbbbbbbbbbbbb1 # ^^ ^ ^--- Trailing 1 so p is odd # || +--- 512-63-2 = 447 lower bits selected before loop # |+--- 63 upper bits selected in loop, repeated until p is prime # +--- upper bit is 1 so we generate an n-bit prime # total: 1 + 63 + 447 + 1 = 512 bits # # Algorithm 2 is implemented in a previous commit on github. The problem # is that it doesn't set the nth bit, and making that change requires a # modification of the algorithm. It was not a lot faster than this A1 # with the native int trial division. If the irandf function was very # slow, then A2 would look more promising. # if (1 && $bits > 64) { my $l = (MPU_64BIT && $bits > 79) ? 63 : 31; $l = 49 if $l == 63 && OLD_PERL_VERSION; # Fix for broken Perl 5.6 $l = $bits-2 if $bits-2 < $l; my $brand = $_RANDF_NBIT->($bits-$l-2); $brand = Math::BigInt->new("$brand") unless ref($brand) eq 'Math::BigInt'; my $b = $brand->blsft(1)->binc(); # Precalculate some modulii so we can do trial division on native int # 9699690 = 2*3*5*7*11*13*17*19, so later operations can be native ints my @premod; my $bpremod = _bigint_to_int($b->copy->bmod(9699690)); my $twopremod = _bigint_to_int(Math::BigInt->new(2)->bmodpow($bits-$l-1, 9699690)); foreach my $zi (0 .. 19-1) { foreach my $pm (3, 5, 7, 11, 13, 17, 19) { next if $zi >= $pm || defined $premod[$pm]; $premod[$pm] = $zi if ( ($twopremod*$zi+$bpremod) % $pm) == 0; } } _make_big_gcds() if $_big_gcd_use < 0; if (!MPU_USE_GMP) { require Math::Prime::Util::PP; } my $loop_limit = 1_000_000; while ($loop_limit-- > 0) { my $a = (1 << $l) + $_RANDF_NBIT->($l); # $a % s == $premod[s] => $p % s == 0 => p will be composite next if $a % 3 == $premod[ 3] || $a % 5 == $premod[ 5] || $a % 7 == $premod[ 7] || $a % 11 == $premod[11] || $a % 13 == $premod[13] || $a % 17 == $premod[17] || $a % 19 == $premod[19]; my $p = Math::BigInt->new("$a")->blsft($bits-$l-1)->badd($b); #die " $a $b $p" if $a % 11 == $premod[11] && $p % 11 != 0; #die "!$a $b $p" if $a % 11 != $premod[11] && $p % 11 == 0; if (MPU_USE_GMP) { next unless Math::Prime::Util::GMP::is_prime($p); } else { next unless Math::BigInt::bgcd($p, 1348781387) == 1; # 23-43 if ($_big_gcd_use && $p > $_big_gcd_top) { next unless Math::BigInt::bgcd($p, $_big_gcd[0]) == 1; next unless Math::BigInt::bgcd($p, $_big_gcd[1]) == 1; next unless Math::BigInt::bgcd($p, $_big_gcd[2]) == 1; next unless Math::BigInt::bgcd($p, $_big_gcd[3]) == 1; } # We know we don't have GMP and are > 2^64, so go directly to this. next unless Math::Prime::Util::PP::is_bpsw_prime($p); } return $p; } croak "Random function broken?"; } # The Trivial method. Great uniformity, and fine for small sizes. It # gets very slow as the bit size increases, but that is why we have the # method above for bigints. if (1) { my $loop_limit = 2_000_000; if ($bits > MPU_MAXBITS) { my $p = Math::BigInt->bone->blsft($bits-1)->binc(); while ($loop_limit-- > 0) { my $n = Math::BigInt->new(''.$_RANDF_NBIT->($bits-2))->blsft(1)->badd($p); return $n if is_prob_prime($n); } } else { my $p = (1 << ($bits-1)) + 1; while ($loop_limit-- > 0) { my $n = $p + ($_RANDF_NBIT->($bits-2) << 1); return $n if is_prob_prime($n); } } croak "Random function broken?"; } else { # Send through the generic random_prime function. Decently fast, but # quite a bit slower than the F&T A1 method above. if (!defined $_random_nbit_ranges[$bits]) { if ($bits > MPU_MAXBITS) { my $low = Math::BigInt->new('2')->bpow($bits-1); my $high = Math::BigInt->new('2')->bpow($bits); # Don't pull the range in to primes, just odds $_random_nbit_ranges[$bits] = [$low+1, $high-1]; } else { my $low = 1 << ($bits-1); my $high = ($bits == MPU_MAXBITS) ? ~0-1 : ~0 >> (MPU_MAXBITS - $bits); $_random_nbit_ranges[$bits] = [next_prime($low-1),prev_prime($high+1)]; # Example: bits = 7. # low = 1<<6 = 64. next_prime(64-1) = 67 # high = ~0 >> (64-7) = 127. prev_prime(127+1) = 127 } } my ($low, $high) = @{$_random_nbit_ranges[$bits]}; return $_random_prime->($low, $high); } } # For stripping off the header on certificates so they can be combined. sub _strip_proof_header { my $proof = shift; $proof =~ s/^\[MPU - Primality Certificate\]\nVersion \S+\n+Proof for:\nN (\d+)\n+//ms; return $proof; } sub random_maurer_prime { my $k = shift; croak "random_maurer_prime, bits must be >= 2" unless $k >= 2; $k = int("$k"); return random_nbit_prime($k) if $k <= MPU_MAXBITS && !OLD_PERL_VERSION; my ($n, $cert) = random_maurer_prime_with_cert($k); croak "maurer prime $n failed certificate verification!" unless verify_prime($cert); return $n; } sub random_maurer_prime_with_cert { my $k = shift; croak "random_maurer_prime, bits must be >= 2" unless $k >= 2; $k = int("$k"); # This should never happen. Trap now to prevent infinite loop. croak "number of bits must not be a bigint" if ref($k) eq 'Math::BigInt'; # Results for random_nbit_prime are proven for all native bit sizes. my $p0 = MPU_MAXBITS; $p0 = 49 if OLD_PERL_VERSION && MPU_MAXBITS > 49; if ($k <= $p0) { my $n = random_nbit_prime($k); my ($isp, $cert) = is_provable_prime_with_cert($n); croak "small nbit prime could not be proven" if $isp != 2; return ($n, $cert); } # Set verbose to 3 to get pretty output like Crypt::Primes my $verbose = prime_get_config->{'verbose'}; local $| = 1 if $verbose > 2; do { require Math::BigFloat; Math::BigFloat->import(); } if !defined $Math::BigFloat::VERSION; # Ignore Maurer's g and c that controls how much trial division is done. my $r = Math::BigFloat->new("0.5"); # relative size of the prime q my $m = 20; # makes sure R is big enough _set_randf(); # Generate a random prime q of size $r*$k, where $r >= 0.5. Try to # cleverly select r to match the size of a typical random factor. if ($k > 2*$m) { do { my $s = Math::BigFloat->new($_RANDF->(2147483647))->bdiv(2147483648); $r = Math::BigFloat->new(2)->bpow($s-1); } while ($k*$r >= $k-$m); } # I've seen +0, +1, and +2 here. Maurer uses +0. Menezes uses +1. # We can use +1 because we're using BLS75 theorem 3 later. my $smallk = int(($r * $k)->bfloor->bstr) + 1; my ($q, $qcert) = random_maurer_prime_with_cert($smallk); $q = Math::BigInt->new("$q") unless ref($q) eq 'Math::BigInt'; my $I = Math::BigInt->new(2)->bpow($k-2)->bdiv($q)->bfloor->as_int(); print "r = $r k = $k q = $q I = $I\n" if $verbose && $verbose != 3; $qcert = ($q < Math::BigInt->new("18446744073709551615")) ? "" : _strip_proof_header($qcert); # Big GCD's are hugely fast with GMP or Pari, but super slow with Calc. _make_big_gcds() if $_big_gcd_use < 0; my $ONE = Math::BigInt->bone; my $TWO = $ONE->copy->binc; my $loop_limit = 1_000_000 + $k * 1_000; while ($loop_limit-- > 0) { # R is a random number between $I+1 and 2*$I #my $R = $I + 1 + $_RANDF->( $I - 1 ); my $R = $I->copy->binc->badd( $_RANDF->($I->copy->bdec) ); #my $n = 2 * $R * $q + 1; my $nm1 = $TWO->copy->bmul($R)->bmul($q); my $n = $nm1->copy->binc; # We constructed a promising looking $n. Now test it. print "." if $verbose > 2; if (MPU_USE_GMP) { # MPU::GMP::is_prob_prime has fast tests built in. next unless Math::Prime::Util::GMP::is_prob_prime($n); } else { # No GMP, so first do trial divisions, then a SPSP test. next unless Math::BigInt::bgcd($n, 111546435)->is_one; if ($_big_gcd_use && $n > $_big_gcd_top) { next unless Math::BigInt::bgcd($n, $_big_gcd[0])->is_one; next unless Math::BigInt::bgcd($n, $_big_gcd[1])->is_one; next unless Math::BigInt::bgcd($n, $_big_gcd[2])->is_one; next unless Math::BigInt::bgcd($n, $_big_gcd[3])->is_one; } print "+" if $verbose > 2; next unless is_strong_pseudoprime($n, 3); } print "*" if $verbose > 2; # We could pick a random generator by doing: # Step 1: pick a random r # Step 2: compute g = r^((n-1)/q) mod p # Step 3: if g == 1, goto Step 1. # Note that n = 2*R*q+1, hence the exponent is 2*R. # We could set r = 0.3333 earlier, then use BLS75 theorem 5 here. # The chain would be shorter, requiring less overall work for # large inputs. Maurer's paper discusses the idea. # Use BLS75 theorem 3. This is easier and possibly faster than # BLS75 theorem 4 (Pocklington) used by Maurer's paper. # Check conditions -- these should be redundant. my $m = $TWO * $R; if (! ($q->is_odd && $q > 2 && $m > 0 && $m * $q + $ONE == $n && $TWO*$q+$ONE > $n->copy->bsqrt()) ) { carp "Maurer prime failed BLS75 theorem 3 conditions. Retry."; next; } # Find a suitable a. Move on if one isn't found quickly. foreach my $trya (2, 3, 5, 7, 11, 13) { my $a = Math::BigInt->new($trya); # m/2 = R (n-1)/2 = (2*R*q)/2 = R*q next unless $a->copy->bmodpow($R, $n) != $nm1; next unless $a->copy->bmodpow($R*$q, $n) == $nm1; print "($k)" if $verbose > 2; croak "Maurer prime $n=2*$R*$q+1 failed BPSW" unless is_prob_prime($n); my $cert = "[MPU - Primality Certificate]\nVersion 1.0\n\n" . "Proof for:\nN $n\n\n" . "Type BLS3\nN $n\nQ $q\nA $a\n" . $qcert; return ($n, $cert); } # Didn't pass the selected a values. Try another R. } croak "Failure in random_maurer_prime, could not find a prime\n"; } # End of random_maurer_prime # Gordon's algorithm for generating a strong prime. sub random_strong_prime { my $t = shift; croak "random_strong_prime, bits must be >= 128" unless $t >= 128; $t = int("$t"); croak "Random strong primes must be >= 173 bits on old Perl" if OLD_PERL_VERSION && MPU_64BIT && $t < 173; _set_randf(); my $l = (($t+1) >> 1) - 2; my $lp = int($t/2) - 20; my $lpp = $l - 20; while (1) { my $qp = random_nbit_prime($lp); my $qpp = random_nbit_prime($lpp); $qp = Math::BigInt->new("$qp") unless ref($qp) eq 'Math::BigInt'; $qpp = Math::BigInt->new("$qpp") unless ref($qpp) eq 'Math::BigInt'; my ($il, $rem) = Math::BigInt->new(2)->bpow($l-1)->bdec()->bdiv(2*$qpp); $il++ if $rem > 0; $il = $il->as_int(); my $iu = Math::BigInt->new(2)->bpow($l)->bsub(2)->bdiv(2*$qpp)->as_int(); my $istart = $il + $_RANDF->($iu - $il); for (my $i = $istart; $i <= $iu; $i++) { # Search for q my $q = 2 * $i * $qpp + 1; next unless is_prob_prime($q); my $pp = $qp->copy->bmodpow($q-2, $q)->bmul(2)->bmul($qp)->bdec(); my ($jl, $rem) = Math::BigInt->new(2)->bpow($t-1)->bsub($pp)->bdiv(2*$q*$qp); $jl++ if $rem > 0; $jl = $jl->as_int(); my $ju = Math::BigInt->new(2)->bpow($t)->bdec()->bsub($pp)->bdiv(2*$q*$qp)->as_int(); my $jstart = $jl + $_RANDF->($ju - $jl); for (my $j = $jstart; $j <= $ju; $j++) { # Search for p my $p = $pp + 2 * $j * $q * $qp; return $p if is_prob_prime($p); } } } } sub random_proven_prime { my $k = shift; my ($n, $cert) = random_proven_prime_with_cert($k); croak "random_proven_prime $n failed certificate verification!" unless verify_prime($cert); return $n; } sub random_proven_prime_with_cert { my $k = shift; if (prime_get_config->{'gmp'} && $k <= 450) { my $n = random_nbit_prime($k); my ($isp, $cert) = is_provable_prime_with_cert($n); croak "small nbit prime could not be proven" if $isp != 2; return ($n, $cert); } return random_maurer_prime_with_cert($k); } sub miller_rabin_random { my($n, $k, $seed) = @_; # Testing this many bases is silly, but let's pretend they have some # good reason. A composite n > 9 must have at least n/4 witnesses, # hence we need to check only floor(3/4)+1 at most. We could improve # this is $_Config{'assume_rh'} is true, to 1 .. 2(logn)^2. if ($k >= int(3*$n/4)) { return is_strong_pseudoprime($n, 2 .. int(3*$n/4)+1+2 ); } _set_randf(); my $brange = $n-3; # Do one first before doing batches return 0 unless is_strong_pseudoprime($n, $_RANDF->($brange)+2 ); $k--; while ($k > 0) { my $nbases = ($k >= 20) ? 20 : $k; my @bases = map { $_RANDF->($brange)+2 } 1..$nbases; return 0 unless is_strong_pseudoprime($n, @bases); $k -= $nbases; } 1; } 1; __END__ # ABSTRACT: Generate random primes =pod =encoding utf8 =head1 NAME Math::Prime::Util::RandomPrimes - Generate random primes =head1 VERSION Version 0.37 =head1 SYNOPSIS =head1 DESCRIPTION Routines to generate random primes, including constructing proven primes. =head1 RANDOM UTILITY FUNCTIONS =head2 get_randf Gets a subroutine that will produce random integers between 0 and C, inclusive. The argument C can be a bigint. =head2 get_randf_nbit Gets a subroutine that will produce random integers between 0 and C<2^n-1>, inclusive. =head1 RANDOM PRIME FUNCTIONS =head2 random_prime Generate a random prime between C and C. If given one argument, C will be 2. =head2 random_ndigit_prime Generate a random prime with C digits. C must be at least 1. =head2 random_nbit_prime Generate a random prime with C bits. C must be at least 2. =head2 random_maurer_prime Construct a random provable prime of C bits using Maurer's FastPrime algorithm. C must be at least 2. =head2 random_maurer_prime_with_cert Construct a random provable prime of C bits using Maurer's FastPrime algorithm. C must be at least 2. Returns a list of two items: the prime and the certificate. =head2 random_strong_prime Construct a random strong prime of C bits. C must be at least 128. =head2 random_proven_prime Generate or construct a random provable prime of C bits. C must be at least 2. =head2 random_proven_prime_with_cert Generate or construct a random provable prime of C bits. C must be at least 2. Returns a list of two items: the prime and the certificate. =head1 RANDOM PRIMALITY FUNCTIONS =head2 miller_rabin_random Given a number C and a number of tests to perform C, this does C Miller-Rabin tests on C using randomly selected bases. The return value is 1 if all bases are a witness to to C, or 0 if any of them fail. =head1 SEE ALSO L =head1 AUTHORS Dana Jacobsen Edana@acm.orgE =head1 COPYRIGHT Copyright 2012-2013 by Dana Jacobsen Edana@acm.orgE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Math-Prime-Util-0.37/lib/Math/Prime/Util/PrimeArray.pm0000644000076400007640000002253512270242116020766 0ustar danadanapackage Math::Prime::Util::PrimeArray; use strict; use warnings; BEGIN { $Math::Prime::Util::PrimeArray::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::PrimeArray::VERSION = '0.37'; } # parent is cleaner, and in the Perl 5.10.1 / 5.12.0 core, but not earlier. # use parent qw( Exporter ); use base qw( Exporter ); our @EXPORT_OK = qw( ); our %EXPORT_TAGS = (all => [ @EXPORT_OK ]); use Math::Prime::Util qw/nth_prime nth_prime_upper nth_prime_lower primes prime_precalc next_prime prev_prime/; use Tie::Array; use Carp qw/carp croak confess/; sub TIEARRAY { my $class = shift; if (@_) { croak "usage: tie ARRAY, '" . __PACKAGE__ . ""; } return bless { # used to keep track of shift SHIFTINDEX => 0, # Remove all extra prime memory when we go out of scope MEMFREE => Math::Prime::Util::MemFree->new, # A chunk of primes PRIMES => [2, 3, 5, 7, 11, 13, 17], # What's the index of the first one? BEG_INDEX => 0, # What's the index of the last one? END_INDEX => 6, # positive = forward, negative = backward, 0 = random ACCESS_TYPE => 0, }, $class; } sub STORE { carp "You cannot write to the prime array"; } sub DELETE { carp "You cannot write to the prime array"; } sub STORESIZE { carp "You cannot write to the prime array"; } sub EXISTS { 1 } #sub EXTEND { my $self = shift; my $count = shift; prime_precalc($count); } sub EXTEND { 1 } sub FETCHSIZE { 0x7FFF_FFFF } # Even on 64-bit # Simple FETCH: # sub FETCH { return nth_prime($_[1]+1); } sub FETCH { my $self = shift; my $index = shift; # We actually don't get negative indices -- they get turned into big numbers croak "Negative index given to prime array" if $index < 0; $index += $self->{SHIFTINDEX}; # take into account any shifts my $begidx = $self->{BEG_INDEX}; my $endidx = $self->{END_INDEX}; if ( $index < $begidx || $index > $endidx ) { if ($index == $endidx+1) { # Forward iteration $self->{ACCESS_TYPE}++; if ($self->{ACCESS_TYPE} > 2) { my $end_prime = nth_prime_upper($index + 10_000); $self->{PRIMES} = primes( $self->{PRIMES}->[-1]+1, $end_prime ); $begidx = $endidx+1; } else { push @{$self->{PRIMES}}, next_prime($self->{PRIMES}->[-1]); } } elsif ($index == $begidx-1) { # Backward iteration $self->{ACCESS_TYPE}--; if ($self->{ACCESS_TYPE} < -2) { my $num = 10_000; my $beg_prime = $index <= $num ? 2 : nth_prime_lower($index - $num ); $self->{PRIMES} = primes($beg_prime, $self->{PRIMES}->[0]-1); $begidx -= scalar @{ $self->{PRIMES} }; } else { $begidx--; unshift @{$self->{PRIMES}}, prev_prime($self->{PRIMES}->[0]); } } else { # Random access $self->{ACCESS_TYPE} = int($self->{ACCESS_TYPE} / 2); # Alternately we could get a small window $begidx = $index; $self->{PRIMES} = [nth_prime($begidx+1)]; } $self->{BEG_INDEX} = $begidx; $self->{END_INDEX} = $begidx + scalar @{$self->{PRIMES}} - 1; } return $self->{PRIMES}->[ $index - $begidx ]; } # Fake out shift and unshift sub SHIFT { my $self = shift; my $head = $self->FETCH(0); $self->{SHIFTINDEX}++; $head; } sub UNSHIFT { my $self = shift; my $shiftamount = defined $_[0] ? shift : 1; $self->{SHIFTINDEX} = ($shiftamount >= $self->{SHIFTINDEX}) ? 0 : $self->{SHIFTINDEX} - $shiftamount; $self->FETCHSIZE; } # CLEAR this # PUSH this, LIST # POP this # SPLICE this, offset, len, LIST # DESTROY this # UNTIE this 1; __END__ # ABSTRACT: A tied array for primes =pod =head1 NAME Math::Prime::Util::PrimeArray - A tied array for primes =head1 VERSION Version 0.37 =head1 SYNOPSIS use Math::Prime::Util::PrimeArray; # Create: tie my @primes, 'Math::Prime::Util::PrimeArray'; # Use in a loop by index: for my $n (1..10) { print "prime $n = $primes[$n]\n"; } # Use in a loop over array: for my $p (@primes) { print "$p\n"; last if $p > $limit; # stop sometime } # Use via array slice: print join(",", @primes[0..50]), "\n"; # Use via each: use 5.012; while( my($index,$value) = each @primes ) { print "The ${index}th prime is $value\n"; last if $p > $limit; # stop sometime } # Use with shift: while ((my $p = shift @primes) < $limit) { print "$p\n"; } =head1 DESCRIPTION An array that acts like the infinite set of primes. This may be more convenient than using L directly, and in some cases it can be faster than calling C and C. If the access pattern is ascending or descending, then a window is sieved and results returned from the window as needed. If the access pattern is random, then C is used. Shifting acts like the array is losing elements at the front, so after two shifts, C<$primes[0] == 5>. Unshift will move the internal shift index back one, unless given an argument which is the number to move back (it silently truncates so it does not shift past the beginning). Example: say shift @primes; # 2 say shift @primes; # 3 say shift @primes; # 5 say $primes[0]; # 7 unshift @primes; # back up one say $primes[0]; # 5 unshift @primes, 2; # back up two say $primes[0]; # 2 If you want sequential primes with low memory, I recommend using L. It is much faster, as the tied array functionality in Perl is not high performance. It isn't as flexible as the prime array, but it is a very common pattern. If you prefer an iterator pattern, I would recommend using L. It will be a bit faster than using this tied array, but of course you don't get random access. If you find yourself using the C operation, consider the iterator. =head1 LIMITATIONS The size of the array will always be shown as 2147483647 (IV32 max), even in a 64-bit environment where primes through C<2^64> are available. There are some people that find the idea of shifting a prime array abhorrent, as after two shifts, "the second prime is 7?!". If this bothers you, do not use C on the tied array. =head1 PERFORMANCE MPU forprimes: forprimes { $sum += $_ } nth_prime(100_000); MPU iterator: my $it = prime_iterator; $sum += $it->() for 1..100000; MPU array: $sum += $_ for @{primes(nth_prime(100_000))}; MPUPA: tie my @primes, ...; $sum += $primes[$_] for 0..99999; MNSP: my $seq = Math::NumSeq::Primes->new; $sum += ($seq->next)[1] for 1..100000; MPTA: tie my @primes, ...; $sum += $primes[$_] for 0..99999; Memory use is comparing the delta between just loading the module and running the test. Perl 5.19.2, Math::NumSeq v61, Math::Prime::TiedArray v0.04. Summing the first 0.1M primes via walking the array: 7ms 52k Math::Prime::Util forprimes 140ms 0 Math::Prime::Util prime_iterator 12ms 4400k Math::Prime::Util sum big array 220ms 840k Math::Prime::Util::PrimeArray 130ms 280k Math::NumSeq::Primes sequence iterator 7560ms 65 MB Math::Prime::TiedArray (extend 1k) Summing the first 1M primes via walking the array: 0.1s 300k Math::Prime::Util forprimes 1.8s 0 Math::Prime::Util prime_iterator 0.2s 40 MB Math::Prime::Util sum big array 1.9s 1.1MB Math::Prime::Util::PrimeArray 7.5s 1.2MB Math::NumSeq::Primes sequence iterator 110.5s 785 MB Math::Prime::TiedArray (extend 1k) Summing the first 10M primes via walking the array: 0.8s 5.9MB Math::Prime::Util forprimes 22.4s 0 Math::Prime::Util prime_iterator 1.5s 368 MB Math::Prime::Util sum big array 19.1s 1.2MB Math::Prime::Util::PrimeArray 3680 s 11.1MB Math::NumSeq::Primes sequence iterator >5000 MB Math::Primes::TiedArray (extend 1k) L offers three obvious solutions: a big array, an iterator, and the C construct. The big array is fast but uses a B of memory, forcing the user to start programming segments. Using the iterator avoids all the memory use, but isn't as fast (this may improve in a later release, as this is a new feature). The C construct is by far the fastest, but it isn't quite as flexible as the iterator (most notably there is no way to exit early, and it doesn't lend itself to wrapping inside a filter). L offers an iterator alternative, and works quite well for reasonably small numbers. It does not support random access. It is very fast for small values, but is very slow with large counts. L is remarkably impractical for anything other than very small numbers. =head1 SEE ALSO This module uses L to do all the work. If you're doing anything but retrieving primes, you should examine that module to see if it has functionality you can use directly, as it may be a lot faster or easier. Similar functionality can be had from L and L. =head1 AUTHORS Dana Jacobsen Edana@acm.orgE =head1 COPYRIGHT Copyright 2012-2013 by Dana Jacobsen Edana@acm.orgE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Math-Prime-Util-0.37/lib/Math/Prime/Util/ECProjectivePoint.pm0000644000076400007640000001452712270242116022251 0ustar danadanapackage Math::Prime::Util::ECProjectivePoint; use strict; use warnings; use Carp qw/carp croak confess/; BEGIN { $Math::Prime::Util::ECProjectivePoint::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::ECProjectivePoint::VERSION = '0.37'; } BEGIN { do { require Math::BigInt; Math::BigInt->import(try=>"GMP,Pari"); } unless defined $Math::BigInt::VERSION; } # Pure perl (with Math::BigInt) manipulation of Elliptic Curves # in projective coordinates. sub new { my ($class, $c, $n, $x, $z) = @_; $c = Math::BigInt->new("$c") unless ref($c) eq 'Math::BigInt'; $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; $x = Math::BigInt->new("$x") unless ref($x) eq 'Math::BigInt'; $z = Math::BigInt->new("$z") unless ref($z) eq 'Math::BigInt'; croak "n must be >= 2" unless $n >= 2; $c->bmod($n); my $self = { c => $c, d => ($c + 2) >> 2, n => $n, x => $x, z => $z, f => $n-$n+1, }; bless $self, $class; return $self; } sub _addx { my ($x1, $x2, $xin, $n) = @_; my $u = ($x2 - 1) * ($x1 + 1); my $v = ($x2 + 1) * ($x1 - 1); my $upv2 = ($u + $v) ** 2; my $umv2 = ($u - $v) ** 2; return ( $upv2 % $n, ($umv2*$xin) % $n ); } sub _add3 { my ($x1, $z1, $x2, $z2, $xin, $zin, $n) = @_; my $u = ($x2 - $z2) * ($x1 + $z1); my $v = ($x2 + $z2) * ($x1 - $z1); my $upv2 = $u + $v; $upv2->bmul($upv2); my $umv2 = $u - $v; $umv2->bmul($umv2); $upv2->bmul($zin)->bmod($n); $umv2->bmul($xin)->bmod($n); return ($upv2, $umv2); } sub _double { my ($x, $z, $n, $d) = @_; my $u = $x + $z; $u->bmul($u); my $v = $x - $z; $v->bmul($v); my $w = $u - $v; my $t = $d * $w + $v; $u->bmul($v)->bmod($n); $w->bmul($t)->bmod($n); return ($u, $w); } sub mul { my ($self, $k) = @_; my $x = $self->{'x'}; my $z = $self->{'z'}; my $n = $self->{'n'}; my $d = $self->{'d'}; my ($x1, $x2, $z1, $z2); my $r = --$k; my $l = -1; while ($r != 1) { $r >>= 1; $l++ } if ($k & (1 << $l)) { ($x2, $z2) = _double($x, $z, $n, $d); ($x1, $z1) = _add3($x2, $z2, $x, $z, $x, $z, $n); ($x2, $z2) = _double($x2, $z2, $n, $d); } else { ($x1, $z1) = _double($x, $z, $n, $d); ($x2, $z2) = _add3($x, $z, $x1, $z1, $x, $z, $n); } $l--; while ($l >= 1) { if ($k & (1 << $l)) { ($x1, $z1) = _add3($x1, $z1, $x2, $z2, $x, $z, $n); ($x2, $z2) = _double($x2, $z2, $n, $d); } else { ($x2, $z2) = _add3($x2, $z2, $x1, $z1, $x, $z, $n); ($x1, $z1) = _double($x1, $z1, $n, $d); } $l--; } if ($k & 1) { ($x, $z) = _double($x2, $z2, $n, $d); } else { ($x, $z) = _add3($x2, $z2, $x1, $z1, $x, $z, $n); } $self->{'x'} = $x; $self->{'z'} = $z; return $self; } sub add { my ($self, $other) = @_; croak "add takes a EC point" unless ref($other) eq 'Math::Prime::Util::ECProjectivePoint'; croak "second point is not on the same curve" unless $self->{'c'} == $other->{'c'} && $self->{'n'} == $other->{'n'}; ($self->{'x'}, $self->{'z'}) = _add3($self->{'x'}, $self->{'z'}, $other->{'x'}, $other->{'z'}, $self->{'x'}, $self->{'z'}, $self->{'n'}); return $self; } sub double { my ($self) = @_; ($self->{'x'}, $self->{'z'}) = _double($self->{'x'}, $self->{'z'}, $self->{'n'}, $self->{'d'}); return $self; } sub _extended_gcd { my ($a, $b) = @_; my $zero = $a-$a; my ($x, $lastx, $y, $lasty) = ($zero, $zero+1, $zero+1, $zero); while ($b != 0) { my $q = int($a/$b); ($a, $b) = ($b, $a % $b); ($x, $lastx) = ($lastx - $q*$x, $x); ($y, $lasty) = ($lasty - $q*$y, $y); } return ($a, $lastx, $lasty); } sub normalize { my ($self) = @_; my $n = $self->{'n'}; my $z = $self->{'z'}; #my ($f, $u, undef) = _extended_gcd( $z, $n ); my $f = Math::BigInt::bgcd( $z, $n ); my $u = $z->copy->bmodinv($n); $self->{'x'} = ( $self->{'x'} * $u ) % $n; $self->{'z'} = $n-$n+1; $self->{'f'} = ($f * $self->{'f'}) % $n; return $self; } sub c { return shift->{'c'}; } sub d { return shift->{'d'}; } sub n { return shift->{'n'}; } sub x { return shift->{'x'}; } sub z { return shift->{'z'}; } sub f { return shift->{'f'}; } sub is_infinity { my $self = shift; return ($self->{'x'}->is_zero() && $self->{'z'}->is_one()); } sub copy { my $self = shift; return Math::Prime::Util::ECProjectivePoint->new( $self->{'c'}, $self->{'n'}, $self->{'x'}, $self->{'z'}); } 1; __END__ # ABSTRACT: Elliptic curve operations for projective points =pod =encoding utf8 =for stopwords mul =head1 NAME Math::Prime::Util::ECProjectivePoint - Elliptic curve operations for projective points =head1 VERSION Version 0.37 =head1 SYNOPSIS # Create a point on a curve (a,b,n) with coordinates 0,1 my $ECP = Math::Prime::Util::ECProjectivePoint->new($c, $n, 0, 1); # scalar multiplication by k. $ECP->mul($k) # add two points on the same curve $ECP->add($ECP2) say "P = O" if $ECP->is_infinity(); =head1 DESCRIPTION This really should just be in Math::EllipticCurve. To write. =head1 FUNCTIONS =head2 new $point = Math::Prime::Util::ECProjectivePoint->new(c, n, x, z); Returns a new point on the curve defined by the Montgomery parameter c. =head2 c =head2 n Returns the C, C, or C values that describe the curve. =head2 d Returns the precalculated value of C. =head2 x =head2 z Returns the C or C values that define the point on the curve. =head2 f Returns a possible factor found after L. =head2 add Takes another point on the same curve as an argument and adds it this point. =head2 double Double the current point on the curve. =head2 mul Takes an integer and performs scalar multiplication of the point. =head2 is_infinity Returns true if the point is (0,1), which is the point at infinity for the affine coordinates. =head2 copy Returns a copy of the point. =head2 normalize Performs an extended GCD operation to make C. If a factor of C is found it is put in C. =head1 SEE ALSO L This really should just be in a L module. =head1 AUTHORS Dana Jacobsen Edana@acm.orgE =head1 COPYRIGHT Copyright 2012-2013 by Dana Jacobsen Edana@acm.orgE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Math-Prime-Util-0.37/lib/Math/Prime/Util/ECAffinePoint.pm0000644000076400007640000001413312270242116021320 0ustar danadanapackage Math::Prime::Util::ECAffinePoint; use strict; use warnings; use Carp qw/carp croak confess/; BEGIN { $Math::Prime::Util::ECAffinePoint::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::ECAffinePoint::VERSION = '0.37'; } BEGIN { do { require Math::BigInt; Math::BigInt->import(try=>"GMP,Pari"); } unless defined $Math::BigInt::VERSION; } # Pure perl (with Math::BigInt) manipulation of Elliptic Curves # in affine coordinates. Should be split into a point class. sub new { my ($class, $a, $b, $n, $x, $y) = @_; $a = Math::BigInt->new("$a") unless ref($a) eq 'Math::BigInt'; $b = Math::BigInt->new("$b") unless ref($b) eq 'Math::BigInt'; $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; $x = Math::BigInt->new("$x") unless ref($x) eq 'Math::BigInt'; $y = Math::BigInt->new("$y") unless ref($y) eq 'Math::BigInt'; croak "n must be >= 2" unless $n >= 2; $a->bmod($n); $b->bmod($n); my $self = { a => $a, b => $b, n => $n, x => $x, y => $y, f => $n->copy->bone, }; bless $self, $class; return $self; } sub _add { my ($self, $P1x, $P1y, $P2x, $P2y) = @_; my $n = $self->{'n'}; if ($P1x == $P2x) { my $t = ($P1y + $P2y) % $n; return (Math::BigInt->bzero,Math::BigInt->bone) if $t == 0; } my $deltax = ($P2x - $P1x) % $n; $deltax->bmodinv($n); return (Math::BigInt->bzero,Math::BigInt->bone) if $deltax eq "NaN"; my $deltay = ($P2y - $P1y) % $n; my $m = ($deltay * $deltax) % $n; # m = deltay / deltax my $x = ($m*$m - $P1x - $P2x) % $n; my $y = ($m*($P1x - $x) - $P1y) % $n; return ($x,$y); } sub _double { my ($self, $P1x, $P1y) = @_; my $n = $self->{'n'}; my $m = 2*$P1y; $m->bmodinv($n); return (Math::BigInt->bzero,Math::BigInt->bone) if $m eq "NaN"; $m = ((3*$P1x*$P1x + $self->{'a'}) * $m) % $n; my $x = ($m*$m - 2*$P1x) % $n; my $y = ($m*($P1x - $x) - $P1y) % $n; return ($x,$y); } sub _inplace_add { my ($P1x, $P1y, $x, $y, $n) = @_; if ($P1x == $x) { my $t = ($P1y + $y) % $n; if ($t == 0) { ($_[2],$_[3]) = (Math::BigInt->bzero,Math::BigInt->bone); return; } } my $deltax = ($x - $P1x) % $n; $deltax->bmodinv($n); if ($deltax eq 'NaN') { ($_[2],$_[3]) = (Math::BigInt->bzero,Math::BigInt->bone); return; } my $deltay = ($y - $P1y) % $n; my $m = ($deltay * $deltax) % $n; # m = deltay / deltax $_[2] = ($m*$m - $P1x - $x) % $n; $_[3] = ($m*($P1x - $_[2]) - $P1y) % $n; } sub _inplace_double { my($x, $y, $a, $n) = @_; my $m = $y+$y; $m->bmodinv($n); if ($m eq 'NaN') { ($_[0],$_[1]) = (Math::BigInt->bzero,Math::BigInt->bone); return; } $m->bmul($x->copy->bmul($x)->bmul(3)->badd($a))->bmod($n); my $xin = $x->copy; $_[0] = ($m*$m - $x - $x) % $n; $_[1] = ($m*($xin - $_[0]) - $y) % $n; } sub mul { my ($self, $k) = @_; my $x = $self->{'x'}; my $y = $self->{'y'}; my $a = $self->{'a'}; my $n = $self->{'n'}; my $f = $self->{'f'}; if (ref($k) eq 'Math::BigInt' && $k < ''.~0) { if ($] >= 5.008 || ~0 == 4294967295) { $k = int($k->bstr); } elsif ($] < 5.008 && ~0 > 4294967295 && $k < 562949953421312) { $k = unpack('Q',pack('Q',$k->bstr)); } } my $Bx = $n->copy->bzero; my $By = $n->copy->bone; my $v = 1; while ($k > 0) { if ( ($k % 2) != 0) { $k--; $f->bmul($Bx-$x)->bmod($n); if ($x->is_zero && $y->is_one) { } elsif ($Bx->is_zero && $By->is_one) { ($Bx,$By) = ($x,$y); } else { _inplace_add($x,$y,$Bx,$By,$n); } } else { $k >>= 1; $f->bmul(2*$y)->bmod($n); _inplace_double($x,$y,$a,$n); } } $f = Math::BigInt::bgcd($f, $n); $self->{'x'} = $Bx; $self->{'y'} = $By; $self->{'f'} = $f; return $self; } sub add { my ($self, $other) = @_; croak "add takes a EC point" unless ref($other) eq 'Math::Prime::Util::ECAffinePoint'; croak "second point is not on the same curve" unless $self->{'a'} == $other->{'a'} && $self->{'b'} == $other->{'b'} && $self->{'n'} == $other->{'n'}; ($self->{'x'}, $self->{'y'}) = $self->_add($self->{'x'}, $self->{'y'}, $other->{'x'}, $other->{'y'}); return $self; } sub a { return shift->{'a'}; } sub b { return shift->{'b'}; } sub n { return shift->{'n'}; } sub x { return shift->{'x'}; } sub y { return shift->{'y'}; } sub f { return shift->{'f'}; } sub is_infinity { my $self = shift; return ($self->{'x'}->is_zero() && $self->{'y'}->is_one()); } 1; __END__ # ABSTRACT: Elliptic curve operations for affine points =pod =encoding utf8 =for stopwords mul =head1 NAME Math::Prime::Util::ECAffinePoint - Elliptic curve operations for affine points =head1 VERSION Version 0.37 =head1 SYNOPSIS # Create a point on a curve (a,b,n) with coordinates 0,1 my $ECP = Math::Prime::Util::ECAffinePoint->new($a, $b, $n, 0, 1); # scalar multiplication by k. $ECP->mul($k) # add two points on the same curve $ECP->add($ECP2) say "P = O" if $ECP->is_infinity(); =head1 DESCRIPTION This really should just be in Math::EllipticCurve. To write. =head1 FUNCTIONS =head2 new $point = Math::Prime::Util::ECAffinePoint->new(a, b, n, x, y); Returns a new point at C<(x,y,1)> on the curve C<(a,b,n)>. =head2 a =head2 b =head2 n Returns the C, C, or C values that describe the curve. =head2 x =head2 y Returns the C or C values that define the point on the curve. =head2 f Returns a possible factor found during EC multiplication. =head2 add Takes another point on the same curve as an argument and adds it this point. =head2 mul Takes an integer and performs scalar multiplication of the point. =head2 is_infinity Returns true if the point is (0,1), which is the point at infinity for the affine coordinates. =head1 SEE ALSO L This really should just be in a L module. =head1 AUTHORS Dana Jacobsen Edana@acm.orgE =head1 COPYRIGHT Copyright 2012-2013 by Dana Jacobsen Edana@acm.orgE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Math-Prime-Util-0.37/lib/Math/Prime/Util.pm0000644000076400007640000041631212270624726016726 0ustar danadanapackage Math::Prime::Util; use strict; use warnings; use Carp qw/croak confess carp/; BEGIN { $Math::Prime::Util::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::VERSION = '0.37'; } # parent is cleaner, and in the Perl 5.10.1 / 5.12.0 core, but not earlier. # use parent qw( Exporter ); use base qw( Exporter ); our @EXPORT_OK = qw( prime_get_config prime_set_config prime_precalc prime_memfree is_prime is_prob_prime is_provable_prime is_provable_prime_with_cert prime_certificate verify_prime is_pseudoprime is_strong_pseudoprime is_lucas_pseudoprime is_strong_lucas_pseudoprime is_extra_strong_lucas_pseudoprime is_almost_extra_strong_lucas_pseudoprime is_frobenius_underwood_pseudoprime is_aks_prime miller_rabin miller_rabin_random lucas_sequence primes forprimes forcomposites fordivisors prime_iterator prime_iterator_object next_prime prev_prime prime_count prime_count_lower prime_count_upper prime_count_approx nth_prime nth_prime_lower nth_prime_upper nth_prime_approx random_prime random_ndigit_prime random_nbit_prime random_strong_prime random_proven_prime random_proven_prime_with_cert random_maurer_prime random_maurer_prime_with_cert primorial pn_primorial consecutive_integer_lcm gcd lcm factor factor_exp all_factors divisors moebius mertens euler_phi jordan_totient exp_mangoldt liouville partitions chebyshev_theta chebyshev_psi divisor_sum carmichael_lambda kronecker znorder znprimroot znlog legendre_phi ExponentialIntegral LogarithmicIntegral RiemannZeta RiemannR ); our %EXPORT_TAGS = (all => [ @EXPORT_OK ]); my %_Config; # Similar to how boolean handles its option sub import { my @options = grep $_ ne '-nobigint', @_; $_[0]->_import_nobigint if @options != @_; @_ = @options; goto &Exporter::import; } sub _import_nobigint { $_Config{'nobigint'} = 1; 1; } BEGIN { # Separate lines to keep compatible with default from 5.6.2. # We could alternately use Config's $Config{uvsize} for MAXBITS use constant OLD_PERL_VERSION=> $] < 5.008; use constant MPU_MAXBITS => (~0 == 4294967295) ? 32 : 64; use constant MPU_32BIT => MPU_MAXBITS == 32; use constant MPU_MAXPARAM => MPU_32BIT ? 4294967295 : 18446744073709551615; use constant MPU_MAXDIGITS => MPU_32BIT ? 10 : 20; use constant MPU_MAXPRIME => MPU_32BIT ? 4294967291 : 18446744073709551557; use constant MPU_MAXPRIMEIDX => MPU_32BIT ? 203280221 : 425656284035217743; use constant UVPACKLET => MPU_32BIT ? 'L' : 'Q'; eval { return 0 if defined $ENV{MPU_NO_XS} && $ENV{MPU_NO_XS} == 1; require XSLoader; XSLoader::load(__PACKAGE__, $Math::Prime::Util::VERSION); prime_precalc(0); $_Config{'maxbits'} = _XS_prime_maxbits(); $_Config{'xs'} = 1; 1; } or do { carp "Using Pure Perl implementation: $@" unless defined $ENV{MPU_NO_XS} && $ENV{MPU_NO_XS} == 1; $_Config{'xs'} = 0; $_Config{'maxbits'} = MPU_MAXBITS; # Load PP front end code require Math::Prime::Util::PPFE; *next_prime = \&Math::Prime::Util::_generic_next_prime; *prev_prime = \&Math::Prime::Util::_generic_prev_prime; *prime_count = \&Math::Prime::Util::_generic_prime_count; *factor = \&Math::Prime::Util::_generic_factor; *factor_exp = \&Math::Prime::Util::_generic_factor_exp; }; # aliases for deprecated names. Will eventually be removed. *all_factors = \&divisors; *miller_rabin = \&is_strong_pseudoprime; $_Config{'nobigint'} = 0; $_Config{'gmp'} = 0; # See if they have the GMP module and haven't requested it not to be used. if (!defined $ENV{MPU_NO_GMP} || $ENV{MPU_NO_GMP} != 1) { $_Config{'gmp'} = 1 if eval { require Math::Prime::Util::GMP; Math::Prime::Util::GMP->import(); 1; }; } } croak "Perl and XS don't agree on bit size" if $_Config{'xs'} && MPU_MAXBITS != _XS_prime_maxbits(); $_Config{'maxparam'} = MPU_MAXPARAM; $_Config{'maxdigits'} = MPU_MAXDIGITS; $_Config{'maxprime'} = MPU_MAXPRIME; $_Config{'maxprimeidx'} = MPU_MAXPRIMEIDX; $_Config{'assume_rh'} = 0; $_Config{'verbose'} = 0; $_Config{'irand'} = undef; # used for code like: # return _XS_foo($n) if $n <= $_XS_MAXVAL # which builds into one scalar whether XS is available and if we can call it. my $_XS_MAXVAL = $_Config{'xs'} ? MPU_MAXPARAM : -1; my $_HAVE_GMP = $_Config{'gmp'}; _XS_set_callgmp($_HAVE_GMP) if $_Config{'xs'}; # Infinity in Perl is rather O/S specific. our $_Infinity = 0+'inf'; $_Infinity = 20**20**20 if 65535 > $_Infinity; # E.g. Windows our $_Neg_Infinity = -$_Infinity; sub prime_get_config { my %config = %_Config; $config{'precalc_to'} = ($_Config{'xs'}) ? _get_prime_cache_size() : Math::Prime::Util::PP::_get_prime_cache_size(); return \%config; } # Note: You can cause yourself pain if you turn on xs or gmp when they're not # loaded. Your calls will probably die horribly. sub prime_set_config { my %params = (@_); # no defaults while (my($param, $value) = each %params) { $param = lc $param; # dispatch table should go here. if ($param eq 'xs') { $_Config{'xs'} = ($value) ? 1 : 0; $_XS_MAXVAL = $_Config{'xs'} ? MPU_MAXPARAM : -1; } elsif ($param eq 'gmp') { $_Config{'gmp'} = ($value) ? 1 : 0; $_HAVE_GMP = $_Config{'gmp'}; _XS_set_callgmp($_HAVE_GMP) if $_Config{'xs'}; } elsif ($param eq 'nobigint') { $_Config{'nobigint'} = ($value) ? 1 : 0; } elsif ($param eq 'irand') { croak "irand must supply a sub" unless (!defined $value) || (ref($value) eq 'CODE'); $_Config{'irand'} = $value; } elsif ($param =~ /^(assume[_ ]?)?[ge]?rh$/ || $param =~ /riemann\s*h/) { $_Config{'assume_rh'} = ($value) ? 1 : 0; } elsif ($param eq 'verbose') { if ($value =~ /^\d+$/) { } elsif ($value =~ /^[ty]/i) { $value = 1; } elsif ($value =~ /^[fn]/i) { $value = 0; } else { croak("Invalid setting for verbose. 0, 1, 2, etc."); } $_Config{'verbose'} = $value; _XS_set_verbose($value) if $_Config{'xs'}; Math::Prime::Util::GMP::_GMP_set_verbose($value) if $_Config{'gmp'}; } else { croak "Unknown or invalid configuration setting: $param\n"; } } 1; } sub _bigint_to_int { return (OLD_PERL_VERSION) ? unpack(UVPACKLET,pack(UVPACKLET,$_[0]->bstr)) : int($_[0]->bstr); } sub _to_bigint { do { require Math::BigInt; Math::BigInt->import(try=>"GMP,Pari"); } unless defined $Math::BigInt::VERSION; return Math::BigInt->new("$_[0]"); } sub _reftyped { my $ref0 = ref($_[0]); if ($ref0) { return ($ref0 eq ref($_[1])) ? $_[1] : $ref0->new("$_[1]"); } my $strn = "$_[1]"; return $_[1] if $strn <= ~0; do { require Math::BigInt; Math::BigInt->import(try=>"GMP,Pari"); } unless defined $Math::BigInt::VERSION; return Math::BigInt->new($strn); } #*_validate_positive_integer = \&Math::Prime::Util::PP::_validate_positive_integer; sub _validate_positive_integer { my($n, $min, $max) = @_; croak "Parameter must be defined" if !defined $n; if (ref($n) eq 'CODE') { $_[0] = $_[0]->(); $n = $_[0]; } if (ref($n) eq 'Math::BigInt') { croak "Parameter '$n' must be a positive integer" if $n->sign() ne '+' || !$n->is_int(); $_[0] = _bigint_to_int($_[0]) if $n <= (OLD_PERL_VERSION ? 562949953421312 : ''.~0); } else { my $strn = "$n"; croak "Parameter '$strn' must be a positive integer" if $strn =~ tr/0123456789//c && $strn !~ /^\+?\d+$/; if ($n <= (OLD_PERL_VERSION ? 562949953421312 : ''.~0)) { $_[0] = $strn if ref($n); } else { #$_[0] = Math::BigInt->new($strn) $_[0] = _to_bigint($strn); } } $_[0]->upgrade(undef) if ref($_[0]) && $_[0]->upgrade(); croak "Parameter '$_[0]' must be >= $min" if defined $min && $_[0] < $min; croak "Parameter '$_[0]' must be <= $max" if defined $max && $_[0] > $max; 1; } ############################################################################# sub primes { my($low,$high) = @_; if (scalar @_ > 1) { _validate_num($low) || _validate_positive_integer($low); _validate_num($high) || _validate_positive_integer($high); } else { ($low,$high) = (2, $low); _validate_num($high) || _validate_positive_integer($high); } my $sref = []; return $sref if ($low > $high) || ($high < 2); if ($high > $_XS_MAXVAL) { if ($_HAVE_GMP) { $sref = Math::Prime::Util::GMP::primes($low,$high); if ($high > ~0) { # Convert the returned strings into BigInts @$sref = map { Math::BigInt->new("$_") } @$sref; } else { @$sref = map { int($_) } @$sref; } return $sref; } require Math::Prime::Util::PP; return Math::Prime::Util::PP::primes($low,$high); } # Decide the method to use. We have four to choose from: # 1. Trial No memory, no overhead, but more time per prime. # 2. Sieve Monolithic cached sieve. # 3. Erat Monolithic uncached sieve. # 4. Segment Segment sieve. Never a bad decision. if (($low+1) >= $high || # Tiny range, or $high > 10**14 && ($high-$low) < 50000) { # Small relative range $sref = trial_primes($low, $high); } elsif ($high <= (65536*30) || # Very small, or $high <= _get_prime_cache_size()) { # already in the main cache. $sref = sieve_primes($low, $high); } else { $sref = segment_primes($low, $high); } # We could return an array ref in scalar context, array in list context with: # return (wantarray) ? @{$sref} : $sref; # but I think the dual interface could be confusing, albeit often handy. return $sref; } ############################################################################# # Random primes. These are front end functions that do input validation, # load the RandomPrimes module, and call its function. sub random_prime { my($low,$high) = @_; if (scalar @_ > 1) { _validate_num($low) || _validate_positive_integer($low); _validate_num($high) || _validate_positive_integer($high); } else { ($low,$high) = (2, $low); _validate_num($high) || _validate_positive_integer($high); } require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_prime($low,$high); } sub random_ndigit_prime { my($digits) = @_; _validate_num($digits, 1) || _validate_positive_integer($digits, 1); require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_ndigit_prime($digits); } sub random_nbit_prime { my($bits) = @_; _validate_num($bits, 2) || _validate_positive_integer($bits, 2); require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_nbit_prime($bits); } sub random_maurer_prime { my($bits) = @_; _validate_num($bits, 2) || _validate_positive_integer($bits, 2); require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_maurer_prime($bits); } sub random_maurer_prime_with_cert { my($bits) = @_; _validate_num($bits, 2) || _validate_positive_integer($bits, 2); require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_maurer_prime_with_cert($bits); } sub random_strong_prime { my($bits) = @_; _validate_num($bits, 128) || _validate_positive_integer($bits, 128); require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_strong_prime($bits); } sub random_proven_prime { my($bits) = @_; _validate_num($bits, 2) || _validate_positive_integer($bits, 2); require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_proven_prime($bits); } sub random_proven_prime_with_cert { my($bits) = @_; _validate_num($bits, 2) || _validate_positive_integer($bits, 2); require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_proven_prime_with_cert($bits); } sub miller_rabin_random { my($n, $k, $seed) = @_; _validate_num($n) || _validate_positive_integer($n); _validate_num($k) || _validate_positive_integer($k); return 1 if $k <= 0; return (is_prob_prime($n) > 0) if $n < 100; return 0 unless $n & 1; return Math::Prime::Util::GMP::miller_rabin_random($n, $k) if $_HAVE_GMP && defined &Math::Prime::Util::GMP::miller_rabin_random; require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::miller_rabin_random($n, $k, $seed); } ############################################################################# # These functions almost always return bigints, so there is no XS # implementation. Try to run the GMP version, and if it isn't available, # load PP and call it. sub primorial { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); if ($_HAVE_GMP && defined &Math::Prime::Util::GMP::primorial) { return _reftyped($_[0], Math::Prime::Util::GMP::primorial($n)); } require Math::Prime::Util::PP; return Math::Prime::Util::PP::primorial($n); } sub pn_primorial { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); if ($_HAVE_GMP && defined &Math::Prime::Util::GMP::pn_primorial) { return _reftyped($_[0], Math::Prime::Util::GMP::pn_primorial($n)); } require Math::Prime::Util::PP; return Math::Prime::Util::PP::primorial(nth_prime($n)); } sub consecutive_integer_lcm { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); return 0 if $n < 1; if ($_HAVE_GMP && defined &Math::Prime::Util::GMP::consecutive_integer_lcm) { return _reftyped($_[0],Math::Prime::Util::GMP::consecutive_integer_lcm($n)); } require Math::Prime::Util::PP; return Math::Prime::Util::PP::consecutive_integer_lcm($n); } # See 2011+ FLINT and Fredrik Johansson's work for state of the art. # Very crude timing estimates (ignores growth rates). # Perl-comb partitions(10^5) ~ 300 seconds ~200,000x slower than Pari # GMP-comb partitions(10^6) ~ 120 seconds ~1,000x slower than Pari # Pari partitions(10^8) ~ 100 seconds # Bober 0.6 partitions(10^9) ~ 20 seconds ~50x faster than Pari # Johansson partitions(10^12) ~ 10 seconds >1000x faster than Pari sub partitions { my($n) = @_; return 1 if defined $n && $n <= 0; _validate_num($n) || _validate_positive_integer($n); if ($_HAVE_GMP && defined &Math::Prime::Util::GMP::partitions) { return _reftyped($_[0],Math::Prime::Util::GMP::partitions($n)); } require Math::Prime::Util::PP; return Math::Prime::Util::PP::partitions($n); } ############################################################################# # forprimes, forcomposites, fordivisors. # These are used when the XS code can't handle it. sub _generic_forprimes { my($sub, $beg, $end) = @_; if (!defined $end) { $end = $beg; $beg = 2; } _validate_positive_integer($beg); _validate_positive_integer($end); $beg = 2 if $beg < 2; { my $pp; local *_ = \$pp; for (my $p = next_prime($beg-1); $p <= $end; $p = next_prime($p)) { $pp = $p; $sub->(); } } } sub _generic_forcomposites { my($sub, $beg, $end) = @_; if (!defined $end) { $end = $beg; $beg = 4; } _validate_positive_integer($beg); _validate_positive_integer($end); $beg = 4 if $beg < 4; $end = Math::BigInt->new(''.~0) if ref($end) ne 'Math::BigInt' && $end == ~0; { my $pp; local *_ = \$pp; for ( ; $beg <= $end ; $beg++ ) { if (!is_prime($beg)) { $pp = $beg; $sub->(); } } } } sub _generic_fordivisors { my($sub, $n) = @_; _validate_positive_integer($n); my @divisors = divisors($n); { my $pp; local *_ = \$pp; foreach my $d (@divisors) { $pp = $d; $sub->(); } } } ############################################################################# # Iterators sub prime_iterator { my($start) = @_; $start = 0 unless defined $start; _validate_num($start) || _validate_positive_integer($start); my $p = ($start > 0) ? $start-1 : 0; # This works fine: # return sub { $p = next_prime($p); return $p; }; # but we can optimize a little if (ref($p) ne 'Math::BigInt' && $p <= $_XS_MAXVAL) { return sub { $p = next_prime($p); return $p; }; } elsif ($_HAVE_GMP) { return sub { $p = $p-$p+Math::Prime::Util::GMP::next_prime($p); return $p;}; } else { require Math::Prime::Util::PP; return sub { $p = Math::Prime::Util::PP::next_prime($p); return $p; } } } sub prime_iterator_object { my($start) = @_; require Math::Prime::Util::PrimeIterator; return Math::Prime::Util::PrimeIterator->new($start); } ############################################################################# # Front ends to functions. # # These will do input validation, then call the appropriate internal function # based on the input (XS, GMP, PP). ############################################################################# sub _generic_next_prime { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); if ($_HAVE_GMP) { return _reftyped($_[0], Math::Prime::Util::GMP::next_prime($n)); } require Math::Prime::Util::PP; return Math::Prime::Util::PP::next_prime($_[0]); } sub _generic_prev_prime { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); if ($_HAVE_GMP) { return _reftyped($_[0], Math::Prime::Util::GMP::prev_prime($n)); } require Math::Prime::Util::PP; return Math::Prime::Util::PP::prev_prime($_[0]); } sub _generic_prime_count { my($low,$high) = @_; if (defined $high) { _validate_num($low) || _validate_positive_integer($low); _validate_num($high) || _validate_positive_integer($high); } else { ($low,$high) = (2, $low); _validate_num($high) || _validate_positive_integer($high); } return 0 if $high < 2 || $low > $high; # We can relax these constraints if MPU::GMP gets a fast implementation. return Math::Prime::Util::GMP::prime_count($low,$high) if $_HAVE_GMP && defined &Math::Prime::Util::GMP::prime_count && ( (ref($high) eq 'Math::BigInt') || (($high-$low) < int($low/1_000_000)) ); require Math::Prime::Util::PP; return Math::Prime::Util::PP::prime_count($low,$high); } sub _generic_factor { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); if ($_HAVE_GMP) { my @factors; if ($n != 1) { @factors = Math::Prime::Util::GMP::factor($n); if (ref($_[0]) eq 'Math::BigInt') { @factors = map { ($_ > ~0) ? Math::BigInt->new(''.$_) : $_ } @factors; } } return @factors; } require Math::Prime::Util::PP; return Math::Prime::Util::PP::factor($n); } sub _generic_factor_exp { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); my %exponents; my @factors = grep { !$exponents{$_}++ } factor($n); return scalar @factors unless wantarray; return (map { [$_, $exponents{$_}] } @factors); } sub lucas_sequence { my($n, $P, $Q, $k) = @_; _validate_num($n) || _validate_positive_integer($n); _validate_num($k) || _validate_positive_integer($k); { my $testP = (!defined $P || $P >= 0) ? $P : -$P; _validate_num($testP) || _validate_positive_integer($testP); } { my $testQ = (!defined $Q || $Q >= 0) ? $Q : -$Q; _validate_num($testQ) || _validate_positive_integer($testQ); } return _XS_lucas_sequence($n, $P, $Q, $k) if ref($_[0]) ne 'Math::BigInt' && $n <= $_XS_MAXVAL && ref($_[3]) ne 'Math::BigInt' && $k <= $_XS_MAXVAL; if ($_HAVE_GMP && defined &Math::Prime::Util::GMP::lucas_sequence) { return map { ($_ > ''.~0) ? Math::BigInt->new(''.$_) : $_ } Math::Prime::Util::GMP::lucas_sequence($n, $P, $Q, $k); } require Math::Prime::Util::PP; return map { ($_ <= ''.~0) ? _bigint_to_int($_) : $_ } Math::Prime::Util::PP::lucas_sequence($n, $P, $Q, $k); } ############################################################################# # Return just the non-cert portion. sub is_provable_prime { my($n) = @_; return 0 if defined $n && $n < 2; _validate_num($n) || _validate_positive_integer($n); return is_prime($n) if $n <= $_XS_MAXVAL; return Math::Prime::Util::GMP::is_provable_prime($n) if $_HAVE_GMP && defined &Math::Prime::Util::GMP::is_provable_prime; my ($is_prime, $cert) = is_provable_prime_with_cert($n); return $is_prime; } # Return just the cert portion. sub prime_certificate { my($n) = @_; my ($is_prime, $cert) = is_provable_prime_with_cert($n); return $cert; } sub is_provable_prime_with_cert { my($n) = @_; return 0 if defined $n && $n < 2; _validate_num($n) || _validate_positive_integer($n); my $header = "[MPU - Primality Certificate]\nVersion 1.0\n\nProof for:\nN $n\n\n"; if ($n <= $_XS_MAXVAL) { my $isp = is_prime($n); return ($isp, '') unless $isp == 2; return (2, $header . "Type Small\nN $n\n"); } if ($_HAVE_GMP && defined &Math::Prime::Util::GMP::is_provable_prime_with_cert) { my ($isp, $cert) = Math::Prime::Util::GMP::is_provable_prime_with_cert($n); # New version that returns string format. #return ($isp, $cert) if ref($cert) ne 'ARRAY'; if (ref($cert) ne 'ARRAY') { # Fix silly 0.13 mistake (TODO: deprecate this) $cert =~ s/^Type Small\n(\d+)/Type Small\nN $1/smg; return ($isp, $cert); } # Old version. Convert. require Math::Prime::Util::PrimalityProving; return ($isp, Math::Prime::Util::PrimalityProving::convert_array_cert_to_string($cert)); } { my $isp = is_prob_prime($n); return ($isp, '') if $isp == 0; return (2, $header . "Type Small\nN $n\n") if $isp == 2; } # Choice of methods for proof: # ECPP needs a fair bit of programming work # APRCL needs a lot of programming work # BLS75 combo Corollary 11 of BLS75. Trial factor n-1 and n+1 to B, find # factors F1 of n-1 and F2 of n+1. Quit when: # B > (N/(F1*F1*(F2/2)))^1/3 or B > (N/((F1/2)*F2*F2))^1/3 # BLS75 n+1 Requires factoring n+1 to (n/2)^1/3 (theorem 19) # BLS75 n-1 Requires factoring n-1 to (n/2)^1/3 (theorem 5 or 7) # Pocklington Requires factoring n-1 to n^1/2 (BLS75 theorem 4) # Lucas Easy, requires factoring of n-1 (BLS75 theorem 1) # AKS horribly slow # See http://primes.utm.edu/prove/merged.html or other sources. require Math::Prime::Util::PrimalityProving; #my ($isp, $pref) = Math::Prime::Util::PrimalityProving::primality_proof_lucas($n); my ($isp, $pref) = Math::Prime::Util::PrimalityProving::primality_proof_bls75($n); carp "proved $n is not prime\n" if !$isp; return ($isp, $pref); } sub verify_prime { my @cdata = @_; require Math::Prime::Util::PrimalityProving; my $cert = ''; if (scalar @cdata == 1 && ref($cdata[0]) eq '') { $cert = $cdata[0]; } else { # We've been given an old array cert $cert = Math::Prime::Util::PrimalityProving::convert_array_cert_to_string(@cdata); if ($cert eq '') { print "primality fail: error converting old certificate" if $_Config{'verbose'}; return 0; } } return 0 if $cert eq ''; return Math::Prime::Util::PrimalityProving::verify_cert($cert); } ############################################################################# ############################################################################# sub RiemannZeta { my($n) = @_; croak("Invalid input to ReimannZeta: x must be > 0") if $n <= 0; return _XS_RiemannZeta($n) if !defined $bignum::VERSION && ref($n) ne 'Math::BigFloat' && $n <= $_XS_MAXVAL; require Math::Prime::Util::PP; return Math::Prime::Util::PP::RiemannZeta($n); } sub RiemannR { my($n) = @_; croak("Invalid input to ReimannR: x must be > 0") if $n <= 0; return _XS_RiemannR($n) if !defined $bignum::VERSION && ref($n) ne 'Math::BigFloat' && $n <= $_XS_MAXVAL; require Math::Prime::Util::PP; return Math::Prime::Util::PP::RiemannR($n); } sub ExponentialIntegral { my($n) = @_; return $_Neg_Infinity if $n == 0; return 0 if $n == $_Neg_Infinity; return $_Infinity if $n == $_Infinity; return _XS_ExponentialIntegral($n) if !defined $bignum::VERSION && ref($n) ne 'Math::BigFloat' && $_Config{'xs'}; require Math::Prime::Util::PP; return Math::Prime::Util::PP::ExponentialIntegral($n); } sub LogarithmicIntegral { my($n) = @_; return 0 if $n == 0; return $_Neg_Infinity if $n == 1; return $_Infinity if $n == $_Infinity; croak("Invalid input to LogarithmicIntegral: x must be >= 0") if $n <= 0; if (!defined $bignum::VERSION && ref($n) ne 'Math::BigFloat' && $_Config{'xs'}) { return 1.045163780117492784844588889194613136522615578151 if $n == 2; return _XS_LogarithmicIntegral($n); } require Math::Prime::Util::PP; return Math::Prime::Util::PP::LogarithmicIntegral($n); } ############################################################################# use Math::Prime::Util::MemFree; 1; __END__ # ABSTRACT: Utilities related to prime numbers, including fast generators / sievers =pod =encoding utf8 =for stopwords forprimes forcomposites fordivisors Möbius Deléglise totient moebius mertens liouville znorder irand primesieve uniqued k-tuples von SoE pari yafu fonction qui compte le nombre nombres voor PhD superset sqrt(N) gcd(A^M k-th (10001st primegen libtommath kronecker znprimroot znlog gcd lcm =head1 NAME Math::Prime::Util - Utilities related to prime numbers, including fast sieves and factoring =head1 VERSION Version 0.37 =head1 SYNOPSIS # Normally you would just import the functions you are using. # Nothing is exported by default. List the functions, or use :all. use Math::Prime::Util ':all'; # Get a big array reference of many primes my $aref = primes( 100_000_000 ); # All the primes between 5k and 10k inclusive my $aref = primes( 5_000, 10_000 ); # If you want them in an array instead my @primes = @{primes( 500 )}; # You can do something for every prime in a range. Twin primes to 10k: forprimes { say if is_prime($_+2) } 10000; # Or for the composites in a range forcomposites { say if is_strong_pseudoprime($_,2) } 10000, 10**6; # For non-bigints, is_prime and is_prob_prime will always be 0 or 2. # They return 0 (composite), 2 (prime), or 1 (probably prime) say "$n is prime" if is_prime($n); say "$n is ", (qw(composite maybe_prime? prime))[is_prob_prime($n)]; # Strong pseudoprime test with multiple bases, using Miller-Rabin say "$n is a prime or 2/7/61-psp" if is_strong_pseudoprime($n, 2, 7, 61); # Standard and strong Lucas-Selfridge, and extra strong Lucas tests say "$n is a prime or lpsp" if is_lucas_pseudoprime($n); say "$n is a prime or slpsp" if is_strong_lucas_pseudoprime($n); say "$n is a prime or eslpsp" if is_extra_strong_lucas_pseudoprime($n); # step to the next prime (returns 0 if not using bigints and we'd overflow) $n = next_prime($n); # step back (returns 0 if given input less than 2) $n = prev_prime($n); # Return Pi(n) -- the number of primes E= n. $primepi = prime_count( 1_000_000 ); $primepi = prime_count( 10**14, 10**14+1000 ); # also does ranges # Quickly return an approximation to Pi(n) my $approx_number_of_primes = prime_count_approx( 10**17 ); # Lower and upper bounds. lower <= Pi(n) <= upper for all n die unless prime_count_lower($n) <= prime_count($n); die unless prime_count_upper($n) >= prime_count($n); # Return p_n, the nth prime say "The ten thousandth prime is ", nth_prime(10_000); # Return a quick approximation to the nth prime say "The one trillionth prime is ~ ", nth_prime_approx(10**12); # Lower and upper bounds. lower <= nth_prime(n) <= upper for all n die unless nth_prime_lower($n) <= nth_prime($n); die unless nth_prime_upper($n) >= nth_prime($n); # Get the prime factors of a number @prime_factors = factor( $n ); # Return ([p1,e1],[p2,e2], ...) for $n = p1^e1 * p2*e2 * ... @pe = factor_exp( $n ); # Get all divisors other than 1 and n @divisors = divisors( $n ); # Or just apply a block for each one fordivisors { $sum += $_ + $_*$_ } $n; # Euler phi (Euler's totient) on a large number use bigint; say euler_phi( 801294088771394680000412 ); say jordan_totient(5, 1234); # Jordan's totient # Moebius function used to calculate Mertens $sum += moebius($_) for (1..200); say "Mertens(200) = $sum"; # Mertens function directly (more efficient for large values) say mertens(10_000_000); # Exponential of Mangoldt function say "lamba(49) = ", log(exp_mangoldt(49)); # Some more number theoretical functions say liouville(4292384); say chebyshev_psi(234984); say chebyshev_theta(92384234); say partitions(1000); # divisor sum $sigma = divisor_sum( $n ); # sum of divisors $sigma0 = divisor_sum( $n, 0 ); # count of divisors $sigmak = divisor_sum( $n, $k ); $sigmaf = divisor_sum( $n, sub { log($_[0]) } ); # arbitrary func # primorial n#, primorial p(n)#, and lcm say "The product of primes below 47 is ", primorial(47); say "The product of the first 47 primes is ", pn_primorial(47); say "lcm(1..1000) is ", consecutive_integer_lcm(1000); # Ei, li, and Riemann R functions my $ei = ExponentialIntegral($x); # $x a real: $x != 0 my $li = LogarithmicIntegral($x); # $x a real: $x >= 0 my $R = RiemannR($x) # $x a real: $x > 0 my $Zeta = RiemannZeta($x) # $x a real: $x >= 0 # Precalculate a sieve, possibly speeding up later work. prime_precalc( 1_000_000_000 ); # Free any memory used by the module. prime_memfree; # Alternate way to free. When this leaves scope, memory is freed. my $mf = Math::Prime::Util::MemFree->new; # Random primes my $small_prime = random_prime(1000); # random prime <= limit my $rand_prime = random_prime(100, 10000); # random prime within a range my $rand_prime = random_ndigit_prime(6); # random 6-digit prime my $rand_prime = random_nbit_prime(128); # random 128-bit prime my $rand_prime = random_strong_prime(256); # random 256-bit strong prime my $rand_prime = random_maurer_prime(256); # random 256-bit provable prime =head1 DESCRIPTION A set of utilities related to prime numbers. These include multiple sieving methods, is_prime, prime_count, nth_prime, approximations and bounds for the prime_count and nth prime, next_prime and prev_prime, factoring utilities, and more. The default sieving and factoring are intended to be (and currently are) the fastest on CPAN, including L, L, L, L, L, L, and L (when the GMP module is available). For numbers in the 10-20 digit range, it is often orders of magnitude faster. Typically it is faster than L for 64-bit operations. All operations support both Perl UV's (32-bit or 64-bit) and bignums. If you want high performance with big numbers (larger than Perl's native 32-bit or 64-bit size), you should install L and L. This will be a recurring theme throughout this documentation -- while all bignum operations are supported in pure Perl, most methods will be much slower than the C+GMP alternative. The module is thread-safe and allows concurrency between Perl threads while still sharing a prime cache. It is not itself multi-threaded. See the L section if you are using Win32 and threads in your program. Two scripts are also included and installed by default: =over 4 =item * primes.pl displays primes between start and end values or expressions, with many options for filtering (e.g. twin, safe, circular, good, lucky, etc.). Use C<--help> to see all the options. =item * factor.pl operates similar to the GNU C program. It supports bigint and expression inputs. =back =head1 BIGNUM SUPPORT By default all functions support bignums. For performance, you should install and use L or L, and L. If you are using bigints, here are some performance suggestions: =over 4 =item * Install L, as that will vastly increase the speed of many of the functions. This does require the L library be installed on your system, but this increasingly comes pre-installed or easily available using the OS vendor package installation tool. =item * Install and use L or L, then use C 'GMP,Pari'> in your script, or on the command line C<-Mbigint=lib,GMP>. Large modular exponentiation is much faster using the GMP or Pari backends, as are the math and approximation functions when called with very large inputs. =item * Install L if you use the Ei, li, Zeta, or R functions. If that module can be loaded, these functions will run much faster on bignum inputs, and are able to provide higher accuracy. =item * I have run these functions on many versions of Perl, and my experience is that if you're using anything older than Perl 5.14, I would recommend you upgrade if you are using bignums a lot. There are some brittle behaviors on 5.12.4 and earlier with bignums. For example, the default BigInt backend in older versions of Perl will sometimes convert small results to doubles, resulting in corrupted output. =back =head1 PRIMALITY TESTING This module provides three functions for general primality testing, as well as numerous specialized functions. The three main functions are: L and L for general use, and L for proofs. For inputs below C<2^64> the functions are identical and fast deterministic testing is performed. That is, the results will always be correct and should take at most a few microseconds for any input. This is hundreds to thousands of times faster than other CPAN modules. For inputs larger than C<2^64>, an extra-strong L is used. See the L section for more discussion. =head1 FUNCTIONS =head2 is_prime print "$n is prime" if is_prime($n); Returns 0 is the number is composite, 1 if it is probably prime, and 2 if it is definitely prime. For numbers smaller than C<2^64> it will only return 0 (composite) or 2 (definitely prime), as this range has been exhaustively tested and has no counterexamples. For larger numbers, an extra-strong BPSW test is used. If L is installed, some additional primality tests are also performed, and a quick attempt is made to perform a primality proof, so it will return 2 for many other inputs. Also see the L function, which will never do additional tests, and the L function which will construct a proof that the input is number prime and returns 2 for almost all primes (at the expense of speed). For native precision numbers (anything smaller than C<2^64>, all three functions are identical and use a deterministic set of tests (selected Miller-Rabin bases or BPSW). For larger inputs both L and L return probable prime results using the extra-strong Baillie-PSW test, which has had no counterexample found since it was published in 1980. For cryptographic key generation, you may want even more testing for probable primes (NIST recommends some additional M-R tests). This can be done using a different test (e.g. L) or using additional M-R tests with random bases with L. Even better, make sure L is installed and use L which should be reasonably fast for sizes under 2048 bits. Another possibility is to use L which constructs a random provable prime. =head2 primes Returns all the primes between the lower and upper limits (inclusive), with a lower limit of C<2> if none is given. An array reference is returned (with large lists this is much faster and uses less memory than returning an array directly). my $aref1 = primes( 1_000_000 ); my $aref2 = primes( 1_000_000_000_000, 1_000_000_001_000 ); my @primes = @{ primes( 500 ) }; print "$_\n" for @{primes(20,100)}; Sieving will be done if required. The algorithm used will depend on the range and whether a sieve result already exists. Possibilities include primality testing (for very small ranges), a Sieve of Eratosthenes using wheel factorization, or a segmented sieve. =head2 next_prime $n = next_prime($n); Returns the next prime greater than the input number. The result will be a bigint if it can not be exactly represented in the native int type (larger than C<4,294,967,291> in 32-bit Perl; larger than C<18,446,744,073,709,551,557> in 64-bit). =head2 prev_prime $n = prev_prime($n); Returns the prime preceding the input number (i.e. the largest prime that is strictly less than the input). 0 is returned if the input is C<2> or lower. =head2 forprimes forprimes { say } 100,200; # print primes from 100 to 200 $sum=0; forprimes { $sum += $_ } 100000; # sum primes to 100k forprimes { say if is_prime($_+2) } 10000; # print twin primes to 10k Given a block and either an end count or a start and end pair, calls the block for each prime in the range. Compared to getting a big array of primes and iterating through it, this is more memory efficient and perhaps more convenient. This will almost always be the fastest way to loop over a range of primes. Nesting and use in threads are allowed. Math::BigInt objects may be used for the range. For some uses an iterator (L, L) or a tied array (L) may be more convenient. Objects can be passed to functions, and allow early loop exits. =head2 forcomposites forcomposites { say } 1000; forcomposites { say } 2000,2020; Given a block and either an end number or a start and end pair, calls the block for each composite in the inclusive range. The composites are the numbers greater than 1 which are not prime: C<4, 6, 8, 9, 10, 12, 14, 15, ...> =head2 fordivisors fordivisors { $prod *= $_ } $n; Given a block and a non-negative number C, the block is called with C<$_> set to each divisor in sorted order. Also see L. =head2 prime_iterator my $it = prime_iterator; $sum += $it->() for 1..100000; Returns a closure-style iterator. The start value defaults to the first prime (2) but an initial value may be given as an argument, which will result in the first value returned being the next prime greater than or equal to the argument. For example, this: my $it = prime_iterator(200); say $it->(); say $it->(); will return 211 followed by 223, as those are the next primes E= 200. On each call, the iterator returns the current value and increments to the next prime. Other options include L (more efficiency, less flexibility), L (an iterator with more functionality), or L (a tied array). =head2 prime_iterator_object my $it = prime_iterator_object; while ($it->value < 100) { say $it->value; $it->next; } $sum += $it->iterate for 1..100000; Returns a L object. A shortcut that loads the package if needed, calls new, and returns the object. See the documentation for that package for details. This object has more features than the simple one above (e.g. the iterator is bi-directional), and also handles iterating across bigints. =head2 prime_count my $primepi = prime_count( 1_000 ); my $pirange = prime_count( 1_000, 10_000 ); Returns the Prime Count function C, also called C in some math packages. When given two arguments, it returns the inclusive count of primes between the ranges. E.g. C<(13,17)> returns 2, C<(14,17)> and C<(13,16)> return 1, C<(14,16)> returns 0. The current implementation decides based on the ranges whether to use a segmented sieve with a fast bit count, or the extended LMO algorithm. The former is preferred for small sizes as well as small ranges. The latter is much faster for large ranges. The segmented sieve is very memory efficient and is quite fast even with large base values. Its complexity is approximately C, where the first term is typically negligible below C<~ 10^11>. Memory use is proportional only to C, with total memory use under 1MB for any base under C<10^14>. The extended LMO method has complexity approximately C, and also uses low memory. A calculation of C completes in a few seconds, C in well under a minute, and C in about one minute. In contrast, even parallel primesieve would take over a week on a similar machine to determine C. Also see the function L which gives a very good approximation to the prime count, and L and L which give tight bounds to the actual prime count. These functions return quickly for any input, including bigints. =head2 prime_count_upper =head2 prime_count_lower my $lower_limit = prime_count_lower($n); my $upper_limit = prime_count_upper($n); # $lower_limit <= prime_count(n) <= $upper_limit Returns an upper or lower bound on the number of primes below the input number. These are analytical routines, so will take a fixed amount of time and no memory. The actual C will always be equal to or between these numbers. A common place these would be used is sizing an array to hold the first C<$n> primes. It may be desirable to use a bit more memory than is necessary, to avoid calling C. These routines use verified tight limits below a range at least C<2^35>, and use the Dusart (2010) bounds of x/logx * (1 + 1/logx + 2.000/log^2x) <= Pi(x) x/logx * (1 + 1/logx + 2.334/log^2x) >= Pi(x) above that range. These bounds do not assume the Riemann Hypothesis. If the configuration option C has been set (it is off by default), then the Schoenfeld (1976) bounds are used for large values. =head2 prime_count_approx print "there are about ", prime_count_approx( 10 ** 18 ), " primes below one quintillion.\n"; Returns an approximation to the C function, without having to generate any primes. For values under C<10^36> this uses the Riemann R function, which is quite accurate: an error of less than C<0.0005%> is typical for input values over C<2^32>, and decreases as the input gets larger. If L is installed, the Riemann R function is used for all values, and will be very fast. If not, then values of C<10^36> and larger will use the approximation C. While not as accurate as the Riemann R function, it still should have error less than C<0.00000000000000001%>. A slightly faster but much less accurate answer can be obtained by averaging the upper and lower bounds. =head2 nth_prime say "The ten thousandth prime is ", nth_prime(10_000); Returns the prime that lies in index C in the array of prime numbers. Put another way, this returns the smallest C

from C<3> until C. Removing primes, this produces the sequence L. =head2 is_almost_extra_strong_lucas_pseudoprime This is similar to the L function, but does not calculate C, so is a little faster, but also weaker. With the current implementations, there is little reason to prefer this unless trying to reproduce specific results. The extra-strong implementation has been optimized to use similar features, removing most of the performance advantage. An optional second argument (an integer between 1 and 256) indicates the increment amount for C

parameter selection. The default value of 1 yields the parameter selection described in L, creating a pseudoprime sequence which is a superset of the latter's pseudoprime sequence L. A value of 2 yields the method used by L. Because the C condition is ignored, this produces about 5% more pseudoprimes than the extra-strong Lucas test. However this is still only 66% of the number produced by the strong Lucas-Selfridge test. No BPSW counterexamples have been found with any of the Lucas tests described. =head2 is_frobenius_underwood_pseudoprime Takes a positive number as input, and returns 1 if the input passes the minimal lambda+2 test (see Underwood 2012 "Quadratic Compositeness Tests"), where C<(L+2)^(n-1) = 5 + 2x mod (n, L^2 - Lx + 1)>. The computational cost for this is between the cost of 2 and 3 strong pseudoprime tests. There are no known counterexamples, but this is not a well studied test. =head2 miller_rabin_random Takes a positive number (C) as input and a positive number (C) of bases to use. Performs C Miller-Rabin tests using uniform random bases between 2 and C. This should not be used in place of L, L, or L. Those functions will be faster and provide better results than running C Miller-Rabin tests. This function can be used if one wants more assurances for non-proven primes, such as for cryptographic uses where the size is large enough that proven primes are not desired. =head2 is_prob_prime my $prob_prime = is_prob_prime($n); # Returns 0 (composite), 2 (prime), or 1 (probably prime) Takes a positive number as input and returns back either 0 (composite), 2 (definitely prime), or 1 (probably prime). For 64-bit input (native or bignum), this uses either a deterministic set of Miller-Rabin tests (1, 2, or 3 tests) or a strong BPSW test consisting of a single base-2 strong probable prime test followed by a strong Lucas test. This has been verified with Jan Feitsma's 2-PSP database to produce no false results for 64-bit inputs. Hence the result will always be 0 (composite) or 2 (prime). For inputs larger than C<2^64>, an extra-strong Baillie-PSW primality test is performed (also called BPSW or BSW). This is a probabilistic test, so only 0 (composite) and 1 (probably prime) are returned. There is a possibility that composites may be returned marked prime, but since the test was published in 1980, not a single BPSW pseudoprime has been found, so it is extremely likely to be prime. While we believe (Pomerance 1984) that an infinite number of counterexamples exist, there is a weak conjecture (Martin) that none exist under 10000 digits. =head2 is_bpsw_prime Given a positive number input, returns 0 (composite), 2 (definitely prime), or 1 (probably prime), using the BPSW primality test (extra-strong variant). Normally one of the L or L functions will suffice, but those functions do pre-tests to find easy composites. If you know this is not necessary, then calling L may save a small amount of time. =head2 is_provable_prime say "$n is definitely prime" if is_provable_prime($n) == 2; Takes a positive number as input and returns back either 0 (composite), 2 (definitely prime), or 1 (probably prime). This gives it the same return values as L and L. Note that numbers below 2^64 are considered proven by the deterministic set of Miller-Rabin bases or the BPSW test. Both of these have been tested for all small (64-bit) composites and do not return false positives. Using the L module is B for doing primality proofs, as it is much, much faster. The pure Perl code is just not fast for this type of operation, nor does it have the best algorithms. It should suffice for proofs of up to 40 digit primes, while the latest MPU::GMP works for primes of hundreds of digits (thousands with an optional larger polynomial set). The pure Perl implementation uses theorem 5 of BLS75 (Brillhart, Lehmer, and Selfridge's 1975 paper), an improvement on the Pocklington-Lehmer test. This requires C to be factored to C<(n/2)^(1/3))>. This is often fast, but as C gets larger, it takes exponentially longer to find factors. L implements both the BLS75 theorem 5 test as well as ECPP (elliptic curve primality proving). It will typically try a quick C proof before using ECPP. Certificates are available with either method. This results in proofs of 200-digit primes in under 1 second on average, and many hundreds of digits are possible. This makes it significantly faster than Pari 2.1.7's C which is the default for L. =head2 prime_certificate my $cert = prime_certificate($n); say verify_prime($cert) ? "proven prime" : "not prime"; Given a positive integer C as input, returns a primality certificate as a multi-line string. If we could not prove C prime, an empty string is returned (C may or may not be composite). This may be examined or given to L for verification. The latter function contains the description of the format. =head2 is_provable_prime_with_cert Given a positive integer as input, returns a two element array containing the result of L: 0 definitely composite 1 probably prime 2 definitely prime and a primality certificate like L. The certificate will be an empty string if the first element is not 2. =head2 verify_prime my $cert = prime_certificate($n); say verify_prime($cert) ? "proven prime" : "not prime"; Given a primality certificate, returns either 0 (not verified) or 1 (verified). Most computations are done using pure Perl with Math::BigInt, so you probably want to install and use Math::BigInt::GMP, and ECPP certificates will be faster with Math::Prime::Util::GMP for its elliptic curve computations. If the certificate is malformed, the routine will carp a warning in addition to returning 0. If the C option is set (see L) then if the validation fails, the reason for the failure is printed in addition to returning 0. If the C option is set to 2 or higher, then a message indicating success and the certificate type is also printed. A certificate may have arbitrary text before the beginning (the primality routines from this module will not have any extra text, but this way verbose output from the prover can be safely stored in a certificate). The certificate begins with the line: [MPU - Primality Certificate] All lines in the certificate beginning with C<#> are treated as comments and ignored, as are blank lines. A version number may follow, such as: Version 1.0 For all inputs, base 10 is the default, but at any point this may be changed with a line like: Base 16 where allowed bases are 10, 16, and 62. This module will only use base 10, so its routines will not output Base commands. Next, we look for (using "100003" as an example): Proof for: N 100003 where the text C indicates we will read an C value. Skipping comments and blank lines, the next line should be "N " followed by the number. After this, we read one or more blocks. Each block is a proof of the form: If Q is prime, then N is prime. Some of the blocks have more than one Q value associated with them, but most only have one. Each block has its own set of conditions which must be verified, and this can be done completely self-contained. That is, each block is independent of the other blocks and may be processed in any order. To be a complete proof, each block must successfully verify. The block types and their conditions are shown below. Finally, when all blocks have been read and verified, we must ensure we can construct a proof tree from the set of blocks. The root of the tree is the initial C, and for each node (block), all C values must either have a block using that value as its C or C must be less than C<2^64> and pass BPSW. Some other certificate formats (e.g. Primo) use an ordered chain, where the first block must be for the initial C, a single C is given which is the implied C for the next block, and so on. This simplifies validation implementation somewhat, and removes some redundant information from the certificate, but has no obvious way to add proof types such as Lucas or the various BLS75 theorems that use multiple factors. I decided that the most general solution was to have the certificate contain the set in any order, and let the verifier do the work of constructing the tree. The blocks begin with the text "Type ..." where ... is the type. One or more values follow. The defined types are: =over 4 =item C Type Small N 5791 N must be less than 2^64 and be prime (use BPSW or deterministic M-R). =item C Type BLS3 N 2297612322987260054928384863 Q 16501461106821092981 A 5 A simple n-1 style proof using BLS75 theorem 3. This block verifies if: a Q is odd b Q > 2 c Q divides N-1 . Let M = (N-1)/Q d MQ+1 = N e M > 0 f 2Q+1 > sqrt(N) g A^((N-1)/2) mod N = N-1 h A^(M/2) mod N != N-1 =item C Type Pocklington N 2297612322987260054928384863 Q 16501461106821092981 A 5 A simple n-1 style proof using generalized Pocklington. This is more restrictive than BLS3 and much more than BLS5. This is Primo's type 1, and this module does not currently generate these blocks. This block verifies if: a Q divides N-1 . Let M = (N-1)/Q b M > 0 c M < Q d MQ+1 = N e A > 1 f A^(N-1) mod N = 1 g gcd(A^M - 1, N) = 1 =item C Type BLS15 N 8087094497428743437627091507362881 Q 175806402118016161687545467551367 LP 1 LQ 22 A simple n+1 style proof using BLS75 theorem 15. This block verifies if: a Q is odd b Q > 2 c Q divides N+1 . Let M = (N+1)/Q d MQ-1 = N e M > 0 f 2Q-1 > sqrt(N) . Let D = LP*LP - 4*LQ g D != 0 h Jacobi(D,N) = -1 . Note: V_{k} indicates the Lucas V sequence with LP,LQ i V_{m/2} mod N != 0 j V_{(N+1)/2} mod N == 0 =item C Type BLS5 N 8087094497428743437627091507362881 Q[1] 98277749 Q[2] 3631 A[0] 11 ---- A more sophisticated n-1 proof using BLS theorem 5. This requires N-1 to be factored only to C<(N/2)^(1/3)>. While this looks much more complicated, it really isn't much more work. The biggest drawback is just that we have multiple Q values to chain rather than a single one. This block verifies if: a N > 2 b N is odd . Note: the block terminates on the first line starting with a C<->. . Let Q[0] = 2 . Let A[i] = 2 if Q[i] exists and A[i] does not c For each i (0 .. maxi): c1 Q[i] > 1 c2 Q[i] < N-1 c3 A[i] > 1 c4 A[i] < N c5 Q[i] divides N-1 . Let F = N-1 divided by each Q[i] as many times as evenly possible . Let R = (N-1)/F d F is even e gcd(F, R) = 1 . Let s = integer part of R / 2F . Let f = fractional part of R / 2F . Let P = (F+1) * (2*F*F + (r-1)*F + 1) f n < P g s = 0 OR r^2-8s is not a perfect square h For each i (0 .. maxi): h1 A[i]^(N-1) mod N = 1 h2 gcd(A[i]^((N-1)/Q[i])-1, N) = 1 =item C Type ECPP N 175806402118016161687545467551367 A 96642115784172626892568853507766 B 111378324928567743759166231879523 M 175806402118016177622955224562171 Q 2297612322987260054928384863 X 3273750212 Y 82061726986387565872737368000504 An elliptic curve primality block, typically generated with an Atkin/Morain ECPP implementation, but this should be adequate for anything using the Atkin-Goldwasser-Kilian-Morain style certificates. Some basic elliptic curve math is needed for these. This block verifies if: . Note: A and B are allowed to be negative, with -1 not uncommon. . Let A = A % N . Let B = B % N a N > 0 b gcd(N, 6) = 1 c gcd(4*A^3 + 27*B^2, N) = 1 d Y^2 mod N = X^3 + A*X + B mod N e M >= N - 2*sqrt(N) + 1 f M <= N + 2*sqrt(N) + 1 g Q > (N^(1/4)+1)^2 h Q < N i M != Q j Q divides M . Note: EC(A,B,N,X,Y) is the point (X,Y) on Y^2 = X^3 + A*X + B, mod N . All values work in affine coordinates, but in theory other . representations work just as well. . Let POINT1 = (M/Q) * EC(A,B,N,X,Y) . Let POINT2 = M * EC(A,B,N,X,Y) [ = Q * POINT1 ] k POINT1 is not the identity l POINT2 is the identity =back =head2 is_aks_prime say "$n is definitely prime" if is_aks_prime($n); Takes a positive number as input, and returns 1 if the input passes the Agrawal-Kayal-Saxena (AKS) primality test. This is a deterministic unconditional primality test which runs in polynomial time for general input. While this is an important theoretical algorithm, and makes an interesting example, it is hard to overstate just how impractically slow it is in practice. It is not used for any purpose in non-theoretical work, as it is literally B of times slower than other algorithms. From R.P. Brent, 2010: "AKS is not a practical algorithm. ECPP is much faster." We have ECPP, and indeed it is much faster. =head2 lucas_sequence my($U, $V, $Qk) = lucas_sequence($n, $P, $Q, $k) Computes C, C, and C for the Lucas sequence defined by C

,C, modulo C. The modular Lucas sequence is used in a number of primality tests and proofs. The following conditions must hold: C< D = P*P - 4*Q != 0> ; C< 0 E P E n> ; C< Q E n> ; C< k E= 0> ; C< n E= 2>. =head2 gcd Given a list of integers, returns the greatest common divisor. This is often used to test for L. =head2 lcm Given a list of integers, returns the least common multiple. Note that we follow the semantics of Mathematica, Pari, and Perl 6, re: lcm(0, n) = 0 Any zero in list results in zero return lcm(n,-m) = lcm(n, m) We use the absolute values =head2 moebius say "$n is square free" if moebius($n) != 0; $sum += moebius($_) for (1..200); say "Mertens(200) = $sum"; Returns μ(n), the Möbius function (also known as the Moebius, Mobius, or MoebiusMu function) for an integer input. This function is 1 if C, 0 if C is not square free (i.e. C has a repeated factor), and C<-1^t> if C is a product of C distinct primes. This is an important function in prime number theory. Like SAGE, we define C for convenience. If called with two arguments, they define a range C to C, and the function returns an array with the value of the Möbius function for every n from low to high inclusive. Large values of high will result in a lot of memory use. The algorithm used for ranges is Deléglise and Rivat (1996) algorithm 4.1, which is a segmented version of Lioen and van de Lune (1994) algorithm 3.2. The return values are read-only constants. This should almost never come up, but it means trying to modify aliased return values will cause an exception (modifying the returned scalar or array is fine). =head2 mertens say "Mertens(10M) = ", mertens(10_000_000); # = 1037 Returns M(n), the Mertens function for a non-negative integer input. This function is defined as C, but calculated more efficiently for large inputs. For example, computing Mertens(100M) takes: time approx mem 0.3s 0.1MB mertens(100_000_000) 1.2s 890MB List::Util::sum(moebius(1,100_000_000)) 77s 0MB $sum += moebius($_) for 1..100_000_000 The summation of individual terms via factoring is quite expensive in time, though uses O(1) space. Using the range version of moebius is much faster, but returns a 100M element array which is not good for memory with this many items. In comparison, this function will generate the equivalent output via a sieving method that is relatively sparse memory and very fast. The current method is a simple C version of Deléglise and Rivat (1996), which involves calculating all moebius values to C, which in turn will require prime sieving to C. Various algorithms exist for this, using differing quantities of μ(n). The simplest way is to efficiently sum all C values. Benito and Varona (2008) show a clever and simple method that only requires C values. Deléglise and Rivat (1996) describe a segmented method using only C values. The current implementation does a simple non-segmented C version of their method. Kuznetsov (2011) gives an alternate method that he indicates is even faster. Lastly, one of the advanced prime count algorithms could be theoretically used to create a faster solution. =head2 euler_phi say "The Euler totient of $n is ", euler_phi($n); Returns φ(n), the Euler totient function (also called Euler's phi or phi function) for an integer value. This is an arithmetic function which counts the number of positive integers less than or equal to C that are relatively prime to C. Given the definition used, C will return 0 for all C 1>. This follows the logic used by SAGE. Mathematica and Pari return C for C 0>. Mathematica returns 0 for C while Pari raises an exception. If called with two arguments, they define a range C to C, and the function returns an array with the totient of every n from low to high inclusive. =head2 jordan_totient say "Jordan's totient J_$k($n) is ", jordan_totient($k, $n); Returns Jordan's totient function for a given integer value. Jordan's totient is a generalization of Euler's totient, where C This counts the number of k-tuples less than or equal to n that form a coprime tuple with n. As with C, 0 is returned for all C 1>. This function can be used to generate some other useful functions, such as the Dedikind psi function, where C. =head2 exp_mangoldt say "exp(lambda($_)) = ", exp_mangoldt($_) for 1 .. 100; Returns EXP(Λ(n)), the exponential of the Mangoldt function (also known as von Mangoldt's function) for an integer value. The Mangoldt function is equal to log p if n is prime or a power of a prime, and 0 otherwise. We return the exponential so all results are integers. Hence the return value for C is: p if n = p^m for some prime p and integer m >= 1 1 otherwise. =head2 liouville Returns λ(n), the Liouville function for a non-negative integer input. This is -1 raised to Ω(n) (the total number of prime factors). =head2 chebyshev_theta say chebyshev_theta(10000); Returns θ(n), the first Chebyshev function for a non-negative integer input. This is the sum of the logarithm of each prime where C

= n>. An alternate computation is as the logarithm of n primorial. Hence these functions: use List::Util qw/sum/; use Math::BigFloat; sub c1a { 0+sum( map { log($_) } @{primes(shift)} ) } sub c1b { Math::BigFloat->new(primorial(shift))->blog } yield similar results, albeit slower and using more memory. =head2 chebyshev_psi say chebyshev_psi(10000); Returns ψ(n), the second Chebyshev function for a non-negative integer input. This is the sum of the logarithm of each prime power where C= n> for an integer k. An alternate computation is as the summatory Mangoldt function. Another alternate computation is as the logarithm of LCM(1,2,...,n). Hence these functions: use List::Util qw/sum/; use Math::BigFloat; sub c2a { 0+sum( map { log(exp_mangoldt($_)) } 1 .. shift ) } sub c2b { Math::BigFloat->new(consecutive_integer_lcm(shift))->blog } yield similar results, albeit slower and using more memory. =head2 divisor_sum say "Sum of divisors of $n:", divisor_sum( $n ); say "sigma_2($n) = ", divisor_sum($n, 2); say "Number of divisors: sigma_0($n) = ", divisor_sum($n, 0); This function takes a positive integer as input and returns the sum of its divisors, including 1 and itself. An optional second argument C may be given, which will result in the sum of the C powers of the divisors to be returned. This is known as the sigma function (see Hardy and Wright section 16.7, or OEIS A000203). The API is identical to Pari/GP's C function. This function is useful for calculating things like aliquot sums, abundant numbers, perfect numbers, etc. The second argument may also be a code reference, which is called for each divisor and the results are summed. This allows computation of other functions, but will be less efficient than using the numeric second argument. This corresponds to Pari/GP's C function. An example of the 5th Jordan totient (OEIS A059378): divisor_sum( $n, sub { my $d=shift; $d**5 * moebius($n/$d); } ); though we have a function L which is more efficient. For numeric second arguments (sigma computations), the result will be a bigint if necessary. For the code reference case, the user must take care to return bigints if overflow will be a concern. =head2 primorial $prim = primorial(11); # 11# = 2*3*5*7*11 = 2310 Returns the primorial C of the positive integer input, defined as the product of the prime numbers less than or equal to C. This is the L: primorial numbers second definition. primorial(0) == 1 primorial($n) == pn_primorial( prime_count($n) ) The result will be a L object if it is larger than the native bit size. Be careful about which version (C or C) matches the definition you want to use. Not all sources agree on the terminology, though they should give a clear definition of which of the two versions they mean. OEIS, Wikipedia, and Mathworld are all consistent, and these functions should match that terminology. This function should return the same result as the C function added in GMP 5.1. =head2 pn_primorial $prim = pn_primorial(5); # p_5# = 2*3*5*7*11 = 2310 Returns the primorial number C of the positive integer input, defined as the product of the first C prime numbers (compare to the factorial, which is the product of the first C natural numbers). This is the L: primorial numbers first definition. pn_primorial(0) == 1 pn_primorial($n) == primorial( nth_prime($n) ) The result will be a L object if it is larger than the native bit size. =head2 consecutive_integer_lcm $lcm = consecutive_integer_lcm($n); Given an unsigned integer argument, returns the least common multiple of all integers from 1 to C. This can be done by manipulation of the primes up to C, resulting in much faster and memory-friendly results than using a factorial. =head2 partitions Calculates the partition function p(n) for a non-negative integer input. This is the number of ways of writing the integer n as a sum of positive integers, without restrictions. This corresponds to Pari's C function and Mathematica's C function. The values produced in order are L. This uses a combinatorial calculation, which means it will not be very fast compared to Pari, Mathematica, or FLINT which use the Rademacher formula using multi-precision floating point. In 10 seconds: 65 Integer::Partition 10_000 MPU pure Perl partitions 200_000 MPU GMP partitions 22_000_000 Pari's numbpart 500_000_000 Jonathan Bober's partitions_c.cc v0.6 If you want the enumerated partitions, see L. It uses a memory efficient iterator and is very fast for enumeration. It is not practical for producing large partition numbers as seen above. =head2 carmichael_lambda Returns the Carmichael function (also called the reduced totient function, or Carmichael λ(n)) of a positive integer argument. It is the smallest positive integer C such that C for every integer C coprime to C. This is L. =head2 kronecker Returns the Kronecker symbol C<(a|n)> for two integers. The possible return values with their meanings for odd positive C are: 0 a = 0 mod n 1 a is a quadratic residue modulo n (a = x^2 mod n for some x) -1 a is a quadratic non-residue modulo n The Kronecker symbol is an extension of the Jacobi symbol to all integer values of C from the latter's domain of positive odd values of C. The Jacobi symbol is itself an extension of the Legendre symbol, which is only defined for odd prime values of C. This corresponds to Pari's C function and Mathematica's C function. =head2 znorder $order = znorder(2, next_prime(10**19)-6); Given two positive integers C and C, returns the multiplicative order of C modulo C. This is the smallest positive integer C such that C. Returns 1 if C. Returns undef if C or if C and C are not coprime, since no value will result in 1 mod n. This corresponds to Pari's C function and Mathematica's C function. =head2 znprimroot Given a positive integer C, returns the smallest primitive root of C<(Z/nZ)^*>, or C if no root exists. A root exists when C, which will be true for all prime C and some composites. L is a sequence of integers where the primitive root exists, while L is a list of the smallest primitive roots, which is what this function produces. =head2 znlog $k = znlog($a, $g, $p) Returns the integer C that solves the equation C, or undef if no solution is found. This is the discrete logarithm problem. The implementation in this version is not very useful, but may be improved. =head2 legendre_phi $phi = legendre_phi(1000000000, 41); Given a non-negative integer C and a non-negative prime number C, returns the Legendre phi function (also called Legendre's sum). This is the count of positive integers E= C which are not divisible by any of the first C primes. =head1 RANDOM PRIMES =head2 random_prime my $small_prime = random_prime(1000); # random prime <= limit my $rand_prime = random_prime(100, 10000); # random prime within a range Returns a pseudo-randomly selected prime that will be greater than or equal to the lower limit and less than or equal to the upper limit. If no lower limit is given, 2 is implied. Returns undef if no primes exist within the range. The goal is to return a uniform distribution of the primes in the range, meaning for each prime in the range, the chances are equally likely that it will be seen. This is removes from consideration such algorithms as C, which although efficient, gives very non-random output. This also implies that the numbers will not be evenly distributed, since the primes are not evenly distributed. Stated differently, the random prime functions return a uniformly selected prime from the set of primes within the range. Hence given C, the numbers 2, 3, 487, 631, and 997 all have the same probability of being returned. For small numbers, a random index selection is done, which gives ideal uniformity and is very efficient with small inputs. For ranges larger than this ~16-bit threshold but within the native bit size, a Monte Carlo method is used (multiple calls to C will be made if necessary). This also gives ideal uniformity and can be very fast for reasonably sized ranges. For even larger numbers, we partition the range, choose a random partition, then select a random prime from the partition. This gives some loss of uniformity but results in many fewer bits of randomness being consumed as well as being much faster. If an C function has been set via L, it will be used to construct any ranged random numbers needed. The function should return a uniformly random 32-bit integer, which is how the irand functions exported by L, L, L, and most other modules behave. If no C function was set, then L is used with a non-blocking seed. This will create good quality random numbers, so there should be little reason to change unless one is generating long-term keys, where using the blocking random source may be preferred. Examples of various ways to set your own irand function: # System rand. You probably don't want to do this. prime_set_config(irand => sub { int(rand(4294967296)) }); # Math::Random::Secure. Uses ISAAC and strong seed methods. use Math::Random::Secure; prime_set_config(irand => \&Math::Random::Secure::irand); # Bytes::Random::Secure (OO interface with full control of options): use Bytes::Random::Secure (); BEGIN { my $rng = Bytes::Random::Secure->new( Bits => 512 ); sub irand { return $rng->irand; } } prime_set_config(irand => \&irand); # Crypt::Random. Uses Pari and /dev/random. Very slow. use Crypt::Random qw/makerandom/; prime_set_config(irand => sub { makerandom(Size=>32, Uniform=>1); }); # Mersenne Twister. Very fast, decent RNG, auto seeding. use Math::Random::MT::Auto; prime_set_config(irand=>sub {Math::Random::MT::Auto::irand() & 0xFFFFFFFF}); # Go back to MPU's default configuration prime_set_config(irand => undef); =head2 random_ndigit_prime say "My 4-digit prime number is: ", random_ndigit_prime(4); Selects a random n-digit prime, where the input is an integer number of digits. One of the primes within that range (e.g. 1000 - 9999 for 4-digits) will be uniformly selected using the C function as described above. If the number of digits is greater than or equal to the maximum native type, then the result will be returned as a BigInt. However, if the C configuration option is on, then output will be restricted to native size numbers, and requests for more digits than natively supported will result in an error. For better performance with large bit sizes, install L. =head2 random_nbit_prime my $bigprime = random_nbit_prime(512); Selects a random n-bit prime, where the input is an integer number of bits. A prime with the nth bit set will be uniformly selected, with randomness supplied via calls to the C function as described above. For bit sizes of 64 and lower, L is used, which gives completely uniform results in this range. For sizes larger than 64, Algorithm 1 of Fouque and Tibouchi (2011) is used, wherein we select a random odd number for the lower bits, then loop selecting random upper bits until the result is prime. This allows a more uniform distribution than the general L case while running slightly faster (in contrast, for large bit sizes L selects a random upper partition then loops on the values within the partition, which very slightly skews the results towards smaller numbers). The C function is used for randomness, so all the discussion in L about that applies here. The result will be a BigInt if the number of bits is greater than the native bit size. For better performance with large bit sizes, install L. =head2 random_strong_prime my $bigprime = random_strong_prime(512); Constructs an n-bit strong prime using Gordon's algorithm. We consider a strong prime I

to be one where =over =item * I

is large. This function requires at least 128 bits. =item * I has a large prime factor I. =item * I has a large prime factor I =item * I has a large prime factor I =back Using a strong prime in cryptography guards against easy factoring with algorithms like Pollard's Rho. Rivest and Silverman (1999) present a case that using strong primes is unnecessary, and most modern cryptographic systems agree. First, the smoothness does not affect more modern factoring methods such as ECM. Second, modern factoring methods like GNFS are far faster than either method so make the point moot. Third, due to key size growth and advances in factoring and attacks, for practical purposes, using large random primes offer security equivalent to strong primes. Similar to L, the result will be a BigInt if the number of bits is greater than the native bit size. For better performance with large bit sizes, install L. =head2 random_proven_prime my $bigprime = random_proven_prime(512); Constructs an n-bit random proven prime. Internally this may use L(L) or L depending on the platform and bit size. =head2 random_proven_prime_with_cert my($n, $cert) = random_proven_prime_with_cert(512) Similar to L, but returns a two-element array containing the n-bit provable prime along with a primality certificate. The certificate is the same as produced by L or L, and can be parsed by L or any other software that understands MPU primality certificates. =head2 random_maurer_prime my $bigprime = random_maurer_prime(512); Construct an n-bit provable prime, using the FastPrime algorithm of Ueli Maurer (1995). This is the same algorithm used by L. Similar to L, the result will be a BigInt if the number of bits is greater than the native bit size. For better performance with large bit sizes, install L. The differences between this function and that in L are described in the L section. Internally this additionally runs the BPSW probable prime test on every partial result, and constructs a primality certificate for the final result, which is verified. These provide additional checks that the resulting value has been properly constructed. An alternative to this function is to run L on the result of L, which will provide more diversity and will be faster up to 512 or so bits. Maurer's method should be much faster for large bit sizes (larger than 2048). If you don't need absolutely proven results, then using L followed by additional tests (L and/or L) should be much faster. =head2 random_maurer_prime_with_cert my($n, $cert) = random_maurer_prime_with_cert(512) As with L, but returns a two-element array containing the n-bit provable prime along with a primality certificate. The certificate is the same as produced by L or L, and can be parsed by L or any other software that understands MPU primality certificates. The proof construction consists of a single chain of C types. =head1 UTILITY FUNCTIONS =head2 prime_precalc prime_precalc( 1_000_000_000 ); Let the module prepare for fast operation up to a specific number. It is not necessary to call this, but it gives you more control over when memory is allocated and gives faster results for multiple calls in some cases. In the current implementation this will calculate a sieve for all numbers up to the specified number. =head2 prime_memfree prime_memfree; Frees any extra memory the module may have allocated. Like with C, it is not necessary to call this, but if you're done making calls, or want things cleanup up, you can use this. The object method might be a better choice for complicated uses. =head2 Math::Prime::Util::MemFree->new my $mf = Math::Prime::Util::MemFree->new; # perform operations. When $mf goes out of scope, memory will be recovered. This is a more robust way of making sure any cached memory is freed, as it will be handled by the last C object leaving scope. This means if your routines were inside an eval that died, things will still get cleaned up. If you call another function that uses a MemFree object, the cache will stay in place because you still have an object. =head2 prime_get_config my $cached_up_to = prime_get_config->{'precalc_to'}; Returns a reference to a hash of the current settings. The hash is copy of the configuration, so changing it has no effect. The settings include: precalc_to primes up to this number are calculated maxbits the maximum number of bits for native operations xs 0 or 1, indicating the XS code is available gmp 0 or 1, indicating GMP code is available maxparam the largest value for most functions, without bigint maxdigits the max digits in a number, without bigint maxprime the largest representable prime, without bigint maxprimeidx the index of maxprime, without bigint assume_rh whether to assume the Riemann hypothesis (default 0) =head2 prime_set_config prime_set_config( assume_rh => 1 ); Allows setting of some parameters. Currently the only parameters are: xs Allows turning off the XS code, forcing the Pure Perl code to be used. Set to 0 to disable XS, set to 1 to re-enable. You probably will never want to do this. gmp Allows turning off the use of L, which means using Pure Perl code for big numbers. Set to 0 to disable GMP, set to 1 to re-enable. You probably will never want to do this. assume_rh Allows functions to assume the Riemann hypothesis is true if set to 1. This defaults to 0. Currently this setting only impacts prime count lower and upper bounds, but could later be applied to other areas such as primality testing. A later version may also have a way to indicate whether no RH, RH, GRH, or ERH is to be assumed. irand Takes a code ref to an irand function returning a uniform number between 0 and 2**32-1. This will be used for all random number generation in the module. =head1 FACTORING FUNCTIONS =head2 factor my @factors = factor(3_369_738_766_071_892_021); # returns (204518747,16476429743) Produces the prime factors of a positive number input, in numerical order. The product of the returned factors will be equal to the input. C will return an empty list, and C will return 0. This matches Pari. In scalar context, returns Ω(n), the total number of prime factors (L). This corresponds to Pari's C function and Mathematica's C function. This is same result that we would get if we evaluated the resulting array in scalar context. The current algorithm for non-bigints is a sequence of small trial division, a few rounds of Pollard's Rho, SQUFOF, Pollard's p-1, Hart's OLF, a long run of Pollard's Rho, and finally trial division if anything survives. This process is repeated for each non-prime factor. In practice, it is very rare to require more than the first Rho + SQUFOF to find a factor, and I have not seen anything go to the last step. Factoring bigints works with pure Perl, and can be very handy on 32-bit machines for numbers just over the 32-bit limit, but it can be B slow for "hard" numbers. Installing the L module will speed up bigint factoring a B, and all future effort on large number factoring will be in that module. If you do not have that module for some reason, use the GMP or Pari version of bigint if possible (e.g. C 'GMP,Pari'>), which will run 2-3x faster (though still 100x slower than the real GMP code). =head2 factor_exp my @factor_exponent_pairs = factor_exp(29513484000); # returns ([2,5], [3,4], [5,3], [7,2], [11,1], [13,2]) # factor(29513484000) # returns (2,2,2,2,2,3,3,3,3,5,5,5,7,7,11,13,13) Produces pairs of prime factors and exponents in numerical factor order. This is more convenient for some algorithms. This is the same form that Mathematica's C and Pari/GP's C functions return. Note that L transposes the Pari result matrix. In scalar context, returns ω(n), the number of unique prime factors (L). This corresponds to Pari's C function and Mathematica's C function. This is same result that we would get if we evaluated the resulting array in scalar context. The internals are identical to L, so all comments there apply. Just the way the factors are arranged is different. =head2 divisors =head2 all_factors my @divisors = divisors(30); # returns (1, 2, 3, 5, 6, 10, 15, 30) Produces all the divisors of a positive number input, including 1 and the input number. The divisors are a power set of multiplications of the prime factors, returned as a uniqued sorted list. The result is identical to that of Pari's C and Mathematica's C functions. In scalar context this returns the sigma0 function, the sigma function (see Hardy and Wright section 16.7, or OEIS A000203). This is the same result as evaluating the array in scalar context. Also see the L functions for looping over the divisors. C is the deprecated name for this function. =head2 trial_factor my @factors = trial_factor($n); Produces the prime factors of a positive number input. The factors will be in numerical order. For large inputs this will be very slow. =head2 fermat_factor my @factors = fermat_factor($n); Produces factors, not necessarily prime, of the positive number input. The particular algorithm is Knuth's algorithm C. For small inputs this will be very fast, but it slows down quite rapidly as the number of digits increases. It is very fast for inputs with a factor close to the midpoint (e.g. a semiprime p*q where p and q are the same number of digits). =head2 holf_factor my @factors = holf_factor($n); Produces factors, not necessarily prime, of the positive number input. An optional number of rounds can be given as a second parameter. It is possible the function will be unable to find a factor, in which case a single element, the input, is returned. This uses Hart's One Line Factorization with no premultiplier. It is an interesting alternative to Fermat's algorithm, and there are some inputs it can rapidly factor. In the long run it has the same advantages and disadvantages as Fermat's method. =head2 squfof_factor my @factors = squfof_factor($n); Produces factors, not necessarily prime, of the positive number input. An optional number of rounds can be given as a second parameter. It is possible the function will be unable to find a factor, in which case a single element, the input, is returned. This function typically runs very fast. =head2 prho_factor =head2 pbrent_factor my @factors = prho_factor($n); my @factors = pbrent_factor($n); # Use a very small number of rounds my @factors = prho_factor($n, 1000); Produces factors, not necessarily prime, of the positive number input. An optional number of rounds can be given as a second parameter. These attempt to find a single factor using Pollard's Rho algorithm, either the original version or Brent's modified version. These are more specialized algorithms usually used for pre-factoring very large inputs, as they are very fast at finding small factors. =head2 pminus1_factor my @factors = pminus1_factor($n); my @factors = pminus1_factor($n, 1_000); # set B1 smoothness my @factors = pminus1_factor($n, 1_000, 50_000); # set B1 and B2 Produces factors, not necessarily prime, of the positive number input. This is Pollard's C method, using two stages with default smoothness settings of 1_000_000 for B1, and C<10 * B1> for B2. This method can rapidly find a factor C

of C where C is smooth (it has no large factors). =head2 pplus1_factor my @factors = pplus1_factor($n); my @factors = pplus1_factor($n, 1_000); # set B1 smoothness Produces factors, not necessarily prime, of the positive number input. This is Williams' C method, using one stage and two predefined initial points. =head1 MATHEMATICAL FUNCTIONS =head2 ExponentialIntegral my $Ei = ExponentialIntegral($x); Given a non-zero floating point input C, this returns the real-valued exponential integral of C, defined as the integral of C from C<-infinity> to C. If the bignum module has been loaded, all inputs will be treated as if they were Math::BigFloat objects. For non-BigInt/BigFloat objects, the result should be accurate to at least 14 digits. For BigInt / BigFloat objects, we first check to see if L is available. If so, then it is used since it is very fast and has high accuracy. Accuracy when using MPFR will be equal to the C value of the input (or the default BigFloat accuracy, which is 40 by default). MPFR is used for positive inputs only. If L is not available or the input is negative, then other methods are used: continued fractions (C -1>), rational Chebyshev approximation (C< -1 E x E 0>), a convergent series (small positive C), or an asymptotic divergent series (large positive C). Accuracy should be at least 14 digits. =head2 LogarithmicIntegral my $li = LogarithmicIntegral($x) Given a positive floating point input, returns the floating point logarithmic integral of C, defined as the integral of C

from C<0> to C. If given a negative input, the function will croak. The function returns 0 at C, and C<-infinity> at C. This is often known as C. A related function is the offset logarithmic integral, sometimes known as C which avoids the singularity at 1. It may be defined as C. Crandall and Pomerance use the term C for this function, and define C. Due to this terminology confusion, it is important to check which exact definition is being used. If the bignum module has been loaded, all inputs will be treated as if they were Math::BigFloat objects. For non-BigInt/BigFloat objects, the result should be accurate to at least 14 digits. For BigInt / BigFloat objects, we first check to see if L is available. If so, then it is used, as it will return results much faster and can be more accurate. Accuracy when using MPFR will be equal to the C value of the input (or the default BigFloat accuracy, which is 40 by default). MPFR is used for inputs greater than 1 only. If L is not installed or the input is less than 1, results will be calculated as C. =head2 RiemannZeta my $z = RiemannZeta($s); Given a floating point input C where C= 0>, returns the floating point value of ζ(s)-1, where ζ(s) is the Riemann zeta function. One is subtracted to ensure maximum precision for large values of C. The zeta function is the sum from k=1 to infinity of C<1 / k^s>. This function only uses real arguments, so is basically the Euler Zeta function. If the bignum module has been loaded, all inputs will be treated as if they were Math::BigFloat objects. For non-BigInt/BigFloat objects, the result should be accurate to at least 14 digits. The XS code uses a rational Chebyshev approximation between 0.5 and 5, and a series for other values. The PP code uses an identical series for all values. For BigInt / BigFloat objects, we first check to see if the Math::MPFR module is installed. If so, then it is used, as it will return results much faster and can be more accurate. Accuracy when using MPFR will be equal to the C value of the input (or the default BigFloat accuracy, which is 40 by default). If Math::MPFR is not installed, then results are calculated using either Borwein (1991) algorithm 2, or the basic series. Full input accuracy is attempted, but Math::BigFloat L produces incorrect high-accuracy computations without the fix. It is also very slow. I highly recommend installing Math::MPFR for BigFloat computations. =head2 RiemannR my $r = RiemannR($x); Given a positive non-zero floating point input, returns the floating point value of Riemann's R function. Riemann's R function gives a very close approximation to the prime counting function. If the bignum module has been loaded, all inputs will be treated as if they were Math::BigFloat objects. For non-BigInt/BigFloat objects, the result should be accurate to at least 14 digits. For BigInt / BigFloat objects, we first check to see if the Math::MPFR module is installed. If so, then it is used, as it will return results much faster and can be more accurate. Accuracy when using MPFR will be equal to the C value of the input (or the default BigFloat accuracy, which is 40 by default). Accuracy without MPFR should be 35 digits. =head1 EXAMPLES Print strong pseudoprimes to base 17 up to 10M: # Similar to A001262's isStrongPsp function, but much faster perl -MMath::Prime::Util=:all -E 'forcomposites { say if is_strong_pseudoprime($_,17) } 10000000;' Print some primes above 64-bit range: perl -MMath::Prime::Util=:all -Mbigint -E 'my $start=100000000000000000000; say join "\n", @{primes($start,$start+1000)}' # Another way perl -MMath::Prime::Util=:all -E 'forprimes { say } "100000000000000000039", "100000000000000000993"' # Similar using Math::Pari: # perl -MMath::Pari=:int,PARI,nextprime -E 'my $start = PARI "100000000000000000000"; my $end = $start+1000; my $p=nextprime($start); while ($p <= $end) { say $p; $p = nextprime($p+1); }' Examining the η3(x) function of Planat and Solé (2011): sub nu3 { my $n = shift; my $phix = chebyshev_psi($n); my $nu3 = 0; foreach my $nu (1..3) { $nu3 += (moebius($nu)/$nu)*LogarithmicIntegral($phix**(1/$nu)); } return $nu3; } say prime_count(1000000); say prime_count_approx(1000000); say nu3(1000000); Construct and use a Sophie-Germain prime iterator: sub make_sophie_germain_iterator { my $p = shift || 2; my $it = prime_iterator($p); return sub { do { $p = $it->() } while !is_prime(2*$p+1); $p; }; } my $sgit = make_sophie_germain_iterator(); print $sgit->(), "\n" for 1 .. 10000; Project Euler, problem 3 (Largest prime factor): use Math::Prime::Util qw/factor/; use bigint; # Only necessary for 32-bit machines. say 0+(factor(600851475143))[-1] Project Euler, problem 7 (10001st prime): use Math::Prime::Util qw/nth_prime/; say nth_prime(10_001); Project Euler, problem 10 (summation of primes): use Math::Prime::Util qw/forprimes/; my $sum = 0; forprimes { $sum += $_ } 2_000_000; say $sum; Project Euler, problem 21 (Amicable numbers): use Math::Prime::Util qw/divisor_sum/; sub dsum { my $n = shift; divisor_sum($n) - $n; } my $sum = 0; foreach my $a (1..10000) { my $b = dsum($a); $sum += $a + $b if $b > $a && dsum($b) == $a; } say $sum; Project Euler, problem 41 (Pandigital prime), brute force command line: perl -MMath::Prime::Util=primes -MList::Util=first -E 'say first { /1/&&/2/&&/3/&&/4/&&/5/&&/6/&&/7/} reverse @{primes(1000000,9999999)};' Project Euler, problem 47 (Distinct primes factors): use Math::Prime::Util qw/pn_primorial factor_exp/; my $n = pn_primorial(4); # Start with the first 4-factor number # factor_exp in scalar context returns the number of distinct prime factors $n++ while (factor_exp($n) != 4 || factor_exp($n+1) != 4 || factor_exp($n+2) != 4 || factor_exp($n+3) != 4); say $n; Project Euler, problem 69, stupid brute force solution (about 1 second): use Math::Prime::Util qw/euler_phi/; my ($n, $max) = (0,0); do { my $ndivphi = $_ / euler_phi($_); ($n, $max) = ($_, $ndivphi) if $ndivphi > $max; } for 1..1000000; say "$n $max"; Here is the right way to do PE problem 69 (under 0.03s): use Math::Prime::Util qw/pn_primorial/; my $n = 0; $n++ while pn_primorial($n+1) < 1000000; say pn_primorial($n); Project Euler, problem 187, stupid brute force solution, ~3 minutes: use Math::Prime::Util qw/factor/; my $nsemis = 0; do { $nsemis++ if scalar factor($_) == 2; } for 1 .. int(10**8)-1; say $nsemis; Here is the best way for PE187. Under 30 milliseconds from the command line: use Math::Prime::Util qw/primes prime_count/; use List::Util qw/sum/; my $limit = shift || int(10**8); my @primes = @{primes(int(sqrt($limit)))}; say sum( map { prime_count(int(($limit-1)/$primes[$_-1])) - $_ + 1 } 1 .. scalar @primes ); Produce the C result from L without skipping: use Math::Prime::Util qw/divisors/; use Algorithm::Combinatorics qw/combinations_with_repetition/; my $n = 139650; my @matches = grep { $_->[0] * $_->[1] == $n && $_->[0] > 1 } combinations_with_repetition( [divisors($n)], 2 ); Compute L just like CRG4's Pari example: use Math::Prime::Util qw/forcomposite divisor_sum/; forcomposites { say if divisor_sum($_)+6 == divisor_sum($_+6) } 9,1e7; Construct the table shown in L: use Math::Prime::Util qw/znorder euler_phi gcd/; foreach my $n (1..100) { if (!znprimroot($n)) { say "$n -"; } else { my $phi = euler_phi($n); my @r = grep { gcd($_,$n) == 1 && znorder($_,$n) == $phi } 1..$n-1; say "$n ", join(" ", @r); } } =head1 PRIMALITY TESTING NOTES Above C<2^64>, L performs an extra-strong L which is fast (a little less than the time to perform 3 Miller-Rabin tests) and has no known counterexamples. If you trust the primality testing done by Pari, Maple, SAGE, FLINT, etc., then this function should be appropriate for you. L will do the same BPSW test as well as some additional testing, making it slightly more time consuming but less likely to produce a false result. This is a little more stringent than Mathematica. L constructs a primality proof. If a certificate is requested, then either BLS75 theorem 5 or ECPP is performed. Without a certificate, the method is implementation specific (currently it is identical, but later releases may use APRCL). With L installed, this is quite fast through 300 or so digits. Math systems 30 years ago typically used Miller-Rabin tests with C bases (usually fixed bases, sometimes random) for primality testing, but these have generally been replaced by some form of BPSW as used in this module. See Pinch's 1993 paper for examples of why using C M-R tests leads to poor results. The three exceptions in common contemporary use I am aware of are: =over 4 =item libtommath Uses the first C prime bases. This is problematic for cryptographic use, as there are known methods (e.g. Arnault 1994) for constructing counterexamples. The number of bases required to avoid false results is unreasonably high, hence performance is slow even if one ignores counterexamples. Unfortunately this is the multi-precision math library used for Perl 6 and at least one CPAN Crypto module. =item GMP/MPIR Uses a set of C static-random bases. The bases are randomly chosen using a PRNG that is seeded identically each call (the seed changes with each release). This offers a very slight advantage over using the first C prime bases, but not much. See, for example, Nicely's L page. =item L Pari 2.1.7 is the default version installed with the L module. It uses 10 random M-R bases (the PRNG uses a fixed seed set at compile time). Pari 2.3.0 was released in May 2006 and it, like all later releases through at least 2.6.1, use BPSW / APRCL, after complaints of false results from using M-R tests. =back Basically the problem is that it is just too easy to get counterexamples from running C M-R tests, forcing one to use a very large number of tests (at least 20) to avoid frequent false results. Using the BPSW test results in no known counterexamples after 30+ years and runs much faster. It can be enhanced with one or more random bases if one desires, and will I be much faster. Using C fixed bases has another problem, which is that in any adversarial situation we can assume the inputs will be selected such that they are one of our counterexamples. Now we need absurdly large numbers of tests. This is like playing "pick my number" but the number is fixed forever at the start, the guesser gets to know everyone else's guesses and results, and can keep playing as long as they like. It's only valid if the players are completely oblivious to what is happening. =head1 LIMITATIONS Perl versions earlier than 5.8.0 have problems doing exact integer math. Some operations will flip signs, and many operations will convert intermediate or output results to doubles, which loses precision on 64-bit systems. This causes numerous functions to not work properly. The test suite will try to determine if your Perl is broken (this only applies to really old versions of Perl compiled for 64-bit when using numbers larger than C<~ 2^49>). The best solution is updating to a more recent Perl. The module is thread-safe and should allow good concurrency on all platforms that support Perl threads except Win32. With Win32, either don't use threads or make sure C is called before using C, C, or C with large inputs. This is B an issue if you use non-Cygwin Win32 B call these routines from within Perl threads. =head1 SEE ALSO This section describes other CPAN modules available that have some feature overlap with this one. Also see the L section. Please let me know if any of this information is inaccurate. Also note that just because a module doesn't match what I believe are the best set of features, doesn't mean it isn't perfect for someone else. I will use SoE to indicate the Sieve of Eratosthenes, and MPU to denote this module (L). Some quick alternatives I can recommend if you don't want to use MPU: =over 4 =item * L is the alternative module I use for basic functionality with small integers. It's fast and simple, and has a good set of features. =item * L is the alternative module I use for primality testing on bigints. The downside is that it can be slow, and the functions other than primality tests are I slow. =item * L if you want the kitchen sink and can install it and handle using it. There are still some functions it doesn't do well (e.g. prime count and nth_prime). =back L has C and C functionality. There is no bigint support. The C function uses well-written trial division, meaning it is very fast for small numbers, but terribly slow for large 64-bit numbers. MPU is similarly fast with small numbers, but becomes faster as the size increases. MPXS's prime sieve is an unoptimized non-segmented SoE which returns an array. Sieve bases larger than C<10^7> start taking inordinately long and using a lot of memory (gigabytes beyond C<10^10>). E.g. C takes 36 seconds with MPXS, but only 0.00015 seconds with MPU. L supports C, C, C, C, C, and C. The caveat is that all functions only work within the sieved range, so are limited to about C<10^10>. It uses a fast SoE to generate the main sieve. The sieve is 2-3x slower than the base sieve for MPU, and is non-segmented so cannot be used for larger values. Since the functions work with the sieve, they are very fast. The fast bit-vector-lookup functionality can be replicated in MPU using C but is not required. L supports the C and C functionality in a somewhat similar way to L. It is the slowest of all the XS sieves, and has the most memory use. It is faster than pure Perl code. L supports C functionality. MPU has more options for random primes (n-digit, n-bit, ranged, and strong) in addition to Maurer's algorithm. MPU does not have the critical bug L. MPU should have a more uniform distribution as well as return a larger subset of primes (L). MPU does not depend on L though can run slow for bigints unless the L or L modules are installed. Having L installed also helps performance for MPU. Crypt::Primes is hardcoded to use L, while MPU uses L, and also allows plugging in a random function. This is more flexible, faster, has fewer dependencies, and uses a CSPRNG for security. MPU can return a primality certificate. What Crypt::Primes has that MPU does not is the ability to return a generator. L calculates prime factors and factors, which correspond to the L and L functions of MPU. These functions do not support bigints. Both are implemented with trial division, meaning they are very fast for really small values, but quickly become unusably slow (factoring 19 digit semiprimes is over 700 times slower). The function C can be done in MPU using C. MPU has no equivalent to C, but see the L section for a way to produce the results. L version 1.12 includes C functionality. The current code is only usable for very tiny inputs as it is incredibly slow and uses lots of memory. L has a patch to make it run much faster and use much less memory. Since it is in pure Perl it will still run quite slow compared to MPU. L supports factorization using wheel factorization (smart trial division). It supports bigints. Unfortunately it is extremely slow on any input that isn't the product of just small factors. Even 7 digit inputs can take hundreds or thousands of times longer to factor than MPU or L. 19-digit semiprimes will take I versus MPU's single milliseconds. L is a placeholder module for bigint factoring. Version 0.02 only supports trial division (the Pollard-Rho method does not work). L allows random access to a tied primes array, almost identically to what MPU provides in L. MPU has attempted to fix Math::Prime::TiedArray's shift bug (L). MPU is typically much faster and will use less memory, but there are some cases where MP:TA is faster (MP:TA stores all entries up to the largest request, while MPU:PA stores only a window around the last request). L supports C, C, C, C, C, C, C, and C functionality. This is a great little module that implements primality functionality. It was the first CPAN module to support the BPSW test. All inputs are processed using GMP, so it of course supports bigints. In fact, Math::Primality was made originally with bigints in mind, while MPU was originally targeted to native integers, but both have added better support for the other. The main differences are extra functionality (MPU has more functions) and performance. With native integer inputs, MPU is generally much faster, especially with L. For bigints, MPU is slower unless the L module is installed, in which case MPU is ~2x faster. L also installs a C program, but it has much less functionality than the one included with MPU. L does not have a one-to-one mapping between functions in MPU, but it does offer a way to get many similar results such as primes, twin primes, Sophie-Germain primes, lucky primes, moebius, divisor count, factor count, Euler totient, primorials, etc. Math::NumSeq is set up for accessing these values in order rather than for arbitrary values, though a few sequences support random access. The primary advantage I see is the uniform access mechanism for a I of sequences. For those methods that overlap, MPU is usually much faster. Importantly, most of the sequences in Math::NumSeq are limited to 32-bit indices. L supports a lot of features, with a great deal of overlap. In general, MPU will be faster for native 64-bit integers, while it's differs for bigints (Pari will always be faster if L is not installed; with it, it varies by function). Note that Pari extends many of these functions to other spaces (Gaussian integers, complex numbers, vectors, matrices, polynomials, etc.) which are beyond the realm of this module. Some of the highlights: =over 4 =item C The default L is built with Pari 2.1.7. This uses 10 M-R tests with randomly chosen bases (fixed seed, but doesn't reset each invocation like GMP's C). This has a greater chance of false positives compared to the BPSW test. Calling with C will perform a Pocklington-Lehmer C proof, but this becomes unreasonably slow past 70 or so digits. If L is built using Pari 2.3.5 (this requires manual configuration) then the primality tests are completely different. Using C will perform a BPSW test and is quite a bit faster than the older test. C now does an APR-CL proof (fast, but no certificate). L uses a strong BPSW test, which is the standard BPSW test based on the 1980 paper. It has no known counterexamples (though like all these tests, we know some exist). Pari 2.3.5 (and through at least 2.6.2) uses an almost-extra-strong BPSW test for its C function. This is deterministic for native integers, and should be excellent for bigints, with a slightly lower chance of counterexamples than the traditional strong test. L uses the full extra-strong BPSW test, which has an even lower chance of counterexample. With L, C adds 1 to 5 extra M-R tests using random bases, which further reduces the probability of a composite being allowed to pass. =item C Only available with version 2.3 of Pari. Similar to MPU's L function in API, but uses a naive counting algorithm with its precalculated primes, so is not of practical use. Incidently, Pari 2.6 (not usable from Perl) has fixed the pre-calculation requirement so it is more useful, but is still thousands of times slower than MPU. =item C Doesn't support ranges, requires bumping up the precalculated primes for larger numbers, which means knowing in advance the upper limit for primes. Support for numbers larger than 400M requires using Pari version 2.3.5. If that is used, sieving is about 2x faster than MPU, but doesn't support segmenting. =item C Similar to MPU's L though with a slightly different return. MPU offers L for a linear array of prime factors where n = p1 * p2 * p3 * ... as (p1,p2,p3,...) and L for an array of factor/exponent pairs where: n = p1^e1 * p2^e2 * ... as ([p1,e1],[p2,e2],...) Pari/GP returns an array similar to the latter. L returns a transposed matrix like: n = p1^e1 * p2^e2 * ... as ([p1,p2,...],[e1,e2,...]) Slower than MPU for all 64-bit inputs on an x86_64 platform, it may be faster for large values on other platforms. With the newer L releases, bigint factoring is slightly faster on average in MPU. =item C Similar to MPU's L. =item C, C, C, C Similar to MPU's L, L, L, and L. =item C, C Similar to MPU's L and L. MPU is 2-20x faster for native integers. MPU also supported range inputs, which can be much more efficient. Without L installed, MPU is very slow with bigints. With it installed, it is about 2x slower than Math::Pari. =item C, C, C, C, C Similar to MPU's L, L, L, L, and L. Pari's C only returns the smallest root for prime powers. The behavior is undefined when the group is not cyclic (sometimes it throws an exception, sometimes it returns an incorrect answer). MPU's L will always return the smallest root if it exists, and C otherwise. =item C Similar to MPU's L. MPU is ~10x faster for native integers and about 2x slower for bigints. =item C Similar to MPU's L. This function is not in Pari 2.1, which is the default version used by Math::Pari. With Pari 2.3 or newer, the functions produce identical results, but Pari is much, much faster. =item C Similar to MPU's L. =item C MPU has L which takes non-negative real inputs, while Pari's function supports negative and complex inputs. =back Overall, L supports a huge variety of functionality and has a sophisticated and mature code base behind it (noting that the default version of Pari used is about 10 years old now). For native integers often using Math::Pari will be slower, but bigints are often superior and it rarely has any performance surprises. Some of the unique features MPU offers include super fast prime counts, nth_prime, ECPP primality proofs with certificates, approximations and limits for both, random primes, fast Mertens calculations, Chebyshev theta and psi functions, and the logarithmic integral and Riemann R functions. All with fairly minimal installation requirements. =head1 PERFORMANCE First, for those looking for the state of the art non-Perl solutions: =over 4 =item Primality testing For general numbers smaller than 2000 or so digits, I believe MPU is the fastest solution (it is faster than Pari 2.6.2 and PFGW), though FLINT might be a little faster for native sizes. For large inputs, L is the fastest primality testing software I'm aware of. It has fast trial division, and is especially fast on many special forms. It does not have a BPSW test however, and there are quite a few counterexamples for a given base of its PRP test, so for primality testing it is most useful for fast filtering of very large candidates. A test such as the BPSW test in this module is then recommended. =item Primality proofs L is the best method for open source primality proving for inputs over 1000 digits. Primo also does well below that size, but other good alternatives are L, the APRCL from the modern L package, or the standalone ECPP from this module with large polynomial set. =item Factoring L, L, and L are all good choices for large inputs. The factoring code in this module (and all other CPAN modules) is very limited compared to those. =item Primes L and L are the fastest publically available code I am aware of. Primesieve will additionally take advantage of multiple cores with excellent efficiency. Tomás Oliveira e Silva's private code may be faster for very large values, but isn't available for testing. Note that the Sieve of Atkin is I faster than the Sieve of Eratosthenes when both are well implemented. The only Sieve of Atkin that is even competitive is Bernstein's super optimized I, which runs on par with the SoE in this module. The SoE's in Pari, yafu, and primesieve are all faster. =item Prime Counts and Nth Prime Outside of private research implementations doing prime counts for C 2^64>, this module should be close to state of the art in performance, and supports results up to C<2^64>. Further performance improvements are planned, as well as expansion to larger values. The fastest solution for small inputs is a hybrid table/sieve method. This module does this for values below 60M. As the inputs get larger, either the tables have to grow exponentially or speed must be sacrificed. Hence this is not a good general solution for most uses. =back =head2 PRIME COUNTS Counting the primes to C<800_000_000> (800 million): Time (s) Module Version Notes --------- -------------------------- ------- ----------- 0.002 Math::Prime::Util 0.35 using extended LMO 0.007 Math::Prime::Util 0.12 using Lehmer's method 0.27 Math::Prime::Util 0.17 segmented mod-30 sieve 0.39 Math::Prime::Util::PP 0.24 Perl (Lehmer's method) 0.9 Math::Prime::Util 0.01 mod-30 sieve 2.9 Math::Prime::FastSieve 0.12 decent odd-number sieve 11.7 Math::Prime::XS 0.26 needs some optimization 15.0 Bit::Vector 7.2 48.9 Math::Prime::Util::PP 0.14 Perl (fastest I know of) 170.0 Faster Perl sieve (net) 2012-01 array of odds 548.1 RosettaCode sieve (net) 2012-06 simplistic Perl 3048.1 Math::Primality 0.08 Perl + Math::GMPz >20000 Math::Big 1.12 Perl, > 26GB RAM used Python's standard modules are very slow: MPMATH v0.17 C takes 169.5s and 25+ GB of RAM. SymPy 0.7.1 C takes 292.2s. However there are very fast solutions written by Robert William Hanks (included in the xt/ directory of this distribution): pure Python in 12.1s and NUMPY in 2.8s. =head2 PRIMALITY TESTING =over 4 =item Small inputs: is_prime from 1 to 20M 2.6s Math::Prime::Util (sieve lookup if prime_precalc used) 3.4s Math::Prime::FastSieve (sieve lookup) 4.4s Math::Prime::Util (trial + deterministic M-R) 10.9s Math::Prime::XS (trial) 36.5s Math::Pari w/2.3.5 (BPSW) 78.2s Math::Pari (10 random M-R) 501.3s Math::Primality (deterministic M-R) =item Large native inputs: is_prime from 10^16 to 10^16 + 20M 7.0s Math::Prime::Util (BPSW) 42.6s Math::Pari w/2.3.5 (BPSW) 144.3s Math::Pari (10 random M-R) 664.0s Math::Primality (BPSW) 30 HRS Math::Prime::XS (trial) These inputs are too large for Math::Prime::FastSieve. =item bigints: is_prime from 10^100 to 10^100 + 0.2M 2.5s Math::Prime::Util (BPSW + 1 random M-R) 3.0s Math::Pari w/2.3.5 (BPSW) 12.9s Math::Primality (BPSW) 35.3s Math::Pari (10 random M-R) 53.5s Math::Prime::Util w/o GMP (BPSW) 94.4s Math::Prime::Util (n-1 or ECPP proof) 102.7s Math::Pari w/2.3.5 (APR-CL proof) =back =over 4 =item * MPU is consistently the fastest solution, and performs the most stringent probable prime tests on bigints. =item * Math::Primality has a lot of overhead that makes it quite slow for native size integers. With bigints we finally see it work well. =item * Math::Pari build with 2.3.5 not only has a better primality test, but runs faster. It still has quite a bit of overhead with native size integers. Pari/gp 2.5.0's takes 11.3s, 16.9s, and 2.9s respectively for the tests above. MPU is still faster, but clearly the time for native integers is dominated by the calling overhead. =back =head2 FACTORING Factoring performance depends on the input, and the algorithm choices used are still being tuned. L is very fast when given input with only small factors, but it slows down rapidly as the smallest factor increases in size. For numbers larger than 32 bits, L can be 100x or more faster (a number with only very small factors will be nearly identical, while a semiprime with large factors will be the extreme end). L is much slower with native sized inputs, probably due to calling overhead. For bigints, the L module is needed or performance will be far worse than Math::Pari. With the GMP module, performance is pretty similar from 20 through 70 digits, which the caveat that the current MPU factoring uses more memory for 60+ digit numbers. L has a lot of data on 64-bit and GMP factoring performance I collected in 2009. Assuming you do not know anything about the inputs, trial division and optimized Fermat or Lehman work very well for small numbers (<= 10 digits), while native SQUFOF is typically the method of choice for 11-18 digits (I've seen claims that a lightweight QS can be faster for 15+ digits). Some form of Quadratic Sieve is usually used for inputs in the 19-100 digit range, and beyond that is the General Number Field Sieve. For serious factoring, I recommend looking at L, L, L, L, and L. The latest yafu should cover most uses, with GGNFS likely only providing a benefit for numbers large enough to warrant distributed processing. =head2 PRIMALITY PROVING The C proving algorithm in L compares well to the version including in Pari. Both are pretty fast to about 60 digits, and work reasonably well to 80 or so before starting to take many minutes per number on a fast computer. Version 0.09 and newer of MPU::GMP contain an ECPP implementation that, while not state of the art compared to closed source solutions, works quite well. It averages less than a second for proving 200-digit primes including creating a certificate. Times below 200 digits are faster than Pari 2.3.5's APR-CL proof. For larger inputs the bottleneck is a limited set of discriminants, and time becomes more variable. There is a larger set of discriminants on github that help, with 300-digit primes taking ~5 seconds on average and typically under a minute for 500-digits. For primality proving with very large numbers, I recommend L. =head2 RANDOM PRIME GENERATION Seconds per prime for random prime generation on a circa-2009 workstation, with L, L, and L installed. bits random +testing rand_prov Maurer CPMaurer ----- -------- -------- --------- -------- -------- 64 0.0001 +0.000008 0.0002 0.0001 0.022 128 0.0020 +0.00023 0.011 0.063 0.057 256 0.0034 +0.0004 0.058 0.13 0.16 512 0.0097 +0.0012 0.28 0.28 0.41 1024 0.060 +0.0060 0.65 0.65 2.19 2048 0.57 +0.039 4.8 4.8 10.99 4096 6.24 +0.25 31.9 31.9 79.71 8192 58.6 +1.61 234.0 234.0 947.3 random = random_nbit_prime (results pass BPSW) random+ = additional time for 3 M-R and a Frobenius test rand_prov = random_proven_prime maurer = random_maurer_prime CPMaurer = Crypt::Primes::maurer L is reasonably fast, and for most purposes should suffice. For cryptographic purposes, one may want additional tests or a proven prime. Additional tests are quite cheap, as shown by the time for three extra M-R and a Frobenius test. At these bit sizes, the chances a composite number passes BPSW, three more M-R tests, and a Frobenius test is I small. L provides a randomly selected prime with an optional certificate, without specifying the particular method. Below 512 bits, using L(L) is typically faster than Maurer's algorithm, but becomes quite slow as the bit size increases. This leaves the decision of the exact method of proving the result to the implementation. L constructs a provable prime. A primality test is run on each intermediate, and it also constructs a complete primality certificate which is verified at the end (and can be returned). While the result is uniformly distributed, only about 10% of the primes in the range are selected for output. This is a result of the FastPrime algorithm and is usually unimportant. L times are included for comparison. It is pretty fast for small sizes but gets slow as the size increases. It does not perform any primality checks on the intermediate results or the final result (I highly recommended you run a primality test on the output). Additionally important for servers, L uses excessive system entropy and can grind to a halt if C is exhausted (it can take B to return). The times above are on a machine running L so never waits for entropy. Without this, the times would be much higher. =head1 AUTHORS Dana Jacobsen Edana@acm.orgE =head1 ACKNOWLEDGEMENTS Eratosthenes of Cyrene provided the elegant and simple algorithm for finding primes. Terje Mathisen, A.R. Quesada, and B. Van Pelt all had useful ideas which I used in my wheel sieve. Tomás Oliveira e Silva has released the source for a very fast segmented sieve. The current implementation does not use these ideas. Future versions might. The SQUFOF implementation being used is a slight modification to the public domain racing version written by Ben Buhrow. Enhancements with ideas from Ben's later code as well as Jason Papadopoulos's public domain implementations are planned for a later version. The LMO implementation is based on the 2003 preprint from Christian Bau, as well as the 2006 paper from Tomás Oliveira e Silva. I also want to thank Kim Walisch for the many discussions about prime counting. =head1 REFERENCES =over 4 =item * Henri Cohen, "A Course in Computational Algebraic Number Theory", Springer, 1996. Practical computational number theory from the team lead of L. Lots of explicit algorithms. =item * Hans Riesel, "Prime Numbers and Computer Methods for Factorization", Birkh?user, 2nd edition, 1994. Lots of information, some code, easy to follow. =item * Pierre Dusart, "Estimates of Some Functions Over Primes without R.H.", preprint, 2010. Updates to the best non-RH bounds for prime count and nth prime. L =item * Pierre Dusart, "Autour de la fonction qui compte le nombre de nombres premiers", PhD thesis, 1998. In French. The mathematics is readable and highly recommended reading if you're interesting in prime number bounds. L =item * Gabriel Mincu, "An Asymptotic Expansion", I, v4, n2, 2003. A very readable account of Cipolla's 1902 nth prime approximation. L =item * Christian Bau, "The Extended Meissel-Lehmer Algorithm", 2003, preprint with example C++ implementation. Very detailed implementation-specific paper which was used for the implementation here. Highly recommended for implementing a sieve-based LMO. L =item * David M. Smith, "Multiple-Precision Exponential Integral and Related Functions", I, v37, n4, 2011. L =item * Vincent Pegoraro and Philipp Slusallek, "On the Evaluation of the Complex-Valued Exponential Integral", I, v15, n3, pp 183-198, 2011. L =item * William H. Press et al., "Numerical Recipes", 3rd edition. =item * W. J. Cody and Henry C. Thacher, Jr., "Chebyshev approximations for the exponential integral Ei(x)", I, v23, pp 289-303, 1969. L =item * W. J. Cody and Henry C. Thacher, Jr., "Rational Chebyshev Approximations for the Exponential Integral E_1(x)", I, v22, pp 641-649, 1968. =item * W. J. Cody, K. E. Hillstrom, and Henry C. Thacher Jr., "Chebyshev Approximations for the Riemann Zeta Function", L, v25, n115, pp 537-547, July 1971. =item * Ueli M. Maurer, "Fast Generation of Prime Numbers and Secure Public-Key Cryptographic Parameters", 1995. Generating random provable primes by building up the prime. L =item * Pierre-Alain Fouque and Mehdi Tibouchi, "Close to Uniform Prime Number Generation With Fewer Random Bits", pre-print, 2011. Describes random prime distributions, their algorithm for creating random primes using few random bits, and comparisons to other methods. Definitely worth reading for the discussions of uniformity. L =item * Douglas A. Stoll and Patrick Demichel , "The impact of ζ(s) complex zeros on π(x) for x E 10^{10^{13}}", L, v80, n276, pp 2381-2394, October 2011. L =item * L =item * Walter M. Lioen and Jan van de Lune, "Systematic Computations on Mertens' Conjecture and Dirichlet's Divisor Problem by Vectorized Sieving", in I, Centrum voor Wiskunde en Informatica, pp. 421-432, 1994. Describes a nice way to compute a range of Möbius values. L =item * Marc Deléglise and Joöl Rivat, "Computing the summation of the Möbius function", I, v5, n4, pp 291-295, 1996. Enhances the Möbius computation in Lioen/van de Lune, and gives a very efficient way to compute the Mertens function. L =item * Manuel Benito and Juan L. Varona, "Recursive formulas related to the summation of the Möbius function", I, v1, pp 25-34, 2007. Among many other things, shows a simple formula for computing the Mertens functions with only n/3 Möbius values (not as fast as Deléglise and Rivat, but really simple). L =item * John Brillhart, D. H. Lehmer, and J. L. Selfridge, "New Primality Criteria and Factorizations of 2^m +/- 1", Mathematics of Computation, v29, n130, Apr 1975, pp 620-647. L =back =head1 COPYRIGHT Copyright 2011-2014 by Dana Jacobsen Edana@acm.orgE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Math-Prime-Util-0.37/META.yml0000664000076400007640000000172712271163661014210 0ustar danadana--- abstract: 'Utilities related to prime numbers, including fast sieves and factoring' author: - 'Dana A Jacobsen ' build_requires: ExtUtils::MakeMaker: 0 Test::More: 0.45 bignum: 0.22 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.86, CPAN::Meta::Converter version 2.133380' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Math-Prime-Util no_index: directory: - t - inc recommends: Math::BigInt::GMP: 0 Math::MPFR: 2.03 Math::Prime::Util::GMP: 0.16 requires: Bytes::Random::Secure: 0.23 Carp: 0 Config: 0 Exporter: 5.562 Math::BigFloat: 1.59 Math::BigInt: 1.88 Tie::Array: 0 XSLoader: 0.01 base: 0 constant: 0 perl: 5.006002 resources: homepage: https://github.com/danaj/Math-Prime-Util license: http://dev.perl.org/licenses/ repository: https://github.com/danaj/Math-Prime-Util version: 0.37 Math-Prime-Util-0.37/bench/0000755000076400007640000000000012271163661014005 5ustar danadanaMath-Prime-Util-0.37/bench/bench-miller-rabin.pl0000755000076400007640000000350712270242116017774 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Primality; use Math::Prime::XS; use Math::Prime::Util; use Math::Prime::Util::GMP; #use Math::Prime::FastSieve; use Benchmark qw/:all/; use List::Util qw/min max/; my $count = shift || -5; srand(29); test_at_digits($_) for (5..18); sub test_at_digits { my $digits = shift; die "Digits must be > 0" unless $digits > 0; my @nums = ndigit_rand($digits, 1000); my $min_num = min @nums; my $max_num = max @nums; #my $sieve = Math::Prime::FastSieve::Sieve->new(10 ** $magnitude + 1); #Math::Prime::Util::prime_precalc(10 ** $magnitude + 1); print "miller_rabin for 1000 random $digits-digit numbers ($min_num - $max_num)\n"; cmpthese($count,{ 'MPU' => sub { Math::Prime::Util::is_strong_pseudoprime($_,2,3,5,7,11,13,17) for @nums }, 'MPU GMP' => sub { Math::Prime::Util::GMP::is_strong_pseudoprime($_,2,3,5,7,11,13,17) for @nums }, 'M:Primality' => sub { for (@nums) { Math::Primality::is_strong_pseudoprime($_,2) && Math::Primality::is_strong_pseudoprime($_,3) && Math::Primality::is_strong_pseudoprime($_,5) && Math::Primality::is_strong_pseudoprime($_,7) && Math::Primality::is_strong_pseudoprime($_,11) && Math::Primality::is_strong_pseudoprime($_,13) && Math::Primality::is_strong_pseudoprime($_,17); } }, }); print "\n"; } use Bytes::Random::Secure qw/random_string_from/; sub ndigit_rand { my($digits, $howmany) = @_; die "digits must be > 0" if $digits < 1; $howmany = 1 unless defined $howmany; my @nums = map { random_string_from("123456789",1) . random_string_from("0123456789",$digits-1) } 1 .. $howmany; @nums = map { Math::BigInt->new($_) } @nums if 10**$digits > ~0; return @nums; } Math-Prime-Util-0.37/bench/factor-gnufactor.pl0000755000076400007640000001373612270242116017613 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/factor/; use File::Temp qw/tempfile/; use Math::BigInt try => 'GMP,Pari'; use Config; use autodie; use Text::Diff; use Time::HiRes qw(gettimeofday tv_interval); my $maxdigits = 100; $| = 1; # fast pipes srand(87431); my $num = 1000; # Note: If you have factor from coreutils 8.20 or later (e.g. you're running # Fedora), then GNU factor will be very fast and support at least 128-bit # inputs (~44 digits). Its growth is not great however, so 25+ digits starts # getting slow. The authors wrote on a forum that a future version will # include a TinyQS, which should make it really rock for medium-size inputs. # # On the other hand, if you have the older factor (e.g. you're running # Ubuntu) then GNU factor uses trial division so will be very painful for # large numbers. You'll probably want to turn it off here as it will be # many thousands of times slower than MPU and Pari. # A benchmarking note: in this script, getting MPU and Pari results are done # by calling a function, where getting GNU factor results are done via # multiple shells to /usr/bin/factor with the inputs as command line # arguments. This adds a lot of overhead that has nothing to do with their # implementation. For comparison, I've included an option for getting MPU # factoring via calling the factor.pl script. Weep at the startup cost. my $do_gnu = 1; my $do_pari = 1; my $use_mpu_factor_script = 0; if ($do_pari) { $do_pari = 0 unless eval { require Math::Pari; Math::Pari->import(); 1; }; } my $rgen = sub { my $range = shift; return 0 if $range <= 0; my $rbits = 0; { my $t = $range; while ($t) { $rbits++; $t >>= 1; } } while (1) { my $rbitsleft = $rbits; my $U = $range - $range; # 0 or bigint 0 while ($rbitsleft > 0) { my $usebits = ($rbitsleft > $Config{randbits}) ? $Config{randbits} : $rbitsleft; $U = ($U << $usebits) + int(rand(1 << $usebits)); $rbitsleft -= $usebits; } return $U if $U <= $range; } }; { # Test from 2 to 10000 print " 2 - 1000"; test_array( 2 .. 1000); print " 1001 - 5000"; test_array( 1001 .. 5000); print " 5001 - 10000"; test_array( 5001 .. 10000); } foreach my $digits (5 .. $maxdigits) { printf "%5d %2d-digit numbers", $num, $digits; my @narray = gendigits($digits, $num); test_array(@narray); $num = int($num * 0.9) + 1; # reduce as we go } sub test_array { my @narray = @_; my($start, $mpusec, $gnusec, $parisec, $diff); my(@mpuarray, @gnuarray, @pariarray); print "."; $start = [gettimeofday]; @mpuarray = mpu_factors(@narray); $mpusec = tv_interval($start); if ($do_gnu) { print "."; $start = [gettimeofday]; @gnuarray = gnu_factors(@narray); $gnusec = tv_interval($start); } if ($do_pari) { print "."; $start = [gettimeofday]; @pariarray = pari_factors(@narray); $parisec = tv_interval($start); } print "."; die "MPU got ", scalar @mpuarray, " factors. GNU factor got ", scalar @gnuarray, "\n" unless !$do_gnu || $#mpuarray == $#gnuarray; die "MPU got ", scalar @mpuarray, " factors. Pari factor got ", scalar @pariarray, "\n" unless !$do_pari || $#mpuarray == $#pariarray; foreach my $n (@narray) { my @mpu = @{shift @mpuarray}; die "mpu array is for the wrong n?" unless $n == shift @mpu; if ($do_gnu) { my @gnu = @{shift @gnuarray}; die "gnu array is for the wrong n?" unless $n == shift @gnu; $diff = diff \@mpu, \@gnu, { STYLE => 'Table' }; die "factor($n): MPU/GNU\n$diff\n" if length($diff) > 0; } if ($do_pari) { my @pari = @{shift @pariarray}; die "pari array is for the wrong n?" unless $n == shift @pari; my $diff = diff \@mpu, \@pari, { STYLE => 'Table' }; die "factor($n): MPU/Pari\n$diff\n" if length($diff) > 0; } } print "."; # We should ignore the small digits, since we're comparing direct # Perl functions with multiple command line invocations. It really # doesn't make sense until we're over 1ms per number. printf " MPU:%8.4f ms", (($mpusec*1000) / scalar @narray); printf(" GNU:%8.4f ms", (($gnusec*1000) / scalar @narray)) if $do_gnu; printf(" Pari:%8.4f ms", (($parisec*1000) / scalar @narray)) if $do_pari; print "\n"; } sub gendigits { my $digits = shift; die "Digits must be > 0" unless $digits > 0; my $howmany = shift; my ($base, $max); if ( 10**$digits < ~0) { $base = ($digits == 1) ? 0 : int(10 ** ($digits-1)); $max = int(10 ** $digits); $max = ~0 if $max > ~0; } else { $base = Math::BigInt->new(10)->bpow($digits-1); $max = Math::BigInt->new(10)->bpow($digits) - 1; } my @nums = map { $base + $rgen->($max-$base) } (1 .. $howmany); return @nums; } sub mpu_factors { my @piarray; if (!$use_mpu_factor_script) { push @piarray, [$_, factor($_)] for @_; } else { my @ns = @_; my $numpercommand = int( (4000-30)/(length($ns[-1])+1) ); while (@ns) { my $cs = join(" ", 'perl -Iblib/lib -Iblib/arch bin/factor.pl', splice(@ns, 0, $numpercommand)); my $fout = qx{$cs}; my @flines = split(/\n/, $fout); foreach my $fline (@flines) { $fline =~ s/^(\d+): //; push @piarray, [$1, split(/ /, $fline)]; } } } @piarray; } sub gnu_factors { my @ns = @_; my @piarray; my $numpercommand = int( (4000-30)/(length($ns[-1])+1) ); while (@ns) { my $cs = join(" ", '/usr/bin/factor', splice(@ns, 0, $numpercommand)); my $fout = qx{$cs}; my @flines = split(/\n/, $fout); foreach my $fline (@flines) { $fline =~ s/^(\d+): //; push @piarray, [$1, split(/ /, $fline)]; } } @piarray; } sub pari_factors { my @piarray; foreach my $n (@_) { my @factors; my ($pn,$pc) = @{Math::Pari::factorint($n)}; # Map the Math::Pari objects returned into Math::BigInts, because Pari will # throw a hissy fit later when we try to compare them to anything else. push @piarray, [ $n, map { (Math::BigInt->new($pn->[$_])) x $pc->[$_] } (0 .. $#$pn) ]; } @piarray; } Math-Prime-Util-0.37/bench/bench-mp-psrp.pl0000755000076400007640000000174612262252474017031 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util; use Math::Prime::Util::GMP; use Math::Primality; use Benchmark qw/:all/; use List::Util qw/min max/; my $count = shift || -2; srand(29); # So we have repeatable results test_at_digits($_, 1000) for (5, 15, 25, 50, 200); sub test_at_digits { my($digits, $numbers) = @_; die "Digits must be > 0" unless $digits > 0; # We get a mix of primes and non-primes. my @nums = map { Math::Prime::Util::random_ndigit_prime($digits)+2 } 1 .. $numbers; print "is_strong_pseudoprime for $numbers random $digits-digit numbers", " (", min(@nums), " - ", max(@nums), ")\n"; cmpthese($count,{ 'MP' =>sub {Math::Primality::is_strong_pseudoprime($_,3) for @nums;}, 'MPU' =>sub {Math::Prime::Util::is_strong_pseudoprime($_,3) for @nums;}, 'MPU PP' =>sub {Math::Prime::Util::PP::miller_rabin($_,3) for @nums;}, 'MPU GMP' =>sub {Math::Prime::Util::GMP::is_strong_pseudoprime($_,3) for @nums;}, }); } Math-Prime-Util-0.37/bench/bench-mp-nextprime.pl0000755000076400007640000000221012266152412020036 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util; use Math::Prime::Util::GMP; use Math::Primality; use Benchmark qw/:all/; my $count = shift || -2; srand(29); # So we have repeatable results Math::Prime::Util::prime_set_config(irand => sub { int(rand(4294967295)) }); test_at_digits($_, 1000) for (5, 15, 25, 50, 200); sub test_at_digits { my($digits, $numbers) = @_; die "Digits must be > 0" unless $digits > 0; my $start = Math::Prime::Util::random_ndigit_prime($digits) - 3; my $end = $start; $end = Math::Prime::Util::GMP::next_prime($end) for 1 .. $numbers; print "next_prime x $numbers starting at $start\n"; cmpthese($count,{ 'MP' => sub { my $n = $start; $n = Math::Primality::next_prime($n) for 1..$numbers; die "MP ended with $n instead of $end" unless $n == $end; }, 'MPU' => sub { my $n = $start; $n = Math::Prime::Util::next_prime($n) for 1..$numbers; die "MPU ended with $n instead of $end" unless $n == $end; }, 'MPU GMP' => sub { my $n = $start; $n = Math::Prime::Util::GMP::next_prime($n) for 1..$numbers; die "MPU GMP ended with $n instead of $end" unless $n == $end; }, }); } Math-Prime-Util-0.37/bench/bench-factor-extra.pl0000755000076400007640000001045212270242116020013 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/-nobigint/; use Benchmark qw/:all/; use List::Util qw/min max/; use Config; my $count = shift || -2; my $is64bit = (~0 > 4294967295); my $maxdigits = ($is64bit) ? 20 : 10; # Noting the range is limited for max. my $rgen = sub { my $range = shift; return 0 if $range <= 0; my $rbits = 0; { my $t = $range; while ($t) { $rbits++; $t >>= 1; } } while (1) { my $rbitsleft = $rbits; my $U = 0; while ($rbitsleft > 0) { my $usebits = ($rbitsleft > $Config{randbits}) ? $Config{randbits} : $rbitsleft; $U = ($U << $usebits) + int(rand(1 << $usebits)); $rbitsleft -= $usebits; } return $U if $U <= $range; } }; srand(29); my $rounds = 400; my $sqrounds = 256*1024; my $rsqrounds = 32*1024; my $p1smooth = 1000; my $hrounds = 10000; my $num_nums = 1000; test_at_digits($_) for ( 3 .. $maxdigits ); sub test_at_digits { my $digits = shift; die "Digits has to be >= 1" unless $digits >= 1; die "Digits has to be <= $maxdigits" if $digits > $maxdigits; my @nums = genrand($digits, $num_nums); #my @nums = gensemi($digits, $num_nums, 23); my $min_num = min @nums; my $max_num = max @nums; # Determine success rates my %nfactored; my $tfac = 0; # Did we find any non-trivial factors? my $calc_nfacs = sub { ((scalar grep { $_ > 5 } @_) > 1) ? 1 : 0 }; for (@nums) { $tfac += $calc_nfacs->(Math::Prime::Util::factor($_)); $nfactored{'prho'} += $calc_nfacs->(Math::Prime::Util::prho_factor($_, $rounds)); $nfactored{'pbrent'} += $calc_nfacs->(Math::Prime::Util::pbrent_factor($_, $rounds)); $nfactored{'pminus1'} += $calc_nfacs->(Math::Prime::Util::pminus1_factor($_, $p1smooth)); $nfactored{'pplus1'} += $calc_nfacs->(Math::Prime::Util::pplus1_factor($_, $p1smooth)); $nfactored{'squfof'} += $calc_nfacs->(Math::Prime::Util::squfof_factor($_, $sqrounds)); #$nfactored{'trial'} += $calc_nfacs->(Math::Prime::Util::trial_factor($_)); #$nfactored{'fermat'} += $calc_nfacs->(Math::Prime::Util::fermat_factor($_, $rounds)); $nfactored{'holf'} += $calc_nfacs->(Math::Prime::Util::holf_factor($_, $hrounds)); } print "factoring $num_nums random $digits-digit numbers ($min_num - $max_num)\n"; print "Factorizations: ", join(", ", map { sprintf "%s %4.1f%%", $_, 100*$nfactored{$_}/$tfac } grep { $_ ne 'fermat' } sort {$nfactored{$a} <=> $nfactored{$b}} keys %nfactored), "\n"; my $lref = { "prho" => sub { Math::Prime::Util::prho_factor($_, $rounds) for @nums }, "pbrent" => sub { Math::Prime::Util::pbrent_factor($_, $rounds) for @nums }, "pminus1" => sub { Math::Prime::Util::pminus1_factor($_, $rounds) for @nums }, "pplus1" => sub { Math::Prime::Util::pplus1_factor($_, $rounds) for @nums}, "fermat" => sub { Math::Prime::Util::fermat_factor($_, $rounds) for @nums}, "holf" => sub { Math::Prime::Util::holf_factor($_, $hrounds) for @nums }, "squfof" => sub { Math::Prime::Util::squfof_factor($_, $sqrounds) for @nums }, "trial" => sub { Math::Prime::Util::trial_factor($_) for @nums }, }; delete $lref->{'fermat'} if $digits >= 9; delete $lref->{'holf'} if $digits >= 17; delete $lref->{'trial'} if $digits >= 15; cmpthese($count, $lref); print "\n"; } sub genrand { my $digits = shift; my $num = shift; my $base = ($digits == 1) ? 0 : int(10 ** ($digits-1)); my $max = int(10 ** $digits); $max = ~0 if $max > ~0; my @nums = map { $base + $rgen->($max-$base) } (1 .. $num); return @nums; } sub gensemi { my $digits = shift; my $num = shift; my $smallest_factor = shift; my $base = ($digits == 1) ? 0 : int(10 ** ($digits-1)); my $max = int(10 ** $digits); $max = (~0-4) if $max > (~0-4); my @semiprimes; foreach my $i (1 .. $num) { my @factors; my $n; while (1) { $n = $base + $rgen->($max-$base); $n += (1,0,5,4,3,2,1,0,3,2,1,0,1,0,3,2,1,0,1,0,3,2,1,0,5,4,3,2,1,0)[$n%30]; @factors = Math::Prime::Util::factor($n); next if scalar @factors != 2; next if $factors[0] < $smallest_factor; next if $factors[1] < $smallest_factor; last if scalar @factors == 2; } die "ummm... $n != $factors[0] * $factors[1]\n" unless $n == $factors[0] * $factors[1]; push @semiprimes, $n; } return @semiprimes; } Math-Prime-Util-0.37/bench/bench-mp-prime_count.pl0000755000076400007640000000157612262252474020372 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util; use Math::Prime::Util::GMP; use Math::Primality; use Benchmark qw/:all/; my $count = shift || -2; #my($n, $exp) = (100000,9592); my($n, $exp) = (1000000,78498); #my($n, $exp) = (10000000,664579); cmpthese($count,{ 'MP' =>sub { die unless $exp == Math::Primality::prime_count($n); }, 'MPU default' =>sub { die unless $exp == Math::Prime::Util::prime_count($n); }, 'MPU XS Sieve' =>sub { die unless $exp == Math::Prime::Util::_XS_prime_count($n); }, 'MPU XS Lehmer'=>sub { die unless $exp == Math::Prime::Util::_XS_lehmer_pi($n); }, 'MPU PP Sieve' =>sub { die unless $exp == Math::Prime::Util::PP::_sieve_prime_count($n); }, 'MPU PP Lehmer'=>sub { die unless $exp == Math::Prime::Util::PP::_lehmer_pi($n); }, 'MPU GMP Trial'=>sub { die unless $exp == Math::Prime::Util::GMP::prime_count(2,$n); }, }); Math-Prime-Util-0.37/bench/bench-pp-isprime.pl0000755000076400007640000001570012003175161017501 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Benchmark qw/:all/; use Devel::Size qw/total_size/; use Math::Prime::Util; *mpu_isprime = \&Math::Prime::Util::is_prime; my $count = shift || -1; my @numlist; my @testnums = (0..1000, 5_000_000 .. 5_001_000, 30037, 20359*41117, 92987*65171, 27361*31249, 70790191, 3211717*9673231); my $ip_subs = { #"Abigail" => sub { my$r;$r=abigail($_) for @numlist; $r;}, "Rosetta" => sub { my$r;$r=rosetta($_) for @numlist; $r;}, "Rosetta2"=> sub { my$r;$r=rosetta2($_) for @numlist; $r;}, "DJ" => sub { my$r;$r=dj($_) for @numlist; $r;}, "DJ2" => sub { my$r;$r=dj2($_) for @numlist; $r;}, "DJ3" => sub { my$r;$r=dj3($_) for @numlist; $r;}, "DJ4" => sub { my$r;$r=dj4($_) for @numlist; $r;}, "MPU" => sub { my$r;$r=mpu_isprime($_) for @numlist; $r;}, }; my %verify = ( 0 => 0, 1 => 0, 2 => 1, 3 => 1, 4 => 0, 5 => 1, 6 => 0, 7 => 1, 13 => 1, 20 => 0, 377 => 0, 70790191 => 1, ); # Verify while (my($name, $sub) = each (%$ip_subs)) { while (my($n, $v_ip) = each (%verify)) { @numlist = ($n); #print "$name($n): ", $sub->(), "\n"; my $isprime = ($sub->() ? 1 : 0); die "$name($n) = $isprime, should be $v_ip\n" unless $isprime == $v_ip; } } for my $n (0 .. 50000) { die "dj($n) != mpu($n)" unless dj($n) == mpu_isprime($n); die "dj2($n) != mpu($n)" unless dj2($n) == mpu_isprime($n); die "dj3($n) != mpu($n)" unless dj3($n) == mpu_isprime($n); die "dj4($n) != mpu($n)" unless dj4($n) == mpu_isprime($n); die "rosetta($n) != mpu($n)" unless rosetta($n) == mpu_isprime($n)/2; die "rosetta2($n) != mpu($n)" unless rosetta2($n) == mpu_isprime($n)/2; } print "Done with verification, starting benchmark\n"; @numlist = @testnums; cmpthese($count, $ip_subs); sub rosetta { my $n = shift; $n % $_ or return 0 for 2 .. sqrt $n; $n > 1; } sub rosetta2 { my $p = shift; if ($p == 2) { return 1; } elsif ($p <= 1 || $p % 2 == 0) { return 0; } else { my $limit = sqrt($p); for (my $i = 3; $i <= $limit; $i += 2) { return 0 if $p % $i == 0; } return 1; } } # Terrifically clever, but useless for large numbers sub abigail { ('1' x shift) !~ /^1?$|^(11+?)\1+$/ } sub dj { my($n) = @_; return 0 if $n < 2; # 0 and 1 are composite return 2 if ($n == 2) || ($n == 3) || ($n == 5); # 2, 3, 5 are prime # multiples of 2,3,5 are composite return 0 if (($n % 2) == 0) || (($n % 3) == 0) || (($n % 5) == 0); my $q; foreach my $i (qw/7 11 13 17 19 23 29 31 37 41 43 47 53 59/) { $q = int($n/$i); return 2 if $q < $i; return 0 if $n == ($q*$i); } my $i = 61; # mod-30 loop while (1) { $q = int($n/$i); last if $q < $i; return 0 if $n == ($q*$i); $i += 6; $q = int($n/$i); last if $q < $i; return 0 if $n == ($q*$i); $i += 4; $q = int($n/$i); last if $q < $i; return 0 if $n == ($q*$i); $i += 2; $q = int($n/$i); last if $q < $i; return 0 if $n == ($q*$i); $i += 4; $q = int($n/$i); last if $q < $i; return 0 if $n == ($q*$i); $i += 2; $q = int($n/$i); last if $q < $i; return 0 if $n == ($q*$i); $i += 4; $q = int($n/$i); last if $q < $i; return 0 if $n == ($q*$i); $i += 6; $q = int($n/$i); last if $q < $i; return 0 if $n == ($q*$i); $i += 2; } 2; } sub dj2 { my($n) = @_; return 2 if ($n == 2) || ($n == 3) || ($n == 5); # 2, 3, 5 are prime return 0 if $n < 7; # everything else below 7 is composite # multiples of 2,3,5 are composite return 0 if (($n % 2) == 0) || (($n % 3) == 0) || (($n % 5) == 0); foreach my $i (qw/7 11 13 17 19 23 29 31 37 41 43 47 53 59/) { return 2 if $i*$i > $n; return 0 if ($n % $i) == 0; } my $limit = int(sqrt($n)); my $i = 61; # mod-30 loop while (1) { return 0 if ($n % $i) == 0; $i += 6; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 4; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 2; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 4; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 2; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 4; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 6; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 2; last if $i > $limit; } 2; } sub dj3 { my($n) = @_; return 2 if ($n == 2) || ($n == 3) || ($n == 5); # 2, 3, 5 are prime return 0 if $n < 7; # everything else below 7 is composite # multiples of 2,3,5 are composite return 0 if (($n % 2) == 0) || (($n % 3) == 0) || (($n % 5) == 0); foreach my $i (qw/7 11 13 17 19 23 29 31 37 41 43 47 53 59/) { return 2 if $i*$i > $n; return 0 if ($n % $i) == 0; } my $limit = int(sqrt($n)); my $i = 61; # mod-30 loop while (($i+30) <= $limit) { return 0 if ($n % $i) == 0; $i += 6; return 0 if ($n % $i) == 0; $i += 4; return 0 if ($n % $i) == 0; $i += 2; return 0 if ($n % $i) == 0; $i += 4; return 0 if ($n % $i) == 0; $i += 2; return 0 if ($n % $i) == 0; $i += 4; return 0 if ($n % $i) == 0; $i += 6; return 0 if ($n % $i) == 0; $i += 2; } while (1) { last if $i > $limit; return 0 if ($n % $i) == 0; $i += 6; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 4; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 2; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 4; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 2; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 4; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 6; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 2; } 2; } sub dj4 { my($n) = @_; return 2 if ($n == 2) || ($n == 3) || ($n == 5); # 2, 3, 5 are prime return 0 if $n < 7; # everything else below 7 is composite # multiples of 2,3,5 are composite return 0 if (($n % 2) == 0) || (($n % 3) == 0) || (($n % 5) == 0); foreach my $i (qw/7 11 13 17 19 23 29/) { return 2 if $i*$i > $n; return 0 if ($n % $i) == 0; } my $limit = int(sqrt($n)); my $i = 31; while (($i+30) <= $limit) { return 0 if ($n % $i) == 0; $i += 6; return 0 if ($n % $i) == 0; $i += 4; return 0 if ($n % $i) == 0; $i += 2; return 0 if ($n % $i) == 0; $i += 4; return 0 if ($n % $i) == 0; $i += 2; return 0 if ($n % $i) == 0; $i += 4; return 0 if ($n % $i) == 0; $i += 6; return 0 if ($n % $i) == 0; $i += 2; } while (1) { last if $i > $limit; return 0 if ($n % $i) == 0; $i += 6; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 4; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 2; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 4; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 2; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 4; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 6; last if $i > $limit; return 0 if ($n % $i) == 0; $i += 2; } 2; } Math-Prime-Util-0.37/bench/bench-factor-semiprime.pl0000755000076400007640000000660612270242116020670 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes srand(377); use Math::Prime::Util qw/factor/; use Math::Factor::XS qw/prime_factors/; use Math::Pari qw/factorint/; use Benchmark qw/:all/; use Data::Dumper; use Config; my $digits = shift || 15; my $count = shift || -3; my $rgen = sub { my $range = shift; return 0 if $range <= 0; my $rbits = 0; { my $t = $range; while ($t) { $rbits++; $t >>= 1; } } while (1) { my $rbitsleft = $rbits; my $U = 0; while ($rbitsleft > 0) { my $usebits = ($rbitsleft > $Config{randbits}) ? $Config{randbits} : $rbitsleft; $U = ($U << $usebits) + int(rand(1 << $usebits)); $rbitsleft -= $usebits; } return $U if $U <= $range; } }; my @min_factors_by_digit = (2,2,3,3,5,11,17,47,97); my $smallest_factor_allowed = $min_factors_by_digit[$digits]; $smallest_factor_allowed = $min_factors_by_digit[-1] unless defined $smallest_factor_allowed; my $numprimes = 200; die "Digits has to be >= 2" unless $digits >= 2; die "Digits has to be <= 10" if (~0 == 4294967295) && ($digits > 10); die "Digits has to be <= 19" if $digits > 19; my $skip_mfxs = ($digits > 17); # Construct some semiprimes of the appropriate number of digits # There are much cleverer ways of doing this, using randomly selected # nth_primes, and so on, but this works well until we get lots of digits. print "Generating $numprimes random $digits-digit semiprimes (min factor $smallest_factor_allowed) "; my @semiprimes; foreach my $i ( 1 .. $numprimes ) { my $base = int(10 ** ($digits-1)); my $add = int(10 ** ($digits)) - $base; my @factors; my $n; while (1) { $n = $base + $rgen->($add); next if $n > (~0 - 4); $n += (1,0,5,4,3,2,1,0,3,2,1,0,1,0,3,2,1,0,1,0,3,2,1,0,5,4,3,2,1,0)[$n%30]; @factors = factor($n); next if scalar @factors != 2; next if $factors[0] < $smallest_factor_allowed; next if $factors[1] < $smallest_factor_allowed; last if scalar @factors == 2; } die "ummm... $n != $factors[0] * $factors[1]\n" unless $n == $factors[0] * $factors[1]; #print "$n == $factors[0] * $factors[1]\n"; push @semiprimes, $n; print "." if ($i % ($numprimes/10)) == 0; } print "done.\n"; print "Verifying Math::Prime::Util $Math::Prime::Util::VERSION ..."; foreach my $sp (@semiprimes) { my @factors = factor($sp); die "wrong for $sp\n" unless ($#factors == 1) && ($factors[0] * $factors[1]) == $sp; } print "OK\n"; if (!$skip_mfxs) { print "Verifying Math::Factor::XS $Math::Factor::XS::VERSION ..."; foreach my $sp (@semiprimes) { my @factors = prime_factors($sp); die "wrong for $sp\n" unless ($#factors == 1) && ($factors[0] * $factors[1]) == $sp; } print "OK\n"; } else { print "Math::Factor::XS is too slow for $digits digits. Skipping.\n"; } print "Verifying Math::Pari $Math::Pari::VERSION ..."; foreach my $sp (@semiprimes) { my @factors; my ($pn,$pc) = @{factorint($sp)}; push @factors, (int($pn->[$_])) x $pc->[$_] for (0 .. $#{$pn}); die "wrong for $sp\n" unless ($#factors == 1) && ($factors[0] * $factors[1]) == $sp; } print "OK\n"; my %compare = ( 'MPU' => sub { do { my @f = factor($_) } for @semiprimes; }, 'MFXS' => sub { do { my @f = prime_factors($_) } for @semiprimes; }, 'Pari' => sub { do { my ($pn,$pc) = @{factorint($_)}; my @f = map { int($pn->[$_]) x $pc->[$_] } 0 .. $#$pn; } for @semiprimes; }, ); delete $compare{'MFXS'} if $skip_mfxs; cmpthese($count, \%compare); Math-Prime-Util-0.37/bench/bench-nthprime.pl0000755000076400007640000000216412270242116017243 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/nth_prime prime_precalc/; use Benchmark qw/:all :hireswallclock/; use Data::Dumper; my $count = shift || -5; #prime_precalc(1000000000); srand(29); my @darray; push @darray, [gendigits($_,int(5400/($_*$_*$_)))] for 2 .. 13; my $sum; foreach my $digits (3 .. 12) { my @digarray = @{$darray[$digits-2]}; my $numitems = scalar @digarray; my $timing = cmpthese( $count, { "$digits" => sub { $sum += nth_prime($_) for @digarray }, }, 'none', ); my $secondsper = $timing->[1]->[1]; if ($timing->[0]->[1] eq 'Rate') { $secondsper =~ s/\/s$//; $secondsper = 1.0 / $secondsper; } $secondsper /= $numitems; my $timestr = (1.0 / $secondsper) . "/s per number"; printf "%4d %2d-digit numbers: %s\n", $numitems, $digits, $timestr; } sub gendigits { my $digits = shift; die "Digits must be > 0" unless $digits > 0; my $num = shift; my $base = ($digits == 1) ? 0 : int(10 ** ($digits-1)); my $max = int(10 ** $digits); $max = ~0 if $max > ~0; my @nums = map { $base+int(rand($max-$base)) } (1 .. $num); return @nums; } Math-Prime-Util-0.37/bench/bench-primecount.pl0000755000076400007640000000662512270242116017610 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util ":all"; use Benchmark qw/:all/; my $maxdigits = (~0 <= 4294967295) ? 10 : 20; my $nnums = 100; my $count = shift || -5; srand(29); my @darray; push @darray, [gendigits($_)] for (2 .. 10); my $sum; print "Direct sieving:\n"; cmpthese($count,{ ' 2' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_segment_pi($_) for @{$darray[2-2]} }, ' 3' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_segment_pi($_) for @{$darray[3-2]} }, ' 4' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_segment_pi($_) for @{$darray[4-2]} }, ' 5' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_segment_pi($_) for @{$darray[5-2]} }, ' 6' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_segment_pi($_) for @{$darray[6-2]} }, ' 7' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_segment_pi($_) for @{$darray[7-2]} }, ' 8' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_segment_pi($_) for @{$darray[8-2]} }, #' 9' => sub { $sum += Math::Prime::Util::_XS_segment_pi($_) for @{$darray[9-2]} }, #'10' => sub { $sum += Math::Prime::Util::_XS_segment_pi($_) for @{$darray[10-2]} }, }); if (0) { print "\n"; print "Direct Lehmer:\n"; cmpthese($count,{ ' 2' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_lehmer_pi($_) for @{$darray[2-2]} }, ' 3' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_lehmer_pi($_) for @{$darray[3-2]} }, ' 4' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_lehmer_pi($_) for @{$darray[4-2]} }, ' 5' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_lehmer_pi($_) for @{$darray[5-2]} }, ' 6' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_lehmer_pi($_) for @{$darray[6-2]} }, ' 7' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_lehmer_pi($_) for @{$darray[7-2]} }, ' 8' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_lehmer_pi($_) for @{$darray[8-2]} }, ' 9' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_lehmer_pi($_) for @{$darray[9-2]} }, '10' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_lehmer_pi($_) for @{$darray[10-2]} }, }); } print "\n"; print "Direct LMO:\n"; cmpthese($count,{ ' 2' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_LMO_pi($_) for @{$darray[2-2]} }, ' 3' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_LMO_pi($_) for @{$darray[3-2]} }, ' 4' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_LMO_pi($_) for @{$darray[4-2]} }, ' 5' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_LMO_pi($_) for @{$darray[5-2]} }, ' 6' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_LMO_pi($_) for @{$darray[6-2]} }, ' 7' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_LMO_pi($_) for @{$darray[7-2]} }, ' 8' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_LMO_pi($_) for @{$darray[8-2]} }, ' 9' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_LMO_pi($_) for @{$darray[9-2]} }, '10' => sub { prime_memfree(); $sum += Math::Prime::Util::_XS_LMO_pi($_) for @{$darray[10-2]} }, }); print "\n"; sub gendigits { my $digits = shift; die "Digits must be > 0" unless $digits > 0; my $base = ($digits == 1) ? 0 : int(10 ** ($digits-1)); my $max = int(10 ** $digits); $max = ~0 if $max > ~0; my @nums = map { $base+int(rand($max-$base)) } (1 .. $nnums); return @nums; } Math-Prime-Util-0.37/bench/bench-random-prime-bigint.pl0000755000076400007640000000067712117256650021300 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/random_nbit_prime/; use Math::BigInt try=>'GMP'; use Benchmark qw/:all/; use List::Util qw/min max/; my $count = shift || -3; srand(29); test_at_bits($_) for (15, 30, 60, 128, 256, 512, 1024, 2048, 4096); sub test_at_bits { my $bits = shift; die "Digits must be > 0" unless $bits > 0; cmpthese($count,{ "$bits bits" => sub { random_nbit_prime($bits); }, }); } Math-Prime-Util-0.37/bench/bench-primearray.pl0000755000076400007640000001726212266152412017601 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/:all/; use Math::Prime::Util::PrimeArray; use Math::NumSeq::Primes; use Math::Prime::TiedArray; use Benchmark qw/:all/; use List::Util qw/min max/; my $count = shift || -2; my ($s, $nlimit, $ilimit, $expect); if (1) { print '-' x 79, "\n"; print "summation to 100k, looking for best methods (typically slice)\n"; $nlimit = 100000; $ilimit = prime_count($nlimit)-1; $expect = 0; forprimes { $expect += $_ } $nlimit; cmpthese($count,{ 'pa index' => sub { $s=0; tie my @primes, "Math::Prime::Util::PrimeArray"; $s += $primes[$_] for 0..$ilimit; die unless $s == $expect; }, 'pa loop' => sub { $s=0; tie my @primes, "Math::Prime::Util::PrimeArray"; for (@primes) { last if $_ > $nlimit; $s += $_; } die $s unless $s == $expect; }, 'pa slice' => sub { $s=0; tie my @primes, "Math::Prime::Util::PrimeArray"; $s += $_ for @primes[0..$ilimit]; die unless $s == $expect; }, 'pa each' => sub { $s=0; tie my @primes, "Math::Prime::Util::PrimeArray"; while(my(undef,$v) = each @primes) { last if $v > $nlimit; $s += $v; } die $s unless $s == $expect; }, 'pa shift' => sub { $s=0; tie my @primes, "Math::Prime::Util::PrimeArray"; while ((my $p = shift @primes) <= $nlimit) { $s += $p; } die unless $s == $expect; }, }); } if (1) { print '-' x 79, "\n"; print "summation to 100k, looking for best MPTA extension (typically ~1000)\n"; $nlimit = 100000; $ilimit = prime_count($nlimit)-1; $expect = 0; forprimes { $expect += $_ } $nlimit; cmpthese($count,{ 'MPTA' => sub { $s=0; tie my @primes, "Math::Prime::TiedArray"; $s += $primes[$_] for 0..$ilimit; die unless $s == $expect; }, 'MPTA 400' => sub { $s=0; tie my @primes, "Math::Prime::TiedArray", extend_step => 400; $s += $primes[$_] for 0..$ilimit; die unless $s == $expect; }, 'MPTA 1000' => sub { $s=0; tie my @primes, "Math::Prime::TiedArray", extend_step => 1000; $s += $primes[$_] for 0..$ilimit; die unless $s == $expect; }, 'MPTA 4000' => sub { $s=0; tie my @primes, "Math::Prime::TiedArray", extend_step => 4000; $s += $primes[$_] for 0..$ilimit; die unless $s == $expect; }, }); } if (1) { print '-' x 79, "\n"; print "summation to 100k\n"; print "Note: MPU::PrimeArray is about 30x faster than MPTA here.\n"; print " Math::NumSeq::Primes is reasonable fast (not random access)\n"; print " MPU's forprimes smashes everything else (not random access)\n"; $nlimit = 100000; $ilimit = prime_count($nlimit)-1; $expect = 0; forprimes { $expect += $_ } $nlimit; cmpthese($count,{ 'primes' => sub { $s=0; $s += $_ for @{primes($nlimit)}; die unless $s == $expect; }, 'forprimes' => sub { $s=0; forprimes { $s += $_ } $nlimit; die unless $s == $expect; }, 'iterator' => sub { $s=0; my $it = prime_iterator(); $s += $it->() for 0..$ilimit; die unless $s == $expect; }, 'OO iter' => sub { $s=0; my $it = prime_iterator_object(); $s += $it->iterate() for 0..$ilimit; die unless $s == $expect; }, 'pa slice' => sub { $s=0; tie my @primes, "Math::Prime::Util::PrimeArray"; $s += $_ for @primes[0..$ilimit]; die unless $s == $expect; }, 'NumSeq' => sub { $s=0; my $seq = Math::NumSeq::Primes->new; while (1) { my($undev,$v) = $seq->next; last if $v > $nlimit; $s += $v; } die $s unless $s == $expect; }, # This was slightly faster than slice or shift 'MPTA' => sub { $s=0; tie my @primes, "Math::Prime::TiedArray", extend_step => 1000; $s += $primes[$_] for 0..$ilimit; die unless $s == $expect; }, }); } if (0) { print '-' x 79, "\n"; print "summation to 10M\n"; print "Note: Math::Prime::TiedArray takes too long\n"; print " Math::NumSeq::Primes is now ~2x slower than PrimeArray\n"; print " forprimes is still the fastest solution for sequential access\n"; $nlimit = 10_000_000; $ilimit = prime_count($nlimit)-1; $expect = 0; forprimes { $expect += $_ } $nlimit; cmpthese($count,{ 'primes' => sub { $s=0; $s += $_ for @{primes($nlimit)}; die unless $s == $expect; }, 'forprimes' => sub { $s=0; forprimes { $s += $_ } $nlimit; die unless $s == $expect; }, 'pa index' => sub { $s=0; tie my @primes, "Math::Prime::Util::PrimeArray"; $s += $primes[$_] for 0..$ilimit; die unless $s == $expect; }, 'pa loop' => sub { $s=0; tie my @primes, "Math::Prime::Util::PrimeArray"; for (@primes) { last if $_ > $nlimit; $s += $_; } die $s unless $s == $expect; }, 'pa slice' => sub { $s=0; tie my @primes, "Math::Prime::Util::PrimeArray"; $s += $_ for @primes[0..$ilimit]; die unless $s == $expect; }, 'pa each' => sub { $s=0; tie my @primes, "Math::Prime::Util::PrimeArray"; while(my(undef,$v) = each @primes) { last if $v > $nlimit; $s += $v; } die $s unless $s == $expect; }, 'pa shift' => sub { $s=0; tie my @primes, "Math::Prime::Util::PrimeArray"; while ((my $p = shift @primes) <= $nlimit) { $s += $p; } die unless $s == $expect; }, 'numseq' => sub { $s=0; my $seq = Math::NumSeq::Primes->new; while (1) { my($undev,$v) = $seq->next; last if $v > $nlimit; $s += $v; } die $s unless $s == $expect; }, }); } if (1) { print '-' x 79, "\n"; print "Walk primes backwards from 1M\n"; print "Note: MPTA takes 4x longer than just calling MPU's nth_prime!\n"; $nlimit = 1_000_000; $ilimit = prime_count($nlimit)-1; $expect = 0; forprimes { $expect += $_ } $nlimit; cmpthese($count,{ 'rev primes'=> sub { $s=0; $s += $_ for reverse @{primes($nlimit)}; die unless $s == $expect; }, 'nthprime' => sub { $s=0; $s += nth_prime($_) for reverse 1..$ilimit+1; die unless $s == $expect; }, 'pa index' => sub { $s=0; tie my @primes, "Math::Prime::Util::PrimeArray"; $s += $primes[$_] for reverse 0..$ilimit; die unless $s == $expect; }, 'OO iter' => sub { $s=0; my $it = prime_iterator_object($nlimit); $s += $it->prev->value() for 0..$ilimit; die unless $s == $expect; }, 'tiedarray' => sub { $s=0; tie my @primes, "Math::Prime::TiedArray", extend_step => 1000; $s += $primes[$_] for reverse 0..$ilimit; die unless $s == $expect; }, }); } if (1) { print '-' x 79, "\n"; print "Random walk in 1M\n"; print "MPTA takes about 2 minutes and lots of RAM per iteration.\n"; srand(29); my @rindex; do { push @rindex, int(rand(1000000)) } for 1..10000; $expect = 0; $expect += nth_prime($_+1) for @rindex; cmpthese($count,{ 'nthprime' => sub { $s=0; $s += nth_prime($_+1) for @rindex; }, 'pa index' => sub { $s=0; tie my @primes, "Math::Prime::Util::PrimeArray"; $s += $primes[$_] for @rindex; die unless $s == $expect; }, # Argh! Is it possible to write a slower sieve than the one MPTA uses? #'tiedarray' => sub { $s=0; tie my @primes, "Math::Prime::TiedArray", extend_step => 10000; # $s += $primes[$_] for @rindex; # die unless $s == $expect; }, }); } print '-' x 79, "\n"; Math-Prime-Util-0.37/bench/bench-is-prime.pl0000755000076400007640000000350312266152412017144 0ustar danadana#!/usr/bin/env perl use strict; use warnings; #use Math::Primality; use Math::Prime::XS; use Math::Prime::Util; #use Math::Pari; #use Math::Prime::FastSieve; use Benchmark qw/:all/; use List::Util qw/min max/; my $count = shift || -5; my $numbers = 1000; my $is64bit = (~0 > 4294967295); my $maxdigits = ($is64bit) ? 20 : 10; # Noting the range is limited for max. my $randf = Math::Prime::Util::_get_rand_func(); my $rand_ndigit_gen = sub { my $digits = shift; die "Digits must be > 0" unless $digits > 0; my $howmany = shift || 1; my ($base, $max); if ( 10**$digits < ~0) { $base = ($digits == 1) ? 0 : int(10 ** ($digits-1)); $max = int(10 ** $digits); $max = ~0 if $max > ~0; } else { $base = Math::BigInt->new(10)->bpow($digits-1); $max = Math::BigInt->new(10)->bpow($digits) - 1; } my @nums = map { $base + $randf->($max-$base) } (1 .. $howmany); return (wantarray) ? @nums : $nums[0]; }; srand(29); test_at_digits($_) for (3 .. $maxdigits); sub test_at_digits { my $digits = shift; die "Digits must be > 0" unless $digits > 0; my @nums = $rand_ndigit_gen->($digits, $numbers); my $min_num = min @nums; my $max_num = max @nums; #my $sieve = Math::Prime::FastSieve::Sieve->new(10 ** $magnitude + 1); #Math::Prime::Util::prime_precalc(10 ** $magnitude + 1); print "is_prime for $numbers random $digits-digit numbers ($min_num - $max_num)\n"; cmpthese($count,{ #'Math::Primality' => sub { Math::Primality::is_prime($_) for @nums }, 'M::P::XS' => sub { Math::Prime::XS::is_prime($_) for @nums }, #'M::P::FS' => sub { $sieve->isprime($_) for @nums }, 'M::P::U' => sub { Math::Prime::Util::is_prime($_) for @nums }, 'MPU prob' => sub { Math::Prime::Util::is_prob_prime($_) for @nums }, #'Math::Pari' => sub { Math::Pari::isprime($_) for @nums }, }); print "\n"; } Math-Prime-Util-0.37/bench/bench-pp-count.pl0000755000076400007640000003117412270242116017165 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Benchmark qw/:all/; #use Devel::Size qw/total_size/; #use Math::Prime::Util; #use Math::Prime::FastSieve; #*mpu_erat = \&Math::Prime::Util::erat_primes; #*fs_erat = \&Math::Prime::FastSieve::primes; my $upper = shift || 8192; my $count = shift || -1; my $countarg; #atkin2(100); exit(0); # Shows sizes for sieving to 100k, and rate/second for sieving to 16k my $pc_subs = { "Rosetta 4" => sub { rosetta4($countarg) }, # 25k 60/s "Atkin MPTA" => sub { atkin($countarg) }, # 3430k 90/s "Merlyn" => sub { merlyn($countarg)}, # 13k 96/s "Rosetta 2" => sub { rosetta2($countarg) }, # 13k 109/s "Atkin 2" => sub { atkin2($countarg) }, # 1669k 110/s "DO Vec" => sub {daoswald_vec($countarg)}, # 13k 112/s "Rosetta 3" => sub { rosetta3($countarg) }, # 4496k 165/s "Rosetta 1" => sub { rosetta1($countarg) }, # 3449k 187/s "Shootout" => sub { shootout($countarg) }, # 3200k 231/s "DJ Vec" => sub { dj1($countarg) }, # 7k 245/s "Scriptol" => sub { scriptol($countarg) }, # 3200k 290/s "DO Array" => sub {daoswald_array($countarg)},# 3200k 306/s "DJ Array" => sub { dj2($countarg) }, # 1494k 475/s "In Many" => sub { inmany($countarg) }, # 2018k 666/s "DJ String1" => sub { dj3($countarg) }, # 50k 981/s "DJ String2" => sub { dj4($countarg) }, # 50k 1682/s # "MPU Sieve" => sub { # scalar @{mpu_erat(2,$countarg)}; }, # 3k 14325/s # "MPFS Sieve" => sub { # scalar @{fs_erat($countarg)}; }, # 7k 14325/s }; my %verify = ( 10 => 4, 11 => 5, 100 => 25, 112 => 29, 113 => 30, 114 => 30, 1000 => 168, 10000 => 1229, 100000 => 9592, ); # Verify while (my($name, $sub) = each (%$pc_subs)) { while (my($n, $pin) = each (%verify)) { $countarg = $n; my $picount = $sub->(); die "$name ($n) = $picount, should be $pin" unless $picount == $pin; } } print "Done with verification, starting benchmark\n"; $countarg = $upper; cmpthese($count, $pc_subs); # www.scriptol.com/programming/sieve.php sub scriptol { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; my @flags = (0 .. $max); for my $i (2 .. int(sqrt($max)) + 1) { next unless defined $flags[$i]; for (my $k=$i+$i; $k <= $max; $k+=$i) { undef $flags[$k]; } } #print "scriptol size: ", total_size(\@flags), "\n" if $max > 90000; my $count = 0; for my $j (2 .. $max) { $count++ if defined $flags[$j]; } $count; } # http://dada.perl.it/shootout/sieve.perl.html sub shootout { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; my $count = 0; my @flags = (0 .. $max); for my $i (2 .. $max) { next unless defined $flags[$i]; for (my $k=$i+$i; $k <= $max; $k+=$i) { undef $flags[$k]; } $count++; } #print "shootout size: ", total_size(\@flags), "\n" if $max > 90000; $count; } # http://c2.com/cgi/wiki?SieveOfEratosthenesInManyProgrammingLanguages sub inmany { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; $max++; my @c; for(my $t=3; $t*$t<$max; $t+=2) { if (!$c[$t]) { for(my $s=$t*$t; $s<$max; $s+=$t*2) { $c[$s]++ } } } #print "inmany size: ", total_size(\@c), "\n" if $max > 90000; my $count = 1; for(my $t=3; $t<$max; $t+=2) { $c[$t] || $count++; } $count; } # http://rosettacode.org/wiki/Sieve_of_Eratosthenes#Perl sub rosetta1 { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; my $count = 0; #my @primes; my @tested = (1); my $j = 1; while ($j < $max) { next if $tested[$j++]; $count++; #push @primes, $j; for (my $k= $j; $k <= $max; $k+=$j) { $tested[$k-1]= 1; } } #print "R1 size: ", total_size(\@tested), "\n" if $max > 90000; $count; #scalar @primes; } # http://rosettacode.org/wiki/Sieve_of_Eratosthenes#Perl sub rosetta2 { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; my $count = 0; #my @primes; my $nonPrimes = ''; foreach my $p (2 .. $max) { unless (vec($nonPrimes, $p, 1)) { for (my $i = $p * $p; $i <= $max; $i += $p) { vec($nonPrimes, $i, 1) = 1; } $count++; #push @primes, $p; } } #print "R2 size: ", total_size(\$nonPrimes), "\n" if $max > 90000; $count; #scalar @primes; } # http://rosettacode.org/wiki/Sieve_of_Eratosthenes#Perl sub rosetta3 { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; my $i; my @s; my $count = scalar grep { not $s[ $i = $_ ] and do { $s[ $i += $_ ]++ while $i <= $max; 1 } } 2 .. $max; #print "R3 size: ", total_size(\@s), "\n" if $max > 90000; $count; #scalar @primes; } # http://rosettacode.org/wiki/Sieve_of_Eratosthenes#Perl sub rosetta4 { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; my $i; my $s = ''; my $count = scalar grep { not vec $s, $i = $_, 1 and do { (vec $s, $i += $_, 1) = 1 while $i <= $max; 1 } } 2 .. $max; #print "R4 size: ", total_size(\$s), "\n" if $max > 90000; $count; #scalar @primes; } # From Math::Primes::TiedArray sub atkin { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; return 2 if $max < 5; my $sqrt = sqrt($max); my %sieve; foreach my $x ( 1 .. $sqrt ) { foreach my $y ( 1 .. $sqrt ) { my $n = 3 * $x**2 - $y**2; if ( $x > $y and $n <= $max and $n % 12 == 11 ) { $sieve{$n} = not $sieve{$n}; } $n = 3 * $x**2 + $y**2; if ( $n <= $max and $n % 12 == 7 ) { $sieve{$n} = not $sieve{$n}; } $n = 4 * $x**2 + $y**2; if ( $n <= $max and ( $n % 12 == 1 or $n % 12 == 5 ) ) { $sieve{$n} = not $sieve{$n}; } } } # eliminate composites by sieving foreach my $n ( 5 .. $sqrt ) { next unless $sieve{$n}; my $k = int(1/$n**2) * $n**2; while ( $k <= $max ) { $sieve{$k} = 0; $k += $n**2; } } $sieve{2} = 1; $sieve{3} = 1; #print "Atkin size: ", total_size(\%sieve), "\n" if $max > 90000; # save the found primes in our cache my $count = 0; foreach my $n ( 2 .. $max ) { next unless $sieve{$n}; $count++; } $count; } # Naive Sieve of Atkin, basically straight from Wikipedia. # # # # First thing to note about SoA, is that people love to quote things like # "memory use is O(N^(1/2+o(1)))" then proceed to _clearly_ use N bytes in # their implementation. If your data structures between SoA and SoE are the # same, then all talk about comparative O(blah..blah) memory use is stupid. # # Secondly, assuming you're not Dan Bernstein, if your Sieve of Atkin is # faster than your Sieve of Eratosthenes, then I strongly suggest you verify # your code actually _works_, and secondly I would bet you made stupid mistakes # in your SoE implementation. If your SoA code even remotely resembles the # Wikipedia code and it comes out faster than SoE, then I *guarantee* your # SoE is borked. # # SoA does have a slightly better asymptotic operation count O(N/loglogN) vs. # O(N) for SoE. The Wikipedia-like code that most people use is O(N) so it # isn't even theoretically better unless you pull lots of stunts like primegen # does. Even if you do, loglogN is essentially a small constant for most uses # (it's under 4 for all 64-bit values), so you need to make sure all the rest # of your overhead is controlled. # # Sumarizing, in practice the SoE is faster, and often a LOT faster. # # # sub atkin2 { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; my @sieve; my $sqrt = int(sqrt($max)); for my $x (1 .. $sqrt) { for my $y (1 .. $sqrt) { my $n; $n = 4*$x*$x + $y*$y; if ( ($n <= $max) && ( (($n%12) == 1) || (($n%12) == 5) ) ) { $sieve[$n] ^= 1; } $n = 3*$x*$x + $y*$y; if ( ($n <= $max) && (($n%12) == 7) ) { $sieve[$n] ^= 1; } $n = 3*$x*$x - $y*$y; if ( ($x > $y) && ($n <= $max) && (($n%12) == 11) ) { $sieve[$n] ^= 1; } } } for my $n (5 .. $sqrt) { if ($sieve[$n]) { my $k = $n*$n; my $z = $k; while ($z <= $max) { $sieve[$z] = 0; $z += $k; } } } $sieve[2] = 1; $sieve[3] = 1; #print "Atkin size: ", total_size(\@sieve), "\n" if $max > 90000; my $count = scalar grep { $sieve[$_] } 2 .. $#sieve; $count; } # https://github.com/daoswald/Inline-C-Perl-Mongers-Talk/blob/master/primesbench.pl sub daoswald_array { my($top) = @_; return 0 if $top < 2; return 1 if $top < 3; $top++; my @primes = (1) x $top; my $i_times_j; for my $i ( 2 .. sqrt $top ) { if ( $primes[$i] ) { for ( my $j = $i; ( $i_times_j = $i * $j ) < $top; $j++ ) { undef $primes[$i_times_j]; } } } #print "do_array size: ", total_size(\@primes), "\n" if $top > 90000; my $count = scalar grep { $primes[$_] } 2 .. $#primes; $count; } sub daoswald_vec { my($top) = @_; return 0 if $top < 2; return 1 if $top < 3; my $primes = ''; vec( $primes, $top, 1 ) = 0; my $i_times_j; for my $i ( 2 .. sqrt $top ) { if ( !vec( $primes, $i, 1 ) ) { for ( my $j = $i; ( $i_times_j = $i * $j ) <= $top; $j++ ) { vec( $primes, $i_times_j, 1 ) = 1; } } } #print "do_vec size: ", total_size(\$primes), "\n" if $top > 90000; my $count = scalar grep { !vec( $primes, $_, 1 ) } 2 .. $top ; $count; } # Merlyn's Unix Review Column 26, June 1999 # http://www.stonehenge.com/merlyn/UnixReview/col26.html sub merlyn { my($UPPER) = @_; return 0 if $UPPER < 2; return 1 if $UPPER < 3; my $count = 0; my $sieve = ""; GUESS: for (my $guess = 2; $guess <= $UPPER; $guess++) { next GUESS if vec($sieve,$guess,1); $count++; for (my $mults = $guess * $guess; $mults <= $UPPER; $mults += $guess) { vec($sieve,$mults,1) = 1; } } #print "Merlyn size: ", total_size(\$sieve), "\n" if $UPPER > 90000; $count; } sub dj1 { my($end) = @_; return 0 if $end < 2; return 1 if $end < 3; # vector my $sieve = ''; my $n = 3; while ( ($n*$n) <= $end ) { my $s = $n*$n; while ($s <= $end) { vec($sieve, $s >> 1, 1) = 1; $s += 2*$n; } do { $n += 2 } while vec($sieve, $n >> 1, 1) != 0; } #print "DJ1 size: ", total_size(\$sieve), "\n" if $end > 90000; my $count = 1; $n = 3; while ($n <= $end) { $count++ if !vec($sieve, $n >> 1, 1); $n += 2; } $count; } sub dj2 { my($end) = @_; return 0 if $end < 2; return 1 if $end < 3; # array my @sieve; my $n = 3; while ( ($n*$n) <= $end ) { my $s = $n*$n; while ($s <= $end) { $sieve[$s>>1] = 1; $s += 2*$n; } do { $n += 2 } while $sieve[$n>>1]; } #print "DJ2 size: ", total_size(\@sieve), "\n" if $end > 90000; my $count = 1; $n = 3; while ($n <= $end) { $count++ if !$sieve[$n>>1]; $n += 2; } $count; } # ~2x faster than inmany, lots faster than the others. Only loses to dj4, # which is just this code with a presieve added. sub dj3 { my($end) = @_; return 0 if $end < 2; return 1 if $end < 3; $end-- if ($end & 1) == 0; # string my $sieve = '1' . '0' x ($end>>1); my $n = 3; while ( ($n*$n) <= $end ) { my $s = $n*$n; my $filter_s = $s >> 1; my $filter_end = $end >> 1; while ($filter_s <= $filter_end) { substr($sieve, $filter_s, 1) = '1'; $filter_s += $n; } do { $n += 2 } while substr($sieve, $n>>1, 1); } #print "DJ3 size: ", total_size(\$sieve), "\n" if $end > 90000; my $count = 1 + $sieve =~ tr/0//; $count; } # 2-3x faster than inmany, 6-7x faster than any of the other non-DJ methods. sub dj4 { my($end) = @_; return 0 if $end < 2; return 1 if $end < 3; $end-- if ($end & 1) == 0; # string with prefill my $whole = int( ($end>>1) / 15); my $sieve = '100010010010110' . '011010010010110' x $whole; substr($sieve, ($end>>1)+1) = ''; my $n = 7; while ( ($n*$n) <= $end ) { my $s = $n*$n; my $filter_s = $s >> 1; my $filter_end = $end >> 1; while ($filter_s <= $filter_end) { substr($sieve, $filter_s, 1) = '1'; $filter_s += $n; } do { $n += 2 } while substr($sieve, $n>>1, 1); } #print "DJ4 size: ", total_size(\$sieve), "\n" if $end > 90000; my $count = 1 + $sieve =~ tr/0//; $count; } Math-Prime-Util-0.37/bench/bench-pp-sieve.pl0000755000076400007640000003010512003175161017140 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Benchmark qw/:all/; #use Devel::Size qw/total_size/; use Math::Prime::Util; use Math::Prime::FastSieve; *mpu_erat = \&Math::Prime::Util::erat_primes; *fs_erat = \&Math::Prime::FastSieve::primes; my $upper = shift || 8192; my $count = shift || -1; my $countarg; my $sum; # This is like counting, but we want an array returned. # The subs will compute a sum on the results. # In practice you would probably want to return a ref to your array, or return # a ref to your sieve structure and let the caller decode it as needed. # Times for 100k. # Vs. MPU sieve, as we move from 8k to 10M: # Atkin MPTA, Rosetta 3 & 1, Shootout, Scriptol, DO Array, DJ Array, and # InMany all slow down. Atkin 2 speeds up (from 65x slower to 54x slower). # The DJ string methods have almost no relative slowdown, so stretch out their # advantage over the other fast ones (In Many, DJ Array, DJ Vec, and DO Array). my $pc_subs = { "Rosetta 4" => sub {$sum=0; $sum+=$_ for rosetta4($countarg);$sum;}, # 9/s "Atkin MPTA"=> sub {$sum=0; $sum+=$_ for atkin($countarg);$sum;}, # 11/s "Merlyn" => sub {$sum=0; $sum+=$_ for merlyn($countarg);$sum;}, # 15/s "Rosetta 2" => sub {$sum=0; $sum+=$_ for rosetta2($countarg);$sum; }, # 16/s "DO Vec" => sub {$sum=0; $sum+=$_ for daos_vec($countarg);$sum;}, # 16/s "Atkin 2" => sub {$sum=0; $sum+=$_ for atkin2($countarg);$sum; }, # 17/s "Rosetta 3" => sub {$sum=0; $sum+=$_ for rosetta3($countarg);$sum; }, # 23/s "Rosetta 1" => sub {$sum=0; $sum+=$_ for rosetta1($countarg);$sum; }, # 26/s "Shootout" => sub {$sum=0; $sum+=$_ for shootout($countarg);$sum; }, # 30/s "Scriptol" => sub {$sum=0; $sum+=$_ for scriptol($countarg);$sum; }, # 33/s "DJ Vec" => sub {$sum=0; $sum+=$_ for dj1($countarg);$sum; }, # 34/s "DO Array" => sub {$sum=0; $sum+=$_ for daos_array($countarg);$sum;},# 41/s "DJ Array" => sub {$sum=0; $sum+=$_ for dj2($countarg);$sum; }, # 63/s "In Many" => sub {$sum=0; $sum+=$_ for inmany($countarg);$sum; }, # 86/s "DJ String1"=> sub {$sum=0; $sum+=$_ for dj3($countarg);$sum; }, # 99/s "DJ String2"=> sub {$sum=0; $sum+=$_ for dj4($countarg);$sum; }, # 134/s "MPFS Sieve"=> sub { # 1216/s $sum=0; $sum+=$_ for @{fs_erat($countarg)};;$sum; }, "MPU Sieve" => sub { # 1290/s $sum=0; $sum+=$_ for @{mpu_erat(2,$countarg)};;$sum; }, }; my %verify = ( 10 => 17, 11 => 28, 100 => 1060, 112 => 1480, 113 => 1593, 114 => 1593, 1000 => 76127, 10000 => 5736396, 100000 => 454396537, ); # Verify while (my($name, $sub) = each (%$pc_subs)) { while (my($n, $v_pi_sum) = each (%verify)) { $countarg = $n; my $pi_sum = $sub->(); die "$name ($n) = $pi_sum, should be $v_pi_sum" unless $pi_sum == $v_pi_sum; } } print "Done with verification, starting benchmark\n"; $countarg = $upper; cmpthese($count, $pc_subs); # www.scriptol.com/programming/sieve.php sub scriptol { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; my @flags = (0 .. $max); for my $i (2 .. int(sqrt($max)) + 1) { next unless defined $flags[$i]; for (my $k=$i+$i; $k <= $max; $k+=$i) { undef $flags[$k]; } } return grep { defined $flags[$_] } 2 .. $max; } # http://dada.perl.it/shootout/sieve.perl.html sub shootout { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; my @primes; my @flags = (0 .. $max); for my $i (2 .. $max) { next unless defined $flags[$i]; for (my $k=$i+$i; $k <= $max; $k+=$i) { undef $flags[$k]; } push @primes, $i; } @primes; } # http://c2.com/cgi/wiki?SieveOfEratosthenesInManyProgrammingLanguages sub inmany { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; my @c; for(my $t=3; $t*$t<=$max; $t+=2) { if (!$c[$t]) { for(my $s=$t*$t; $s<=$max; $s+=$t*2) { $c[$s]++ } } } my @primes = (2); for(my $t=3; $t<=$max; $t+=2) { $c[$t] || push @primes, $t; } @primes; # grep { $c[$_] } 3 .. $max; } # http://rosettacode.org/wiki/Sieve_of_Eratosthenes#Perl sub rosetta1 { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; my @primes; my @tested = (1); my $j = 1; while ($j < $max) { next if $tested[$j++]; push @primes, $j; for (my $k= $j; $k <= $max; $k+=$j) { $tested[$k-1]= 1; } } @primes; } # http://rosettacode.org/wiki/Sieve_of_Eratosthenes#Perl sub rosetta2 { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; my @primes; my $nonPrimes = ''; foreach my $p (2 .. $max) { unless (vec($nonPrimes, $p, 1)) { for (my $i = $p * $p; $i <= $max; $i += $p) { vec($nonPrimes, $i, 1) = 1; } push @primes, $p; } } @primes; } # http://rosettacode.org/wiki/Sieve_of_Eratosthenes#Perl sub rosetta3 { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; my(@s, $i); grep { not $s[ $i = $_ ] and do { $s[ $i += $_ ]++ while $i <= $max; 1 } } 2 .. $max; } # http://rosettacode.org/wiki/Sieve_of_Eratosthenes#Perl sub rosetta4 { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; my $i; my $s = ''; grep { not vec $s, $i = $_, 1 and do { (vec $s, $i += $_, 1) = 1 while $i <= $max; 1 } } 2 .. $max; } # From Math::Primes::TiedArray sub atkin { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; return 2 if $max < 5; my $sqrt = sqrt($max); my %sieve; foreach my $x ( 1 .. $sqrt ) { foreach my $y ( 1 .. $sqrt ) { my $n = 3 * $x**2 - $y**2; if ( $x > $y and $n <= $max and $n % 12 == 11 ) { $sieve{$n} = not $sieve{$n}; } $n = 3 * $x**2 + $y**2; if ( $n <= $max and $n % 12 == 7 ) { $sieve{$n} = not $sieve{$n}; } $n = 4 * $x**2 + $y**2; if ( $n <= $max and ( $n % 12 == 1 or $n % 12 == 5 ) ) { $sieve{$n} = not $sieve{$n}; } } } # eliminate composites by sieving foreach my $n ( 5 .. $sqrt ) { next unless $sieve{$n}; my $k = int(1/$n**2) * $n**2; while ( $k <= $max ) { $sieve{$k} = 0; $k += $n**2; } } my @primes = (2, 3); push @primes, grep { $sieve{$_} } 5 .. $max; @primes; } # Naive Sieve of Atkin, basically straight from Wikipedia. # # # # First thing to note about SoA, is that people love to quote things like # "memory use is O(N^(1/2+o(1)))" then proceed to _clearly_ use N bytes in # their implementation. If your data structures between SoA and SoE are the # same, then all talk about comparative O(blah..blah) memory use is stupid. # # Secondly, assuming you're not Dan Bernstein, if your Sieve of Atkin is # faster than your Sieve of Eratosthenes, then I strongly suggest you verify # your code actually _works_, and secondly I would bet you made stupid mistakes # in your SoE implementation. If your SoA code even remotely resembles the # Wikipedia code and it comes out faster than SoE, then I _guarantee_ your # SoE is borked. # # SoA does have a slightly better asymptotic operation count O(N/loglogN) vs. # O(N) for SoE. The Wikipedia-like code that most people use is O(N) so it # isn't even theoretically better unless you pull lots of stunts like primegen # does. Even if you do, loglogN is essentially a small constant for most uses # (it's under 4 for all 64-bit values), so you need to make sure all the rest # of your overhead is controlled. # # Sumarizing, in practice the SoE is faster, and often a LOT faster. # # # sub atkin2 { my($max) = @_; return 0 if $max < 2; return 1 if $max < 3; my @sieve; my $sqrt = int(sqrt($max)); for my $x (1 .. $sqrt) { for my $y (1 .. $sqrt) { my $n; $n = 4*$x*$x + $y*$y; if ( ($n <= $max) && ( (($n%12) == 1) || (($n%12) == 5) ) ) { $sieve[$n] ^= 1; } $n = 3*$x*$x + $y*$y; if ( ($n <= $max) && (($n%12) == 7) ) { $sieve[$n] ^= 1; } $n = 3*$x*$x - $y*$y; if ( ($x > $y) && ($n <= $max) && (($n%12) == 11) ) { $sieve[$n] ^= 1; } } } for my $n (5 .. $sqrt) { if ($sieve[$n]) { my $k = $n*$n; my $z = $k; while ($z <= $max) { $sieve[$z] = 0; $z += $k; } } } $sieve[2] = 1; $sieve[3] = 1; grep { $sieve[$_] } 2 .. $max; } # https://github.com/daoswald/Inline-C-Perl-Mongers-Talk/blob/master/primesbench.pl sub daos_array { my($top) = @_; return 0 if $top < 2; return 1 if $top < 3; $top++; my @primes = (1) x $top; my $i_times_j; for my $i ( 2 .. sqrt $top ) { if ( $primes[$i] ) { for ( my $j = $i; ( $i_times_j = $i * $j ) < $top; $j++ ) { undef $primes[$i_times_j]; } } } return grep { $primes[$_] } 2 .. $#primes; } sub daos_vec { my($top) = @_; return 0 if $top < 2; return 1 if $top < 3; my $primes = ''; vec( $primes, $top, 1 ) = 0; my $i_times_j; for my $i ( 2 .. sqrt $top ) { if ( !vec( $primes, $i, 1 ) ) { for ( my $j = $i; ( $i_times_j = $i * $j ) <= $top; $j++ ) { vec( $primes, $i_times_j, 1 ) = 1; } } } return grep { !vec( $primes, $_, 1 ) } 2 .. $top; } # Merlyn's Unix Review Column 26, June 1999 # http://www.stonehenge.com/merlyn/UnixReview/col26.html sub merlyn { my($UPPER) = @_; return 0 if $UPPER < 2; return 1 if $UPPER < 3; my @primes; my $sieve = ""; GUESS: for (my $guess = 2; $guess <= $UPPER; $guess++) { next GUESS if vec($sieve,$guess,1); push @primes, $guess; for (my $mults = $guess * $guess; $mults <= $UPPER; $mults += $guess) { vec($sieve,$mults,1) = 1; } } @primes; } sub dj1 { my($end) = @_; return 0 if $end < 2; return 1 if $end < 3; # vector my $sieve = ''; my $n = 3; while ( ($n*$n) <= $end ) { my $s = $n*$n; while ($s <= $end) { vec($sieve, $s >> 1, 1) = 1; $s += 2*$n; } do { $n += 2 } while vec($sieve, $n >> 1, 1) != 0; } my @primes = (2); $n = 3; while ($n <= $end) { push @primes, $n if !vec($sieve, $n >> 1, 1); $n += 2; } @primes; } sub dj2 { my($end) = @_; return 0 if $end < 2; return 1 if $end < 3; # array my @sieve; my $n = 3; while ( ($n*$n) <= $end ) { my $s = $n*$n; while ($s <= $end) { $sieve[$s>>1] = 1; $s += 2*$n; } do { $n += 2 } while $sieve[$n>>1]; } my @primes = (2); $n = 3; while ($n <= $end) { push @primes, $n if !$sieve[$n>>1]; $n += 2; } @primes; } sub dj3 { my($end) = @_; return 0 if $end < 2; return 1 if $end < 3; $end-- if ($end & 1) == 0; # string my $sieve = '1' . '0' x ($end>>1); my $n = 3; while ( ($n*$n) <= $end ) { my $s = $n*$n; my $filter_s = $s >> 1; my $filter_end = $end >> 1; while ($filter_s <= $filter_end) { substr($sieve, $filter_s, 1) = '1'; $filter_s += $n; } do { $n += 2 } while substr($sieve, $n>>1, 1); } my @primes = (2); $n = 3-2; foreach my $s (split("0", substr($sieve, 1), -1)) { $n += 2 + 2 * length($s); push @primes, $n if $n <= $end; } @primes; } sub dj4 { my($end) = @_; return 0 if $end < 2; return 1 if $end < 3; $end-- if ($end & 1) == 0; # string with prefill my $whole = int( ($end>>1) / 15); my $sieve = '100010010010110' . '011010010010110' x $whole; substr($sieve, ($end>>1)+1) = ''; my $n = 7; while ( ($n*$n) <= $end ) { my $s = $n*$n; my $filter_s = $s >> 1; my $filter_end = $end >> 1; while ($filter_s <= $filter_end) { substr($sieve, $filter_s, 1) = '1'; $filter_s += $n; } do { $n += 2 } while substr($sieve, $n>>1, 1); } my @primes = (2, 3, 5); $n = 7-2; foreach my $s (split("0", substr($sieve, 3), -1)) { $n += 2 + 2 * length($s); push @primes, $n if $n <= $end; } @primes; } Math-Prime-Util-0.37/bench/bench-isprime-bpsw.pl0000755000076400007640000000447412266152412020050 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util; use Math::Primality; my $count = shift || -1; # GMP is ~3x faster than Calc or Pari for these operations use bigint try=>'GMP'; srand(500); use Config; my $rgen = sub { my $range = shift; return 0 if $range <= 0; my $rbits = 0; { my $t = $range; while ($t) { $rbits++; $t >>= 1; } } while (1) { my $rbitsleft = $rbits; my $U = $range - $range; # 0 or bigint 0 while ($rbitsleft > 0) { my $usebits = ($rbitsleft > $Config{randbits}) ? $Config{randbits} : $rbitsleft; $U = ($U << $usebits) + int(rand(1 << $usebits)); $rbitsleft -= $usebits; } return $U if $U <= $range; } }; my @rns; while (@rns < 50) { my $n = $rgen->( Math::BigInt->new(2)->bpow(81) ); $n++ if ($n % 2) == 0; next unless ($n % 2) != 0; push @rns, $n; } map { $_ = int($_->bstr) if $_ <= ~0 } @rns; #print "$_\n" for @rns; no bigint; # Benchmark doesn't work with bigint on. print "Verifying"; for my $n (@rns) { die "bad MR for $n" unless Math::Prime::Util::is_strong_pseudoprime($n,2) == Math::Primality::is_strong_pseudoprime("$n","2"); die "bad LP for $n" unless Math::Prime::Util::is_strong_lucas_pseudoprime($n) == Math::Primality::is_strong_lucas_pseudoprime("$n"); die "bad IP for $n" unless (Math::Prime::Util::is_prime($n)?1:0) == (Math::Primality::is_prime("$n")?1:0); print "."; } print "OK\n"; use Benchmark qw/:all/; my $sum = 0; cmpthese($count, { "MP MR" => sub { $sum += Math::Primality::is_strong_pseudoprime("$_","2") for @rns; }, "MPU MR" => sub { $sum += Math::Prime::Util::GMP::is_strong_pseudoprime($_,2) for @rns; }, #"MPUxMR" => sub { Math::Prime::Util::miller_rabin($_,2) for @rns; }, "MP LP" => sub { $sum += Math::Primality::is_strong_lucas_pseudoprime("$_") for @rns;}, "MPU LP" => sub { $sum += Math::Prime::Util::GMP::is_strong_lucas_pseudoprime($_) for @rns;}, "MPU ELP" => sub { $sum += Math::Prime::Util::GMP::is_extra_strong_lucas_pseudoprime($_) for @rns;}, #"MPU AELP" => sub { $sum += Math::Prime::Util::GMP::is_almost_extra_strong_lucas_pseudoprime($_) for @rns;}, "MP IP" => sub { $sum += Math::Primality::is_prime("$_") for @rns;}, "MPU IP" => sub { $sum += Math::Prime::Util::is_prime($_) for @rns;}, #"MPUxIP" => sub { Math::Prime::Util::is_prime($_) for @rns;}, }); Math-Prime-Util-0.37/bench/bench-random-prime.pl0000755000076400007640000000075212061060267020013 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/-nobigint random_prime random_ndigit_prime/; use Benchmark qw/:all/; use List::Util qw/min max/; my $count = shift || -3; my $maxdigits = (~0 <= 4294967295) ? 10 : 20; srand(29); test_at_digits($_) for (2 .. $maxdigits); sub test_at_digits { my $digits = shift; die "Digits must be > 0" unless $digits > 0; cmpthese($count,{ "$digits digits" => sub { random_ndigit_prime($digits) for (1..1000) }, }); } Math-Prime-Util-0.37/bench/bench-factor.pl0000755000076400007640000000600712270242116016673 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/factor/; # Compare to Math::Factor::XS, which uses trial division. use Math::Factor::XS qw/prime_factors/; use Benchmark qw/:all/; use List::Util qw/min max reduce/; my $count = shift || -2; my $is64bit = (~0 > 4294967295); my $maxdigits = ($is64bit) ? 20 : 10; # Noting the range is limited for max. my $semiprimes = 0; my $howmany = 1000; for my $d ( 3 .. $maxdigits ) { print "Factor $howmany $d-digit numbers\n"; test_at_digits($d, $howmany); } sub test_at_digits { my $digits = shift; die "Digits has to be >= 1" unless $digits >= 1; die "Digits has to be <= $maxdigits" if $digits > $maxdigits; my $quantity = shift; my @rnd = ndigit_rand($digits, $quantity); my @smp = genrough($digits, $quantity); # verify (can be _really_ slow for 18+ digits) foreach my $p (@rnd, @smp) { next if $p < 2; verify_factor($p, [prime_factors($p)], [factor($p)], "Math::Prime::Util $Math::Prime::Util::VERSION"); } #my $min_num = min @nums; #my $max_num = max @nums; #my $whatstr = "$digits-digit ", $semiprimes ? "semiprime" : "random"; #print "factoring 1000 $digits-digit ", # $semiprimes ? "semiprimes" : "random numbers", # " ($min_num - $max_num)\n"; my $lref = { "MPU random" => sub { my@a=factor($_) for @rnd }, "MPU nonsmooth" => sub { my@a=factor($_) for @smp }, "MFXS random" => sub { my@a=prime_factors($_) for @rnd }, "MFXS nonsmooth" => sub { my@a=prime_factors($_) for @smp }, }; cmpthese($count, $lref); } sub verify_factor { my ($n, $aref1, $aref2, $name) = @_; return 1 if "@$aref1" eq "@$aref2"; my @master = @$aref1; my @check = @$aref2; die "Factor $n master fail!" unless $n == reduce { $a * $b } @master; die "Factor $n fail: $name" unless $#check == $#master; die "Factor $n fail: $name" unless $n == reduce { $a * $b } @check; for (0 .. $#master) { die "Factor $n fail: $name" unless $master[$_] == $check[$_]; } 1; } sub genrough { my ($digits, $num) = @_; my @min_factors_by_digit = (2,2,3,5,7,13,23,47,97); my $smallest_factor = $min_factors_by_digit[$digits]; $smallest_factor = $min_factors_by_digit[-1] unless defined $smallest_factor; my @semiprimes; foreach my $i (1 .. $num) { my $n; my @facn; do { $n = ndigit_rand($digits, 1); @facn = Math::Prime::Util::trial_factor($n,$smallest_factor); } while scalar(@facn) > 1; push @semiprimes, $n; } return @semiprimes; } use Bytes::Random::Secure qw/random_string_from/; sub ndigit_rand { my($digits, $howmany) = @_; die "digits must be > 0" if $digits < 1; $howmany = 1 unless defined $howmany; # TODO: need to skip things larger than ~0 for this module my @nums = map { random_string_from("123456789",1) . random_string_from("0123456789",$digits-1) } 1 .. $howmany; if (10**$digits > ~0) { @nums = map { Math::BigInt->new($_) } @nums; } else { @nums = map { int($_) } @nums; } return wantarray ? @nums : $nums[0]; } Math-Prime-Util-0.37/bench/bench-pcapprox.pl0000755000076400007640000000204211765037625017263 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util ":all"; use Benchmark qw/:all/; use List::Util qw/min max/; my $maxdigits = (~0 <= 4294967295) ? 10 : 20; my $count = shift || -5; srand(29); test_at_digits($_) for (5 .. $maxdigits); sub test_at_digits { my $digits = shift; die "Digits must be > 0" unless $digits > 0; my $base = ($digits == 1) ? 0 : int(10 ** ($digits-1)); my $max = int(10 ** $digits); $max = ~0 if $max > ~0; my @nums = map { $base+int(rand($max-$base)) } (1 .. 1000); my $min_num = min @nums; my $max_num = max @nums; #print "miller_rabin for 1000 random $digits-digit numbers ($min_num - $max_num)\n"; my $sum; cmpthese($count,{ 'lower' => sub { $sum += prime_count_lower($_) for @nums }, 'luapprox' => sub { $sum += (prime_count_lower($_)+prime_count_upper($_))/2 for @nums }, 'approx' => sub { $sum += prime_count_approx($_) for @nums }, 'li' => sub { $sum += LogarithmicIntegral($_) for @nums }, 'R' => sub { $sum += RiemannR($_) for @nums }, }); print "\n"; } Math-Prime-Util-0.37/ppport.h0000644000076400007640000055600212270242116014423 0ustar danadana#if 0 <<'SKIP'; #endif /* ---------------------------------------------------------------------- ppport.h -- Perl/Pollution/Portability Version 3.21 Automatically created by Devel::PPPort running under perl 5.019005. Do NOT edit this file directly! -- Edit PPPort_pm.PL and the includes in parts/inc/ instead. Use 'perldoc ppport.h' to view the documentation below. ---------------------------------------------------------------------- SKIP =pod =head1 NAME ppport.h - Perl/Pollution/Portability version 3.21 =head1 SYNOPSIS perl ppport.h [options] [source files] Searches current directory for files if no [source files] are given --help show short help --version show version --patch=file write one patch file with changes --copy=suffix write changed copies with suffix --diff=program use diff program and options --compat-version=version provide compatibility with Perl version --cplusplus accept C++ comments --quiet don't output anything except fatal errors --nodiag don't show diagnostics --nohints don't show hints --nochanges don't suggest changes --nofilter don't filter input files --strip strip all script and doc functionality from ppport.h --list-provided list provided API --list-unsupported list unsupported API --api-info=name show Perl API portability information =head1 COMPATIBILITY This version of F is designed to support operation with Perl installations back to 5.003, and has been tested up to 5.11.5. =head1 OPTIONS =head2 --help Display a brief usage summary. =head2 --version Display the version of F. =head2 --patch=I If this option is given, a single patch file will be created if any changes are suggested. This requires a working diff program to be installed on your system. =head2 --copy=I If this option is given, a copy of each file will be saved with the given suffix that contains the suggested changes. This does not require any external programs. Note that this does not automagially add a dot between the original filename and the suffix. If you want the dot, you have to include it in the option argument. If neither C<--patch> or C<--copy> are given, the default is to simply print the diffs for each file. This requires either C or a C program to be installed. =head2 --diff=I Manually set the diff program and options to use. The default is to use C, when installed, and output unified context diffs. =head2 --compat-version=I Tell F to check for compatibility with the given Perl version. The default is to check for compatibility with Perl version 5.003. You can use this option to reduce the output of F if you intend to be backward compatible only down to a certain Perl version. =head2 --cplusplus Usually, F will detect C++ style comments and replace them with C style comments for portability reasons. Using this option instructs F to leave C++ comments untouched. =head2 --quiet Be quiet. Don't print anything except fatal errors. =head2 --nodiag Don't output any diagnostic messages. Only portability alerts will be printed. =head2 --nohints Don't output any hints. Hints often contain useful portability notes. Warnings will still be displayed. =head2 --nochanges Don't suggest any changes. Only give diagnostic output and hints unless these are also deactivated. =head2 --nofilter Don't filter the list of input files. By default, files not looking like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped. =head2 --strip Strip all script and documentation functionality from F. This reduces the size of F dramatically and may be useful if you want to include F in smaller modules without increasing their distribution size too much. The stripped F will have a C<--unstrip> option that allows you to undo the stripping, but only if an appropriate C module is installed. =head2 --list-provided Lists the API elements for which compatibility is provided by F. Also lists if it must be explicitly requested, if it has dependencies, and if there are hints or warnings for it. =head2 --list-unsupported Lists the API elements that are known not to be supported by F and below which version of Perl they probably won't be available or work. =head2 --api-info=I Show portability information for API elements matching I. If I is surrounded by slashes, it is interpreted as a regular expression. =head1 DESCRIPTION In order for a Perl extension (XS) module to be as portable as possible across differing versions of Perl itself, certain steps need to be taken. =over 4 =item * Including this header is the first major one. This alone will give you access to a large part of the Perl API that hasn't been available in earlier Perl releases. Use perl ppport.h --list-provided to see which API elements are provided by ppport.h. =item * You should avoid using deprecated parts of the API. For example, using global Perl variables without the C prefix is deprecated. Also, some API functions used to have a C prefix. Using this form is also deprecated. You can safely use the supported API, as F will provide wrappers for older Perl versions. =item * If you use one of a few functions or variables that were not present in earlier versions of Perl, and that can't be provided using a macro, you have to explicitly request support for these functions by adding one or more C<#define>s in your source code before the inclusion of F. These functions or variables will be marked C in the list shown by C<--list-provided>. Depending on whether you module has a single or multiple files that use such functions or variables, you want either C or global variants. For a C function or variable (used only in a single source file), use: #define NEED_function #define NEED_variable For a global function or variable (used in multiple source files), use: #define NEED_function_GLOBAL #define NEED_variable_GLOBAL Note that you mustn't have more than one global request for the same function or variable in your project. Function / Variable Static Request Global Request ----------------------------------------------------------------------------------------- PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL grok_number() NEED_grok_number NEED_grok_number_GLOBAL grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL load_module() NEED_load_module NEED_load_module_GLOBAL my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL pv_display() NEED_pv_display NEED_pv_display_GLOBAL pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL vload_module() NEED_vload_module NEED_vload_module_GLOBAL vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL warner() NEED_warner NEED_warner_GLOBAL To avoid namespace conflicts, you can change the namespace of the explicitly exported functions / variables using the C macro. Just C<#define> the macro before including C: #define DPPP_NAMESPACE MyOwnNamespace_ #include "ppport.h" The default namespace is C. =back The good thing is that most of the above can be checked by running F on your source code. See the next section for details. =head1 EXAMPLES To verify whether F is needed for your module, whether you should make any changes to your code, and whether any special defines should be used, F can be run as a Perl script to check your source code. Simply say: perl ppport.h The result will usually be a list of patches suggesting changes that should at least be acceptable, if not necessarily the most efficient solution, or a fix for all possible problems. If you know that your XS module uses features only available in newer Perl releases, if you're aware that it uses C++ comments, and if you want all suggestions as a single patch file, you could use something like this: perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff If you only want your code to be scanned without any suggestions for changes, use: perl ppport.h --nochanges You can specify a different C program or options, using the C<--diff> option: perl ppport.h --diff='diff -C 10' This would output context diffs with 10 lines of context. If you want to create patched copies of your files instead, use: perl ppport.h --copy=.new To display portability information for the C function, use: perl ppport.h --api-info=newSVpvn Since the argument to C<--api-info> can be a regular expression, you can use perl ppport.h --api-info=/_nomg$/ to display portability information for all C<_nomg> functions or perl ppport.h --api-info=/./ to display information for all known API elements. =head1 BUGS If this version of F is causing failure during the compilation of this module, please check if newer versions of either this module or C are available on CPAN before sending a bug report. If F was generated using the latest version of C and is causing failure of this module, please file a bug report using the CPAN Request Tracker at L. Please include the following information: =over 4 =item 1. The complete output from running "perl -V" =item 2. This file. =item 3. The name and version of the module you were trying to build. =item 4. A full log of the build that failed. =item 5. Any other information that you think could be relevant. =back For the latest version of this code, please get the C module from CPAN. =head1 COPYRIGHT Version 3.x, Copyright (c) 2004-2013, Marcus Holland-Moritz. Version 2.x, Copyright (C) 2001, Paul Marquess. Version 1.x, Copyright (C) 1999, Kenneth Albanowski. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO See L. =cut use strict; # Disable broken TRIE-optimization BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 } my $VERSION = 3.21; my %opt = ( quiet => 0, diag => 1, hints => 1, changes => 1, cplusplus => 0, filter => 1, strip => 0, version => 0, ); my($ppport) = $0 =~ /([\w.]+)$/; my $LF = '(?:\r\n|[\r\n])'; # line feed my $HS = "[ \t]"; # horizontal whitespace # Never use C comments in this file! my $ccs = '/'.'*'; my $cce = '*'.'/'; my $rccs = quotemeta $ccs; my $rcce = quotemeta $cce; eval { require Getopt::Long; Getopt::Long::GetOptions(\%opt, qw( help quiet diag! filter! hints! changes! cplusplus strip version patch=s copy=s diff=s compat-version=s list-provided list-unsupported api-info=s )) or usage(); }; if ($@ and grep /^-/, @ARGV) { usage() if "@ARGV" =~ /^--?h(?:elp)?$/; die "Getopt::Long not found. Please don't use any options.\n"; } if ($opt{version}) { print "This is $0 $VERSION.\n"; exit 0; } usage() if $opt{help}; strip() if $opt{strip}; if (exists $opt{'compat-version'}) { my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) }; if ($@) { die "Invalid version number format: '$opt{'compat-version'}'\n"; } die "Only Perl 5 is supported\n" if $r != 5; die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000; $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s; } else { $opt{'compat-version'} = 5; } my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/ ? ( $1 => { ($2 ? ( base => $2 ) : ()), ($3 ? ( todo => $3 ) : ()), (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()), (index($4, 'p') >= 0 ? ( provided => 1 ) : ()), (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()), } ) : die "invalid spec: $_" } qw( AvFILLp|5.004050||p AvFILL||| BhkDISABLE||5.019003| BhkENABLE||5.019003| BhkENTRY_set||5.019003| BhkENTRY||| BhkFLAGS||| CALL_BLOCK_HOOKS||| CLASS|||n CPERLscope|5.005000||p CX_CURPAD_SAVE||| CX_CURPAD_SV||| CopFILEAV|5.006000||p CopFILEGV_set|5.006000||p CopFILEGV|5.006000||p CopFILESV|5.006000||p CopFILE_set|5.006000||p CopFILE|5.006000||p CopSTASHPV_set|5.006000||p CopSTASHPV|5.006000||p CopSTASH_eq|5.006000||p CopSTASH_set|5.006000||p CopSTASH|5.006000||p CopyD|5.009002|5.004050|p Copy||5.004050| CvPADLIST||5.008001| CvSTASH||| CvWEAKOUTSIDE||| DEFSV_set|5.010001||p DEFSV|5.004050||p END_EXTERN_C|5.005000||p ENTER||| ERRSV|5.004050||p EXTEND||| EXTERN_C|5.005000||p F0convert|||n FREETMPS||| GIMME_V||5.004000|n GIMME|||n GROK_NUMERIC_RADIX|5.007002||p G_ARRAY||| G_DISCARD||| G_EVAL||| G_METHOD|5.006001||p G_NOARGS||| G_SCALAR||| G_VOID||5.004000| GetVars||| GvAV||| GvCV||| GvHV||| GvSVn|5.009003||p GvSV||| Gv_AMupdate||5.011000| HEf_SVKEY||5.004000| HeHASH||5.004000| HeKEY||5.004000| HeKLEN||5.004000| HePV||5.004000| HeSVKEY_force||5.004000| HeSVKEY_set||5.004000| HeSVKEY||5.004000| HeUTF8||5.010001| HeVAL||5.004000| HvENAMELEN||5.015004| HvENAMEUTF8||5.015004| HvENAME||5.013007| HvNAMELEN_get|5.009003||p HvNAMELEN||5.015004| HvNAMEUTF8||5.015004| HvNAME_get|5.009003||p HvNAME||| INT2PTR|5.006000||p IN_LOCALE_COMPILETIME|5.007002||p IN_LOCALE_RUNTIME|5.007002||p IN_LOCALE|5.007002||p IN_PERL_COMPILETIME|5.008001||p IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p IS_NUMBER_INFINITY|5.007002||p IS_NUMBER_IN_UV|5.007002||p IS_NUMBER_NAN|5.007003||p IS_NUMBER_NEG|5.007002||p IS_NUMBER_NOT_INT|5.007002||p IVSIZE|5.006000||p IVTYPE|5.006000||p IVdf|5.006000||p LEAVE||| LINKLIST||5.013006| LVRET||| MARK||| MULTICALL||5.019003| MY_CXT_CLONE|5.009002||p MY_CXT_INIT|5.007003||p MY_CXT|5.007003||p MoveD|5.009002|5.004050|p Move||5.004050| NOOP|5.005000||p NUM2PTR|5.006000||p NVTYPE|5.006000||p NVef|5.006001||p NVff|5.006001||p NVgf|5.006001||p Newxc|5.009003||p Newxz|5.009003||p Newx|5.009003||p Nullav||| Nullch||| Nullcv||| Nullhv||| Nullsv||| OP_CLASS||5.013007| OP_DESC||5.007003| OP_NAME||5.007003| ORIGMARK||| PAD_BASE_SV||| PAD_CLONE_VARS||| PAD_COMPNAME_FLAGS||| PAD_COMPNAME_GEN_set||| PAD_COMPNAME_GEN||| PAD_COMPNAME_OURSTASH||| PAD_COMPNAME_PV||| PAD_COMPNAME_TYPE||| PAD_RESTORE_LOCAL||| PAD_SAVE_LOCAL||| PAD_SAVE_SETNULLPAD||| PAD_SETSV||| PAD_SET_CUR_NOSAVE||| PAD_SET_CUR||| PAD_SVl||| PAD_SV||| PERLIO_FUNCS_CAST|5.009003||p PERLIO_FUNCS_DECL|5.009003||p PERL_ABS|5.008001||p PERL_BCDVERSION|5.019002||p PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p PERL_HASH|5.004000||p PERL_INT_MAX|5.004000||p PERL_INT_MIN|5.004000||p PERL_LONG_MAX|5.004000||p PERL_LONG_MIN|5.004000||p PERL_MAGIC_arylen|5.007002||p PERL_MAGIC_backref|5.007002||p PERL_MAGIC_bm|5.007002||p PERL_MAGIC_collxfrm|5.007002||p PERL_MAGIC_dbfile|5.007002||p PERL_MAGIC_dbline|5.007002||p PERL_MAGIC_defelem|5.007002||p PERL_MAGIC_envelem|5.007002||p PERL_MAGIC_env|5.007002||p PERL_MAGIC_ext|5.007002||p PERL_MAGIC_fm|5.007002||p PERL_MAGIC_glob|5.019002||p PERL_MAGIC_isaelem|5.007002||p PERL_MAGIC_isa|5.007002||p PERL_MAGIC_mutex|5.019002||p PERL_MAGIC_nkeys|5.007002||p PERL_MAGIC_overload_elem|5.019002||p PERL_MAGIC_overload_table|5.007002||p PERL_MAGIC_overload|5.019002||p PERL_MAGIC_pos|5.007002||p PERL_MAGIC_qr|5.007002||p PERL_MAGIC_regdata|5.007002||p PERL_MAGIC_regdatum|5.007002||p PERL_MAGIC_regex_global|5.007002||p PERL_MAGIC_shared_scalar|5.007003||p PERL_MAGIC_shared|5.007003||p PERL_MAGIC_sigelem|5.007002||p PERL_MAGIC_sig|5.007002||p PERL_MAGIC_substr|5.007002||p PERL_MAGIC_sv|5.007002||p PERL_MAGIC_taint|5.007002||p PERL_MAGIC_tiedelem|5.007002||p PERL_MAGIC_tiedscalar|5.007002||p PERL_MAGIC_tied|5.007002||p PERL_MAGIC_utf8|5.008001||p PERL_MAGIC_uvar_elem|5.007003||p PERL_MAGIC_uvar|5.007002||p PERL_MAGIC_vec|5.007002||p PERL_MAGIC_vstring|5.008001||p PERL_PV_ESCAPE_ALL|5.009004||p PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p PERL_PV_ESCAPE_NOCLEAR|5.009004||p PERL_PV_ESCAPE_QUOTE|5.009004||p PERL_PV_ESCAPE_RE|5.009005||p PERL_PV_ESCAPE_UNI_DETECT|5.009004||p PERL_PV_ESCAPE_UNI|5.009004||p PERL_PV_PRETTY_DUMP|5.009004||p PERL_PV_PRETTY_ELLIPSES|5.010000||p PERL_PV_PRETTY_LTGT|5.009004||p PERL_PV_PRETTY_NOCLEAR|5.010000||p PERL_PV_PRETTY_QUOTE|5.009004||p PERL_PV_PRETTY_REGPROP|5.009004||p PERL_QUAD_MAX|5.004000||p PERL_QUAD_MIN|5.004000||p PERL_REVISION|5.006000||p PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p PERL_SCAN_DISALLOW_PREFIX|5.007003||p PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p PERL_SCAN_SILENT_ILLDIGIT|5.008001||p PERL_SHORT_MAX|5.004000||p PERL_SHORT_MIN|5.004000||p PERL_SIGNALS_UNSAFE_FLAG|5.008001||p PERL_SUBVERSION|5.006000||p PERL_SYS_INIT3||5.010000| PERL_SYS_INIT||5.010000| PERL_SYS_TERM||5.019003| PERL_UCHAR_MAX|5.004000||p PERL_UCHAR_MIN|5.004000||p PERL_UINT_MAX|5.004000||p PERL_UINT_MIN|5.004000||p PERL_ULONG_MAX|5.004000||p PERL_ULONG_MIN|5.004000||p PERL_UNUSED_ARG|5.009003||p PERL_UNUSED_CONTEXT|5.009004||p PERL_UNUSED_DECL|5.007002||p PERL_UNUSED_VAR|5.007002||p PERL_UQUAD_MAX|5.004000||p PERL_UQUAD_MIN|5.004000||p PERL_USE_GCC_BRACE_GROUPS|5.009004||p PERL_USHORT_MAX|5.004000||p PERL_USHORT_MIN|5.004000||p PERL_VERSION|5.006000||p PL_DBsignal|5.005000||p PL_DBsingle|||pn PL_DBsub|||pn PL_DBtrace|||pn PL_Sv|5.005000||p PL_bufend|5.019002||p PL_bufptr|5.019002||p PL_check||5.006000| PL_compiling|5.004050||p PL_comppad_name||5.017004| PL_comppad||5.008001| PL_copline|5.019002||p PL_curcop|5.004050||p PL_curpad||5.005000| PL_curstash|5.004050||p PL_debstash|5.004050||p PL_defgv|5.004050||p PL_diehook|5.004050||p PL_dirty|5.004050||p PL_dowarn|||pn PL_errgv|5.004050||p PL_error_count|5.019002||p PL_expect|5.019002||p PL_hexdigit|5.005000||p PL_hints|5.005000||p PL_in_my_stash|5.019002||p PL_in_my|5.019002||p PL_keyword_plugin||5.011002| PL_last_in_gv|||n PL_laststatval|5.005000||p PL_lex_state|5.019002||p PL_lex_stuff|5.019002||p PL_linestr|5.019002||p PL_modglobal||5.005000|n PL_na|5.004050||pn PL_no_modify|5.006000||p PL_ofsgv|||n PL_opfreehook||5.011000|n PL_parser|5.009005|5.009005|p PL_peepp||5.007003|n PL_perl_destruct_level|5.004050||p PL_perldb|5.004050||p PL_ppaddr|5.006000||p PL_rpeepp||5.013005|n PL_rsfp_filters|5.019002||p PL_rsfp|5.019002||p PL_rs|||n PL_signals|5.008001||p PL_stack_base|5.004050||p PL_stack_sp|5.004050||p PL_statcache|5.005000||p PL_stdingv|5.004050||p PL_sv_arenaroot|5.004050||p PL_sv_no|5.004050||pn PL_sv_undef|5.004050||pn PL_sv_yes|5.004050||pn PL_tainted|5.004050||p PL_tainting|5.004050||p PL_tokenbuf|5.019002||p POP_MULTICALL||5.019003| POPi|||n POPl|||n POPn|||n POPpbytex||5.007001|n POPpx||5.005030|n POPp|||n POPs|||n PTR2IV|5.006000||p PTR2NV|5.006000||p PTR2UV|5.006000||p PTR2nat|5.009003||p PTR2ul|5.007001||p PTRV|5.006000||p PUSHMARK||| PUSH_MULTICALL||5.019003| PUSHi||| PUSHmortal|5.009002||p PUSHn||| PUSHp||| PUSHs||| PUSHu|5.004000||p PUTBACK||| PadARRAY||5.019003| PadMAX||5.019003| PadlistARRAY||5.019003| PadlistMAX||5.019003| PadlistNAMESARRAY||5.019003| PadlistNAMESMAX||5.019003| PadlistNAMES||5.019003| PadlistREFCNT||5.017004| PadnameIsOUR||| PadnameIsSTATE||| PadnameLEN||5.019003| PadnameOURSTASH||| PadnameOUTER||| PadnamePV||5.019003| PadnameSV||5.019003| PadnameTYPE||| PadnameUTF8||5.019003| PadnamelistARRAY||5.019003| PadnamelistMAX||5.019003| PerlIO_clearerr||5.007003| PerlIO_close||5.007003| PerlIO_context_layers||5.009004| PerlIO_eof||5.007003| PerlIO_error||5.007003| PerlIO_fileno||5.007003| PerlIO_fill||5.007003| PerlIO_flush||5.007003| PerlIO_get_base||5.007003| PerlIO_get_bufsiz||5.007003| PerlIO_get_cnt||5.007003| PerlIO_get_ptr||5.007003| PerlIO_read||5.007003| PerlIO_seek||5.007003| PerlIO_set_cnt||5.007003| PerlIO_set_ptrcnt||5.007003| PerlIO_setlinebuf||5.007003| PerlIO_stderr||5.007003| PerlIO_stdin||5.007003| PerlIO_stdout||5.007003| PerlIO_tell||5.007003| PerlIO_unread||5.007003| PerlIO_write||5.007003| Perl_signbit||5.009005|n PoisonFree|5.009004||p PoisonNew|5.009004||p PoisonWith|5.009004||p Poison|5.008000||p READ_XDIGIT||5.017006| RETVAL|||n Renewc||| Renew||| SAVECLEARSV||| SAVECOMPPAD||| SAVEPADSV||| SAVETMPS||| SAVE_DEFSV|5.004050||p SPAGAIN||| SP||| START_EXTERN_C|5.005000||p START_MY_CXT|5.007003||p STMT_END|||p STMT_START|||p STR_WITH_LEN|5.009003||p ST||| SV_CONST_RETURN|5.009003||p SV_COW_DROP_PV|5.008001||p SV_COW_SHARED_HASH_KEYS|5.009005||p SV_GMAGIC|5.007002||p SV_HAS_TRAILING_NUL|5.009004||p SV_IMMEDIATE_UNREF|5.007001||p SV_MUTABLE_RETURN|5.009003||p SV_NOSTEAL|5.009002||p SV_SMAGIC|5.009003||p SV_UTF8_NO_ENCODING|5.008001||p SVfARG|5.009005||p SVf_UTF8|5.006000||p SVf|5.006000||p SVt_INVLIST||5.019002| SVt_IV||| SVt_NULL||| SVt_NV||| SVt_PVAV||| SVt_PVCV||| SVt_PVFM||| SVt_PVGV||| SVt_PVHV||| SVt_PVIO||| SVt_PVIV||| SVt_PVLV||| SVt_PVMG||| SVt_PVNV||| SVt_PV||| SVt_REGEXP||5.011000| Safefree||| Slab_Alloc||| Slab_Free||| Slab_to_ro||| Slab_to_rw||| StructCopy||| SvCUR_set||| SvCUR||| SvEND||| SvGAMAGIC||5.006001| SvGETMAGIC|5.004050||p SvGROW||| SvIOK_UV||5.006000| SvIOK_notUV||5.006000| SvIOK_off||| SvIOK_only_UV||5.006000| SvIOK_only||| SvIOK_on||| SvIOKp||| SvIOK||| SvIVX||| SvIV_nomg|5.009001||p SvIV_set||| SvIVx||| SvIV||| SvIsCOW_shared_hash||5.008003| SvIsCOW||5.008003| SvLEN_set||| SvLEN||| SvLOCK||5.007003| SvMAGIC_set|5.009003||p SvNIOK_off||| SvNIOKp||| SvNIOK||| SvNOK_off||| SvNOK_only||| SvNOK_on||| SvNOKp||| SvNOK||| SvNVX||| SvNV_nomg||5.013002| SvNV_set||| SvNVx||| SvNV||| SvOK||| SvOOK_offset||5.011000| SvOOK||| SvPOK_off||| SvPOK_only_UTF8||5.006000| SvPOK_only||| SvPOK_on||| SvPOKp||| SvPOK||| SvPVX_const|5.009003||p SvPVX_mutable|5.009003||p SvPVX||| SvPV_const|5.009003||p SvPV_flags_const_nolen|5.009003||p SvPV_flags_const|5.009003||p SvPV_flags_mutable|5.009003||p SvPV_flags|5.007002||p SvPV_force_flags_mutable|5.009003||p SvPV_force_flags_nolen|5.009003||p SvPV_force_flags|5.007002||p SvPV_force_mutable|5.009003||p SvPV_force_nolen|5.009003||p SvPV_force_nomg_nolen|5.009003||p SvPV_force_nomg|5.007002||p SvPV_force|||p SvPV_mutable|5.009003||p SvPV_nolen_const|5.009003||p SvPV_nolen|5.006000||p SvPV_nomg_const_nolen|5.009003||p SvPV_nomg_const|5.009003||p SvPV_nomg_nolen|5.013007||p SvPV_nomg|5.007002||p SvPV_renew|5.009003||p SvPV_set||| SvPVbyte_force||5.009002| SvPVbyte_nolen||5.006000| SvPVbytex_force||5.006000| SvPVbytex||5.006000| SvPVbyte|5.006000||p SvPVutf8_force||5.006000| SvPVutf8_nolen||5.006000| SvPVutf8x_force||5.006000| SvPVutf8x||5.006000| SvPVutf8||5.006000| SvPVx||| SvPV||| SvREFCNT_dec_NN||5.017007| SvREFCNT_dec||| SvREFCNT_inc_NN|5.009004||p SvREFCNT_inc_simple_NN|5.009004||p SvREFCNT_inc_simple_void_NN|5.009004||p SvREFCNT_inc_simple_void|5.009004||p SvREFCNT_inc_simple|5.009004||p SvREFCNT_inc_void_NN|5.009004||p SvREFCNT_inc_void|5.009004||p SvREFCNT_inc|||p SvREFCNT||| SvROK_off||| SvROK_on||| SvROK||| SvRV_set|5.009003||p SvRV||| SvRXOK||5.009005| SvRX||5.009005| SvSETMAGIC||| SvSHARED_HASH|5.009003||p SvSHARE||5.007003| SvSTASH_set|5.009003||p SvSTASH||| SvSetMagicSV_nosteal||5.004000| SvSetMagicSV||5.004000| SvSetSV_nosteal||5.004000| SvSetSV||| SvTAINTED_off||5.004000| SvTAINTED_on||5.004000| SvTAINTED||5.004000| SvTAINT||| SvTHINKFIRST||| SvTRUE_nomg||5.013006| SvTRUE||| SvTYPE||| SvUNLOCK||5.007003| SvUOK|5.007001|5.006000|p SvUPGRADE||| SvUTF8_off||5.006000| SvUTF8_on||5.006000| SvUTF8||5.006000| SvUVXx|5.004000||p SvUVX|5.004000||p SvUV_nomg|5.009001||p SvUV_set|5.009003||p SvUVx|5.004000||p SvUV|5.004000||p SvVOK||5.008001| SvVSTRING_mg|5.009004||p THIS|||n UNDERBAR|5.009002||p UTF8_MAXBYTES|5.009002||p UVSIZE|5.006000||p UVTYPE|5.006000||p UVXf|5.007001||p UVof|5.006000||p UVuf|5.006000||p UVxf|5.006000||p WARN_ALL|5.006000||p WARN_AMBIGUOUS|5.006000||p WARN_ASSERTIONS|5.019002||p WARN_BAREWORD|5.006000||p WARN_CLOSED|5.006000||p WARN_CLOSURE|5.006000||p WARN_DEBUGGING|5.006000||p WARN_DEPRECATED|5.006000||p WARN_DIGIT|5.006000||p WARN_EXEC|5.006000||p WARN_EXITING|5.006000||p WARN_GLOB|5.006000||p WARN_INPLACE|5.006000||p WARN_INTERNAL|5.006000||p WARN_IO|5.006000||p WARN_LAYER|5.008000||p WARN_MALLOC|5.006000||p WARN_MISC|5.006000||p WARN_NEWLINE|5.006000||p WARN_NUMERIC|5.006000||p WARN_ONCE|5.006000||p WARN_OVERFLOW|5.006000||p WARN_PACK|5.006000||p WARN_PARENTHESIS|5.006000||p WARN_PIPE|5.006000||p WARN_PORTABLE|5.006000||p WARN_PRECEDENCE|5.006000||p WARN_PRINTF|5.006000||p WARN_PROTOTYPE|5.006000||p WARN_QW|5.006000||p WARN_RECURSION|5.006000||p WARN_REDEFINE|5.006000||p WARN_REGEXP|5.006000||p WARN_RESERVED|5.006000||p WARN_SEMICOLON|5.006000||p WARN_SEVERE|5.006000||p WARN_SIGNAL|5.006000||p WARN_SUBSTR|5.006000||p WARN_SYNTAX|5.006000||p WARN_TAINT|5.006000||p WARN_THREADS|5.008000||p WARN_UNINITIALIZED|5.006000||p WARN_UNOPENED|5.006000||p WARN_UNPACK|5.006000||p WARN_UNTIE|5.006000||p WARN_UTF8|5.006000||p WARN_VOID|5.006000||p WIDEST_UTYPE|5.015004||p XCPT_CATCH|5.009002||p XCPT_RETHROW|5.009002|5.007001|p XCPT_TRY_END|5.009002|5.004000|p XCPT_TRY_START|5.009002|5.004000|p XPUSHi||| XPUSHmortal|5.009002||p XPUSHn||| XPUSHp||| XPUSHs||| XPUSHu|5.004000||p XSPROTO|5.010000||p XSRETURN_EMPTY||| XSRETURN_IV||| XSRETURN_NO||| XSRETURN_NV||| XSRETURN_PV||| XSRETURN_UNDEF||| XSRETURN_UV|5.008001||p XSRETURN_YES||| XSRETURN|||p XST_mIV||| XST_mNO||| XST_mNV||| XST_mPV||| XST_mUNDEF||| XST_mUV|5.008001||p XST_mYES||| XS_APIVERSION_BOOTCHECK||5.013004| XS_EXTERNAL||5.019003| XS_INTERNAL||5.019003| XS_VERSION_BOOTCHECK||| XS_VERSION||| XSprePUSH|5.006000||p XS||| XopDISABLE||5.019003| XopENABLE||5.019003| XopENTRY_set||5.019003| XopENTRY||5.019003| XopFLAGS||5.013007| ZeroD|5.009002||p Zero||| _aMY_CXT|5.007003||p _add_range_to_invlist||| _append_range_to_invlist||| _core_swash_init||| _get_swash_invlist||| _invlist_array_init||| _invlist_contains_cp||| _invlist_contents||| _invlist_dump||| _invlist_intersection_maybe_complement_2nd||| _invlist_intersection||| _invlist_invert_prop||| _invlist_invert||| _invlist_len||| _invlist_populate_swatch||| _invlist_search||| _invlist_subtract||| _invlist_union_maybe_complement_2nd||| _invlist_union||| _is_uni_FOO||5.017008| _is_uni_perl_idcont||5.017008| _is_uni_perl_idstart||5.017007| _is_utf8_FOO||5.017008| _is_utf8_mark||5.017008| _is_utf8_perl_idcont||5.017008| _is_utf8_perl_idstart||5.017007| _new_invlist_C_array||| _new_invlist||| _pMY_CXT|5.007003||p _swash_inversion_hash||| _swash_to_invlist||| _to_fold_latin1||| _to_uni_fold_flags||5.013011| _to_upper_title_latin1||| _to_utf8_fold_flags||5.015006| _to_utf8_lower_flags||5.015006| _to_utf8_title_flags||5.015006| _to_utf8_upper_flags||5.015006| aMY_CXT_|5.007003||p aMY_CXT|5.007003||p aTHXR_|5.019002||p aTHXR|5.019002||p aTHX_|5.006000||p aTHX|5.006000||p aassign_common_vars||| add_cp_to_invlist||| add_data|||n add_utf16_textfilter||| addmad||| adjust_size_and_find_bucket|||n adjust_stack_on_leave||| alloc_maybe_populate_EXACT||| alloccopstash||| allocmy||| amagic_call||| amagic_cmp_locale||| amagic_cmp||| amagic_deref_call||5.013007| amagic_i_ncmp||| amagic_is_enabled||| amagic_ncmp||| anonymise_cv_maybe||| any_dup||| ao||| append_madprops||| apply_attrs_my||| apply_attrs_string||5.006001| apply_attrs||| apply||| assert_uft8_cache_coherent||| atfork_lock||5.007003|n atfork_unlock||5.007003|n av_arylen_p||5.009003| av_clear||| av_create_and_push||5.009005| av_create_and_unshift_one||5.009005| av_delete||5.006000| av_exists||5.006000| av_extend_guts||| av_extend||| av_fetch||| av_fill||| av_iter_p||5.011000| av_len||| av_make||| av_pop||| av_push||| av_reify||| av_shift||| av_store||| av_tindex||5.017009| av_top_index||5.017009| av_undef||| av_unshift||| ax|||n bad_type_gv||| bad_type_pv||| bind_match||| block_end||| block_gimme||5.004000| block_start||| blockhook_register||5.013003| boolSV|5.004000||p boot_core_PerlIO||| boot_core_UNIVERSAL||| boot_core_mro||| bytes_cmp_utf8||5.013007| bytes_from_utf8||5.007001| bytes_to_uni|||n bytes_to_utf8||5.006001| call_argv|5.006000||p call_atexit||5.006000| call_list||5.004000| call_method|5.006000||p call_pv|5.006000||p call_sv|5.006000||p caller_cx||5.013005| calloc||5.007002|n cando||| cast_i32||5.006000| cast_iv||5.006000| cast_ulong||5.006000| cast_uv||5.006000| check_locale_boundary_crossing||| check_type_and_open||| check_uni||| check_utf8_print||| checkcomma||| ckWARN|5.006000||p ck_entersub_args_core||| ck_entersub_args_list||5.013006| ck_entersub_args_proto_or_list||5.013006| ck_entersub_args_proto||5.013006| ck_warner_d||5.011001|v ck_warner||5.011001|v ckwarn_common||| ckwarn_d||5.009003| ckwarn||5.009003| cl_and|||n cl_anything|||n cl_init|||n cl_is_anything|||n cl_or|||n clear_placeholders||| clone_params_del|||n clone_params_new|||n closest_cop||| compute_EXACTish||| convert||| cop_fetch_label||5.015001| cop_free||| cop_hints_2hv||5.013007| cop_hints_fetch_pvn||5.013007| cop_hints_fetch_pvs||5.013007| cop_hints_fetch_pv||5.013007| cop_hints_fetch_sv||5.013007| cop_store_label||5.015001| cophh_2hv||5.013007| cophh_copy||5.013007| cophh_delete_pvn||5.013007| cophh_delete_pvs||5.013007| cophh_delete_pv||5.013007| cophh_delete_sv||5.013007| cophh_fetch_pvn||5.013007| cophh_fetch_pvs||5.013007| cophh_fetch_pv||5.013007| cophh_fetch_sv||5.013007| cophh_free||5.013007| cophh_new_empty||5.019003| cophh_store_pvn||5.013007| cophh_store_pvs||5.013007| cophh_store_pv||5.013007| cophh_store_sv||5.013007| core_prototype||| core_regclass_swash||| coresub_op||| could_it_be_a_POSIX_class||| cr_textfilter||| create_eval_scope||| croak_memory_wrap||5.019003|n croak_no_mem|||n croak_no_modify||5.013003|n croak_nocontext|||vn croak_popstack|||n croak_sv||5.013001| croak_xs_usage||5.010001|n croak|||v csighandler||5.009003|n curmad||| current_re_engine||| curse||| custom_op_desc||5.007003| custom_op_name||5.007003| custom_op_register||5.013007| custom_op_xop||5.013007| cv_ckproto_len_flags||| cv_clone_into||| cv_clone||| cv_const_sv_or_av||| cv_const_sv||5.004000| cv_dump||| cv_forget_slab||| cv_get_call_checker||5.013006| cv_set_call_checker||5.013006| cv_undef||| cvgv_set||| cvstash_set||| cx_dump||5.005000| cx_dup||| cxinc||| dAXMARK|5.009003||p dAX|5.007002||p dITEMS|5.007002||p dMARK||| dMULTICALL||5.009003| dMY_CXT_SV|5.007003||p dMY_CXT|5.007003||p dNOOP|5.006000||p dORIGMARK||| dSP||| dTHR|5.004050||p dTHXR|5.019002||p dTHXa|5.006000||p dTHXoa|5.006000||p dTHX|5.006000||p dUNDERBAR|5.009002||p dVAR|5.009003||p dXCPT|5.009002||p dXSARGS||| dXSI32||| dXSTARG|5.006000||p deb_curcv||| deb_nocontext|||vn deb_stack_all||| deb_stack_n||| debop||5.005000| debprofdump||5.005000| debprof||| debstackptrs||5.007003| debstack||5.007003| debug_start_match||| deb||5.007003|v defelem_target||| del_sv||| delete_eval_scope||| delimcpy||5.004000|n deprecate_commaless_var_list||| despatch_signals||5.007001| destroy_matcher||| die_nocontext|||vn die_sv||5.013001| die_unwind||| die|||v dirp_dup||| div128||| djSP||| do_aexec5||| do_aexec||| do_aspawn||| do_binmode||5.004050| do_chomp||| do_close||| do_delete_local||| do_dump_pad||| do_eof||| do_exec3||| do_execfree||| do_exec||| do_gv_dump||5.006000| do_gvgv_dump||5.006000| do_hv_dump||5.006000| do_ipcctl||| do_ipcget||| do_join||| do_magic_dump||5.006000| do_msgrcv||| do_msgsnd||| do_ncmp||| do_oddball||| do_op_dump||5.006000| do_op_xmldump||| do_open9||5.006000| do_openn||5.007001| do_open||5.004000| do_pmop_dump||5.006000| do_pmop_xmldump||| do_print||| do_readline||| do_seek||| do_semop||| do_shmio||| do_smartmatch||| do_spawn_nowait||| do_spawn||| do_sprintf||| do_sv_dump||5.006000| do_sysseek||| do_tell||| do_trans_complex_utf8||| do_trans_complex||| do_trans_count_utf8||| do_trans_count||| do_trans_simple_utf8||| do_trans_simple||| do_trans||| do_vecget||| do_vecset||| do_vop||| docatch||| doeval||| dofile||| dofindlabel||| doform||| doing_taint||5.008001|n dooneliner||| doopen_pm||| doparseform||| dopoptoeval||| dopoptogiven||| dopoptolabel||| dopoptoloop||| dopoptosub_at||| dopoptowhen||| doref||5.009003| dounwind||| dowantarray||| dump_all_perl||| dump_all||5.006000| dump_eval||5.006000| dump_exec_pos||| dump_fds||| dump_form||5.006000| dump_indent||5.006000|v dump_mstats||| dump_packsubs_perl||| dump_packsubs||5.006000| dump_sub_perl||| dump_sub||5.006000| dump_sv_child||| dump_trie_interim_list||| dump_trie_interim_table||| dump_trie||| dump_vindent||5.006000| dumpuntil||| dup_attrlist||| emulate_cop_io||| eval_pv|5.006000||p eval_sv|5.006000||p exec_failed||| expect_number||| fbm_compile||5.005000| fbm_instr||5.005000| feature_is_enabled||| filter_add||| filter_del||| filter_gets||| filter_read||| finalize_optree||| finalize_op||| find_and_forget_pmops||| find_array_subscript||| find_beginning||| find_byclass||| find_hash_subscript||| find_in_my_stash||| find_lexical_cv||| find_runcv_where||| find_runcv||5.008001| find_rundefsv2||| find_rundefsvoffset||5.009002| find_rundefsv||5.013002| find_script||| find_uninit_var||| first_symbol|||n foldEQ_latin1||5.013008|n foldEQ_locale||5.013002|n foldEQ_utf8_flags||5.013010| foldEQ_utf8||5.013002| foldEQ||5.013002|n fold_constants||| forbid_setid||| force_ident_maybe_lex||| force_ident||| force_list||| force_next||| force_strict_version||| force_version||| force_word||| forget_pmop||| form_nocontext|||vn form_short_octal_warning||| form||5.004000|v fp_dup||| fprintf_nocontext|||vn free_global_struct||| free_tied_hv_pool||| free_tmps||| gen_constant_list||| get_and_check_backslash_N_name||| get_aux_mg||| get_av|5.006000||p get_context||5.006000|n get_cvn_flags|5.009005||p get_cvs|5.011000||p get_cv|5.006000||p get_db_sub||| get_debug_opts||| get_hash_seed||| get_hv|5.006000||p get_invlist_iter_addr||| get_invlist_offset_addr||| get_invlist_previous_index_addr||| get_mstats||| get_no_modify||| get_num||| get_op_descs||5.005000| get_op_names||5.005000| get_opargs||| get_ppaddr||5.006000| get_re_arg||| get_sv|5.006000||p get_vtbl||5.005030| getcwd_sv||5.007002| getenv_len||| glob_2number||| glob_assign_glob||| glob_assign_ref||| gp_dup||| gp_free||| gp_ref||| grok_bin|5.007003||p grok_bslash_N||| grok_bslash_c||| grok_bslash_o||| grok_bslash_x||| grok_hex|5.007003||p grok_number|5.007002||p grok_numeric_radix|5.007002||p grok_oct|5.007003||p group_end||| gv_AVadd||| gv_HVadd||| gv_IOadd||| gv_SVadd||| gv_add_by_type||5.011000| gv_autoload4||5.004000| gv_autoload_pvn||5.015004| gv_autoload_pv||5.015004| gv_autoload_sv||5.015004| gv_check||| gv_const_sv||5.009003| gv_dump||5.006000| gv_efullname3||5.004000| gv_efullname4||5.006001| gv_efullname||| gv_ename||| gv_fetchfile_flags||5.009005| gv_fetchfile||| gv_fetchmeth_autoload||5.007003| gv_fetchmeth_pv_autoload||5.015004| gv_fetchmeth_pvn_autoload||5.015004| gv_fetchmeth_pvn||5.015004| gv_fetchmeth_pv||5.015004| gv_fetchmeth_sv_autoload||5.015004| gv_fetchmeth_sv||5.015004| gv_fetchmethod_autoload||5.004000| gv_fetchmethod_pv_flags||5.015004| gv_fetchmethod_pvn_flags||5.015004| gv_fetchmethod_sv_flags||5.015004| gv_fetchmethod||| gv_fetchmeth||| gv_fetchpvn_flags|5.009002||p gv_fetchpvs|5.009004||p gv_fetchpv||| gv_fetchsv|5.009002||p gv_fullname3||5.004000| gv_fullname4||5.006001| gv_fullname||| gv_handler||5.007001| gv_init_pvn||5.015004| gv_init_pv||5.015004| gv_init_svtype||| gv_init_sv||5.015004| gv_init||| gv_magicalize_isa||| gv_name_set||5.009004| gv_stashpvn|5.004000||p gv_stashpvs|5.009003||p gv_stashpv||| gv_stashsv||| gv_try_downgrade||| handle_regex_sets||| he_dup||| hek_dup||| hfree_next_entry||| hfreeentries||| hsplit||| hv_assert||| hv_auxinit||| hv_backreferences_p||| hv_clear_placeholders||5.009001| hv_clear||| hv_common_key_len||5.010000| hv_common||5.010000| hv_copy_hints_hv||5.009004| hv_delayfree_ent||5.004000| hv_delete_common||| hv_delete_ent||5.004000| hv_delete||| hv_eiter_p||5.009003| hv_eiter_set||5.009003| hv_ename_add||| hv_ename_delete||| hv_exists_ent||5.004000| hv_exists||| hv_fetch_ent||5.004000| hv_fetchs|5.009003||p hv_fetch||| hv_fill||5.013002| hv_free_ent_ret||| hv_free_ent||5.004000| hv_iterinit||| hv_iterkeysv||5.004000| hv_iterkey||| hv_iternext_flags||5.008000| hv_iternextsv||| hv_iternext||| hv_iterval||| hv_kill_backrefs||| hv_ksplit||5.004000| hv_magic_check|||n hv_magic||| hv_name_set||5.009003| hv_notallowed||| hv_placeholders_get||5.009003| hv_placeholders_p||| hv_placeholders_set||5.009003| hv_rand_set||5.017011| hv_riter_p||5.009003| hv_riter_set||5.009003| hv_scalar||5.009001| hv_store_ent||5.004000| hv_store_flags||5.008000| hv_stores|5.009004||p hv_store||| hv_undef_flags||| hv_undef||| ibcmp_locale||5.004000| ibcmp_utf8||5.007003| ibcmp||| incline||| incpush_if_exists||| incpush_use_sep||| incpush||| ingroup||| init_argv_symbols||| init_constants||| init_dbargs||| init_debugger||| init_global_struct||| init_i18nl10n||5.006000| init_i18nl14n||5.006000| init_ids||| init_interp||| init_main_stash||| init_perllib||| init_postdump_symbols||| init_predump_symbols||| init_stacks||5.005000| init_tm||5.007002| inplace_aassign||| instr|||n intro_my||| intuit_method||| intuit_more||| invert||| invlist_array||| invlist_clone||| invlist_extend||| invlist_highest||| invlist_is_iterating||| invlist_iterfinish||| invlist_iterinit||| invlist_iternext||| invlist_max||| invlist_previous_index||| invlist_set_len||| invlist_set_previous_index||| invlist_trim||| invoke_exception_hook||| io_close||| isALNUMC|5.006000||p isALNUM_lazy||| isALPHANUMERIC||5.017008| isALPHA||| isASCII|5.006000|5.006000|p isBLANK|5.006001||p isCNTRL|5.006000|5.006000|p isDIGIT||| isFOO_lc||| isFOO_utf8_lc||| isGRAPH|5.006000||p isGV_with_GP|5.009004||p isIDCONT||5.017008| isIDFIRST_lazy||| isIDFIRST||| isLOWER||| isOCTAL||5.013005| isPRINT|5.004000||p isPSXSPC|5.006001||p isPUNCT|5.006000||p isSPACE||| isUPPER||| isWORDCHAR||5.013006| isXDIGIT|5.006000||p is_an_int||| is_ascii_string||5.011000|n is_cur_LC_category_utf8||| is_handle_constructor|||n is_list_assignment||| is_lvalue_sub||5.007001| is_uni_alnum_lc||5.006000| is_uni_alnumc_lc||5.017007| is_uni_alnumc||5.017007| is_uni_alnum||5.006000| is_uni_alpha_lc||5.006000| is_uni_alpha||5.006000| is_uni_ascii_lc||5.006000| is_uni_ascii||5.006000| is_uni_blank_lc||5.017002| is_uni_blank||5.017002| is_uni_cntrl_lc||5.006000| is_uni_cntrl||5.006000| is_uni_digit_lc||5.006000| is_uni_digit||5.006000| is_uni_graph_lc||5.006000| is_uni_graph||5.006000| is_uni_idfirst_lc||5.006000| is_uni_idfirst||5.006000| is_uni_lower_lc||5.006000| is_uni_lower||5.006000| is_uni_print_lc||5.006000| is_uni_print||5.006000| is_uni_punct_lc||5.006000| is_uni_punct||5.006000| is_uni_space_lc||5.006000| is_uni_space||5.006000| is_uni_upper_lc||5.006000| is_uni_upper||5.006000| is_uni_xdigit_lc||5.006000| is_uni_xdigit||5.006000| is_utf8_alnumc||5.017007| is_utf8_alnum||5.006000| is_utf8_alpha||5.006000| is_utf8_ascii||5.006000| is_utf8_blank||5.017002| is_utf8_char_buf||5.015008|n is_utf8_char_slow|||n is_utf8_char||5.006000|n is_utf8_cntrl||5.006000| is_utf8_common||| is_utf8_digit||5.006000| is_utf8_graph||5.006000| is_utf8_idcont||5.008000| is_utf8_idfirst||5.006000| is_utf8_lower||5.006000| is_utf8_mark||5.006000| is_utf8_perl_space||5.011001| is_utf8_perl_word||5.011001| is_utf8_posix_digit||5.011001| is_utf8_print||5.006000| is_utf8_punct||5.006000| is_utf8_space||5.006000| is_utf8_string_loclen||5.009003|n is_utf8_string_loc||5.008001|n is_utf8_string||5.006001|n is_utf8_upper||5.006000| is_utf8_xdigit||5.006000| is_utf8_xidcont||5.013010| is_utf8_xidfirst||5.013010| isa_lookup||| items|||n ix|||n jmaybe||| join_exact||| keyword_plugin_standard||| keyword||| leave_scope||| lex_bufutf8||5.011002| lex_discard_to||5.011002| lex_grow_linestr||5.011002| lex_next_chunk||5.011002| lex_peek_unichar||5.011002| lex_read_space||5.011002| lex_read_to||5.011002| lex_read_unichar||5.011002| lex_start||5.009005| lex_stuff_pvn||5.011002| lex_stuff_pvs||5.013005| lex_stuff_pv||5.013006| lex_stuff_sv||5.011002| lex_unstuff||5.011002| listkids||| list||| load_module_nocontext|||vn load_module|5.006000||pv localize||| looks_like_bool||| looks_like_number||| lop||| mPUSHi|5.009002||p mPUSHn|5.009002||p mPUSHp|5.009002||p mPUSHs|5.010001||p mPUSHu|5.009002||p mXPUSHi|5.009002||p mXPUSHn|5.009002||p mXPUSHp|5.009002||p mXPUSHs|5.010001||p mXPUSHu|5.009002||p mad_free||| madlex||| madparse||| magic_clear_all_env||| magic_cleararylen_p||| magic_clearenv||| magic_clearhints||| magic_clearhint||| magic_clearisa||| magic_clearpack||| magic_clearsig||| magic_copycallchecker||| magic_dump||5.006000| magic_existspack||| magic_freearylen_p||| magic_freeovrld||| magic_getarylen||| magic_getdefelem||| magic_getnkeys||| magic_getpack||| magic_getpos||| magic_getsig||| magic_getsubstr||| magic_gettaint||| magic_getuvar||| magic_getvec||| magic_get||| magic_killbackrefs||| magic_methcall1||| magic_methcall|||v magic_methpack||| magic_nextpack||| magic_regdata_cnt||| magic_regdatum_get||| magic_regdatum_set||| magic_scalarpack||| magic_set_all_env||| magic_setarylen||| magic_setcollxfrm||| magic_setdbline||| magic_setdefelem||| magic_setenv||| magic_sethint||| magic_setisa||| magic_setmglob||| magic_setnkeys||| magic_setpack||| magic_setpos||| magic_setregexp||| magic_setsig||| magic_setsubstr||| magic_settaint||| magic_setutf8||| magic_setuvar||| magic_setvec||| magic_set||| magic_sizepack||| magic_wipepack||| make_matcher||| make_trie_failtable||| make_trie||| malloc_good_size|||n malloced_size|||n malloc||5.007002|n markstack_grow||| matcher_matches_sv||| mayberelocate||| measure_struct||| memEQs|5.009005||p memEQ|5.004000||p memNEs|5.009005||p memNE|5.004000||p mem_collxfrm||| mem_log_common|||n mess_alloc||| mess_nocontext|||vn mess_sv||5.013001| mess||5.006000|v method_common||| mfree||5.007002|n mg_clear||| mg_copy||| mg_dup||| mg_find_mglob||| mg_findext||5.013008| mg_find||| mg_free_type||5.013006| mg_free||| mg_get||| mg_length||5.005000| mg_localize||| mg_magical||| mg_set||| mg_size||5.005000| mini_mktime||5.007002| minus_v||| missingterm||| mode_from_discipline||| modkids||| more_bodies||| more_sv||| moreswitches||| mro_clean_isarev||| mro_gather_and_rename||| mro_get_from_name||5.010001| mro_get_linear_isa_dfs||| mro_get_linear_isa||5.009005| mro_get_private_data||5.010001| mro_isa_changed_in||| mro_meta_dup||| mro_meta_init||| mro_method_changed_in||5.009005| mro_package_moved||| mro_register||5.010001| mro_set_mro||5.010001| mro_set_private_data||5.010001| mul128||| mulexp10|||n my_atof2||5.007002| my_atof||5.006000| my_attrs||| my_bcopy|||n my_bzero|||n my_chsize||| my_clearenv||| my_cxt_index||| my_cxt_init||| my_dirfd||5.009005| my_exit_jump||| my_exit||| my_failure_exit||5.004000| my_fflush_all||5.006000| my_fork||5.007003|n my_kid||| my_lstat_flags||| my_lstat||5.019003| my_memcmp|||n my_memset||5.004000|n my_pclose||5.004000| my_popen_list||5.007001| my_popen||5.004000| my_setenv||| my_snprintf|5.009004||pvn my_socketpair||5.007003|n my_sprintf|5.009003||pvn my_stat_flags||| my_stat||5.019003| my_strftime||5.007002| my_strlcat|5.009004||pn my_strlcpy|5.009004||pn my_unexec||| my_vsnprintf||5.009004|n need_utf8|||n newANONATTRSUB||5.006000| newANONHASH||| newANONLIST||| newANONSUB||| newASSIGNOP||| newATTRSUB_flags||| newATTRSUB||5.006000| newAVREF||| newAV||| newBINOP||| newCONDOP||| newCONSTSUB_flags||5.015006| newCONSTSUB|5.004050||p newCVREF||| newDEFSVOP||| newFORM||| newFOROP||5.013007| newGIVENOP||5.009003| newGIVWHENOP||| newGP||| newGVOP||| newGVREF||| newGVgen_flags||5.015004| newGVgen||| newHVREF||| newHVhv||5.005000| newHV||| newIO||| newLISTOP||| newLOGOP||| newLOOPEX||| newLOOPOP||| newMADPROP||| newMADsv||| newMYSUB||5.017004| newNULLLIST||| newOP||| newPADOP||| newPMOP||| newPROG||| newPVOP||| newRANGE||| newRV_inc|5.004000||p newRV_noinc|5.004000||p newRV||| newSLICEOP||| newSTATEOP||| newSTUB||| newSUB||| newSVOP||| newSVREF||| newSV_type|5.009005||p newSVhek||5.009003| newSViv||| newSVnv||| newSVpadname||5.017004| newSVpv_share||5.013006| newSVpvf_nocontext|||vn newSVpvf||5.004000|v newSVpvn_flags|5.010001||p newSVpvn_share|5.007001||p newSVpvn_utf8|5.010001||p newSVpvn|5.004050||p newSVpvs_flags|5.010001||p newSVpvs_share|5.009003||p newSVpvs|5.009003||p newSVpv||| newSVrv||| newSVsv||| newSVuv|5.006000||p newSV||| newTOKEN||| newUNOP||| newWHENOP||5.009003| newWHILEOP||5.013007| newXS_flags||5.009004| newXS_len_flags||| newXSproto||5.006000| newXS||5.006000| new_collate||5.006000| new_constant||| new_ctype||5.006000| new_he||| new_logop||| new_numeric||5.006000| new_stackinfo||5.005000| new_version||5.009000| new_warnings_bitfield||| next_symbol||| nextargv||| nextchar||| ninstr|||n no_bareword_allowed||| no_fh_allowed||| no_op||| not_a_number||| not_incrementable||| nothreadhook||5.008000| nuke_stacks||| num_overflow|||n oopsAV||| oopsHV||| op_append_elem||5.013006| op_append_list||5.013006| op_clear||| op_const_sv||| op_contextualize||5.013006| op_dump||5.006000| op_free||| op_getmad_weak||| op_getmad||| op_integerize||| op_linklist||5.013006| op_lvalue_flags||| op_lvalue||5.013007| op_null||5.007002| op_prepend_elem||5.013006| op_refcnt_dec||| op_refcnt_inc||| op_refcnt_lock||5.009002| op_refcnt_unlock||5.009002| op_scope||5.013007| op_std_init||| op_unscope||| op_xmldump||| open_script||| opslab_force_free||| opslab_free_nopad||| opslab_free||| pMY_CXT_|5.007003||p pMY_CXT|5.007003||p pTHX_|5.006000||p pTHX|5.006000||p packWARN|5.007003||p pack_cat||5.007003| pack_rec||| package_version||| package||| packlist||5.008001| pad_add_anon||5.008001| pad_add_name_pvn||5.015001| pad_add_name_pvs||5.015001| pad_add_name_pv||5.015001| pad_add_name_sv||5.015001| pad_alloc_name||| pad_alloc||| pad_block_start||| pad_check_dup||| pad_compname_type||5.009003| pad_findlex||| pad_findmy_pvn||5.015001| pad_findmy_pvs||5.015001| pad_findmy_pv||5.015001| pad_findmy_sv||5.015001| pad_fixup_inner_anons||| pad_free||| pad_leavemy||| pad_new||5.008001| pad_peg|||n pad_push||| pad_reset||| pad_setsv||| pad_sv||| pad_swipe||| pad_tidy||5.008001| padlist_dup||| padlist_store||| parse_arithexpr||5.013008| parse_barestmt||5.013007| parse_block||5.013007| parse_body||| parse_fullexpr||5.013008| parse_fullstmt||5.013005| parse_ident||| parse_label||5.013007| parse_listexpr||5.013008| parse_lparen_question_flags||| parse_stmtseq||5.013006| parse_termexpr||5.013008| parse_unicode_opts||| parser_dup||| parser_free_nexttoke_ops||| parser_free||| path_is_searchable|||n peep||| pending_ident||| perl_alloc_using|||n perl_alloc|||n perl_clone_using|||n perl_clone|||n perl_construct|||n perl_destruct||5.007003|n perl_free|||n perl_parse||5.006000|n perl_run|||n pidgone||| pm_description||| pmop_dump||5.006000| pmop_xmldump||| pmruntime||| pmtrans||| pop_scope||| populate_isa|||v pregcomp||5.009005| pregexec||| pregfree2||5.011000| pregfree||| prepend_madprops||| prescan_version||5.011004| printbuf||| printf_nocontext|||vn process_special_blocks||| ptr_hash|||n ptr_table_clear||5.009005| ptr_table_fetch||5.009005| ptr_table_find|||n ptr_table_free||5.009005| ptr_table_new||5.009005| ptr_table_split||5.009005| ptr_table_store||5.009005| push_scope||| put_byte||| put_latin1_charclass_innards||| pv_display|5.006000||p pv_escape|5.009004||p pv_pretty|5.009004||p pv_uni_display||5.007003| qerror||| qsortsvu||| re_compile||5.009005| re_croak2||| re_dup_guts||| re_intuit_start||5.019001| re_intuit_string||5.006000| re_op_compile||| readpipe_override||| realloc||5.007002|n reentrant_free||5.019003| reentrant_init||5.019003| reentrant_retry||5.019003|vn reentrant_size||5.019003| ref_array_or_hash||| refcounted_he_chain_2hv||| refcounted_he_fetch_pvn||| refcounted_he_fetch_pvs||| refcounted_he_fetch_pv||| refcounted_he_fetch_sv||| refcounted_he_free||| refcounted_he_inc||| refcounted_he_new_pvn||| refcounted_he_new_pvs||| refcounted_he_new_pv||| refcounted_he_new_sv||| refcounted_he_value||| refkids||| refto||| ref||5.019003| reg_check_named_buff_matched||| reg_named_buff_all||5.009005| reg_named_buff_exists||5.009005| reg_named_buff_fetch||5.009005| reg_named_buff_firstkey||5.009005| reg_named_buff_iter||| reg_named_buff_nextkey||5.009005| reg_named_buff_scalar||5.009005| reg_named_buff||| reg_node||| reg_numbered_buff_fetch||| reg_numbered_buff_length||| reg_numbered_buff_store||| reg_qr_package||| reg_recode||| reg_scan_name||| reg_skipcomment||| reg_temp_copy||| reganode||| regatom||| regbranch||| regclass_swash||5.009004| regclass||| regcppop||| regcppush||| regcurly||| regdump_extflags||| regdump_intflags||| regdump||5.005000| regdupe_internal||| regexec_flags||5.005000| regfree_internal||5.009005| reghop3|||n reghop4|||n reghopmaybe3|||n reginclass||| reginitcolors||5.006000| reginsert||| regmatch||| regnext||5.005000| regpatws|||n regpiece||| regpposixcc||| regprop||| regrepeat||| regtail_study||| regtail||| regtry||| reguni||| regwhite|||n reg||| repeatcpy|||n report_evil_fh||| report_redefined_cv||| report_uninit||| report_wrongway_fh||| require_pv||5.006000| require_tie_mod||| restore_magic||| rninstr|||n rpeep||| rsignal_restore||| rsignal_save||| rsignal_state||5.004000| rsignal||5.004000| run_body||| run_user_filter||| runops_debug||5.005000| runops_standard||5.005000| rv2cv_op_cv||5.013006| rvpv_dup||| rxres_free||| rxres_restore||| rxres_save||| safesyscalloc||5.006000|n safesysfree||5.006000|n safesysmalloc||5.006000|n safesysrealloc||5.006000|n same_dirent||| save_I16||5.004000| save_I32||| save_I8||5.006000| save_adelete||5.011000| save_aelem_flags||5.011000| save_aelem||5.004050| save_alloc||5.006000| save_aptr||| save_ary||| save_bool||5.008001| save_clearsv||| save_delete||| save_destructor_x||5.006000| save_destructor||5.006000| save_freeop||| save_freepv||| save_freesv||| save_generic_pvref||5.006001| save_generic_svref||5.005030| save_gp||5.004000| save_hash||| save_hdelete||5.011000| save_hek_flags|||n save_helem_flags||5.011000| save_helem||5.004050| save_hints||5.010001| save_hptr||| save_int||| save_item||| save_iv||5.005000| save_lines||| save_list||| save_long||| save_magic_flags||| save_mortalizesv||5.007001| save_nogv||| save_op||5.005000| save_padsv_and_mortalize||5.010001| save_pptr||| save_pushi32ptr||5.010001| save_pushptri32ptr||| save_pushptrptr||5.010001| save_pushptr||5.010001| save_re_context||5.006000| save_scalar_at||| save_scalar||| save_set_svflags||5.009000| save_shared_pvref||5.007003| save_sptr||| save_svref||| save_vptr||5.006000| savepvn||| savepvs||5.009003| savepv||| savesharedpvn||5.009005| savesharedpvs||5.013006| savesharedpv||5.007003| savesharedsvpv||5.013006| savestack_grow_cnt||5.008001| savestack_grow||| savesvpv||5.009002| sawparens||| scalar_mod_type|||n scalarboolean||| scalarkids||| scalarseq||| scalarvoid||| scalar||| scan_bin||5.006000| scan_commit||| scan_const||| scan_formline||| scan_heredoc||| scan_hex||| scan_ident||| scan_inputsymbol||| scan_num||5.007001| scan_oct||| scan_pat||| scan_str||| scan_subst||| scan_trans||| scan_version||5.009001| scan_vstring||5.009005| scan_word||| screaminstr||5.005000| search_const||| seed||5.008001| sequence_num||| set_context||5.006000|n set_numeric_local||5.006000| set_numeric_radix||5.006000| set_numeric_standard||5.006000| setdefout||| share_hek_flags||| share_hek||5.004000| si_dup||| sighandler|||n simplify_sort||| skipspace0||| skipspace1||| skipspace2||| skipspace_flags||| softref2xv||| sortcv_stacked||| sortcv_xsub||| sortcv||| sortsv_flags||5.009003| sortsv||5.007003| space_join_names_mortal||| ss_dup||| stack_grow||| start_force||| start_glob||| start_subparse||5.004000| stdize_locale||| strEQ||| strGE||| strGT||| strLE||| strLT||| strNE||| str_to_version||5.006000| strip_return||| strnEQ||| strnNE||| study_chunk||| sub_crush_depth||| sublex_done||| sublex_push||| sublex_start||| sv_2bool_flags||5.013006| sv_2bool||| sv_2cv||| sv_2io||| sv_2iuv_common||| sv_2iuv_non_preserve||| sv_2iv_flags||5.009001| sv_2iv||| sv_2mortal||| sv_2num||| sv_2nv_flags||5.013001| sv_2pv_flags|5.007002||p sv_2pv_nolen|5.006000||p sv_2pvbyte_nolen|5.006000||p sv_2pvbyte|5.006000||p sv_2pvutf8_nolen||5.006000| sv_2pvutf8||5.006000| sv_2pv||| sv_2uv_flags||5.009001| sv_2uv|5.004000||p sv_add_arena||| sv_add_backref||| sv_backoff||| sv_bless||| sv_cat_decode||5.008001| sv_catpv_flags||5.013006| sv_catpv_mg|5.004050||p sv_catpv_nomg||5.013006| sv_catpvf_mg_nocontext|||pvn sv_catpvf_mg|5.006000|5.004000|pv sv_catpvf_nocontext|||vn sv_catpvf||5.004000|v sv_catpvn_flags||5.007002| sv_catpvn_mg|5.004050||p sv_catpvn_nomg|5.007002||p sv_catpvn||| sv_catpvs_flags||5.013006| sv_catpvs_mg||5.013006| sv_catpvs_nomg||5.013006| sv_catpvs|5.009003||p sv_catpv||| sv_catsv_flags||5.007002| sv_catsv_mg|5.004050||p sv_catsv_nomg|5.007002||p sv_catsv||| sv_catxmlpvn||| sv_catxmlpv||| sv_catxmlsv||| sv_chop||| sv_clean_all||| sv_clean_objs||| sv_clear||| sv_cmp_flags||5.013006| sv_cmp_locale_flags||5.013006| sv_cmp_locale||5.004000| sv_cmp||| sv_collxfrm_flags||5.013006| sv_collxfrm||| sv_copypv_flags||5.017002| sv_copypv_nomg||5.017002| sv_copypv||| sv_dec_nomg||5.013002| sv_dec||| sv_del_backref||| sv_derived_from_pvn||5.015004| sv_derived_from_pv||5.015004| sv_derived_from_sv||5.015004| sv_derived_from||5.004000| sv_destroyable||5.010000| sv_display||| sv_does_pvn||5.015004| sv_does_pv||5.015004| sv_does_sv||5.015004| sv_does||5.009004| sv_dump||| sv_dup_common||| sv_dup_inc_multiple||| sv_dup_inc||| sv_dup||| sv_eq_flags||5.013006| sv_eq||| sv_exp_grow||| sv_force_normal_flags||5.007001| sv_force_normal||5.006000| sv_free2||| sv_free_arenas||| sv_free||| sv_gets||5.004000| sv_grow||| sv_i_ncmp||| sv_inc_nomg||5.013002| sv_inc||| sv_insert_flags||5.010001| sv_insert||| sv_isa||| sv_isobject||| sv_iv||5.005000| sv_kill_backrefs||| sv_len_utf8_nomg||| sv_len_utf8||5.006000| sv_len||| sv_magic_portable|5.019003|5.004000|p sv_magicext_mglob||| sv_magicext||5.007003| sv_magic||| sv_mortalcopy_flags||| sv_mortalcopy||| sv_ncmp||| sv_newmortal||| sv_newref||| sv_nolocking||5.007003| sv_nosharing||5.007003| sv_nounlocking||| sv_nv||5.005000| sv_peek||5.005000| sv_pos_b2u_flags||5.019003| sv_pos_b2u_midway||| sv_pos_b2u||5.006000| sv_pos_u2b_cached||| sv_pos_u2b_flags||5.011005| sv_pos_u2b_forwards|||n sv_pos_u2b_midway|||n sv_pos_u2b||5.006000| sv_pvbyten_force||5.006000| sv_pvbyten||5.006000| sv_pvbyte||5.006000| sv_pvn_force_flags|5.007002||p sv_pvn_force||| sv_pvn_nomg|5.007003|5.005000|p sv_pvn||5.005000| sv_pvutf8n_force||5.006000| sv_pvutf8n||5.006000| sv_pvutf8||5.006000| sv_pv||5.006000| sv_recode_to_utf8||5.007003| sv_reftype||| sv_ref||| sv_release_COW||| sv_replace||| sv_report_used||| sv_resetpvn||| sv_reset||| sv_rvweaken||5.006000| sv_sethek||| sv_setiv_mg|5.004050||p sv_setiv||| sv_setnv_mg|5.006000||p sv_setnv||| sv_setpv_mg|5.004050||p sv_setpvf_mg_nocontext|||pvn sv_setpvf_mg|5.006000|5.004000|pv sv_setpvf_nocontext|||vn sv_setpvf||5.004000|v sv_setpviv_mg||5.008001| sv_setpviv||5.008001| sv_setpvn_mg|5.004050||p sv_setpvn||| sv_setpvs_mg||5.013006| sv_setpvs|5.009004||p sv_setpv||| sv_setref_iv||| sv_setref_nv||| sv_setref_pvn||| sv_setref_pvs||5.019003| sv_setref_pv||| sv_setref_uv||5.007001| sv_setsv_cow||| sv_setsv_flags||5.007002| sv_setsv_mg|5.004050||p sv_setsv_nomg|5.007002||p sv_setsv||| sv_setuv_mg|5.004050||p sv_setuv|5.004000||p sv_tainted||5.004000| sv_taint||5.004000| sv_true||5.005000| sv_unglob||| sv_uni_display||5.007003| sv_unmagicext||5.013008| sv_unmagic||| sv_unref_flags||5.007001| sv_unref||| sv_untaint||5.004000| sv_upgrade||| sv_usepvn_flags||5.009004| sv_usepvn_mg|5.004050||p sv_usepvn||| sv_utf8_decode||5.006000| sv_utf8_downgrade||5.006000| sv_utf8_encode||5.006000| sv_utf8_upgrade_flags_grow||5.011000| sv_utf8_upgrade_flags||5.007002| sv_utf8_upgrade_nomg||5.007002| sv_utf8_upgrade||5.007001| sv_uv|5.005000||p sv_vcatpvf_mg|5.006000|5.004000|p sv_vcatpvfn_flags||5.017002| sv_vcatpvfn||5.004000| sv_vcatpvf|5.006000|5.004000|p sv_vsetpvf_mg|5.006000|5.004000|p sv_vsetpvfn||5.004000| sv_vsetpvf|5.006000|5.004000|p sv_xmlpeek||| svtype||| swallow_bom||| swash_fetch||5.007002| swash_init||5.006000| swatch_get||| sys_init3||5.010000|n sys_init||5.010000|n sys_intern_clear||| sys_intern_dup||| sys_intern_init||| sys_term||5.010000|n taint_env||| taint_proper||| tied_method|||v tmps_grow||5.006000| toFOLD_uni||5.007003| toFOLD_utf8||5.019001| toFOLD||5.019001| toLOWER_L1||5.019001| toLOWER_LC||5.004000| toLOWER_uni||5.007003| toLOWER_utf8||5.015007| toLOWER||| toTITLE_uni||5.007003| toTITLE_utf8||5.015007| toTITLE||5.019001| toUPPER_uni||5.007003| toUPPER_utf8||5.015007| toUPPER||5.004000| to_byte_substr||| to_lower_latin1||| to_uni_fold||5.007003| to_uni_lower_lc||5.006000| to_uni_lower||5.007003| to_uni_title_lc||5.006000| to_uni_title||5.007003| to_uni_upper_lc||5.006000| to_uni_upper||5.007003| to_utf8_case||5.007003| to_utf8_fold||5.015007| to_utf8_lower||5.015007| to_utf8_substr||| to_utf8_title||5.015007| to_utf8_upper||5.015007| token_free||| token_getmad||| tokenize_use||| tokeq||| tokereport||| too_few_arguments_pv||| too_few_arguments_sv||| too_many_arguments_pv||| too_many_arguments_sv||| translate_substr_offsets||| try_amagic_bin||| try_amagic_un||| uiv_2buf|||n unlnk||| unpack_rec||| unpack_str||5.007003| unpackstring||5.008001| unreferenced_to_tmp_stack||| unshare_hek_or_pvn||| unshare_hek||| unsharepvn||5.004000| unwind_handler_stack||| update_debugger_info||| upg_version||5.009005| usage||| utf16_textfilter||| utf16_to_utf8_reversed||5.006001| utf16_to_utf8||5.006001| utf8_distance||5.006000| utf8_hop||5.006000| utf8_length||5.007001| utf8_mg_len_cache_update||| utf8_mg_pos_cache_update||| utf8_to_bytes||5.006001| utf8_to_uvchr_buf||5.015009| utf8_to_uvchr||5.007001| utf8_to_uvuni_buf||5.015009| utf8_to_uvuni||5.007001| utf8n_to_uvchr||| utf8n_to_uvuni||5.007001| utilize||| uvchr_to_utf8_flags||5.007003| uvchr_to_utf8||| uvuni_to_utf8_flags||5.007003| uvuni_to_utf8||5.007001| valid_utf8_to_uvchr||| valid_utf8_to_uvuni||5.015009| validate_proto||| validate_suid||| varname||| vcmp||5.009000| vcroak||5.006000| vdeb||5.007003| vform||5.006000| visit||| vivify_defelem||| vivify_ref||| vload_module|5.006000||p vmess||5.006000| vnewSVpvf|5.006000|5.004000|p vnormal||5.009002| vnumify||5.009000| vstringify||5.009000| vverify||5.009003| vwarner||5.006000| vwarn||5.006000| wait4pid||| warn_nocontext|||vn warn_sv||5.013001| warner_nocontext|||vn warner|5.006000|5.004000|pv warn|||v was_lvalue_sub||| watch||| whichsig_pvn||5.015004| whichsig_pv||5.015004| whichsig_sv||5.015004| whichsig||| win32_croak_not_implemented|||n with_queued_errors||| wrap_op_checker||5.015008| write_to_stderr||| xmldump_all_perl||| xmldump_all||| xmldump_attr||| xmldump_eval||| xmldump_form||| xmldump_indent|||v xmldump_packsubs_perl||| xmldump_packsubs||| xmldump_sub_perl||| xmldump_sub||| xmldump_vindent||| xs_apiversion_bootcheck||| xs_version_bootcheck||| yyerror_pvn||| yyerror_pv||| yyerror||| yylex||| yyparse||| yyunlex||| yywarn||| ); if (exists $opt{'list-unsupported'}) { my $f; for $f (sort { lc $a cmp lc $b } keys %API) { next unless $API{$f}{todo}; print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n"; } exit 0; } # Scan for possible replacement candidates my(%replace, %need, %hints, %warnings, %depends); my $replace = 0; my($hint, $define, $function); sub find_api { my $code = shift; $code =~ s{ / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*) | "[^"\\]*(?:\\.[^"\\]*)*" | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx; grep { exists $API{$_} } $code =~ /(\w+)/mg; } while () { if ($hint) { my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings; if (m{^\s*\*\s(.*?)\s*$}) { for (@{$hint->[1]}) { $h->{$_} ||= ''; # suppress warning with older perls $h->{$_} .= "$1\n"; } } else { undef $hint } } $hint = [$1, [split /,?\s+/, $2]] if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$}; if ($define) { if ($define->[1] =~ /\\$/) { $define->[1] .= $_; } else { if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) { my @n = find_api($define->[1]); push @{$depends{$define->[0]}}, @n if @n } undef $define; } } $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)}; if ($function) { if (/^}/) { if (exists $API{$function->[0]}) { my @n = find_api($function->[1]); push @{$depends{$function->[0]}}, @n if @n } undef $function; } else { $function->[1] .= $_; } } $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)}; $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$}; $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)}; $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce}; $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$}; if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) { my @deps = map { s/\s+//g; $_ } split /,/, $3; my $d; for $d (map { s/\s+//g; $_ } split /,/, $1) { push @{$depends{$d}}, @deps; } } $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)}; } for (values %depends) { my %s; $_ = [sort grep !$s{$_}++, @$_]; } if (exists $opt{'api-info'}) { my $f; my $count = 0; my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$"; for $f (sort { lc $a cmp lc $b } keys %API) { next unless $f =~ /$match/; print "\n=== $f ===\n\n"; my $info = 0; if ($API{$f}{base} || $API{$f}{todo}) { my $base = format_version($API{$f}{base} || $API{$f}{todo}); print "Supported at least starting from perl-$base.\n"; $info++; } if ($API{$f}{provided}) { my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003"; print "Support by $ppport provided back to perl-$todo.\n"; print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f}; print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f}; print "\n$hints{$f}" if exists $hints{$f}; print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f}; $info++; } print "No portability information available.\n" unless $info; $count++; } $count or print "Found no API matching '$opt{'api-info'}'."; print "\n"; exit 0; } if (exists $opt{'list-provided'}) { my $f; for $f (sort { lc $a cmp lc $b } keys %API) { next unless $API{$f}{provided}; my @flags; push @flags, 'explicit' if exists $need{$f}; push @flags, 'depend' if exists $depends{$f}; push @flags, 'hint' if exists $hints{$f}; push @flags, 'warning' if exists $warnings{$f}; my $flags = @flags ? ' ['.join(', ', @flags).']' : ''; print "$f$flags\n"; } exit 0; } my @files; my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc ); my $srcext = join '|', map { quotemeta $_ } @srcext; if (@ARGV) { my %seen; for (@ARGV) { if (-e) { if (-f) { push @files, $_ unless $seen{$_}++; } else { warn "'$_' is not a file.\n" } } else { my @new = grep { -f } glob $_ or warn "'$_' does not exist.\n"; push @files, grep { !$seen{$_}++ } @new; } } } else { eval { require File::Find; File::Find::find(sub { $File::Find::name =~ /($srcext)$/i and push @files, $File::Find::name; }, '.'); }; if ($@) { @files = map { glob "*$_" } @srcext; } } if (!@ARGV || $opt{filter}) { my(@in, @out); my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files; for (@files) { my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i; push @{ $out ? \@out : \@in }, $_; } if (@ARGV && @out) { warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out); } @files = @in; } die "No input files given!\n" unless @files; my(%files, %global, %revreplace); %revreplace = reverse %replace; my $filename; my $patch_opened = 0; for $filename (@files) { unless (open IN, "<$filename") { warn "Unable to read from $filename: $!\n"; next; } info("Scanning $filename ..."); my $c = do { local $/; }; close IN; my %file = (orig => $c, changes => 0); # Temporarily remove C/XS comments and strings from the code my @ccom; $c =~ s{ ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]* | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* ) | ( ^$HS*\#[^\r\n]* | "[^"\\]*(?:\\.[^"\\]*)*" | '[^'\\]*(?:\\.[^'\\]*)*' | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) ) }{ defined $2 and push @ccom, $2; defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex; $file{ccom} = \@ccom; $file{code} = $c; $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m; my $func; for $func (keys %API) { my $match = $func; $match .= "|$revreplace{$func}" if exists $revreplace{$func}; if ($c =~ /\b(?:Perl_)?($match)\b/) { $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func}; $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/; if (exists $API{$func}{provided}) { $file{uses_provided}{$func}++; if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) { $file{uses}{$func}++; my @deps = rec_depend($func); if (@deps) { $file{uses_deps}{$func} = \@deps; for (@deps) { $file{uses}{$_} = 0 unless exists $file{uses}{$_}; } } for ($func, @deps) { $file{needs}{$_} = 'static' if exists $need{$_}; } } } if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) { if ($c =~ /\b$func\b/) { $file{uses_todo}{$func}++; } } } } while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) { if (exists $need{$2}) { $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++; } else { warning("Possibly wrong #define $1 in $filename") } } for (qw(uses needs uses_todo needed_global needed_static)) { for $func (keys %{$file{$_}}) { push @{$global{$_}{$func}}, $filename; } } $files{$filename} = \%file; } # Globally resolve NEED_'s my $need; for $need (keys %{$global{needs}}) { if (@{$global{needs}{$need}} > 1) { my @targets = @{$global{needs}{$need}}; my @t = grep $files{$_}{needed_global}{$need}, @targets; @targets = @t if @t; @t = grep /\.xs$/i, @targets; @targets = @t if @t; my $target = shift @targets; $files{$target}{needs}{$need} = 'global'; for (@{$global{needs}{$need}}) { $files{$_}{needs}{$need} = 'extern' if $_ ne $target; } } } for $filename (@files) { exists $files{$filename} or next; info("=== Analyzing $filename ==="); my %file = %{$files{$filename}}; my $func; my $c = $file{code}; my $warnings = 0; for $func (sort keys %{$file{uses_Perl}}) { if ($API{$func}{varargs}) { unless ($API{$func}{nothxarg}) { my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))} { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge); if ($changes) { warning("Doesn't pass interpreter argument aTHX to Perl_$func"); $file{changes} += $changes; } } } else { warning("Uses Perl_$func instead of $func"); $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*} {$func$1(}g); } } for $func (sort keys %{$file{uses_replace}}) { warning("Uses $func instead of $replace{$func}"); $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); } for $func (sort keys %{$file{uses_provided}}) { if ($file{uses}{$func}) { if (exists $file{uses_deps}{$func}) { diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}})); } else { diag("Uses $func"); } } $warnings += hint($func); } unless ($opt{quiet}) { for $func (sort keys %{$file{uses_todo}}) { print "*** WARNING: Uses $func, which may not be portable below perl ", format_version($API{$func}{todo}), ", even with '$ppport'\n"; $warnings++; } } for $func (sort keys %{$file{needed_static}}) { my $message = ''; if (not exists $file{uses}{$func}) { $message = "No need to define NEED_$func if $func is never used"; } elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') { $message = "No need to define NEED_$func when already needed globally"; } if ($message) { diag($message); $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg); } } for $func (sort keys %{$file{needed_global}}) { my $message = ''; if (not exists $global{uses}{$func}) { $message = "No need to define NEED_${func}_GLOBAL if $func is never used"; } elsif (exists $file{needs}{$func}) { if ($file{needs}{$func} eq 'extern') { $message = "No need to define NEED_${func}_GLOBAL when already needed globally"; } elsif ($file{needs}{$func} eq 'static') { $message = "No need to define NEED_${func}_GLOBAL when only used in this file"; } } if ($message) { diag($message); $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg); } } $file{needs_inc_ppport} = keys %{$file{uses}}; if ($file{needs_inc_ppport}) { my $pp = ''; for $func (sort keys %{$file{needs}}) { my $type = $file{needs}{$func}; next if $type eq 'extern'; my $suffix = $type eq 'global' ? '_GLOBAL' : ''; unless (exists $file{"needed_$type"}{$func}) { if ($type eq 'global') { diag("Files [@{$global{needs}{$func}}] need $func, adding global request"); } else { diag("File needs $func, adding static request"); } $pp .= "#define NEED_$func$suffix\n"; } } if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) { $pp = ''; $file{changes}++; } unless ($file{has_inc_ppport}) { diag("Needs to include '$ppport'"); $pp .= qq(#include "$ppport"\n) } if ($pp) { $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms) || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m) || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m) || ($c =~ s/^/$pp/); } } else { if ($file{has_inc_ppport}) { diag("No need to include '$ppport'"); $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m); } } # put back in our C comments my $ix; my $cppc = 0; my @ccom = @{$file{ccom}}; for $ix (0 .. $#ccom) { if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) { $cppc++; $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/; } else { $c =~ s/$rccs$ix$rcce/$ccom[$ix]/; } } if ($cppc) { my $s = $cppc != 1 ? 's' : ''; warning("Uses $cppc C++ style comment$s, which is not portable"); } my $s = $warnings != 1 ? 's' : ''; my $warn = $warnings ? " ($warnings warning$s)" : ''; info("Analysis completed$warn"); if ($file{changes}) { if (exists $opt{copy}) { my $newfile = "$filename$opt{copy}"; if (-e $newfile) { error("'$newfile' already exists, refusing to write copy of '$filename'"); } else { local *F; if (open F, ">$newfile") { info("Writing copy of '$filename' with changes to '$newfile'"); print F $c; close F; } else { error("Cannot open '$newfile' for writing: $!"); } } } elsif (exists $opt{patch} || $opt{changes}) { if (exists $opt{patch}) { unless ($patch_opened) { if (open PATCH, ">$opt{patch}") { $patch_opened = 1; } else { error("Cannot open '$opt{patch}' for writing: $!"); delete $opt{patch}; $opt{changes} = 1; goto fallback; } } mydiff(\*PATCH, $filename, $c); } else { fallback: info("Suggested changes:"); mydiff(\*STDOUT, $filename, $c); } } else { my $s = $file{changes} == 1 ? '' : 's'; info("$file{changes} potentially required change$s detected"); } } else { info("Looks good"); } } close PATCH if $patch_opened; exit 0; sub try_use { eval "use @_;"; return $@ eq '' } sub mydiff { local *F = shift; my($file, $str) = @_; my $diff; if (exists $opt{diff}) { $diff = run_diff($opt{diff}, $file, $str); } if (!defined $diff and try_use('Text::Diff')) { $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' }); $diff = <
$tmp") { print F $str; close F; if (open F, "$prog $file $tmp |") { while () { s/\Q$tmp\E/$file.patched/; $diff .= $_; } close F; unlink $tmp; return $diff; } unlink $tmp; } else { error("Cannot open '$tmp' for writing: $!"); } return undef; } sub rec_depend { my($func, $seen) = @_; return () unless exists $depends{$func}; $seen = {%{$seen||{}}}; return () if $seen->{$func}++; my %s; grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}}; } sub parse_version { my $ver = shift; if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { return ($1, $2, $3); } elsif ($ver !~ /^\d+\.[\d_]+$/) { die "cannot parse version '$ver'\n"; } $ver =~ s/_//g; $ver =~ s/$/000000/; my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; $v = int $v; $s = int $s; if ($r < 5 || ($r == 5 && $v < 6)) { if ($s % 10) { die "cannot parse version '$ver'\n"; } } return ($r, $v, $s); } sub format_version { my $ver = shift; $ver =~ s/$/000000/; my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; $v = int $v; $s = int $s; if ($r < 5 || ($r == 5 && $v < 6)) { if ($s % 10) { die "invalid version '$ver'\n"; } $s /= 10; $ver = sprintf "%d.%03d", $r, $v; $s > 0 and $ver .= sprintf "_%02d", $s; return $ver; } return sprintf "%d.%d.%d", $r, $v, $s; } sub info { $opt{quiet} and return; print @_, "\n"; } sub diag { $opt{quiet} and return; $opt{diag} and print @_, "\n"; } sub warning { $opt{quiet} and return; print "*** ", @_, "\n"; } sub error { print "*** ERROR: ", @_, "\n"; } my %given_hints; my %given_warnings; sub hint { $opt{quiet} and return; my $func = shift; my $rv = 0; if (exists $warnings{$func} && !$given_warnings{$func}++) { my $warn = $warnings{$func}; $warn =~ s!^!*** !mg; print "*** WARNING: $func\n", $warn; $rv++; } if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) { my $hint = $hints{$func}; $hint =~ s/^/ /mg; print " --- hint for $func ---\n", $hint; } $rv; } sub usage { my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms; my %M = ( 'I' => '*' ); $usage =~ s/^\s*perl\s+\S+/$^X $0/; $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g; print < }; my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms; $copy =~ s/^(?=\S+)/ /gms; $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms; $self =~ s/^SKIP.*(?=^__DATA__)/SKIP if (\@ARGV && \$ARGV[0] eq '--unstrip') { eval { require Devel::PPPort }; \$@ and die "Cannot require Devel::PPPort, please install.\\n"; if (eval \$Devel::PPPort::VERSION < $VERSION) { die "$0 was originally generated with Devel::PPPort $VERSION.\\n" . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n" . "Please install a newer version, or --unstrip will not work.\\n"; } Devel::PPPort::WriteFile(\$0); exit 0; } print <$0" or die "cannot strip $0: $!\n"; print OUT "$pl$c\n"; exit 0; } __DATA__ */ #ifndef _P_P_PORTABILITY_H_ #define _P_P_PORTABILITY_H_ #ifndef DPPP_NAMESPACE # define DPPP_NAMESPACE DPPP_ #endif #define DPPP_CAT2(x,y) CAT2(x,y) #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name) #ifndef PERL_REVISION # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION)) # define PERL_PATCHLEVEL_H_IMPLICIT # include # endif # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL))) # include # endif # ifndef PERL_REVISION # define PERL_REVISION (5) /* Replace: 1 */ # define PERL_VERSION PATCHLEVEL # define PERL_SUBVERSION SUBVERSION /* Replace PERL_PATCHLEVEL with PERL_VERSION */ /* Replace: 0 */ # endif #endif #define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10)) #define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION)) /* It is very unlikely that anyone will try to use this with Perl 6 (or greater), but who knows. */ #if PERL_REVISION != 5 # error ppport.h only works with Perl version 5 #endif /* PERL_REVISION != 5 */ #ifndef dTHR # define dTHR dNOOP #endif #ifndef dTHX # define dTHX dNOOP #endif #ifndef dTHXa # define dTHXa(x) dNOOP #endif #ifndef pTHX # define pTHX void #endif #ifndef pTHX_ # define pTHX_ #endif #ifndef aTHX # define aTHX #endif #ifndef aTHX_ # define aTHX_ #endif #if (PERL_BCDVERSION < 0x5006000) # ifdef USE_THREADS # define aTHXR thr # define aTHXR_ thr, # else # define aTHXR # define aTHXR_ # endif # define dTHXR dTHR #else # define aTHXR aTHX # define aTHXR_ aTHX_ # define dTHXR dTHX #endif #ifndef dTHXoa # define dTHXoa(x) dTHXa(x) #endif #ifdef I_LIMITS # include #endif #ifndef PERL_UCHAR_MIN # define PERL_UCHAR_MIN ((unsigned char)0) #endif #ifndef PERL_UCHAR_MAX # ifdef UCHAR_MAX # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX) # else # ifdef MAXUCHAR # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR) # else # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0) # endif # endif #endif #ifndef PERL_USHORT_MIN # define PERL_USHORT_MIN ((unsigned short)0) #endif #ifndef PERL_USHORT_MAX # ifdef USHORT_MAX # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX) # else # ifdef MAXUSHORT # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT) # else # ifdef USHRT_MAX # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX) # else # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0) # endif # endif # endif #endif #ifndef PERL_SHORT_MAX # ifdef SHORT_MAX # define PERL_SHORT_MAX ((short)SHORT_MAX) # else # ifdef MAXSHORT /* Often used in */ # define PERL_SHORT_MAX ((short)MAXSHORT) # else # ifdef SHRT_MAX # define PERL_SHORT_MAX ((short)SHRT_MAX) # else # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1)) # endif # endif # endif #endif #ifndef PERL_SHORT_MIN # ifdef SHORT_MIN # define PERL_SHORT_MIN ((short)SHORT_MIN) # else # ifdef MINSHORT # define PERL_SHORT_MIN ((short)MINSHORT) # else # ifdef SHRT_MIN # define PERL_SHORT_MIN ((short)SHRT_MIN) # else # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) # endif # endif # endif #endif #ifndef PERL_UINT_MAX # ifdef UINT_MAX # define PERL_UINT_MAX ((unsigned int)UINT_MAX) # else # ifdef MAXUINT # define PERL_UINT_MAX ((unsigned int)MAXUINT) # else # define PERL_UINT_MAX (~(unsigned int)0) # endif # endif #endif #ifndef PERL_UINT_MIN # define PERL_UINT_MIN ((unsigned int)0) #endif #ifndef PERL_INT_MAX # ifdef INT_MAX # define PERL_INT_MAX ((int)INT_MAX) # else # ifdef MAXINT /* Often used in */ # define PERL_INT_MAX ((int)MAXINT) # else # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1)) # endif # endif #endif #ifndef PERL_INT_MIN # ifdef INT_MIN # define PERL_INT_MIN ((int)INT_MIN) # else # ifdef MININT # define PERL_INT_MIN ((int)MININT) # else # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3)) # endif # endif #endif #ifndef PERL_ULONG_MAX # ifdef ULONG_MAX # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX) # else # ifdef MAXULONG # define PERL_ULONG_MAX ((unsigned long)MAXULONG) # else # define PERL_ULONG_MAX (~(unsigned long)0) # endif # endif #endif #ifndef PERL_ULONG_MIN # define PERL_ULONG_MIN ((unsigned long)0L) #endif #ifndef PERL_LONG_MAX # ifdef LONG_MAX # define PERL_LONG_MAX ((long)LONG_MAX) # else # ifdef MAXLONG # define PERL_LONG_MAX ((long)MAXLONG) # else # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1)) # endif # endif #endif #ifndef PERL_LONG_MIN # ifdef LONG_MIN # define PERL_LONG_MIN ((long)LONG_MIN) # else # ifdef MINLONG # define PERL_LONG_MIN ((long)MINLONG) # else # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3)) # endif # endif #endif #if defined(HAS_QUAD) && (defined(convex) || defined(uts)) # ifndef PERL_UQUAD_MAX # ifdef ULONGLONG_MAX # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX) # else # ifdef MAXULONGLONG # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG) # else # define PERL_UQUAD_MAX (~(unsigned long long)0) # endif # endif # endif # ifndef PERL_UQUAD_MIN # define PERL_UQUAD_MIN ((unsigned long long)0L) # endif # ifndef PERL_QUAD_MAX # ifdef LONGLONG_MAX # define PERL_QUAD_MAX ((long long)LONGLONG_MAX) # else # ifdef MAXLONGLONG # define PERL_QUAD_MAX ((long long)MAXLONGLONG) # else # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1)) # endif # endif # endif # ifndef PERL_QUAD_MIN # ifdef LONGLONG_MIN # define PERL_QUAD_MIN ((long long)LONGLONG_MIN) # else # ifdef MINLONGLONG # define PERL_QUAD_MIN ((long long)MINLONGLONG) # else # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) # endif # endif # endif #endif /* This is based on code from 5.003 perl.h */ #ifdef HAS_QUAD # ifdef cray #ifndef IVTYPE # define IVTYPE int #endif #ifndef IV_MIN # define IV_MIN PERL_INT_MIN #endif #ifndef IV_MAX # define IV_MAX PERL_INT_MAX #endif #ifndef UV_MIN # define UV_MIN PERL_UINT_MIN #endif #ifndef UV_MAX # define UV_MAX PERL_UINT_MAX #endif # ifdef INTSIZE #ifndef IVSIZE # define IVSIZE INTSIZE #endif # endif # else # if defined(convex) || defined(uts) #ifndef IVTYPE # define IVTYPE long long #endif #ifndef IV_MIN # define IV_MIN PERL_QUAD_MIN #endif #ifndef IV_MAX # define IV_MAX PERL_QUAD_MAX #endif #ifndef UV_MIN # define UV_MIN PERL_UQUAD_MIN #endif #ifndef UV_MAX # define UV_MAX PERL_UQUAD_MAX #endif # ifdef LONGLONGSIZE #ifndef IVSIZE # define IVSIZE LONGLONGSIZE #endif # endif # else #ifndef IVTYPE # define IVTYPE long #endif #ifndef IV_MIN # define IV_MIN PERL_LONG_MIN #endif #ifndef IV_MAX # define IV_MAX PERL_LONG_MAX #endif #ifndef UV_MIN # define UV_MIN PERL_ULONG_MIN #endif #ifndef UV_MAX # define UV_MAX PERL_ULONG_MAX #endif # ifdef LONGSIZE #ifndef IVSIZE # define IVSIZE LONGSIZE #endif # endif # endif # endif #ifndef IVSIZE # define IVSIZE 8 #endif #ifndef LONGSIZE # define LONGSIZE 8 #endif #ifndef PERL_QUAD_MIN # define PERL_QUAD_MIN IV_MIN #endif #ifndef PERL_QUAD_MAX # define PERL_QUAD_MAX IV_MAX #endif #ifndef PERL_UQUAD_MIN # define PERL_UQUAD_MIN UV_MIN #endif #ifndef PERL_UQUAD_MAX # define PERL_UQUAD_MAX UV_MAX #endif #else #ifndef IVTYPE # define IVTYPE long #endif #ifndef LONGSIZE # define LONGSIZE 4 #endif #ifndef IV_MIN # define IV_MIN PERL_LONG_MIN #endif #ifndef IV_MAX # define IV_MAX PERL_LONG_MAX #endif #ifndef UV_MIN # define UV_MIN PERL_ULONG_MIN #endif #ifndef UV_MAX # define UV_MAX PERL_ULONG_MAX #endif #endif #ifndef IVSIZE # ifdef LONGSIZE # define IVSIZE LONGSIZE # else # define IVSIZE 4 /* A bold guess, but the best we can make. */ # endif #endif #ifndef UVTYPE # define UVTYPE unsigned IVTYPE #endif #ifndef UVSIZE # define UVSIZE IVSIZE #endif #ifndef sv_setuv # define sv_setuv(sv, uv) \ STMT_START { \ UV TeMpUv = uv; \ if (TeMpUv <= IV_MAX) \ sv_setiv(sv, TeMpUv); \ else \ sv_setnv(sv, (double)TeMpUv); \ } STMT_END #endif #ifndef newSVuv # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv)) #endif #ifndef sv_2uv # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv))) #endif #ifndef SvUVX # define SvUVX(sv) ((UV)SvIVX(sv)) #endif #ifndef SvUVXx # define SvUVXx(sv) SvUVX(sv) #endif #ifndef SvUV # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) #endif #ifndef SvUVx # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) #endif /* Hint: sv_uv * Always use the SvUVx() macro instead of sv_uv(). */ #ifndef sv_uv # define sv_uv(sv) SvUVx(sv) #endif #if !defined(SvUOK) && defined(SvIOK_UV) # define SvUOK(sv) SvIOK_UV(sv) #endif #ifndef XST_mUV # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) ) #endif #ifndef XSRETURN_UV # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END #endif #ifndef PUSHu # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END #endif #ifndef XPUSHu # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END #endif #ifdef HAS_MEMCMP #ifndef memNE # define memNE(s1,s2,l) (memcmp(s1,s2,l)) #endif #ifndef memEQ # define memEQ(s1,s2,l) (!memcmp(s1,s2,l)) #endif #else #ifndef memNE # define memNE(s1,s2,l) (bcmp(s1,s2,l)) #endif #ifndef memEQ # define memEQ(s1,s2,l) (!bcmp(s1,s2,l)) #endif #endif #ifndef memEQs # define memEQs(s1, l, s2) \ (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1))) #endif #ifndef memNEs # define memNEs(s1, l, s2) !memEQs(s1, l, s2) #endif #ifndef MoveD # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t)) #endif #ifndef CopyD # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) #endif #ifdef HAS_MEMSET #ifndef ZeroD # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t)) #endif #else #ifndef ZeroD # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d) #endif #endif #ifndef PoisonWith # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t)) #endif #ifndef PoisonNew # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB) #endif #ifndef PoisonFree # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF) #endif #ifndef Poison # define Poison(d,n,t) PoisonFree(d,n,t) #endif #ifndef Newx # define Newx(v,n,t) New(0,v,n,t) #endif #ifndef Newxc # define Newxc(v,n,t,c) Newc(0,v,n,t,c) #endif #ifndef Newxz # define Newxz(v,n,t) Newz(0,v,n,t) #endif #ifndef PERL_UNUSED_DECL # ifdef HASATTRIBUTE # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) # define PERL_UNUSED_DECL # else # define PERL_UNUSED_DECL __attribute__((unused)) # endif # else # define PERL_UNUSED_DECL # endif #endif #ifndef PERL_UNUSED_ARG # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */ # include # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x)) # else # define PERL_UNUSED_ARG(x) ((void)x) # endif #endif #ifndef PERL_UNUSED_VAR # define PERL_UNUSED_VAR(x) ((void)x) #endif #ifndef PERL_UNUSED_CONTEXT # ifdef USE_ITHREADS # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl) # else # define PERL_UNUSED_CONTEXT # endif #endif #ifndef NOOP # define NOOP /*EMPTY*/(void)0 #endif #ifndef dNOOP # define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL #endif #ifndef NVTYPE # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) # define NVTYPE long double # else # define NVTYPE double # endif typedef NVTYPE NV; #endif #ifndef INT2PTR # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) # define PTRV UV # define INT2PTR(any,d) (any)(d) # else # if PTRSIZE == LONGSIZE # define PTRV unsigned long # else # define PTRV unsigned # endif # define INT2PTR(any,d) (any)(PTRV)(d) # endif #endif #ifndef PTR2ul # if PTRSIZE == LONGSIZE # define PTR2ul(p) (unsigned long)(p) # else # define PTR2ul(p) INT2PTR(unsigned long,p) # endif #endif #ifndef PTR2nat # define PTR2nat(p) (PTRV)(p) #endif #ifndef NUM2PTR # define NUM2PTR(any,d) (any)PTR2nat(d) #endif #ifndef PTR2IV # define PTR2IV(p) INT2PTR(IV,p) #endif #ifndef PTR2UV # define PTR2UV(p) INT2PTR(UV,p) #endif #ifndef PTR2NV # define PTR2NV(p) NUM2PTR(NV,p) #endif #undef START_EXTERN_C #undef END_EXTERN_C #undef EXTERN_C #ifdef __cplusplus # define START_EXTERN_C extern "C" { # define END_EXTERN_C } # define EXTERN_C extern "C" #else # define START_EXTERN_C # define END_EXTERN_C # define EXTERN_C extern #endif #if defined(PERL_GCC_PEDANTIC) # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN # define PERL_GCC_BRACE_GROUPS_FORBIDDEN # endif #endif #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) # ifndef PERL_USE_GCC_BRACE_GROUPS # define PERL_USE_GCC_BRACE_GROUPS # endif #endif #undef STMT_START #undef STMT_END #ifdef PERL_USE_GCC_BRACE_GROUPS # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ # define STMT_END ) #else # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) # define STMT_START if (1) # define STMT_END else (void)0 # else # define STMT_START do # define STMT_END while (0) # endif #endif #ifndef boolSV # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) #endif /* DEFSV appears first in 5.004_56 */ #ifndef DEFSV # define DEFSV GvSV(PL_defgv) #endif #ifndef SAVE_DEFSV # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) #endif #ifndef DEFSV_set # define DEFSV_set(sv) (DEFSV = (sv)) #endif /* Older perls (<=5.003) lack AvFILLp */ #ifndef AvFILLp # define AvFILLp AvFILL #endif #ifndef ERRSV # define ERRSV get_sv("@",FALSE) #endif /* Hint: gv_stashpvn * This function's backport doesn't support the length parameter, but * rather ignores it. Portability can only be ensured if the length * parameter is used for speed reasons, but the length can always be * correctly computed from the string argument. */ #ifndef gv_stashpvn # define gv_stashpvn(str,len,create) gv_stashpv(str,create) #endif /* Replace: 1 */ #ifndef get_cv # define get_cv perl_get_cv #endif #ifndef get_sv # define get_sv perl_get_sv #endif #ifndef get_av # define get_av perl_get_av #endif #ifndef get_hv # define get_hv perl_get_hv #endif /* Replace: 0 */ #ifndef dUNDERBAR # define dUNDERBAR dNOOP #endif #ifndef UNDERBAR # define UNDERBAR DEFSV #endif #ifndef dAX # define dAX I32 ax = MARK - PL_stack_base + 1 #endif #ifndef dITEMS # define dITEMS I32 items = SP - MARK #endif #ifndef dXSTARG # define dXSTARG SV * targ = sv_newmortal() #endif #ifndef dAXMARK # define dAXMARK I32 ax = POPMARK; \ register SV ** const mark = PL_stack_base + ax++ #endif #ifndef XSprePUSH # define XSprePUSH (sp = PL_stack_base + ax - 1) #endif #if (PERL_BCDVERSION < 0x5005000) # undef XSRETURN # define XSRETURN(off) \ STMT_START { \ PL_stack_sp = PL_stack_base + ax + ((off) - 1); \ return; \ } STMT_END #endif #ifndef XSPROTO # define XSPROTO(name) void name(pTHX_ CV* cv) #endif #ifndef SVfARG # define SVfARG(p) ((void*)(p)) #endif #ifndef PERL_ABS # define PERL_ABS(x) ((x) < 0 ? -(x) : (x)) #endif #ifndef dVAR # define dVAR dNOOP #endif #ifndef SVf # define SVf "_" #endif #ifndef UTF8_MAXBYTES # define UTF8_MAXBYTES UTF8_MAXLEN #endif #ifndef CPERLscope # define CPERLscope(x) x #endif #ifndef PERL_HASH # define PERL_HASH(hash,str,len) \ STMT_START { \ const char *s_PeRlHaSh = str; \ I32 i_PeRlHaSh = len; \ U32 hash_PeRlHaSh = 0; \ while (i_PeRlHaSh--) \ hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \ (hash) = hash_PeRlHaSh; \ } STMT_END #endif #ifndef PERLIO_FUNCS_DECL # ifdef PERLIO_FUNCS_CONST # define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs # define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs) # else # define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs # define PERLIO_FUNCS_CAST(funcs) (funcs) # endif #endif /* provide these typedefs for older perls */ #if (PERL_BCDVERSION < 0x5009003) # ifdef ARGSproto typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto); # else typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX); # endif typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*); #endif #ifndef isPSXSPC # define isPSXSPC(c) (isSPACE(c) || (c) == '\v') #endif #ifndef isBLANK # define isBLANK(c) ((c) == ' ' || (c) == '\t') #endif #ifdef EBCDIC #ifndef isALNUMC # define isALNUMC(c) isalnum(c) #endif #ifndef isASCII # define isASCII(c) isascii(c) #endif #ifndef isCNTRL # define isCNTRL(c) iscntrl(c) #endif #ifndef isGRAPH # define isGRAPH(c) isgraph(c) #endif #ifndef isPRINT # define isPRINT(c) isprint(c) #endif #ifndef isPUNCT # define isPUNCT(c) ispunct(c) #endif #ifndef isXDIGIT # define isXDIGIT(c) isxdigit(c) #endif #else # if (PERL_BCDVERSION < 0x5010000) /* Hint: isPRINT * The implementation in older perl versions includes all of the * isSPACE() characters, which is wrong. The version provided by * Devel::PPPort always overrides a present buggy version. */ # undef isPRINT # endif #ifdef HAS_QUAD # define WIDEST_UTYPE U64TYPE #else # define WIDEST_UTYPE U32 #endif #ifndef isALNUMC # define isALNUMC(c) (isALPHA(c) || isDIGIT(c)) #endif #ifndef isASCII # define isASCII(c) ((WIDEST_UTYPE) (c) <= 127) #endif #ifndef isCNTRL # define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127) #endif #ifndef isGRAPH # define isGRAPH(c) (isALNUM(c) || isPUNCT(c)) #endif #ifndef isPRINT # define isPRINT(c) (((c) >= 32 && (c) < 127)) #endif #ifndef isPUNCT # define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126)) #endif #ifndef isXDIGIT # define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F')) #endif #endif #ifndef PERL_SIGNALS_UNSAFE_FLAG #define PERL_SIGNALS_UNSAFE_FLAG 0x0001 #if (PERL_BCDVERSION < 0x5008000) # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG #else # define D_PPP_PERL_SIGNALS_INIT 0 #endif #if defined(NEED_PL_signals) static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT; #elif defined(NEED_PL_signals_GLOBAL) U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT; #else extern U32 DPPP_(my_PL_signals); #endif #define PL_signals DPPP_(my_PL_signals) #endif /* Hint: PL_ppaddr * Calling an op via PL_ppaddr requires passing a context argument * for threaded builds. Since the context argument is different for * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will * automatically be defined as the correct argument. */ #if (PERL_BCDVERSION <= 0x5005005) /* Replace: 1 */ # define PL_ppaddr ppaddr # define PL_no_modify no_modify /* Replace: 0 */ #endif #if (PERL_BCDVERSION <= 0x5004005) /* Replace: 1 */ # define PL_DBsignal DBsignal # define PL_DBsingle DBsingle # define PL_DBsub DBsub # define PL_DBtrace DBtrace # define PL_Sv Sv # define PL_bufend bufend # define PL_bufptr bufptr # define PL_compiling compiling # define PL_copline copline # define PL_curcop curcop # define PL_curstash curstash # define PL_debstash debstash # define PL_defgv defgv # define PL_diehook diehook # define PL_dirty dirty # define PL_dowarn dowarn # define PL_errgv errgv # define PL_error_count error_count # define PL_expect expect # define PL_hexdigit hexdigit # define PL_hints hints # define PL_in_my in_my # define PL_laststatval laststatval # define PL_lex_state lex_state # define PL_lex_stuff lex_stuff # define PL_linestr linestr # define PL_na na # define PL_perl_destruct_level perl_destruct_level # define PL_perldb perldb # define PL_rsfp_filters rsfp_filters # define PL_rsfp rsfp # define PL_stack_base stack_base # define PL_stack_sp stack_sp # define PL_statcache statcache # define PL_stdingv stdingv # define PL_sv_arenaroot sv_arenaroot # define PL_sv_no sv_no # define PL_sv_undef sv_undef # define PL_sv_yes sv_yes # define PL_tainted tainted # define PL_tainting tainting # define PL_tokenbuf tokenbuf /* Replace: 0 */ #endif /* Warning: PL_parser * For perl versions earlier than 5.9.5, this is an always * non-NULL dummy. Also, it cannot be dereferenced. Don't * use it if you can avoid is and unless you absolutely know * what you're doing. * If you always check that PL_parser is non-NULL, you can * define DPPP_PL_parser_NO_DUMMY to avoid the creation of * a dummy parser structure. */ #if (PERL_BCDVERSION >= 0x5009005) # ifdef DPPP_PL_parser_NO_DUMMY # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \ (croak("panic: PL_parser == NULL in %s:%d", \ __FILE__, __LINE__), (yy_parser *) NULL))->var) # else # ifdef DPPP_PL_parser_NO_DUMMY_WARNING # define D_PPP_parser_dummy_warning(var) # else # define D_PPP_parser_dummy_warning(var) \ warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__), # endif # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \ (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var) #if defined(NEED_PL_parser) static yy_parser DPPP_(dummy_PL_parser); #elif defined(NEED_PL_parser_GLOBAL) yy_parser DPPP_(dummy_PL_parser); #else extern yy_parser DPPP_(dummy_PL_parser); #endif # endif /* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */ /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf * Do not use this variable unless you know exactly what you're * doint. It is internal to the perl parser and may change or even * be removed in the future. As of perl 5.9.5, you have to check * for (PL_parser != NULL) for this variable to have any effect. * An always non-NULL PL_parser dummy is provided for earlier * perl versions. * If PL_parser is NULL when you try to access this variable, a * dummy is being accessed instead and a warning is issued unless * you define DPPP_PL_parser_NO_DUMMY_WARNING. * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access * this variable will croak with a panic message. */ # define PL_expect D_PPP_my_PL_parser_var(expect) # define PL_copline D_PPP_my_PL_parser_var(copline) # define PL_rsfp D_PPP_my_PL_parser_var(rsfp) # define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters) # define PL_linestr D_PPP_my_PL_parser_var(linestr) # define PL_bufptr D_PPP_my_PL_parser_var(bufptr) # define PL_bufend D_PPP_my_PL_parser_var(bufend) # define PL_lex_state D_PPP_my_PL_parser_var(lex_state) # define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff) # define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf) # define PL_in_my D_PPP_my_PL_parser_var(in_my) # define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash) # define PL_error_count D_PPP_my_PL_parser_var(error_count) #else /* ensure that PL_parser != NULL and cannot be dereferenced */ # define PL_parser ((void *) 1) #endif #ifndef mPUSHs # define mPUSHs(s) PUSHs(sv_2mortal(s)) #endif #ifndef PUSHmortal # define PUSHmortal PUSHs(sv_newmortal()) #endif #ifndef mPUSHp # define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l)) #endif #ifndef mPUSHn # define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n)) #endif #ifndef mPUSHi # define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i)) #endif #ifndef mPUSHu # define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u)) #endif #ifndef mXPUSHs # define mXPUSHs(s) XPUSHs(sv_2mortal(s)) #endif #ifndef XPUSHmortal # define XPUSHmortal XPUSHs(sv_newmortal()) #endif #ifndef mXPUSHp # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END #endif #ifndef mXPUSHn # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END #endif #ifndef mXPUSHi # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END #endif #ifndef mXPUSHu # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END #endif /* Replace: 1 */ #ifndef call_sv # define call_sv perl_call_sv #endif #ifndef call_pv # define call_pv perl_call_pv #endif #ifndef call_argv # define call_argv perl_call_argv #endif #ifndef call_method # define call_method perl_call_method #endif #ifndef eval_sv # define eval_sv perl_eval_sv #endif /* Replace: 0 */ #ifndef PERL_LOADMOD_DENY # define PERL_LOADMOD_DENY 0x1 #endif #ifndef PERL_LOADMOD_NOIMPORT # define PERL_LOADMOD_NOIMPORT 0x2 #endif #ifndef PERL_LOADMOD_IMPORT_OPS # define PERL_LOADMOD_IMPORT_OPS 0x4 #endif #ifndef G_METHOD # define G_METHOD 64 # ifdef call_sv # undef call_sv # endif # if (PERL_BCDVERSION < 0x5006000) # define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \ (flags) & ~G_METHOD) : perl_call_sv(sv, flags)) # else # define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \ (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags)) # endif #endif /* Replace perl_eval_pv with eval_pv */ #ifndef eval_pv #if defined(NEED_eval_pv) static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error); static #else extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error); #endif #ifdef eval_pv # undef eval_pv #endif #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b) #define Perl_eval_pv DPPP_(my_eval_pv) #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL) SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error) { dSP; SV* sv = newSVpv(p, 0); PUSHMARK(sp); eval_sv(sv, G_SCALAR); SvREFCNT_dec(sv); SPAGAIN; sv = POPs; PUTBACK; if (croak_on_error && SvTRUE(GvSV(errgv))) croak(SvPVx(GvSV(errgv), na)); return sv; } #endif #endif #ifndef vload_module #if defined(NEED_vload_module) static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args); static #else extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args); #endif #ifdef vload_module # undef vload_module #endif #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d) #define Perl_vload_module DPPP_(my_vload_module) #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL) void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args) { dTHR; dVAR; OP *veop, *imop; OP * const modname = newSVOP(OP_CONST, 0, name); /* 5.005 has a somewhat hacky force_normal that doesn't croak on SvREADONLY() if PL_compling is true. Current perls take care in ck_require() to correctly turn off SvREADONLY before calling force_normal_flags(). This seems a better fix than fudging PL_compling */ SvREADONLY_off(((SVOP*)modname)->op_sv); modname->op_private |= OPpCONST_BARE; if (ver) { veop = newSVOP(OP_CONST, 0, ver); } else veop = NULL; if (flags & PERL_LOADMOD_NOIMPORT) { imop = sawparens(newNULLLIST()); } else if (flags & PERL_LOADMOD_IMPORT_OPS) { imop = va_arg(*args, OP*); } else { SV *sv; imop = NULL; sv = va_arg(*args, SV*); while (sv) { imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv)); sv = va_arg(*args, SV*); } } { const line_t ocopline = PL_copline; COP * const ocurcop = PL_curcop; const int oexpect = PL_expect; #if (PERL_BCDVERSION >= 0x5004000) utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0), veop, modname, imop); #else utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(), modname, imop); #endif PL_expect = oexpect; PL_copline = ocopline; PL_curcop = ocurcop; } } #endif #endif #ifndef load_module #if defined(NEED_load_module) static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...); static #else extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...); #endif #ifdef load_module # undef load_module #endif #define load_module DPPP_(my_load_module) #define Perl_load_module DPPP_(my_load_module) #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL) void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...) { va_list args; va_start(args, ver); vload_module(flags, name, ver, &args); va_end(args); } #endif #endif #ifndef newRV_inc # define newRV_inc(sv) newRV(sv) /* Replace */ #endif #ifndef newRV_noinc #if defined(NEED_newRV_noinc) static SV * DPPP_(my_newRV_noinc)(SV *sv); static #else extern SV * DPPP_(my_newRV_noinc)(SV *sv); #endif #ifdef newRV_noinc # undef newRV_noinc #endif #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a) #define Perl_newRV_noinc DPPP_(my_newRV_noinc) #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL) SV * DPPP_(my_newRV_noinc)(SV *sv) { SV *rv = (SV *)newRV(sv); SvREFCNT_dec(sv); return rv; } #endif #endif /* Hint: newCONSTSUB * Returns a CV* as of perl-5.7.1. This return value is not supported * by Devel::PPPort. */ /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005) #if defined(NEED_newCONSTSUB) static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv); static #else extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv); #endif #ifdef newCONSTSUB # undef newCONSTSUB #endif #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c) #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB) #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) /* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */ /* (There's no PL_parser in perl < 5.005, so this is completely safe) */ #define D_PPP_PL_copline PL_copline void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv) { U32 oldhints = PL_hints; HV *old_cop_stash = PL_curcop->cop_stash; HV *old_curstash = PL_curstash; line_t oldline = PL_curcop->cop_line; PL_curcop->cop_line = D_PPP_PL_copline; PL_hints &= ~HINT_BLOCK_SCOPE; if (stash) PL_curstash = PL_curcop->cop_stash = stash; newSUB( #if (PERL_BCDVERSION < 0x5003022) start_subparse(), #elif (PERL_BCDVERSION == 0x5003022) start_subparse(0), #else /* 5.003_23 onwards */ start_subparse(FALSE, 0), #endif newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)), newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) ); PL_hints = oldhints; PL_curcop->cop_stash = old_cop_stash; PL_curstash = old_curstash; PL_curcop->cop_line = oldline; } #endif #endif /* * Boilerplate macros for initializing and accessing interpreter-local * data from C. All statics in extensions should be reworked to use * this, if you want to make the extension thread-safe. See ext/re/re.xs * for an example of the use of these macros. * * Code that uses these macros is responsible for the following: * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" * 2. Declare a typedef named my_cxt_t that is a structure that contains * all the data that needs to be interpreter-local. * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. * 4. Use the MY_CXT_INIT macro such that it is called exactly once * (typically put in the BOOT: section). * 5. Use the members of the my_cxt_t structure everywhere as * MY_CXT.member. * 6. Use the dMY_CXT macro (a declaration) in all the functions that * access MY_CXT. */ #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) #ifndef START_MY_CXT /* This must appear in all extensions that define a my_cxt_t structure, * right after the definition (i.e. at file scope). The non-threads * case below uses it to declare the data as static. */ #define START_MY_CXT #if (PERL_BCDVERSION < 0x5004068) /* Fetches the SV that keeps the per-interpreter data. */ #define dMY_CXT_SV \ SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE) #else /* >= perl5.004_68 */ #define dMY_CXT_SV \ SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ sizeof(MY_CXT_KEY)-1, TRUE) #endif /* < perl5.004_68 */ /* This declaration should be used within all functions that use the * interpreter-local data. */ #define dMY_CXT \ dMY_CXT_SV; \ my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) /* Creates and zeroes the per-interpreter data. * (We allocate my_cxtp in a Perl SV so that it will be released when * the interpreter goes away.) */ #define MY_CXT_INIT \ dMY_CXT_SV; \ /* newSV() allocates one more than needed */ \ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ Zero(my_cxtp, 1, my_cxt_t); \ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) /* This macro must be used to access members of the my_cxt_t structure. * e.g. MYCXT.some_data */ #define MY_CXT (*my_cxtp) /* Judicious use of these macros can reduce the number of times dMY_CXT * is used. Use is similar to pTHX, aTHX etc. */ #define pMY_CXT my_cxt_t *my_cxtp #define pMY_CXT_ pMY_CXT, #define _pMY_CXT ,pMY_CXT #define aMY_CXT my_cxtp #define aMY_CXT_ aMY_CXT, #define _aMY_CXT ,aMY_CXT #endif /* START_MY_CXT */ #ifndef MY_CXT_CLONE /* Clones the per-interpreter data. */ #define MY_CXT_CLONE \ dMY_CXT_SV; \ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) #endif #else /* single interpreter */ #ifndef START_MY_CXT #define START_MY_CXT static my_cxt_t my_cxt; #define dMY_CXT_SV dNOOP #define dMY_CXT dNOOP #define MY_CXT_INIT NOOP #define MY_CXT my_cxt #define pMY_CXT void #define pMY_CXT_ #define _pMY_CXT #define aMY_CXT #define aMY_CXT_ #define _aMY_CXT #endif /* START_MY_CXT */ #ifndef MY_CXT_CLONE #define MY_CXT_CLONE NOOP #endif #endif #ifndef IVdf # if IVSIZE == LONGSIZE # define IVdf "ld" # define UVuf "lu" # define UVof "lo" # define UVxf "lx" # define UVXf "lX" # elif IVSIZE == INTSIZE # define IVdf "d" # define UVuf "u" # define UVof "o" # define UVxf "x" # define UVXf "X" # else # error "cannot define IV/UV formats" # endif #endif #ifndef NVef # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000) /* Not very likely, but let's try anyway. */ # define NVef PERL_PRIeldbl # define NVff PERL_PRIfldbl # define NVgf PERL_PRIgldbl # else # define NVef "e" # define NVff "f" # define NVgf "g" # endif #endif #ifndef SvREFCNT_inc # ifdef PERL_USE_GCC_BRACE_GROUPS # define SvREFCNT_inc(sv) \ ({ \ SV * const _sv = (SV*)(sv); \ if (_sv) \ (SvREFCNT(_sv))++; \ _sv; \ }) # else # define SvREFCNT_inc(sv) \ ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL) # endif #endif #ifndef SvREFCNT_inc_simple # ifdef PERL_USE_GCC_BRACE_GROUPS # define SvREFCNT_inc_simple(sv) \ ({ \ if (sv) \ (SvREFCNT(sv))++; \ (SV *)(sv); \ }) # else # define SvREFCNT_inc_simple(sv) \ ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL) # endif #endif #ifndef SvREFCNT_inc_NN # ifdef PERL_USE_GCC_BRACE_GROUPS # define SvREFCNT_inc_NN(sv) \ ({ \ SV * const _sv = (SV*)(sv); \ SvREFCNT(_sv)++; \ _sv; \ }) # else # define SvREFCNT_inc_NN(sv) \ (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv) # endif #endif #ifndef SvREFCNT_inc_void # ifdef PERL_USE_GCC_BRACE_GROUPS # define SvREFCNT_inc_void(sv) \ ({ \ SV * const _sv = (SV*)(sv); \ if (_sv) \ (void)(SvREFCNT(_sv)++); \ }) # else # define SvREFCNT_inc_void(sv) \ (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0) # endif #endif #ifndef SvREFCNT_inc_simple_void # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END #endif #ifndef SvREFCNT_inc_simple_NN # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv)) #endif #ifndef SvREFCNT_inc_void_NN # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) #endif #ifndef SvREFCNT_inc_simple_void_NN # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) #endif #ifndef newSV_type #if defined(NEED_newSV_type) static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t); static #else extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t); #endif #ifdef newSV_type # undef newSV_type #endif #define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a) #define Perl_newSV_type DPPP_(my_newSV_type) #if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL) SV* DPPP_(my_newSV_type)(pTHX_ svtype const t) { SV* const sv = newSV(0); sv_upgrade(sv, t); return sv; } #endif #endif #if (PERL_BCDVERSION < 0x5006000) # define D_PPP_CONSTPV_ARG(x) ((char *) (x)) #else # define D_PPP_CONSTPV_ARG(x) (x) #endif #ifndef newSVpvn # define newSVpvn(data,len) ((data) \ ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \ : newSV(0)) #endif #ifndef newSVpvn_utf8 # define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0) #endif #ifndef SVf_UTF8 # define SVf_UTF8 0 #endif #ifndef newSVpvn_flags #if defined(NEED_newSVpvn_flags) static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags); static #else extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags); #endif #ifdef newSVpvn_flags # undef newSVpvn_flags #endif #define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c) #define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags) #if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL) SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags) { SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len); SvFLAGS(sv) |= (flags & SVf_UTF8); return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv; } #endif #endif /* Backwards compatibility stuff... :-( */ #if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen) # define NEED_sv_2pv_flags #endif #if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL) # define NEED_sv_2pv_flags_GLOBAL #endif /* Hint: sv_2pv_nolen * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen(). */ #ifndef sv_2pv_nolen # define sv_2pv_nolen(sv) SvPV_nolen(sv) #endif #ifdef SvPVbyte /* Hint: SvPVbyte * Does not work in perl-5.6.1, ppport.h implements a version * borrowed from perl-5.7.3. */ #if (PERL_BCDVERSION < 0x5007000) #if defined(NEED_sv_2pvbyte) static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp); static #else extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp); #endif #ifdef sv_2pvbyte # undef sv_2pvbyte #endif #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b) #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte) #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL) char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp) { sv_utf8_downgrade(sv,0); return SvPV(sv,*lp); } #endif /* Hint: sv_2pvbyte * Use the SvPVbyte() macro instead of sv_2pvbyte(). */ #undef SvPVbyte #define SvPVbyte(sv, lp) \ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp)) #endif #else # define SvPVbyte SvPV # define sv_2pvbyte sv_2pv #endif #ifndef sv_2pvbyte_nolen # define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv) #endif /* Hint: sv_pvn * Always use the SvPV() macro instead of sv_pvn(). */ /* Hint: sv_pvn_force * Always use the SvPV_force() macro instead of sv_pvn_force(). */ /* If these are undefined, they're not handled by the core anyway */ #ifndef SV_IMMEDIATE_UNREF # define SV_IMMEDIATE_UNREF 0 #endif #ifndef SV_GMAGIC # define SV_GMAGIC 0 #endif #ifndef SV_COW_DROP_PV # define SV_COW_DROP_PV 0 #endif #ifndef SV_UTF8_NO_ENCODING # define SV_UTF8_NO_ENCODING 0 #endif #ifndef SV_NOSTEAL # define SV_NOSTEAL 0 #endif #ifndef SV_CONST_RETURN # define SV_CONST_RETURN 0 #endif #ifndef SV_MUTABLE_RETURN # define SV_MUTABLE_RETURN 0 #endif #ifndef SV_SMAGIC # define SV_SMAGIC 0 #endif #ifndef SV_HAS_TRAILING_NUL # define SV_HAS_TRAILING_NUL 0 #endif #ifndef SV_COW_SHARED_HASH_KEYS # define SV_COW_SHARED_HASH_KEYS 0 #endif #if (PERL_BCDVERSION < 0x5007002) #if defined(NEED_sv_2pv_flags) static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags); static #else extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags); #endif #ifdef sv_2pv_flags # undef sv_2pv_flags #endif #define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c) #define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags) #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL) char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags) { STRLEN n_a = (STRLEN) flags; return sv_2pv(sv, lp ? lp : &n_a); } #endif #if defined(NEED_sv_pvn_force_flags) static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags); static #else extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags); #endif #ifdef sv_pvn_force_flags # undef sv_pvn_force_flags #endif #define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c) #define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags) #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL) char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags) { STRLEN n_a = (STRLEN) flags; return sv_pvn_force(sv, lp ? lp : &n_a); } #endif #endif #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) ) # define DPPP_SVPV_NOLEN_LP_ARG &PL_na #else # define DPPP_SVPV_NOLEN_LP_ARG 0 #endif #ifndef SvPV_const # define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC) #endif #ifndef SvPV_mutable # define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC) #endif #ifndef SvPV_flags # define SvPV_flags(sv, lp, flags) \ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags)) #endif #ifndef SvPV_flags_const # define SvPV_flags_const(sv, lp, flags) \ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \ (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN)) #endif #ifndef SvPV_flags_const_nolen # define SvPV_flags_const_nolen(sv, flags) \ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ ? SvPVX_const(sv) : \ (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN)) #endif #ifndef SvPV_flags_mutable # define SvPV_flags_mutable(sv, lp, flags) \ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \ sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) #endif #ifndef SvPV_force # define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC) #endif #ifndef SvPV_force_nolen # define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC) #endif #ifndef SvPV_force_mutable # define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC) #endif #ifndef SvPV_force_nomg # define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0) #endif #ifndef SvPV_force_nomg_nolen # define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0) #endif #ifndef SvPV_force_flags # define SvPV_force_flags(sv, lp, flags) \ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags)) #endif #ifndef SvPV_force_flags_nolen # define SvPV_force_flags_nolen(sv, flags) \ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags)) #endif #ifndef SvPV_force_flags_mutable # define SvPV_force_flags_mutable(sv, lp, flags) \ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \ : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) #endif #ifndef SvPV_nolen # define SvPV_nolen(sv) \ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC)) #endif #ifndef SvPV_nolen_const # define SvPV_nolen_const(sv) \ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN)) #endif #ifndef SvPV_nomg # define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0) #endif #ifndef SvPV_nomg_const # define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0) #endif #ifndef SvPV_nomg_const_nolen # define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0) #endif #ifndef SvPV_nomg_nolen # define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, 0)) #endif #ifndef SvPV_renew # define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \ SvPV_set((sv), (char *) saferealloc( \ (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \ } STMT_END #endif #ifndef SvMAGIC_set # define SvMAGIC_set(sv, val) \ STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END #endif #if (PERL_BCDVERSION < 0x5009003) #ifndef SvPVX_const # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv))) #endif #ifndef SvPVX_mutable # define SvPVX_mutable(sv) (0 + SvPVX(sv)) #endif #ifndef SvRV_set # define SvRV_set(sv, val) \ STMT_START { assert(SvTYPE(sv) >= SVt_RV); \ (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END #endif #else #ifndef SvPVX_const # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv)) #endif #ifndef SvPVX_mutable # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv) #endif #ifndef SvRV_set # define SvRV_set(sv, val) \ STMT_START { assert(SvTYPE(sv) >= SVt_RV); \ ((sv)->sv_u.svu_rv = (val)); } STMT_END #endif #endif #ifndef SvSTASH_set # define SvSTASH_set(sv, val) \ STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END #endif #if (PERL_BCDVERSION < 0x5004000) #ifndef SvUV_set # define SvUV_set(sv, val) \ STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \ (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END #endif #else #ifndef SvUV_set # define SvUV_set(sv, val) \ STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \ (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END #endif #endif #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf) #if defined(NEED_vnewSVpvf) static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args); static #else extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args); #endif #ifdef vnewSVpvf # undef vnewSVpvf #endif #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b) #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf) #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL) SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args) { register SV *sv = newSV(0); sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); return sv; } #endif #endif #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf) # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) #endif #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf) # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) #endif #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg) #if defined(NEED_sv_catpvf_mg) static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...); static #else extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...); #endif #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg) #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL) void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...) { va_list args; va_start(args, pat); sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); SvSETMAGIC(sv); va_end(args); } #endif #endif #ifdef PERL_IMPLICIT_CONTEXT #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext) #if defined(NEED_sv_catpvf_mg_nocontext) static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...); static #else extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...); #endif #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL) void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...) { dTHX; va_list args; va_start(args, pat); sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); SvSETMAGIC(sv); va_end(args); } #endif #endif #endif /* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */ #ifndef sv_catpvf_mg # ifdef PERL_IMPLICIT_CONTEXT # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext # else # define sv_catpvf_mg Perl_sv_catpvf_mg # endif #endif #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg) # define sv_vcatpvf_mg(sv, pat, args) \ STMT_START { \ sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ SvSETMAGIC(sv); \ } STMT_END #endif #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg) #if defined(NEED_sv_setpvf_mg) static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...); static #else extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...); #endif #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg) #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL) void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...) { va_list args; va_start(args, pat); sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); SvSETMAGIC(sv); va_end(args); } #endif #endif #ifdef PERL_IMPLICIT_CONTEXT #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext) #if defined(NEED_sv_setpvf_mg_nocontext) static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...); static #else extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...); #endif #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL) void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...) { dTHX; va_list args; va_start(args, pat); sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); SvSETMAGIC(sv); va_end(args); } #endif #endif #endif /* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */ #ifndef sv_setpvf_mg # ifdef PERL_IMPLICIT_CONTEXT # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext # else # define sv_setpvf_mg Perl_sv_setpvf_mg # endif #endif #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg) # define sv_vsetpvf_mg(sv, pat, args) \ STMT_START { \ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ SvSETMAGIC(sv); \ } STMT_END #endif /* Hint: newSVpvn_share * The SVs created by this function only mimic the behaviour of * shared PVs without really being shared. Only use if you know * what you're doing. */ #ifndef newSVpvn_share #if defined(NEED_newSVpvn_share) static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash); static #else extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash); #endif #ifdef newSVpvn_share # undef newSVpvn_share #endif #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c) #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share) #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL) SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash) { SV *sv; if (len < 0) len = -len; if (!hash) PERL_HASH(hash, (char*) src, len); sv = newSVpvn((char *) src, len); sv_upgrade(sv, SVt_PVIV); SvIVX(sv) = hash; SvREADONLY_on(sv); SvPOK_on(sv); return sv; } #endif #endif #ifndef SvSHARED_HASH # define SvSHARED_HASH(sv) (0 + SvUVX(sv)) #endif #ifndef HvNAME_get # define HvNAME_get(hv) HvNAME(hv) #endif #ifndef HvNAMELEN_get # define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0) #endif #ifndef GvSVn # define GvSVn(gv) GvSV(gv) #endif #ifndef isGV_with_GP # define isGV_with_GP(gv) isGV(gv) #endif #ifndef gv_fetchpvn_flags # define gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt) #endif #ifndef gv_fetchsv # define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt) #endif #ifndef get_cvn_flags # define get_cvn_flags(name, namelen, flags) get_cv(name, flags) #endif #ifndef WARN_ALL # define WARN_ALL 0 #endif #ifndef WARN_CLOSURE # define WARN_CLOSURE 1 #endif #ifndef WARN_DEPRECATED # define WARN_DEPRECATED 2 #endif #ifndef WARN_EXITING # define WARN_EXITING 3 #endif #ifndef WARN_GLOB # define WARN_GLOB 4 #endif #ifndef WARN_IO # define WARN_IO 5 #endif #ifndef WARN_CLOSED # define WARN_CLOSED 6 #endif #ifndef WARN_EXEC # define WARN_EXEC 7 #endif #ifndef WARN_LAYER # define WARN_LAYER 8 #endif #ifndef WARN_NEWLINE # define WARN_NEWLINE 9 #endif #ifndef WARN_PIPE # define WARN_PIPE 10 #endif #ifndef WARN_UNOPENED # define WARN_UNOPENED 11 #endif #ifndef WARN_MISC # define WARN_MISC 12 #endif #ifndef WARN_NUMERIC # define WARN_NUMERIC 13 #endif #ifndef WARN_ONCE # define WARN_ONCE 14 #endif #ifndef WARN_OVERFLOW # define WARN_OVERFLOW 15 #endif #ifndef WARN_PACK # define WARN_PACK 16 #endif #ifndef WARN_PORTABLE # define WARN_PORTABLE 17 #endif #ifndef WARN_RECURSION # define WARN_RECURSION 18 #endif #ifndef WARN_REDEFINE # define WARN_REDEFINE 19 #endif #ifndef WARN_REGEXP # define WARN_REGEXP 20 #endif #ifndef WARN_SEVERE # define WARN_SEVERE 21 #endif #ifndef WARN_DEBUGGING # define WARN_DEBUGGING 22 #endif #ifndef WARN_INPLACE # define WARN_INPLACE 23 #endif #ifndef WARN_INTERNAL # define WARN_INTERNAL 24 #endif #ifndef WARN_MALLOC # define WARN_MALLOC 25 #endif #ifndef WARN_SIGNAL # define WARN_SIGNAL 26 #endif #ifndef WARN_SUBSTR # define WARN_SUBSTR 27 #endif #ifndef WARN_SYNTAX # define WARN_SYNTAX 28 #endif #ifndef WARN_AMBIGUOUS # define WARN_AMBIGUOUS 29 #endif #ifndef WARN_BAREWORD # define WARN_BAREWORD 30 #endif #ifndef WARN_DIGIT # define WARN_DIGIT 31 #endif #ifndef WARN_PARENTHESIS # define WARN_PARENTHESIS 32 #endif #ifndef WARN_PRECEDENCE # define WARN_PRECEDENCE 33 #endif #ifndef WARN_PRINTF # define WARN_PRINTF 34 #endif #ifndef WARN_PROTOTYPE # define WARN_PROTOTYPE 35 #endif #ifndef WARN_QW # define WARN_QW 36 #endif #ifndef WARN_RESERVED # define WARN_RESERVED 37 #endif #ifndef WARN_SEMICOLON # define WARN_SEMICOLON 38 #endif #ifndef WARN_TAINT # define WARN_TAINT 39 #endif #ifndef WARN_THREADS # define WARN_THREADS 40 #endif #ifndef WARN_UNINITIALIZED # define WARN_UNINITIALIZED 41 #endif #ifndef WARN_UNPACK # define WARN_UNPACK 42 #endif #ifndef WARN_UNTIE # define WARN_UNTIE 43 #endif #ifndef WARN_UTF8 # define WARN_UTF8 44 #endif #ifndef WARN_VOID # define WARN_VOID 45 #endif #ifndef WARN_ASSERTIONS # define WARN_ASSERTIONS 46 #endif #ifndef packWARN # define packWARN(a) (a) #endif #ifndef ckWARN # ifdef G_WARN_ON # define ckWARN(a) (PL_dowarn & G_WARN_ON) # else # define ckWARN(a) PL_dowarn # endif #endif #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner) #if defined(NEED_warner) static void DPPP_(my_warner)(U32 err, const char *pat, ...); static #else extern void DPPP_(my_warner)(U32 err, const char *pat, ...); #endif #define Perl_warner DPPP_(my_warner) #if defined(NEED_warner) || defined(NEED_warner_GLOBAL) void DPPP_(my_warner)(U32 err, const char *pat, ...) { SV *sv; va_list args; PERL_UNUSED_ARG(err); va_start(args, pat); sv = vnewSVpvf(pat, &args); va_end(args); sv_2mortal(sv); warn("%s", SvPV_nolen(sv)); } #define warner Perl_warner #define Perl_warner_nocontext Perl_warner #endif #endif /* concatenating with "" ensures that only literal strings are accepted as argument * note that STR_WITH_LEN() can't be used as argument to macros or functions that * under some configurations might be macros */ #ifndef STR_WITH_LEN # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1) #endif #ifndef newSVpvs # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1) #endif #ifndef newSVpvs_flags # define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags) #endif #ifndef newSVpvs_share # define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0) #endif #ifndef sv_catpvs # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1) #endif #ifndef sv_setpvs # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1) #endif #ifndef hv_fetchs # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval) #endif #ifndef hv_stores # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0) #endif #ifndef gv_fetchpvs # define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt) #endif #ifndef gv_stashpvs # define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags) #endif #ifndef get_cvs # define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags) #endif #ifndef SvGETMAGIC # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END #endif #ifndef PERL_MAGIC_sv # define PERL_MAGIC_sv '\0' #endif #ifndef PERL_MAGIC_overload # define PERL_MAGIC_overload 'A' #endif #ifndef PERL_MAGIC_overload_elem # define PERL_MAGIC_overload_elem 'a' #endif #ifndef PERL_MAGIC_overload_table # define PERL_MAGIC_overload_table 'c' #endif #ifndef PERL_MAGIC_bm # define PERL_MAGIC_bm 'B' #endif #ifndef PERL_MAGIC_regdata # define PERL_MAGIC_regdata 'D' #endif #ifndef PERL_MAGIC_regdatum # define PERL_MAGIC_regdatum 'd' #endif #ifndef PERL_MAGIC_env # define PERL_MAGIC_env 'E' #endif #ifndef PERL_MAGIC_envelem # define PERL_MAGIC_envelem 'e' #endif #ifndef PERL_MAGIC_fm # define PERL_MAGIC_fm 'f' #endif #ifndef PERL_MAGIC_regex_global # define PERL_MAGIC_regex_global 'g' #endif #ifndef PERL_MAGIC_isa # define PERL_MAGIC_isa 'I' #endif #ifndef PERL_MAGIC_isaelem # define PERL_MAGIC_isaelem 'i' #endif #ifndef PERL_MAGIC_nkeys # define PERL_MAGIC_nkeys 'k' #endif #ifndef PERL_MAGIC_dbfile # define PERL_MAGIC_dbfile 'L' #endif #ifndef PERL_MAGIC_dbline # define PERL_MAGIC_dbline 'l' #endif #ifndef PERL_MAGIC_mutex # define PERL_MAGIC_mutex 'm' #endif #ifndef PERL_MAGIC_shared # define PERL_MAGIC_shared 'N' #endif #ifndef PERL_MAGIC_shared_scalar # define PERL_MAGIC_shared_scalar 'n' #endif #ifndef PERL_MAGIC_collxfrm # define PERL_MAGIC_collxfrm 'o' #endif #ifndef PERL_MAGIC_tied # define PERL_MAGIC_tied 'P' #endif #ifndef PERL_MAGIC_tiedelem # define PERL_MAGIC_tiedelem 'p' #endif #ifndef PERL_MAGIC_tiedscalar # define PERL_MAGIC_tiedscalar 'q' #endif #ifndef PERL_MAGIC_qr # define PERL_MAGIC_qr 'r' #endif #ifndef PERL_MAGIC_sig # define PERL_MAGIC_sig 'S' #endif #ifndef PERL_MAGIC_sigelem # define PERL_MAGIC_sigelem 's' #endif #ifndef PERL_MAGIC_taint # define PERL_MAGIC_taint 't' #endif #ifndef PERL_MAGIC_uvar # define PERL_MAGIC_uvar 'U' #endif #ifndef PERL_MAGIC_uvar_elem # define PERL_MAGIC_uvar_elem 'u' #endif #ifndef PERL_MAGIC_vstring # define PERL_MAGIC_vstring 'V' #endif #ifndef PERL_MAGIC_vec # define PERL_MAGIC_vec 'v' #endif #ifndef PERL_MAGIC_utf8 # define PERL_MAGIC_utf8 'w' #endif #ifndef PERL_MAGIC_substr # define PERL_MAGIC_substr 'x' #endif #ifndef PERL_MAGIC_defelem # define PERL_MAGIC_defelem 'y' #endif #ifndef PERL_MAGIC_glob # define PERL_MAGIC_glob '*' #endif #ifndef PERL_MAGIC_arylen # define PERL_MAGIC_arylen '#' #endif #ifndef PERL_MAGIC_pos # define PERL_MAGIC_pos '.' #endif #ifndef PERL_MAGIC_backref # define PERL_MAGIC_backref '<' #endif #ifndef PERL_MAGIC_ext # define PERL_MAGIC_ext '~' #endif /* That's the best we can do... */ #ifndef sv_catpvn_nomg # define sv_catpvn_nomg sv_catpvn #endif #ifndef sv_catsv_nomg # define sv_catsv_nomg sv_catsv #endif #ifndef sv_setsv_nomg # define sv_setsv_nomg sv_setsv #endif #ifndef sv_pvn_nomg # define sv_pvn_nomg sv_pvn #endif #ifndef SvIV_nomg # define SvIV_nomg SvIV #endif #ifndef SvUV_nomg # define SvUV_nomg SvUV #endif #ifndef sv_catpv_mg # define sv_catpv_mg(sv, ptr) \ STMT_START { \ SV *TeMpSv = sv; \ sv_catpv(TeMpSv,ptr); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_catpvn_mg # define sv_catpvn_mg(sv, ptr, len) \ STMT_START { \ SV *TeMpSv = sv; \ sv_catpvn(TeMpSv,ptr,len); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_catsv_mg # define sv_catsv_mg(dsv, ssv) \ STMT_START { \ SV *TeMpSv = dsv; \ sv_catsv(TeMpSv,ssv); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_setiv_mg # define sv_setiv_mg(sv, i) \ STMT_START { \ SV *TeMpSv = sv; \ sv_setiv(TeMpSv,i); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_setnv_mg # define sv_setnv_mg(sv, num) \ STMT_START { \ SV *TeMpSv = sv; \ sv_setnv(TeMpSv,num); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_setpv_mg # define sv_setpv_mg(sv, ptr) \ STMT_START { \ SV *TeMpSv = sv; \ sv_setpv(TeMpSv,ptr); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_setpvn_mg # define sv_setpvn_mg(sv, ptr, len) \ STMT_START { \ SV *TeMpSv = sv; \ sv_setpvn(TeMpSv,ptr,len); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_setsv_mg # define sv_setsv_mg(dsv, ssv) \ STMT_START { \ SV *TeMpSv = dsv; \ sv_setsv(TeMpSv,ssv); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_setuv_mg # define sv_setuv_mg(sv, i) \ STMT_START { \ SV *TeMpSv = sv; \ sv_setuv(TeMpSv,i); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_usepvn_mg # define sv_usepvn_mg(sv, ptr, len) \ STMT_START { \ SV *TeMpSv = sv; \ sv_usepvn(TeMpSv,ptr,len); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef SvVSTRING_mg # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL) #endif /* Hint: sv_magic_portable * This is a compatibility function that is only available with * Devel::PPPort. It is NOT in the perl core. * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when * it is being passed a name pointer with namlen == 0. In that * case, perl 5.8.0 and later store the pointer, not a copy of it. * The compatibility can be provided back to perl 5.004. With * earlier versions, the code will not compile. */ #if (PERL_BCDVERSION < 0x5004000) /* code that uses sv_magic_portable will not compile */ #elif (PERL_BCDVERSION < 0x5008000) # define sv_magic_portable(sv, obj, how, name, namlen) \ STMT_START { \ SV *SvMp_sv = (sv); \ char *SvMp_name = (char *) (name); \ I32 SvMp_namlen = (namlen); \ if (SvMp_name && SvMp_namlen == 0) \ { \ MAGIC *mg; \ sv_magic(SvMp_sv, obj, how, 0, 0); \ mg = SvMAGIC(SvMp_sv); \ mg->mg_len = -42; /* XXX: this is the tricky part */ \ mg->mg_ptr = SvMp_name; \ } \ else \ { \ sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \ } \ } STMT_END #else # define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e) #endif #ifdef USE_ITHREADS #ifndef CopFILE # define CopFILE(c) ((c)->cop_file) #endif #ifndef CopFILEGV # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv) #endif #ifndef CopFILE_set # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) #endif #ifndef CopFILESV # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv) #endif #ifndef CopFILEAV # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav) #endif #ifndef CopSTASHPV # define CopSTASHPV(c) ((c)->cop_stashpv) #endif #ifndef CopSTASHPV_set # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch)) #endif #ifndef CopSTASH # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv) #endif #ifndef CopSTASH_set # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch) #endif #ifndef CopSTASH_eq # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \ || (CopSTASHPV(c) && HvNAME(hv) \ && strEQ(CopSTASHPV(c), HvNAME(hv))))) #endif #else #ifndef CopFILEGV # define CopFILEGV(c) ((c)->cop_filegv) #endif #ifndef CopFILEGV_set # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv)) #endif #ifndef CopFILE_set # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv)) #endif #ifndef CopFILESV # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv) #endif #ifndef CopFILEAV # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav) #endif #ifndef CopFILE # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch) #endif #ifndef CopSTASH # define CopSTASH(c) ((c)->cop_stash) #endif #ifndef CopSTASH_set # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv)) #endif #ifndef CopSTASHPV # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch) #endif #ifndef CopSTASHPV_set # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) #endif #ifndef CopSTASH_eq # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) #endif #endif /* USE_ITHREADS */ #ifndef IN_PERL_COMPILETIME # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling) #endif #ifndef IN_LOCALE_RUNTIME # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) #endif #ifndef IN_LOCALE_COMPILETIME # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) #endif #ifndef IN_LOCALE # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) #endif #ifndef IS_NUMBER_IN_UV # define IS_NUMBER_IN_UV 0x01 #endif #ifndef IS_NUMBER_GREATER_THAN_UV_MAX # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 #endif #ifndef IS_NUMBER_NOT_INT # define IS_NUMBER_NOT_INT 0x04 #endif #ifndef IS_NUMBER_NEG # define IS_NUMBER_NEG 0x08 #endif #ifndef IS_NUMBER_INFINITY # define IS_NUMBER_INFINITY 0x10 #endif #ifndef IS_NUMBER_NAN # define IS_NUMBER_NAN 0x20 #endif #ifndef GROK_NUMERIC_RADIX # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) #endif #ifndef PERL_SCAN_GREATER_THAN_UV_MAX # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 #endif #ifndef PERL_SCAN_SILENT_ILLDIGIT # define PERL_SCAN_SILENT_ILLDIGIT 0x04 #endif #ifndef PERL_SCAN_ALLOW_UNDERSCORES # define PERL_SCAN_ALLOW_UNDERSCORES 0x01 #endif #ifndef PERL_SCAN_DISALLOW_PREFIX # define PERL_SCAN_DISALLOW_PREFIX 0x02 #endif #ifndef grok_numeric_radix #if defined(NEED_grok_numeric_radix) static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send); static #else extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send); #endif #ifdef grok_numeric_radix # undef grok_numeric_radix #endif #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b) #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix) #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL) bool DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send) { #ifdef USE_LOCALE_NUMERIC #ifdef PL_numeric_radix_sv if (PL_numeric_radix_sv && IN_LOCALE) { STRLEN len; char* radix = SvPV(PL_numeric_radix_sv, len); if (*sp + len <= send && memEQ(*sp, radix, len)) { *sp += len; return TRUE; } } #else /* older perls don't have PL_numeric_radix_sv so the radix * must manually be requested from locale.h */ #include dTHR; /* needed for older threaded perls */ struct lconv *lc = localeconv(); char *radix = lc->decimal_point; if (radix && IN_LOCALE) { STRLEN len = strlen(radix); if (*sp + len <= send && memEQ(*sp, radix, len)) { *sp += len; return TRUE; } } #endif #endif /* USE_LOCALE_NUMERIC */ /* always try "." if numeric radix didn't match because * we may have data from different locales mixed */ if (*sp < send && **sp == '.') { ++*sp; return TRUE; } return FALSE; } #endif #endif #ifndef grok_number #if defined(NEED_grok_number) static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep); static #else extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep); #endif #ifdef grok_number # undef grok_number #endif #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c) #define Perl_grok_number DPPP_(my_grok_number) #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL) int DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep) { const char *s = pv; const char *send = pv + len; const UV max_div_10 = UV_MAX / 10; const char max_mod_10 = UV_MAX % 10; int numtype = 0; int sawinf = 0; int sawnan = 0; while (s < send && isSPACE(*s)) s++; if (s == send) { return 0; } else if (*s == '-') { s++; numtype = IS_NUMBER_NEG; } else if (*s == '+') s++; if (s == send) return 0; /* next must be digit or the radix separator or beginning of infinity */ if (isDIGIT(*s)) { /* UVs are at least 32 bits, so the first 9 decimal digits cannot overflow. */ UV value = *s - '0'; /* This construction seems to be more optimiser friendly. (without it gcc does the isDIGIT test and the *s - '0' separately) With it gcc on arm is managing 6 instructions (6 cycles) per digit. In theory the optimiser could deduce how far to unroll the loop before checking for overflow. */ if (++s < send) { int digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { /* Now got 9 digits, so need to check each time for overflow. */ digit = *s - '0'; while (digit >= 0 && digit <= 9 && (value < max_div_10 || (value == max_div_10 && digit <= max_mod_10))) { value = value * 10 + digit; if (++s < send) digit = *s - '0'; else break; } if (digit >= 0 && digit <= 9 && (s < send)) { /* value overflowed. skip the remaining digits, don't worry about setting *valuep. */ do { s++; } while (s < send && isDIGIT(*s)); numtype |= IS_NUMBER_GREATER_THAN_UV_MAX; goto skip_value; } } } } } } } } } } } } } } } } } } numtype |= IS_NUMBER_IN_UV; if (valuep) *valuep = value; skip_value: if (GROK_NUMERIC_RADIX(&s, send)) { numtype |= IS_NUMBER_NOT_INT; while (s < send && isDIGIT(*s)) /* optional digits after the radix */ s++; } } else if (GROK_NUMERIC_RADIX(&s, send)) { numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */ /* no digits before the radix means we need digits after it */ if (s < send && isDIGIT(*s)) { do { s++; } while (s < send && isDIGIT(*s)); if (valuep) { /* integer approximation is valid - it's 0. */ *valuep = 0; } } else return 0; } else if (*s == 'I' || *s == 'i') { s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; s++; if (s == send || (*s != 'F' && *s != 'f')) return 0; s++; if (s < send && (*s == 'I' || *s == 'i')) { s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; s++; if (s == send || (*s != 'I' && *s != 'i')) return 0; s++; if (s == send || (*s != 'T' && *s != 't')) return 0; s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0; s++; } sawinf = 1; } else if (*s == 'N' || *s == 'n') { /* XXX TODO: There are signaling NaNs and quiet NaNs. */ s++; if (s == send || (*s != 'A' && *s != 'a')) return 0; s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; s++; sawnan = 1; } else return 0; if (sawinf) { numtype &= IS_NUMBER_NEG; /* Keep track of sign */ numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT; } else if (sawnan) { numtype &= IS_NUMBER_NEG; /* Keep track of sign */ numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT; } else if (s < send) { /* we can have an optional exponent part */ if (*s == 'e' || *s == 'E') { /* The only flag we keep is sign. Blow away any "it's UV" */ numtype &= IS_NUMBER_NEG; numtype |= IS_NUMBER_NOT_INT; s++; if (s < send && (*s == '-' || *s == '+')) s++; if (s < send && isDIGIT(*s)) { do { s++; } while (s < send && isDIGIT(*s)); } else return 0; } } while (s < send && isSPACE(*s)) s++; if (s >= send) return numtype; if (len == 10 && memEQ(pv, "0 but true", 10)) { if (valuep) *valuep = 0; return IS_NUMBER_IN_UV; } return 0; } #endif #endif /* * The grok_* routines have been modified to use warn() instead of * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit, * which is why the stack variable has been renamed to 'xdigit'. */ #ifndef grok_bin #if defined(NEED_grok_bin) static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); static #else extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); #endif #ifdef grok_bin # undef grok_bin #endif #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d) #define Perl_grok_bin DPPP_(my_grok_bin) #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL) UV DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) { const char *s = start; STRLEN len = *len_p; UV value = 0; NV value_nv = 0; const UV max_div_2 = UV_MAX / 2; bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; bool overflowed = FALSE; if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { /* strip off leading b or 0b. for compatibility silently suffer "b" and "0b" as valid binary numbers. */ if (len >= 1) { if (s[0] == 'b') { s++; len--; } else if (len >= 2 && s[0] == '0' && s[1] == 'b') { s+=2; len-=2; } } } for (; len-- && *s; s++) { char bit = *s; if (bit == '0' || bit == '1') { /* Write it in this wonky order with a goto to attempt to get the compiler to make the common case integer-only loop pretty tight. With gcc seems to be much straighter code than old scan_bin. */ redo: if (!overflowed) { if (value <= max_div_2) { value = (value << 1) | (bit - '0'); continue; } /* Bah. We're just overflowed. */ warn("Integer overflow in binary number"); overflowed = TRUE; value_nv = (NV) value; } value_nv *= 2.0; /* If an NV has not enough bits in its mantissa to * represent a UV this summing of small low-order numbers * is a waste of time (because the NV cannot preserve * the low-order bits anyway): we could just remember when * did we overflow and in the end just multiply value_nv by the * right amount. */ value_nv += (NV)(bit - '0'); continue; } if (bit == '_' && len && allow_underscores && (bit = s[1]) && (bit == '0' || bit == '1')) { --len; ++s; goto redo; } if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) warn("Illegal binary digit '%c' ignored", *s); break; } if ( ( overflowed && value_nv > 4294967295.0) #if UVSIZE > 4 || (!overflowed && value > 0xffffffff ) #endif ) { warn("Binary number > 0b11111111111111111111111111111111 non-portable"); } *len_p = s - start; if (!overflowed) { *flags = 0; return value; } *flags = PERL_SCAN_GREATER_THAN_UV_MAX; if (result) *result = value_nv; return UV_MAX; } #endif #endif #ifndef grok_hex #if defined(NEED_grok_hex) static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); static #else extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); #endif #ifdef grok_hex # undef grok_hex #endif #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d) #define Perl_grok_hex DPPP_(my_grok_hex) #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL) UV DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) { const char *s = start; STRLEN len = *len_p; UV value = 0; NV value_nv = 0; const UV max_div_16 = UV_MAX / 16; bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; bool overflowed = FALSE; const char *xdigit; if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { /* strip off leading x or 0x. for compatibility silently suffer "x" and "0x" as valid hex numbers. */ if (len >= 1) { if (s[0] == 'x') { s++; len--; } else if (len >= 2 && s[0] == '0' && s[1] == 'x') { s+=2; len-=2; } } } for (; len-- && *s; s++) { xdigit = strchr((char *) PL_hexdigit, *s); if (xdigit) { /* Write it in this wonky order with a goto to attempt to get the compiler to make the common case integer-only loop pretty tight. With gcc seems to be much straighter code than old scan_hex. */ redo: if (!overflowed) { if (value <= max_div_16) { value = (value << 4) | ((xdigit - PL_hexdigit) & 15); continue; } warn("Integer overflow in hexadecimal number"); overflowed = TRUE; value_nv = (NV) value; } value_nv *= 16.0; /* If an NV has not enough bits in its mantissa to * represent a UV this summing of small low-order numbers * is a waste of time (because the NV cannot preserve * the low-order bits anyway): we could just remember when * did we overflow and in the end just multiply value_nv by the * right amount of 16-tuples. */ value_nv += (NV)((xdigit - PL_hexdigit) & 15); continue; } if (*s == '_' && len && allow_underscores && s[1] && (xdigit = strchr((char *) PL_hexdigit, s[1]))) { --len; ++s; goto redo; } if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) warn("Illegal hexadecimal digit '%c' ignored", *s); break; } if ( ( overflowed && value_nv > 4294967295.0) #if UVSIZE > 4 || (!overflowed && value > 0xffffffff ) #endif ) { warn("Hexadecimal number > 0xffffffff non-portable"); } *len_p = s - start; if (!overflowed) { *flags = 0; return value; } *flags = PERL_SCAN_GREATER_THAN_UV_MAX; if (result) *result = value_nv; return UV_MAX; } #endif #endif #ifndef grok_oct #if defined(NEED_grok_oct) static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); static #else extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); #endif #ifdef grok_oct # undef grok_oct #endif #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d) #define Perl_grok_oct DPPP_(my_grok_oct) #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL) UV DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) { const char *s = start; STRLEN len = *len_p; UV value = 0; NV value_nv = 0; const UV max_div_8 = UV_MAX / 8; bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; bool overflowed = FALSE; for (; len-- && *s; s++) { /* gcc 2.95 optimiser not smart enough to figure that this subtraction out front allows slicker code. */ int digit = *s - '0'; if (digit >= 0 && digit <= 7) { /* Write it in this wonky order with a goto to attempt to get the compiler to make the common case integer-only loop pretty tight. */ redo: if (!overflowed) { if (value <= max_div_8) { value = (value << 3) | digit; continue; } /* Bah. We're just overflowed. */ warn("Integer overflow in octal number"); overflowed = TRUE; value_nv = (NV) value; } value_nv *= 8.0; /* If an NV has not enough bits in its mantissa to * represent a UV this summing of small low-order numbers * is a waste of time (because the NV cannot preserve * the low-order bits anyway): we could just remember when * did we overflow and in the end just multiply value_nv by the * right amount of 8-tuples. */ value_nv += (NV)digit; continue; } if (digit == ('_' - '0') && len && allow_underscores && (digit = s[1] - '0') && (digit >= 0 && digit <= 7)) { --len; ++s; goto redo; } /* Allow \octal to work the DWIM way (that is, stop scanning * as soon as non-octal characters are seen, complain only iff * someone seems to want to use the digits eight and nine). */ if (digit == 8 || digit == 9) { if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) warn("Illegal octal digit '%c' ignored", *s); } break; } if ( ( overflowed && value_nv > 4294967295.0) #if UVSIZE > 4 || (!overflowed && value > 0xffffffff ) #endif ) { warn("Octal number > 037777777777 non-portable"); } *len_p = s - start; if (!overflowed) { *flags = 0; return value; } *flags = PERL_SCAN_GREATER_THAN_UV_MAX; if (result) *result = value_nv; return UV_MAX; } #endif #endif #if !defined(my_snprintf) #if defined(NEED_my_snprintf) static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...); static #else extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...); #endif #define my_snprintf DPPP_(my_my_snprintf) #define Perl_my_snprintf DPPP_(my_my_snprintf) #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL) int DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...) { dTHX; int retval; va_list ap; va_start(ap, format); #ifdef HAS_VSNPRINTF retval = vsnprintf(buffer, len, format, ap); #else retval = vsprintf(buffer, format, ap); #endif va_end(ap); if (retval < 0 || (len > 0 && (Size_t)retval >= len)) Perl_croak(aTHX_ "panic: my_snprintf buffer overflow"); return retval; } #endif #endif #if !defined(my_sprintf) #if defined(NEED_my_sprintf) static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...); static #else extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...); #endif #define my_sprintf DPPP_(my_my_sprintf) #define Perl_my_sprintf DPPP_(my_my_sprintf) #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL) int DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...) { va_list args; va_start(args, pat); vsprintf(buffer, pat, args); va_end(args); return strlen(buffer); } #endif #endif #ifdef NO_XSLOCKS # ifdef dJMPENV # define dXCPT dJMPENV; int rEtV = 0 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0) # define XCPT_TRY_END JMPENV_POP; # define XCPT_CATCH if (rEtV != 0) # define XCPT_RETHROW JMPENV_JUMP(rEtV) # else # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0) # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf); # define XCPT_CATCH if (rEtV != 0) # define XCPT_RETHROW Siglongjmp(top_env, rEtV) # endif #endif #if !defined(my_strlcat) #if defined(NEED_my_strlcat) static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size); static #else extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size); #endif #define my_strlcat DPPP_(my_my_strlcat) #define Perl_my_strlcat DPPP_(my_my_strlcat) #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL) Size_t DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size) { Size_t used, length, copy; used = strlen(dst); length = strlen(src); if (size > 0 && used < size - 1) { copy = (length >= size - used) ? size - used - 1 : length; memcpy(dst + used, src, copy); dst[used + copy] = '\0'; } return used + length; } #endif #endif #if !defined(my_strlcpy) #if defined(NEED_my_strlcpy) static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size); static #else extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size); #endif #define my_strlcpy DPPP_(my_my_strlcpy) #define Perl_my_strlcpy DPPP_(my_my_strlcpy) #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL) Size_t DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size) { Size_t length, copy; length = strlen(src); if (size > 0) { copy = (length >= size) ? size - 1 : length; memcpy(dst, src, copy); dst[copy] = '\0'; } return length; } #endif #endif #ifndef PERL_PV_ESCAPE_QUOTE # define PERL_PV_ESCAPE_QUOTE 0x0001 #endif #ifndef PERL_PV_PRETTY_QUOTE # define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE #endif #ifndef PERL_PV_PRETTY_ELLIPSES # define PERL_PV_PRETTY_ELLIPSES 0x0002 #endif #ifndef PERL_PV_PRETTY_LTGT # define PERL_PV_PRETTY_LTGT 0x0004 #endif #ifndef PERL_PV_ESCAPE_FIRSTCHAR # define PERL_PV_ESCAPE_FIRSTCHAR 0x0008 #endif #ifndef PERL_PV_ESCAPE_UNI # define PERL_PV_ESCAPE_UNI 0x0100 #endif #ifndef PERL_PV_ESCAPE_UNI_DETECT # define PERL_PV_ESCAPE_UNI_DETECT 0x0200 #endif #ifndef PERL_PV_ESCAPE_ALL # define PERL_PV_ESCAPE_ALL 0x1000 #endif #ifndef PERL_PV_ESCAPE_NOBACKSLASH # define PERL_PV_ESCAPE_NOBACKSLASH 0x2000 #endif #ifndef PERL_PV_ESCAPE_NOCLEAR # define PERL_PV_ESCAPE_NOCLEAR 0x4000 #endif #ifndef PERL_PV_ESCAPE_RE # define PERL_PV_ESCAPE_RE 0x8000 #endif #ifndef PERL_PV_PRETTY_NOCLEAR # define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR #endif #ifndef PERL_PV_PRETTY_DUMP # define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE #endif #ifndef PERL_PV_PRETTY_REGPROP # define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE #endif /* Hint: pv_escape * Note that unicode functionality is only backported to * those perl versions that support it. For older perl * versions, the implementation will fall back to bytes. */ #ifndef pv_escape #if defined(NEED_pv_escape) static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags); static #else extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags); #endif #ifdef pv_escape # undef pv_escape #endif #define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f) #define Perl_pv_escape DPPP_(my_pv_escape) #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL) char * DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags) { const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\'; const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc; char octbuf[32] = "%123456789ABCDF"; STRLEN wrote = 0; STRLEN chsize = 0; STRLEN readsize = 1; #if defined(is_utf8_string) && defined(utf8_to_uvchr) bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0; #endif const char *pv = str; const char * const end = pv + count; octbuf[0] = esc; if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) sv_setpvs(dsv, ""); #if defined(is_utf8_string) && defined(utf8_to_uvchr) if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count)) isuni = 1; #endif for (; pv < end && (!max || wrote < max) ; pv += readsize) { const UV u = #if defined(is_utf8_string) && defined(utf8_to_uvchr) isuni ? utf8_to_uvchr((U8*)pv, &readsize) : #endif (U8)*pv; const U8 c = (U8)u & 0xFF; if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) { if (flags & PERL_PV_ESCAPE_FIRSTCHAR) chsize = my_snprintf(octbuf, sizeof octbuf, "%"UVxf, u); else chsize = my_snprintf(octbuf, sizeof octbuf, "%cx{%"UVxf"}", esc, u); } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) { chsize = 1; } else { if (c == dq || c == esc || !isPRINT(c)) { chsize = 2; switch (c) { case '\\' : /* fallthrough */ case '%' : if (c == esc) octbuf[1] = esc; else chsize = 1; break; case '\v' : octbuf[1] = 'v'; break; case '\t' : octbuf[1] = 't'; break; case '\r' : octbuf[1] = 'r'; break; case '\n' : octbuf[1] = 'n'; break; case '\f' : octbuf[1] = 'f'; break; case '"' : if (dq == '"') octbuf[1] = '"'; else chsize = 1; break; default: chsize = my_snprintf(octbuf, sizeof octbuf, pv < end && isDIGIT((U8)*(pv+readsize)) ? "%c%03o" : "%c%o", esc, c); } } else { chsize = 1; } } if (max && wrote + chsize > max) { break; } else if (chsize > 1) { sv_catpvn(dsv, octbuf, chsize); wrote += chsize; } else { char tmp[2]; my_snprintf(tmp, sizeof tmp, "%c", c); sv_catpvn(dsv, tmp, 1); wrote++; } if (flags & PERL_PV_ESCAPE_FIRSTCHAR) break; } if (escaped != NULL) *escaped= pv - str; return SvPVX(dsv); } #endif #endif #ifndef pv_pretty #if defined(NEED_pv_pretty) static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags); static #else extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags); #endif #ifdef pv_pretty # undef pv_pretty #endif #define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g) #define Perl_pv_pretty DPPP_(my_pv_pretty) #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL) char * DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags) { const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%'; STRLEN escaped; if (!(flags & PERL_PV_PRETTY_NOCLEAR)) sv_setpvs(dsv, ""); if (dq == '"') sv_catpvs(dsv, "\""); else if (flags & PERL_PV_PRETTY_LTGT) sv_catpvs(dsv, "<"); if (start_color != NULL) sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color)); pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR); if (end_color != NULL) sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color)); if (dq == '"') sv_catpvs(dsv, "\""); else if (flags & PERL_PV_PRETTY_LTGT) sv_catpvs(dsv, ">"); if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count) sv_catpvs(dsv, "..."); return SvPVX(dsv); } #endif #endif #ifndef pv_display #if defined(NEED_pv_display) static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim); static #else extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim); #endif #ifdef pv_display # undef pv_display #endif #define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e) #define Perl_pv_display DPPP_(my_pv_display) #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL) char * DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim) { pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP); if (len > cur && pv[cur] == '\0') sv_catpvs(dsv, "\\0"); return SvPVX(dsv); } #endif #endif #endif /* _P_P_PORTABILITY_H_ */ /* End of File ppport.h */ Math-Prime-Util-0.37/examples/0000755000076400007640000000000012271163661014544 5ustar danadanaMath-Prime-Util-0.37/examples/twin_primes.pl0000755000076400007640000000434512270624726017455 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/prime_iterator prime_iterator_object next_prime is_prime nth_prime_upper prime_precalc/; my $count = shift || 20; # Find twin primes (numbers where p and p+2 are prime) # Time for the first 300k: # # Not iterators: # 0.6s forprimes { say $l if $l+2==$_; $l=$_; } 64764841 # 1.0s bin/primes.pl --twin 2 64764839 # # Iterators with precalc: # 1.6s get_twin_prime_iterator2 # 2.4s get_twin_prime_iterator1 # 4.2s get_twin_prime_iterator3 # 4.5s get_twin_prime_iterator4 (object iterator) # # Iterators without precalc: # 7.7s get_twin_prime_iterator2 # 8.5s get_twin_prime_iterator1 # 10.8s get_twin_prime_iterator3 # 16.7s get_twin_prime_iterator4 (object iterator) # # Alternatives: # 251.9s Math::NumSeq::TwinPrimes (Perl 5.19.7, Math::NumSeq 67) # This speeds things up, but isn't necessary. my $estimate = 5000 + int( nth_prime_upper($count) * 1.4 * log($count) ); prime_precalc($estimate); # Create a twin prime iterator using the prime_iterator construct sub get_twin_prime_iterator1 { my $p = shift || 2; my $it = prime_iterator($p); my $prev = $it->(); # prev = 2 $p = $it->(); # p = 3 return sub { do { ($prev, $p) = ($p, $it->()) } while ($p-$prev) != 2; $prev; }; } # Create a twin prime iterator using the next_prime function # A bit faster than the prime_iterator version. sub get_twin_prime_iterator2 { my $start = shift || 2; my $p = next_prime($start-1); my $prev = next_prime($p); return sub { do { ($prev, $p) = ($p, next_prime($p)) } while ($p-$prev) != 2; $prev; }; } # Use Iterator::Simple #use Iterator::Simple qw/igrep/; #sub get_twin_prime_iterator3 { # my $start = shift || 2; # return igrep { is_prime($_+2) } prime_iterator($start); #} # Not very efficient, using object iterator and peek. sub get_twin_prime_iterator4 { my $p = shift || 2; my $it = Math::Prime::Util::prime_iterator_object($p); $p = $it->value(); return sub { $it->next() while $it->peek() - $it->value() != 2; $it->iterate(); }; } my $twinit = get_twin_prime_iterator2(); for (1..$count) { print $twinit->(), "\n"; } Math-Prime-Util-0.37/examples/README0000644000076400007640000000313412271154234015421 0ustar danadana abundant.pl Prints the first N abundant (or deficient, or perfect) numbers. E.g: perl abundant.pl 100 abundant perl abundant.pl 100 deficient perl abundant.pl 15 perfect sophie_germain.pl Prints the first N Sophie-Germain primes. E.g.: perl sophia_germain.pl 100000 twin_primes.pl Prints the first N twin-primes (first value of the pair). E.g.: perl twin_primes.pl 100000 find_mr_bases.pl An example using threads to do a parallel search for good deterministic bases for a Miller-Rabin test. This is definitely not the fastest way to find these, but it's a decent example of quickly trying out an idea. Be sure to set $nthreads to the right value for your machine. It should fully load your CPUs. parallel_fibprime.pl Find Fibonacci primes, in parallel. You will want Math::Prime::Util::GMP installed, as these are many-thousand-digit numbers. porter.pl Various ways of constructing a sequence suggested by Michael B. Porter: a(n) = m s.t. sigma(m) + sigma(m+1) + ... + sigma(m+n-1) is prime. Includes comparison to Pari/GP. verify-cert.pl Takes an MPU or Primo primality certificate and verifies it. This is obsolete, as Math::Prime::Util::GMP now includes C code for this. verify-gmp-ecpp-cert.pl Parses the verbose output of GMP-ECPP to construct a certificate, then runs it through the verification process. verify-sage-ecpp-cert.pl Verifies the output of SAGE's ECPP. The SAGE module looks like it died in development and never got into SAGE. NZMath's ECPP doesn't seem to output a certificate, which makes it much less useful. Math-Prime-Util-0.37/examples/verify-gmp-ecpp-cert.pl0000755000076400007640000000353312266152412021051 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::BigInt try=>"GMP,Pari"; use Math::Prime::Util qw/:all/; use Data::Dump qw/dumpf/; my $bifilter = sub { my($ctx, $n) = @_; return {dump=>"$n"} if ref($n) eq "Math::BigInt"; undef; }; # Takes the output of GMP-ECPP, creates a certificate in the format used # by MPU, and runs it through the verifier. # # Example: # # perl -MMath::Prime::Util=:all -E 'say random_ndigit_prime(60)' | \ # gmp-ecpp -q | \ # perl examples/verify-gmp-eccp-cert.pl my $early_check = 0; my $N; my ($n, $a, $b, $m, $q, $Px, $Py); my @cert; while (<>) { if (/^N\[(\d+)\]\s*=\s*(\d+)/) { $n = $2; if ($1 == 0) { if (defined $N) { # I guess we're done with the last one... print verify_prime(@cert) ? "SUCCESS\n" : "FAILURE\n"; } #die "Bad input" if defined $N; $N = $n; @cert = ($n, "AGKM"); } } elsif (/^a\s*=\s*(\d+)/) { $a = $1; } elsif (/^b\s*=\s*(\d+)/) { $b = $1; } elsif (/^m\s*=\s*(\d+)/) { $m = $1; } elsif (/^q\s*=\s*(\d+)/) { $q = $1; } elsif (/^P\s*=\s*\(\s*(\d+)\s*,\s*(\d+)\s*\)/) { $Px = $1; $Py = $2; die "Bad input\n" unless defined $N && defined $a && defined $b && defined $m && defined $q && defined $Px && defined $Py; # If for a given q value, is_prime returns 2, that indicates it can # produce an n-1 primality proof very quickly, so we could stop now. if ($early_check) { my $bq = Math::BigInt->new("$q"); if (is_prime($bq) == 2) { push @cert, [$n, $a, $b, $m, [prime_certificate($bq)], [$Px,$Py]]; last; } } push @cert, [$n, $a, $b, $m, $q, [$Px,$Py]]; } else { undef $N if /^proven prime/; } } print dumpf(\@cert, $bifilter), "\n"; print verify_prime(@cert) ? "SUCCESS\n" : "FAILURE\n"; Math-Prime-Util-0.37/examples/verify-cert.pl0000755000076400007640000004423612270624726017357 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::BigInt lib=>"GMP,Pari"; use Math::Prime::Util qw/:all/; use Time::HiRes qw(gettimeofday tv_interval); use Getopt::Long; $|++; # MPU and PRIMO certificate verification. # Written by Dana Jacobsen, 2013. # Requires Math::Prime::Util v0.30 or later. # Will be very slow without Math:::Prime::Util::GMP for EC operations. # Exits with: # 0 all numbers verified prime # 1 at least one number verified composite # 2 incorrect or incomplete conditions. Cannot verify. # 3 certificate file cannot be parsed or no number found # The candidate number is always checked against is_prime first. That # performs an extra-strong Lucas pseudoprime test followed by at least # one additional M-R test using a random base. my $verbose = 2; my $quiet; my $verb; my $timing; GetOptions("verbose+" => \$verb, "quiet" => \$quiet, "timing" => \$timing, ) or die "Error in option parsing\n"; $verbose = $verb if defined $verb; $verbose = 0 if $quiet; sub error ($) { my $message = shift; warn "\n$message\n" if $verbose; exit(3); # error in certificate } sub fail ($) { my $message = shift; warn "\n$message\n" if $verbose; exit(2); # Failed a condition } my $orig_N; my $N; my %parts; # Map of "N is prime if Q is prime" my %proof_funcs = ( ECPP => \&prove_ecpp, # Standard ECPP proof ECPP3 => \&prove_ecpp3, # Primo type 3 ECPP4 => \&prove_ecpp4, # Primo type 4 BLS15 => \&prove_bls15, # basic n+1, includes Primo type 2 BLS3 => \&prove_bls3, # basic n-1 BLS5 => \&prove_bls5, # much better n-1 SMALL => \&prove_small, # n <= 2^64 POCKLINGTON => \&prove_pock, # simple n-1, Primo type 1 LUCAS => \&prove_lucas, # n-1 completely factored ); my $smallval = Math::BigInt->new(2)->bpow(64); my $step = 1; my $base = 10; my $cert_type = 'Unknown'; my $start_time; while (<>) { next if /^\s*#/ or /^\s*$/; # Skip comments and blank lines chomp; if (/^\[(\S+) - Primality Certificate\]/) { error "Unknown certificate type: $1" unless $1 eq 'MPU' || $1 eq 'PRIMO'; $cert_type = $1; next; } if ( ($cert_type eq 'PRIMO' && /^\[Candidate\]/) || ($cert_type eq 'MPU' && /^Proof for:/) ) { if (defined $N) { # Done with this number, starting the next. print " " x 60, "\r" if $verbose == 2; if (final_verify($N)) { print "PRIME\n" if $verbose; } else { print "NOT PROVEN\n" if $verbose; exit(2); } undef $N; undef %parts; $step = 1; } if ($cert_type eq 'PRIMO') { ($N) = primo_read_vars('Candidate', qw/N/); } else { ($N) = read_vars('Proof for', qw/N/); } $start_time = [gettimeofday]; $orig_N = $N; if ($verbose == 1) { print "N $N"; } elsif ($verbose == 2) { print "$N\n"; } if (!is_prime($N)) { print "COMPOSITE\n" if $verbose; exit(1); } next; } if ($cert_type eq 'PRIMO') { if (/^Type\s*=\s*(\d+)/) { my $type = $1; error("Starting type without telling me the N value!") unless defined $N; if ($type == 4) { my ($n, $f) = verify_ecpp4( $N, primo_read_vars('4', qw/S R J T/) ); $N = $f; } elsif ($type == 3) { my ($n, $f) = verify_ecpp3( $N, primo_read_vars('3', qw/S R A B T/) ); $N = $f; } elsif ($type == 2) { my ($s, $r, $q) = primo_read_vars('2', qw/S R Q/); my $p = ($q->is_odd()) ? 2 : 1; my ($n, $f) = verify_bls15( $N, $r, $p, $q ); $N = $f; } elsif ($type == 1) { my ($s, $r, $b) = primo_read_vars('1', qw/S R B/); fail "Type 1: $N failed SR + 1 = N" unless $s*$r+1 == $N; my ($n, $f) = verify_pock( $N, $r, $b ); # S = (N-1)/r $N = $f; } elsif ($type == 0) { # Final } else { error "Unknown type: $type"; } if ($verbose == 1) { print "."; } elsif ($verbose == 2) { printf "step %2d: %4d digits type %d\r", $step++, length($N), $type; } } } elsif ($cert_type eq 'MPU') { if (/^Base (\d+)/) { $base = $1; error "Invalid base: $base" unless $base == 10 || $base == 16 || $base == 62; error "Sorry, only base 10 implemented in this version" unless $base == 10; } elsif (/^Type (.*?)\s*$/) { error("Starting type without telling me the N value!") unless defined $N; my $type = $1; $type =~ tr/a-z/A-Z/; error("Unknown type: $type") unless defined $proof_funcs{$type}; my ($n, @q) = $proof_funcs{$type}->(); $parts{$n} = [@q]; if ($verbose == 1) { print "."; } elsif ($verbose == 2) { printf "step %2d: %4d digits type %-12s\r", $step++, length($n), $type; } } } } error("No N found") unless defined $N; print " " x 60, "\r" if $verbose == 2; if (final_verify($N)) { print "PRIME\n" if $verbose; exit(0); } else { print "NOT PROVEN\n" if $verbose; exit(2); } sub final_verify { my $n = shift; die "Internal error: argument not defined" unless defined $n; if ($timing) { my $seconds = tv_interval($start_time); printf "%7.6f seconds for verification of %d digit number\n", $seconds, length($orig_N); } if ($cert_type eq 'PRIMO') { fail "Type 0: $n failed N > 18" unless $n > 18; fail "Type 0: $n failed N < 34 * 10^13" unless $n < (34*10**13); fail "Type 0: $n failed spsp(2,3,5,7,11,13,17)" unless is_strong_pseudoprime($n,2,3,5,7,11,13,17); return 1; } my @qs = ($n); while (@qs) { my $q = shift @qs; # Check that this q has a chain if (!defined $parts{$q}) { # Auto-small: handle small q right here. if ($q <= $smallval) { fail "Small n $q does not pass BPSW" unless is_prime($q); next; } else { error "q value $q has no proof\n"; } } die "Internal error: Invalid parts entry" unless ref($parts{$q}) eq 'ARRAY'; # q is prime if all it's chains are prime. push @qs, @{$parts{$q}}; } 1; } ############################################################################## # MPU Proof handlers ############################################################################## sub prove_ecpp { verify_ecpp( read_vars('ECPP', qw/N A B M Q X Y/) ); } sub prove_ecpp3 { verify_ecpp3( read_vars('ECPP3', qw/N S R A B T/) ); } sub prove_ecpp4 { verify_ecpp4( read_vars('ECPP4', qw/N S R J T/) ); } sub prove_bls15 { verify_bls15( read_vars('BLS15', qw/N Q LP LQ/) ); } sub prove_bls3 { verify_bls3( read_vars('BLS3', qw/N Q A/) ); } sub prove_pock { verify_pock( read_vars('POCKLINGTON', qw/N Q A/) ); } sub prove_small { verify_small( read_vars('Small', qw/N/) ); } sub prove_bls5 { # No good way to do this using read_vars my ($n, @Q, @A); my $index = 0; $Q[0] = Math::BigInt->new(2); # 2 is implicit while (1) { my $line = <>; error("end of file during type BLS5") unless defined $line; # Skip comments and blank lines next if $line =~ /^\s*#/ or $line =~ /^\s*$/; # Stop when we see a line starting with -. last if $line =~ /^-/; chomp($line); if ($line =~ /^N\s+(\d+)/) { error("BLS5: N redefined") if defined $n; $n = Math::BigInt->new("$1"); } elsif ($line =~ /^Q\[(\d+)\]\s+(\d+)/) { $index++; error("BLS5: Invalid index: $1") unless $1 == $index; $Q[$1] = Math::BigInt->new("$2"); } elsif ($line =~ /^A\[(\d+)\]\s+(\d+)/) { error("BLS5: Invalid index: A[$1]") unless $1 >= 0 && $1 <= $index; $A[$1] = Math::BigInt->new("$2"); } else { error("Unrecognized line: $line"); } } verify_bls5($n, \@Q, \@A); } sub prove_lucas { # No good way to do this using read_vars my ($n, @Q, $a); my $index = 0; while (1) { my $line = <>; error("end of file during type Lucas") unless defined $line; # Skip comments and blank lines next if $line =~ /^\s*#/ or $line =~ /^\s*$/; chomp($line); if ($line =~ /^N\s+(\d+)/) { error("Lucas: N redefined") if defined $n; $n = Math::BigInt->new("$1"); } elsif ($line =~ /^Q\[(\d+)\]\s+(\d+)/) { $index++; error("Lucas: Invalid index: $1") unless $1 == $index; $Q[$1] = Math::BigInt->new("$2"); } elsif ($line =~ /^A\s+(\d+)/) { $a = Math::BigInt->new("$1"); last; } else { error("Unrecognized line: $line"); } } verify_lucas($n, \@Q, $a); } ############################################################################## # Proof verifications ############################################################################## sub verify_ecpp { my ($n, $a, $b, $m, $q, $x, $y) = @_; $a %= $n if $a < 0; $b %= $n if $b < 0; fail "ECPP: $n failed N > 0" unless $n > 0; fail "ECPP: $n failed gcd(N, 6) = 1" unless Math::BigInt::bgcd($n, 6) == 1; fail "ECPP: $n failed gcd(4*a^3 + 27*b^2, N) = 1" unless Math::BigInt::bgcd(4*$a*$a*$a+27*$b*$b,$n) == 1; fail "ECPP: $n failed Y^2 = X^3 + A*X + B mod N" unless ($y*$y) % $n == ($x*$x*$x + $a*$x + $b) % $n; fail "ECPP: $n failed M >= N - 2*sqrt(N) + 1" unless $m >= $n - 2*$n->copy->bsqrt() + 1; fail "ECPP: $n failed M <= N + 2*sqrt(N) + 1" unless $m <= $n + 2*$n->copy->bsqrt() + 1; fail "ECPP: $n failed Q > (N^(1/4)+1)^2" unless $q > $n->copy->broot(4)->badd(1)->bpow(2); fail "ECPP: $n failed Q < N" unless $q < $n; fail "ECPP: $n failed M != Q" unless $m != $q; my ($mdivq, $rem) = $m->copy->bdiv($q); fail "ECPP: $n failed Q divides M" unless $rem == 0; # Now verify the elliptic curve my $correct_point = 0; if (prime_get_config->{'gmp'} && defined &Math::Prime::Util::GMP::_validate_ecpp_curve) { $correct_point = Math::Prime::Util::GMP::_validate_ecpp_curve($a, $b, $n, $x, $y, $m, $q); } else { if (!defined $Math::Prime::Util::ECAffinePoint::VERSION) { eval { require Math::Prime::Util::ECAffinePoint; 1; } or do { die "Cannot load Math::Prime::Util::ECAffinePoint"; }; } my $ECP = Math::Prime::Util::ECAffinePoint->new($a, $b, $n, $x, $y); # Compute U = (m/q)P, check U != point at infinity $ECP->mul( $m->copy->bdiv($q)->as_int ); if (!$ECP->is_infinity) { # Compute V = qU, check V = point at infinity $ECP->mul( $q ); $correct_point = 1 if $ECP->is_infinity; } } fail "ECPP: $n failed elliptic curve conditions" unless $correct_point; ($n, $q); } sub verify_ecpp3 { my ($n, $s, $r, $a, $b, $t) = @_; fail "ECPP3: $n failed |A| <= N/2" unless 2*abs($a) <= $n; fail "ECPP3: $n failed |B| <= N/2" unless 2*abs($b) <= $n; fail "ECPP3: $n failed T >= 0" unless $t >= 0; fail "ECPP3: $n failed T < N" unless $t < $n; my $l = ($t*$t*$t + $a*$t + $b) % $n; verify_ecpp( $n, ($a * $l*$l) % $n, ($b * $l*$l*$l) % $n, $r*$s, $r, ($t*$l) % $n, ($l*$l) % $n ); } sub verify_ecpp4 { my ($n, $s, $r, $j, $t) = @_; fail "ECPP4: $n failed |J| <= N/2" unless 2*abs($j) <= $n; fail "ECPP4: $n failed T >= 0" unless $t >= 0; fail "ECPP4: $n failed T < N" unless $t < $n; my $a = 3 * $j * (1728 - $j); my $b = 2 * $j * (1728 - $j) * (1728 - $j); my $l = ($t*$t*$t + $a*$t + $b) % $n; verify_ecpp( $n, ($a * $l*$l) % $n, ($b * $l*$l*$l) % $n, $r*$s, $r, ($t*$l) % $n, ($l*$l) % $n ); } sub verify_bls15 { my ($n, $q, $lp, $lq) = @_; fail "BLS15: $n failed Q odd" unless $q->is_odd(); fail "BLS15: $n failed Q > 2" unless $q > 2; my ($m, $rem) = ($n+1)->copy->bdiv($q); fail "BLS15: $n failed Q divides N+1" unless $rem == 0; fail "BLS15: $n failed MQ-1 = N" unless $m*$q-1 == $n; fail "BLS15: $n failed M > 0" unless $m > 0; fail "BLS15: $n failed 2Q-1 > sqrt(N)" unless 2*$q-1 > $n->copy->bsqrt(); my $D = $lp*$lp - 4*$lq; fail "BLS15: $n failed D != 0" unless $D != 0; fail "BLS15: $n failed jacobi(D,N) = -1" unless kronecker($D,$n) == -1; fail "BLS15: $n failed V_{m/2} mod N != 0" unless (lucas_sequence($n, $lp, $lq, $m/2))[1] != 0; fail "BLS15: $n failed V_{(N+1)/2} mod N == 0" unless (lucas_sequence($n, $lp, $lq, ($n+1)/2))[1] == 0; ($n, $q); } sub verify_bls3 { my ($n, $q, $a) = @_; fail "BLS3: $n failed Q odd" unless $q->is_odd(); fail "BLS3: $n failed Q > 2" unless $q > 2; my ($m, $rem) = ($n-1)->copy->bdiv($q); fail "BLS3: $n failed Q divides N-1" unless $rem == 0; fail "BLS3: $n failed MQ+1 = N" unless $m*$q+1 == $n; fail "BLS3: $n failed M > 0" unless $m > 0; fail "BLS3: $n failed 2Q+1 > sqrt(n)" unless 2*$q+1 > $n->copy->bsqrt(); fail "BLS3: $n failed A^((N-1)/2) = N-1 mod N" unless $a->copy->bmodpow(($n-1)/2, $n) == $n-1; fail "BLS3: $n failed A^(M/2) != N-1 mod N" unless $a->copy->bmodpow($m/2,$n) != $n-1; ($n, $q); } sub verify_pock { my ($n, $q, $a) = @_; my ($m, $rem) = ($n-1)->copy->bdiv($q); fail "Pocklington: $n failed Q divides N-1" unless $rem == 0; fail "Pocklington: $n failed M is even" unless $m->is_even(); fail "Pocklington: $n failed M > 0" unless $m > 0; fail "Pocklington: $n failed M < Q" unless $m < $q; fail "Pocklington: $n failed MQ+1 = N" unless $m*$q+1 == $n; fail "Pocklington: $n failed A > 1" unless $a > 1; fail "Pocklington: $n failed A^(N-1) mod N = 1" unless $a->copy->bmodpow($n-1, $n) == 1; fail "Pocklington: $n failed gcd(A^M - 1, N) = 1" unless Math::BigInt::bgcd($a->copy->bmodpow($m, $n)-1, $n) == 1; ($n, $q); } sub verify_small { my ($n) = @_; fail "Small n $n is > 2^64\n" unless $n <= $smallval; fail "Small n $n does not pass BPSW" unless is_prime($n); ($n); } sub verify_bls5 { my ($n, $Qr, $Ar) = @_; my @Q = @{$Qr}; my @A = @{$Ar}; my $nm1 = $n - 1; my $F = Math::BigInt->bone; my $R = $nm1->copy; my $index = $#Q; foreach my $i (0 .. $index) { error "BLS5: $n failed Q[$i] doesn't exist" unless defined $Q[$i]; $A[$i] = Math::BigInt->new(2) unless defined $A[$i]; fail "BLS5: $n failed Q[$i] > 1" unless $Q[$i] > 1; fail "BLS5: $n failed Q[$i] < N-1" unless $Q[$i] < $nm1; fail "BLS5: $n failed A[$i] > 1" unless $A[$i] > 1; fail "BLS5: $n failed A[$i] < N" unless $A[$i] < $n; fail "BLS5: $n failed Q[$i] divides N-1" unless ($nm1 % $Q[$i]) == 0; while (($R % $Q[$i]) == 0) { $F *= $Q[$i]; $R /= $Q[$i]; } } die "BLS5: Internal error R != (N-1)/F\n" unless $R == $nm1/$F; fail "BLS5: $n failed F is even" unless $F->is_even(); fail "BLS5: $n failed gcd(F, R) = 1\n" unless Math::BigInt::bgcd($F,$R) == 1; my ($s, $r) = $R->copy->bdiv(2*$F); my $P = ($F+1) * (2 * $F * $F + ($r-1)*$F + 1); fail "BLS5: $n failed n < P" unless $n < $P; fail "BLS5: $n failed s=0 OR r^2-8s not a perfect square" unless $s == 0 or !_is_perfect_square($r*$r - 8*$s); foreach my $i (0 .. $index) { my $a = $A[$i]; my $q = $Q[$i]; fail "BLS5: $n failed A[i]^(N-1) mod N = 1" unless $a->copy->bmodpow($nm1, $n) == 1; fail "BLS5: $n failed gcd(A[i]^((N-1)/Q[i])-1, N) = 1" unless Math::BigInt::bgcd($a->copy->bmodpow($nm1/$q, $n)-1, $n) == 1; } ($n, @Q); } sub verify_lucas { my ($n, $Qr, $a) = @_; my @Q = @{$Qr}; my $index = $#Q; fail "Lucas: $n failed A > 1" unless $a > 1; fail "Lucas: $n failed A < N" unless $a < $n; my $nm1 = $n - 1; my $F = Math::BigInt->bone; my $R = $nm1->copy; fail "Lucas: $n failed A^(N-1) mod N = 1" unless $a->copy->bmodpow($nm1, $n) == 1; foreach my $i (1 .. $index) { error "Lucas: $n failed Q[$i] doesn't exist" unless defined $Q[$i]; fail "Lucas: $n failed Q[$i] > 1" unless $Q[$i] > 1; fail "Lucas: $n failed Q[$i] < N-1" unless $Q[$i] < $nm1; fail "Lucas: $n failed Q[$i] divides N-1" unless ($nm1 % $Q[$i]) == 0; fail "Lucas: $n failed A^((N-1)/Q[$i]) mod N != 1" unless $a->copy->bmodpow($nm1/$Q[$i], $n) != 1; while (($R % $Q[$i]) == 0) { $F *= $Q[$i]; $R /= $Q[$i]; } } fail("Lucas: $n failed N-1 has only factors Q") unless $R == 1 && $F == $nm1; shift @Q; # Remove Q[0] ($n, @Q); } ############################################################################## # Utility functions ############################################################################## sub read_vars { my $type = shift; my %vars = map { $_ => 1 } @_; my %return; while (scalar keys %vars) { my $line = <>; error("end of file during type $type") unless defined $line; # Skip comments and blank lines next if $line =~ /^\s*#/ or $line =~ /^\s*$/; chomp($line); error("Still missing values in type $type") if $line =~ /^Type /; if ($line =~ /^(\S+)\s+(-?\d+)/) { my ($var, $val) = ($1, $2); $var =~ tr/a-z/A-Z/; error("Type $type: repeated or inappropriate var: $line") unless defined $vars{$var}; $return{$var} = $val; delete $vars{$var}; } else { error("Unrecognized line: $line"); } } # Now return them in the order given, turned into bigints. return map { Math::BigInt->new("$return{$_}") } @_; } sub primo_read_vars { my $type = shift; my %vars = map { $_ => 1 } @_; my %return; while (scalar keys %vars) { my $line = <>; error("end of file during type $type") unless defined $line; error("blank line during type $type") if $line =~ /^\s*$/; chomp($line); error("Still missing values in type $type") if $line =~ /^Type=/; if ($line =~ /^(\S+)\s*=\s*(\S+)/) { my ($var, $val) = ($1, $2); $var =~ tr/a-z/A-Z/; $val = "0x$val" if $var =~ s/\$$//; # For Primo, just skip things we don't understand. next unless defined $vars{$var}; $return{$var} = $val; delete $vars{$var}; } else { error("Unrecognized line: $line"); } } # Now return them in the order given, turned into bigints. my @ret; foreach my $var (@_) { my $sign = 1; $sign = -1 if $return{$var} =~ s/^(0x)?-/$1/; push @ret, Math::BigInt->new($return{$var}) * $sign; } return @ret; } sub _is_perfect_square { my($n) = @_; if (ref($n) eq 'Math::BigInt') { my $mc = int(($n & 31)->bstr); if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) { my $sq = $n->copy->bsqrt->bfloor; $sq->bmul($sq); return 1 if $sq == $n; } } else { my $mc = $n & 31; if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) { my $sq = int(sqrt($n)); return 1 if ($sq*$sq) == $n; } } 0; } Math-Prime-Util-0.37/examples/abundant.pl0000755000076400007640000000211612270624726016703 0ustar danadana#!/usr/bin/env perl use strict; use warnings; # Find the first N abundant, deficient, or perfect numbers. use Math::Prime::Util qw/divisor_sum next_prime is_prime/; my $count = shift || 20; my $type = lc(shift || 'abundant'); my $p = 0; if ($type eq 'abundant') { while ($count-- > 0) { do { $p++ } while divisor_sum($p)-$p <= $p; print "$p\n"; } } elsif ($type eq 'deficient') { while ($count-- > 0) { do { $p++ } while divisor_sum($p)-$p >= $p; print "$p\n"; } } elsif ($type eq 'perfect') { # We'll use the chain of work by Euclid, Ibn al-Haytham, Euler, and others. # We just look for 2^(p-1)*(2^p-1) where 2^p-1 is prime. # Basically we're just finding Mersenne primes. # It's possible there are odd perfect numbers larger than 10^1500. do { require Math::BigInt; Math::BigInt->import(try=>"GMP,Pari"); }; while ($count-- > 0) { while (1) { $p = next_prime($p); last if is_prime(Math::BigInt->new(2)->bpow($p)->bdec); } print Math::BigInt->from_bin( '0b' . '1'x$p . '0'x($p-1) ), "\n"; } } else { die "Unknown type: $type\n"; } Math-Prime-Util-0.37/examples/verify-sage-ecpp-cert.pl0000755000076400007640000000323712266152412021206 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::BigInt try=>"GMP,Pari"; use Math::Prime::Util qw/:all/; use Data::Dump qw/dump/; # Takes the output of one of the Sage functions: # goldwasser_kilian(n) # atkin_morain(n) # ecpp(n) # and run it through MPU's verifier. # # Example: # perl verify-sage-ecpp-cert.pl <) { chomp; push @input, split(/\s*,\s*/, $_); } my $N; my ($n, $a, $b, $m, $q, $Px, $Py); my @cert; while (@input) { $_ = shift @input; $_ =~ s/L\s*$//; if (!defined $N) { die "Need brackets around certificate\n" unless s/^\s*\[//; $N = $_; $n = $_; @cert = ($N, "AGKM"); } elsif (!defined $n) { $n = $_; } elsif (!defined $a) { $a = $_; } elsif (!defined $b) { $b = $_; } elsif (!defined $m) { $m = $_; } elsif (!defined $q) { $q = $_; } elsif (!defined $Px) { die "Can't parse point" unless /\(\s*(\d+)\s*:\s*(\d+)\s*:\s*(\d+)\s*\)/; $Px = $1; $Py = $2; die "Bad input\n" unless defined $n && defined $a && defined $b && defined $m && defined $q && defined $Px && defined $Py; push @cert, [$n, $a, $b, $m, $q, [$Px,$Py]]; undef $n; undef $a; undef $b; undef $m; undef $q; undef $Px; undef $Py; } } print dump(\@cert), "\n"; print verify_prime(@cert) ? "SUCCESS\n" : "FAILURE\n"; Math-Prime-Util-0.37/examples/find_mr_bases.pl0000755000076400007640000000367412270624726017714 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use threads; use threads::shared; use Math::Prime::Util qw/is_prime is_strong_pseudoprime forcomposites/; my $nthreads = 4; # Single base. my @composites; forcomposites { push @composites, $_ if $_ % 2; } 1_000_000; # Serial: # my $base = 2; # my $maxn = 2; # while (1) { # for my $n (@composites) { # if (is_strong_pseudoprime($n,$base)) { # if ($n > $maxn) { # print "base $base good up to $n\n"; # $maxn = $n; # } # last; # } # } # $base++; # } # Parallel: my $maxn :shared; my $start = int(2**60+2**41); # People have mined below 2^55 $maxn = 2047; my @threads; push @threads, threads->create('search_bases', $start, $_) for 1..$nthreads; # We should sit here doing cond_waits on a results array. $_->join() for (@threads); sub search_bases { my($start, $t) = @_; for (my $base = $start + $t - 1; 1; $base += $t) { next if is_strong_pseudoprime(4, $base) || is_strong_pseudoprime(6, $base); for my $n (@composites) { if (is_strong_pseudoprime($n,$base)) { if ($n > $maxn) { lock($maxn); print "base $base good up to $n\n" if $n > $maxn; $maxn = $n; } last; } } } } __END__ base 2 good up to 2047 base 3273 good up to 2209 base 4414 good up to 2443 base 5222 good up to 2611 base 8286 good up to 4033 base 10822 good up to 5411 base 13011 good up to 6505 base 67910 good up to 9073 base 82967 good up to 10371 base 254923 good up to 18299 base 2974927 good up to 18721 base 4095086 good up to 38323 base 70903283 good up to 38503 (best results known, not found with this program) 2011-02-12 base 814494960528 good up to 132239 2012-07-02 base 64390572806844 good up to 161701 2012-10-15 base 1769236083487960 good up to 192001 2012-10-17 base 1948244569546278 good up to 212321 2013-01-14 base 34933608779780163 good up to 218245 2013-03-03 base 9345883071009581737 good up to 341531 Math-Prime-Util-0.37/examples/parallel_fibprime.pl0000755000076400007640000000711112270624726020560 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use threads; use threads::shared; # Overkill, but let's try to select a good bigint module. my $bigint_class; if (eval { require Math::GMPz; 1; }) { $bigint_class = "Math::GMPz"; } elsif (eval { require Math::GMP; 1; }) { $bigint_class = "Math::GMP"; } else { require Math::BigInt; Math::BigInt->import(try=>"GMP,Pari"); $bigint_class = "Math::BigInt"; } use Math::Prime::Util ':all'; use Time::HiRes qw(gettimeofday tv_interval); $| = 1; # Find Fibonacci primes in parallel, using Math::Prime::Util and Perl threads. # # Dana Jacobsen, 2012. # # This will fully utilize however many cores you choose (using the $nthreads # variable). It spreads the numbers across threads, where each one runs a # BPSW test. A separate thread handles the in-order display. I have tested # it on machines with 2, 4, 8, 12, 24, and 64 cores. # # On my 12-core computer: # 24 5387 0.65488 # 25 9311 4.39227 # 26 9677 4.54363 # 27 14431 18.82531 # 28 25561 121.34584 # 29 30757 212.99409 # 30 35999 376.59567 # 31 37511 432.10713 # 32 50833 1151.85562 # # Using 60 cores of a Power 7 machine (each one slower than the x86 above) # 27 14431 14.23748 # 28 25561 81.95451 # 29 30757 117.95914 # 30 35999 224.14832 # 31 37511 267.01445 # 32 50833 677.61661 # 33 81839 3230.63871 # 34 104911 7861.65752 # 35 130021 16170.56098 # 36 148091 24841.65174 # # Though not as pretty as the Haskell solution on haskell.org, it is a # different way of solving the problem that is faster and more scalable. my $time_start = [gettimeofday]; my $nthreads = 12; prime_precalc(1_000_000); my @found :shared; # push the primes found here my @karray : shared; # array of min k for each thread my @threads; push @threads, threads->create('fibprime', $_) for 1 .. $nthreads; # Let the threads work for a little before starting the display loop sleep 2; my $n = 0; lock(@karray); while (1) { cond_wait(@karray); { lock(@found); next if @found == 0; # Someone has found a result. Discover min k processed so far. my $mink = $karray[1] || 0; for my $t (2..$nthreads) { my $progress = $karray[$t] || 0; $mink = $progress if $progress < $mink; } next unless $mink > 0; # someone hasn't even started @found = sort { (split(/ /, $a))[0] <=> (split(/ /, $b))[0] } @found; while ( @found > 0 && (split(/ /, $found[0]))[0] <= $mink ) { my($k, $time_int) = split(/ /, shift @found); printf "%3d %7d %20.5f\n", ++$n, $k, $time_int; } } } $_->join() for (@threads); sub fib_n { my ($n, $fibstate) = @_; @$fibstate = (1, $bigint_class->new(0), $bigint_class->new(1)) unless defined $fibstate->[0]; my ($curn, $a, $b) = @$fibstate; die "fib_n only increases" if $n < $curn; do { ($a, $b) = ($b, $a+$b); } for (1 .. $n-$curn); @$fibstate = ($n, $a, $b); $b; } sub fibprime { my $tnum = shift; my @fibstate; my $nth = $tnum; while (1) { # Exploit knowledge that excepting k=4, all prime F_k have a prime k. my $k = ($nth <= 2) ? 2 + $nth : nth_prime($nth); $nth += $nthreads; my $Fk = fib_n($k, \@fibstate); if (is_prob_prime($Fk)) { lock(@found); push @found, $k . " " . tv_interval($time_start); } { lock(@karray); $karray[$tnum] = $k; cond_signal(@karray); } } } Math-Prime-Util-0.37/examples/porter.pl0000755000076400007640000000635512271153524016425 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use 5.14.0; use Math::Prime::Util qw/:all/; use List::Util qw/sum/; use Benchmark qw/:all/; my $lim = shift || 1000; # Michael B Porter proposed this OEIS sequence: # # a(n) = m such that sigma(m) + sigma(m+1) + ... + sigma(m+n-1) is prime # # http://oeis.org/wiki/User:Michael_B._Porter # # Charles R Greathouse IV suggested this as an efficient computation: # a(n)=my(t=sum(i=1,n,sigma(i)),k=1);while(!isprime(t),t-=sigma(k)-sigma(n+k);k++);k # which can be turned into a vector as: # vector(1000,i,a(i)) # # Pari does this for 10k elements in ~15 seconds. # Version opt2 does it in Perl in 3.0s. # For 20k it's 63s in Pari, 12s in Perl. # Of course Pari could be optimized as well. sub simple { my $lim = shift; my @list; foreach my $n (1 .. $lim) { my($m, $sum) = (1, 0); while (!is_prime($sum)) { $sum = 0; $sum += divisor_sum($m+$_) for 0..$n-1; $m++; } push @list, $m-1; } return @list; } # perl -MMath::Prime::Util=:all -E 'my @list; foreach my $n (1 .. 1000) { my ($m,$sum) = (1,0); while (!is_prime($sum)) { $sum = 0; $sum += divisor_sum($m+$_) for 0..$n-1; $m++; } push @list, $m-1; } say join ",", @list;' sub crg4 { my $lim = shift; my @list; foreach my $n (1 .. $lim) { my($k, $t) = (1,0); $t += divisor_sum($_) for 1..$n; while (!is_prime($t)) { $t -= divisor_sum($k)-divisor_sum($n+$k); $k++; } push @list,$k; } return @list; } # perl -MMath::Prime::Util=:all -E 'my @list; foreach my $n (1 .. 10000) { my($k,$t)=(1,0); $t += divisor_sum($_) for 1..$n; while (!is_prime($t)) { $t -= divisor_sum($k)-divisor_sum($n+$k); $k++; } push @list, $k; } say join ",", @list;' # 9.8s for 10k sub opt1 { my $lim = shift; my @list = map { my($n,$t,$k) = ($_,0,1); $t += divisor_sum($_) for 1..$n; while (!is_prime($t)) { $t -= divisor_sum($k) - divisor_sum($n+$k); $k++; } $k; } 1 .. $lim; return @list; } # perl -MMath::Prime::Util=:all -E 'say join ",", map { my($n,$t,$k) = ($_,0,1); $t += divisor_sum($_) for 1..$n; while (!is_prime($t)) { $t -= divisor_sum($k) - divisor_sum($n+$k); $k++; } $k; } 1 .. 10000' # 9.5s for 10k sub opt2 { my $lim = shift; my @ds; my @list = map { my($n,$t,$k) = ($_,0,1); $ds[$n] //= divisor_sum($n); $t += $ds[$_] for 1..$n; while (!is_prime($t)) { $ds[$n+$k] //= divisor_sum($n+$k); $t -= $ds[$k] - $ds[$n+$k]; $k++; } $k; } 1 .. $lim; return @list; } # perl -MMath::Prime::Util=:all -E '@ds = (1,1); say join ",", map { my($n,$t,$k) = ($_,0,1); $t += $ds[$_] for 1..$n; while (!is_prime($t)) { $ds[$n+$k] //= divisor_sum($n+$k); $t -= $ds[$k] - $ds[$n+$k]; $k++; } $k; } 1..10000' # 3.0s for 10k # Verify { my $vlim = 100; my @a1 = simple($vlim); my @a2 = crg4($vlim); my @a3 = opt1($vlim); my @a4 = opt2($vlim); foreach my $i (0 .. $vlim-1) { die "Mismatch in crg4 at $i" unless $a1[$i] == $a2[$i]; die "Mismatch in opt1 at $i" unless $a1[$i] == $a3[$i]; die "Mismatch in opt2 at $i" unless $a1[$i] == $a4[$i]; } } cmpthese(-5, { #'simple' => sub { simple($lim) }, 'crg4' => sub { crg4($lim) }, 'opt1' => sub { opt1($lim) }, 'opt2' => sub { opt2($lim) }, }); #say join ", ", opt1($lim); Math-Prime-Util-0.37/examples/sophie_germain.pl0000755000076400007640000000536512270624726020111 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/prime_iterator is_prime next_prime nth_prime_upper prime_precalc forprimes/; my $count = shift || 20; my $method = shift || 'forprimes'; my $precalc = 0; # If set, precalc all the values we'll call is_prime on # Find Sophie Germain primes (numbers where p and 2p+1 are both prime). # Four methods are shown: forprimes, iter, iter2, and MNS. # Times for 300k: # # 300k 1M # precalc: # forprimes 1.3s 9.0MB 7.1s 21.6MB # iter 2.8s 8.7MB 12.6s 21.4MB # iter2 1.9s 8.7MB 9.4s 21.4MB # no precalc: # forprimes 1.5s 4.5MB 5.6s 4.5MB # iter 9.5s 4.3MB 37.5s 4.3MB # iter2 8.5s 4.3MB 33.9s 4.3MB # MNS 254.3s 11.3MB >1500s >15 MB if ($precalc) { prime_precalc(2 * sg_upper_bound($count)); } if ($method eq 'forprimes') { my $estimate = sg_upper_bound($count); my $numfound = 0; forprimes { if ($numfound < $count && is_prime(2*$_+1)) { print "$_\n"; $numfound++; } } $estimate; die "Estimate too low" unless $numfound >= $count; } elsif ($method eq 'iter') { # Wrap the standard iterator sub get_sophie_germain_iterator { my $p = shift || 2; my $it = prime_iterator($p); return sub { do { $p = $it->() } while !is_prime(2*$p+1); $p; }; } my $sgit = get_sophie_germain_iterator(); print $sgit->(), "\n" for 1 .. $count; } elsif ($method eq 'iter2') { # Iterate directly using next_prime my $prime = 2; for (1 .. $count) { $prime = next_prime($prime) while !is_prime(2*$prime+1); print "$prime\n"; $prime = next_prime($prime); } } elsif ($method eq 'MNS') { # Use Math::NumSeq require Math::NumSeq::SophieGermainPrimes; my $seq = Math::NumSeq::SophieGermainPrimes->new; for (1 .. $count) { print 0+($seq->next)[1]; } } # Used for precalc and the forprimes example sub sg_upper_bound { my $count = shift; my $nth = nth_prime_upper($count); # For lack of a better formula, do this step-wise estimate. my $estimate = ($count < 5000) ? 150 + int( $nth * log($nth) * 1.2 ) : ($count < 19000) ? int( $nth * log($nth) * 1.135 ) : ($count < 45000) ? int( $nth * log($nth) * 1.10 ) : ($count < 100000) ? int( $nth * log($nth) * 1.08 ) : ($count < 165000) ? int( $nth * log($nth) * 1.06 ) : ($count < 360000) ? int( $nth * log($nth) * 1.05 ) : ($count < 750000) ? int( $nth * log($nth) * 1.04 ) : ($count <1700000) ? int( $nth * log($nth) * 1.03 ) : int( $nth * log($nth) * 1.02 ); return $estimate; } Math-Prime-Util-0.37/MANIFEST0000644000076400007640000000524512271163661014065 0ustar danadanaChanges cpanfile lib/Math/Prime/Util.pm lib/Math/Prime/Util/MemFree.pm lib/Math/Prime/Util/PrimeArray.pm lib/Math/Prime/Util/PrimeIterator.pm lib/Math/Prime/Util/PP.pm lib/Math/Prime/Util/PPFE.pm lib/Math/Prime/Util/ZetaBigFloat.pm lib/Math/Prime/Util/ECAffinePoint.pm lib/Math/Prime/Util/ECProjectivePoint.pm lib/Math/Prime/Util/PrimalityProving.pm lib/Math/Prime/Util/RandomPrimes.pm LICENSE Makefile.PL MANIFEST README TODO XS.xs ptypes.h multicall.h mulmod.h aks.h aks.c cache.h cache.c constants.h factor.h factor.c lehmer.h lehmer.c lmo.h lmo.c ppport.h primality.h primality.c sieve.h sieve.c util.h util.c bench/bench-factor.pl bench/bench-factor-extra.pl bench/bench-factor-semiprime.pl bench/bench-is-prime.pl bench/bench-isprime-bpsw.pl bench/bench-miller-rabin.pl bench/bench-nthprime.pl bench/bench-pcapprox.pl bench/bench-primearray.pl bench/bench-primecount.pl bench/bench-random-prime.pl bench/bench-random-prime-bigint.pl bench/bench-pp-count.pl bench/bench-pp-isprime.pl bench/bench-pp-sieve.pl bench/bench-mp-nextprime.pl bench/bench-mp-psrp.pl bench/bench-mp-prime_count.pl bench/factor-gnufactor.pl examples/README examples/sophie_germain.pl examples/twin_primes.pl examples/abundant.pl examples/find_mr_bases.pl examples/parallel_fibprime.pl examples/porter.pl examples/verify-gmp-ecpp-cert.pl examples/verify-sage-ecpp-cert.pl examples/verify-cert.pl bin/primes.pl bin/factor.pl t/01-load.t t/02-can.t t/03-init.t t/04-inputvalidation.t t/10-isprime.t t/11-primes.t t/12-nextprime.t t/13-primecount.t t/14-nthprime.t t/15-probprime.t t/16-randomprime.t t/17-pseudoprime.t t/18-functions.t t/19-moebius.t t/20-primorial.t t/21-conseq-lcm.t t/22-aks-prime.t t/23-primality-proofs.t t/24-partitions.t t/30-relations.t t/31-threading.t t/32-iterators.t t/50-factoring.t t/51-primearray.t t/70-rt-bignum.t t/80-pp.t t/81-bignum.t t/90-release-perlcritic.t t/91-release-pod-syntax.t t/92-release-pod-coverage.t t/93-release-spelling.t t/94-weaken.t xt/moebius-mertens.pl xt/totient-range.pl xt/primality-small.pl xt/primality-aks.pl xt/primality-proofs.pl xt/small-is-next-prev.pl xt/factor-holf.pl xt/legendre_phi.t xt/make-script-test-data.pl xt/measure_zeta_accuracy.pl xt/pari-totient-moebius.pl xt/nthprime.t xt/pari-compare.pl xt/primecount-approx.t xt/primecount-many.t xt/primes-edgecases.pl xt/rwh_primecount.py xt/rwh_primecount_numpy.py xt/test-bpsw.pl xt/test-factor-mpxs.pl xt/test-nthapprox.pl xt/test-pcapprox.pl xt/test-primes-script.pl xt/test-primes-script2.pl xt/test-factor-yafu.pl xt/test-nextprime-yafu.pl .travis.yml META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Math-Prime-Util-0.37/cache.c0000644000076400007640000001654712270624726014155 0ustar danadana#include #include #include #include "ptypes.h" #include "cache.h" #include "sieve.h" #include "constants.h" /* _MPU_FILL_EXTRA_N and _MPU_INITIAL_CACHE_SIZE */ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" /* * These functions are used internally by the .c and .xs files. * They handle a cached primary set of primes, as well as a segment * area for use by all the functions that want to do segmented operation. * * We must be thread-safe, and we want to allow a good deal of concurrency. * It is imperative these be used correctly. After calling the get method, * use the sieve or segment, then release. You MUST call release before you * return or croak. You ought to release as soon as you're done using the * sieve or segment. */ static int mutex_init = 0; #ifndef USE_ITHREADS #define WRITE_LOCK_START #define WRITE_LOCK_END #define READ_LOCK_START #define READ_LOCK_END #else static perl_mutex segment_mutex; static perl_mutex primary_cache_mutex; static perl_cond primary_cache_turn; static int primary_cache_reading; static int primary_cache_writing; static int primary_cache_writers; #define WRITE_LOCK_START \ do { \ MUTEX_LOCK(&primary_cache_mutex); \ primary_cache_writers++; \ while (primary_cache_reading || primary_cache_writing) \ COND_WAIT(&primary_cache_turn, &primary_cache_mutex); \ primary_cache_writing++; \ MUTEX_UNLOCK(&primary_cache_mutex); \ } while (0) #define WRITE_LOCK_END \ do { \ MUTEX_LOCK(&primary_cache_mutex); \ primary_cache_writing--; \ primary_cache_writers--; \ COND_BROADCAST(&primary_cache_turn); \ MUTEX_UNLOCK(&primary_cache_mutex); \ } while (0) #define READ_LOCK_START \ do { \ MUTEX_LOCK(&primary_cache_mutex); \ if (primary_cache_writers) \ COND_WAIT(&primary_cache_turn, &primary_cache_mutex); \ while (primary_cache_writing) \ COND_WAIT(&primary_cache_turn, &primary_cache_mutex); \ primary_cache_reading++; \ MUTEX_UNLOCK(&primary_cache_mutex); \ } while (0) #define READ_LOCK_END \ do { \ MUTEX_LOCK(&primary_cache_mutex); \ primary_cache_reading--; \ COND_BROADCAST(&primary_cache_turn); \ MUTEX_UNLOCK(&primary_cache_mutex); \ } while (0) #endif static unsigned char* prime_cache_sieve = 0; static UV prime_cache_size = 0; /* Erase the primary cache and fill up to n. */ /* Note: You must have a write lock before calling this! */ static void _erase_and_fill_prime_cache(UV n) { UV padded_n; if (n >= (UV_MAX-_MPU_FILL_EXTRA_N)) padded_n = UV_MAX; else padded_n = ((n + _MPU_FILL_EXTRA_N)/30)*30; /* If new size isn't larger or smaller, then we're done. */ if (prime_cache_size == padded_n) return; if (prime_cache_sieve != 0) Safefree(prime_cache_sieve); prime_cache_sieve = 0; prime_cache_size = 0; if (n > 0) { prime_cache_sieve = sieve_erat30(padded_n); MPUassert(prime_cache_sieve != 0, "sieve returned null"); prime_cache_size = padded_n; } } /* * Get the size and a pointer to the cached prime sieve. * Returns the maximum sieved value available. * Allocates and sieves if needed. * * The sieve holds 30 numbers per byte, using a mod-30 wheel. */ UV get_prime_cache(UV n, const unsigned char** sieve) { #ifdef USE_ITHREADS if (sieve == 0) { if (prime_cache_size < n) { WRITE_LOCK_START; _erase_and_fill_prime_cache(n); WRITE_LOCK_END; } return prime_cache_size; } /* This could be done more efficiently if we converted a write lock to a * reader after doing the expansion. But I think this solution is less * error prone (though could lead to starvation in pathological cases). */ READ_LOCK_START; while (prime_cache_size < n) { /* The cache isn't big enough. Expand it. */ READ_LOCK_END; /* thread reminder: the world can change right here */ WRITE_LOCK_START; if (prime_cache_size < n) _erase_and_fill_prime_cache(n); WRITE_LOCK_END; /* thread reminder: the world can change right here */ READ_LOCK_START; } MPUassert(prime_cache_size >= n, "prime cache is too small!"); *sieve = prime_cache_sieve; return prime_cache_size; #else if (prime_cache_size < n) _erase_and_fill_prime_cache(n); MPUassert(prime_cache_size >= n, "prime cache is too small!"); if (sieve != 0) *sieve = prime_cache_sieve; return prime_cache_size; #endif } #ifdef USE_ITHREADS void release_prime_cache(const unsigned char* mem) { (void)mem; /* We don't currently care about the pointer */ READ_LOCK_END; } #endif /* The segment everyone is trying to share */ #define PRIMARY_SEGMENT_CHUNK_SIZE UVCONST(256*1024-16) static unsigned char* prime_segment = 0; static int prime_segment_is_available = 1; /* If that's in use, malloc a new one of this size */ #define SECONDARY_SEGMENT_CHUNK_SIZE UVCONST( 64*1024-16) unsigned char* get_prime_segment(UV *size) { unsigned char* mem; int use_prime_segment = 0; MPUassert(size != 0, "get_prime_segment given null size pointer"); MPUassert(mutex_init == 1, "segment mutex has not been initialized"); MUTEX_LOCK(&segment_mutex); if (prime_segment_is_available) { prime_segment_is_available = 0; use_prime_segment = 1; } MUTEX_UNLOCK(&segment_mutex); if (use_prime_segment) { if (prime_segment == 0) New(0, prime_segment, PRIMARY_SEGMENT_CHUNK_SIZE, unsigned char); *size = PRIMARY_SEGMENT_CHUNK_SIZE; mem = prime_segment; } else { New(0, mem, SECONDARY_SEGMENT_CHUNK_SIZE, unsigned char); *size = SECONDARY_SEGMENT_CHUNK_SIZE; } MPUassert(mem != 0, "get_prime_segment allocation failure"); return mem; } void release_prime_segment(unsigned char* mem) { MUTEX_LOCK(&segment_mutex); if (mem == prime_segment) { prime_segment_is_available = 1; mem = 0; } MUTEX_UNLOCK(&segment_mutex); if (mem) Safefree(mem); } void prime_precalc(UV n) { if (!mutex_init) { MUTEX_INIT(&segment_mutex); MUTEX_INIT(&primary_cache_mutex); COND_INIT(&primary_cache_turn); mutex_init = 1; } /* On initialization, make a few primes (30k per 1k memory) */ if (n == 0) n = _MPU_INITIAL_CACHE_SIZE; get_prime_cache(n, 0); /* Sieve to n */ /* TODO: should we prealloc the segment here? */ } void prime_memfree(void) { unsigned char* old_segment = 0; MPUassert(mutex_init == 1, "cache mutexes have not been initialized"); MUTEX_LOCK(&segment_mutex); /* Don't free if another thread is using it */ if ( (prime_segment != 0) && (prime_segment_is_available) ) {\ unsigned char* new_segment = old_segment; old_segment = prime_segment; prime_segment = new_segment; /* Exchanged old_segment / prime_segment */ } MUTEX_UNLOCK(&segment_mutex); if (old_segment) Safefree(old_segment); WRITE_LOCK_START; /* Put primary cache back to initial state */ _erase_and_fill_prime_cache(_MPU_INITIAL_CACHE_SIZE); WRITE_LOCK_END; } void _prime_memfreeall(void) { /* No locks. We're shutting everything down. */ if (mutex_init) { MUTEX_DESTROY(&segment_mutex); MUTEX_DESTROY(&primary_cache_mutex); COND_DESTROY(&primary_cache_turn); mutex_init = 0; } if (prime_cache_sieve != 0) Safefree(prime_cache_sieve); prime_cache_sieve = 0; prime_cache_size = 0; if (prime_segment != 0) Safefree(prime_segment); prime_segment = 0; } Math-Prime-Util-0.37/aks.h0000644000076400007640000000014512117256616013657 0ustar danadana#ifndef MPU_AKS_H #define MPU_AKS_H #include "ptypes.h" extern int _XS_is_aks_prime(UV n); #endif Math-Prime-Util-0.37/primality.c0000644000076400007640000005703612270242116015107 0ustar danadana#include #include #include #include #include "ptypes.h" #include "primality.h" #include "mulmod.h" #define FUNC_gcd_ui 1 #define FUNC_is_perfect_square #include "util.h" /* Primality related functions, including Montgomery math */ static const UV mr_bases_const2[1] = {2}; /****************************************************************************** Code inside USE_MONT_PRIMALITY is Montgomery math and efficient M-R from Wojciech Izykowski. See: https://github.com/wizykowski/miller-rabin Copyright (c) 2013, Wojciech Izykowski All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ******************************************************************************/ #if USE_MONT_PRIMALITY static INLINE uint64_t mont_prod64(uint64_t a, uint64_t b, uint64_t n, uint64_t npi) { uint64_t t_hi, t_lo, m, mn_hi, mn_lo, u; int carry; /* t_hi * 2^64 + t_lo = a*b */ asm("mulq %3" : "=a"(t_lo), "=d"(t_hi) : "a"(a), "rm"(b)); m = t_lo * npi; /* mn_hi * 2^64 + mn_lo = m*n */ asm("mulq %3" : "=a"(mn_lo), "=d"(mn_hi) : "a"(m), "rm"(n)); carry = t_lo + mn_lo < t_lo ? 1 : 0; u = t_hi + mn_hi + carry; if (u < t_hi) return u-n; return u >= n ? u-n : u; } #define mont_square64(a, n, npi) mont_prod64(a, a, n, npi) static INLINE UV mont_powmod64(uint64_t a, uint64_t k, uint64_t one, uint64_t n, uint64_t npi) { uint64_t t = one; while (k) { if (k & 1) t = mont_prod64(t, a, n, npi); k >>= 1; if (k) a = mont_square64(a, n, npi); } return t; } static INLINE uint64_t modular_inverse64(const uint64_t a) { uint64_t u,x,w,z,q; x = 1; z = a; q = (-z)/z + 1; /* = 2^64 / z */ u = - q; /* = -q * x */ w = - q * z; /* = b - q * z = 2^64 - q * z */ /* after first iteration all variables are 64-bit */ while (w) { if (w < z) { q = u; u = x; x = q; /* swap(u, x) */ q = w; w = z; z = q; /* swap(w, z) */ } q = w / z; u -= q * x; w -= q * z; } return x; } static INLINE uint64_t compute_modn64(const uint64_t n) { if (n <= (1ULL << 63)) { uint64_t res = ((1ULL << 63) % n) << 1; return res < n ? res : res-n; } else return -n; } #define compute_a_times_2_64_mod_n(a, n, r) mulmod(a, r, n) static INLINE uint64_t compute_2_65_mod_n(const uint64_t n, const uint64_t modn) { if (n <= (1ULL << 63)) { uint64_t res = modn << 1; return res < n ? res : res - n; } else { /* n can fit 2 or 3 times in 2^65 */ if (n > UVCONST(12297829382473034410)) return -n-n; /* 2^65 mod n = 2^65 - 2*n */ else return -n-n-n; /* 2^65 mod n = 2^65 - 3*n */ } } /* static INLINE int efficient_mr64(const uint64_t bases[], const int cnt, const uint64_t n) */ static int monty_mr64(const uint64_t n, const UV* bases, int cnt) { int i, j, t; const uint64_t npi = modular_inverse64(-((int64_t)n)); const uint64_t r = compute_modn64(n); uint64_t u = n - 1; const uint64_t nr = n - r; t = 0; while (!(u&1)) { t++; u >>= 1; } for (j = 0; j < cnt; j++) { const uint64_t a = bases[j]; uint64_t A = compute_a_times_2_64_mod_n(a, n, r); uint64_t d; if (a < 2) croak("Base %"UVuf" is invalid", (UV)a); if (!A) continue; /* PRIME in subtest */ d = mont_powmod64(A, u, r, n, npi); /* compute a^u mod n */ if (d == r || d == nr) continue; /* PRIME in subtest */ for (i=1; i>= 1; if ( (m % 8) == 3 || (m % 8) == 5 ) j = -j; } { UV t = n; n = m; m = t; } if ( (n % 4) == 3 && (m % 4) == 3 ) j = -j; n = n % m; } return (m == 1) ? j : 0; } /* Fermat pseudoprime */ int _XS_is_pseudoprime(UV const n, UV a) { UV x; if (n < 5) return (n == 2 || n == 3); if (a < 2) croak("Base %"UVuf" is invalid", a); if (a >= n) { a %= n; if ( a <= 1 || a == n-1 ) return 1; } x = powmod(a, n-1, n); /* x = a^(n-1) mod n */ return (x == 1); } /* Miller-Rabin probabilistic primality test * Returns 1 if probably prime relative to the bases, 0 if composite. * Bases must be between 2 and n-2 */ int _XS_miller_rabin(UV const n, const UV *bases, int nbases) { UV d = n-1; int b, r, s = 0; MPUassert(n > 3, "MR called with n <= 3"); if ((n & 1) == 0) return 0; #if USE_MONT_PRIMALITY if (n >= UVCONST(4294967295)) return monty_mr64((uint64_t)n, bases, nbases); #endif while (!(d&1)) { s++; d >>= 1; } for (b = 0; b < nbases; b++) { UV x, a = bases[b]; if (a < 2) croak("Base %"UVuf" is invalid", a); if (a >= n) a %= n; if ( (a <= 1) || (a == n-1) ) continue; /* n is a strong pseudoprime to base a if either: * a^d = 1 mod n * a^(d2^r) = -1 mod n for some r: 0 <= r <= s-1 */ x = powmod(a, d, n); if ( (x == 1) || (x == n-1) ) continue; for (r = 1; r < s; r++) { /* r=0 was just done, test r = 1 to s-1 */ x = sqrmod(x, n); if ( x == n-1 ) break; if ( x == 1 ) return 0; } if (r >= s) return 0; } return 1; } int _XS_BPSW(UV const n) { if (n < 7) return (n == 2 || n == 3 || n == 5); if ((n % 2) == 0 || n == UV_MAX) return 0; #if !USE_MONT_PRIMALITY return _XS_miller_rabin(n, mr_bases_const2, 1) && _XS_is_almost_extra_strong_lucas_pseudoprime(n,1); #else if (n < UVCONST(4294967295)) { return _XS_miller_rabin(n, mr_bases_const2, 1) && _XS_is_almost_extra_strong_lucas_pseudoprime(n,1); } else { const uint64_t npi = modular_inverse64(-((int64_t)n)); const uint64_t montr = compute_modn64(n); const uint64_t mont2 = compute_2_65_mod_n(n, montr); uint64_t u = n-1; const uint64_t nr = n-montr; int i, t = 0; UV P, V, d, s; /* M-R with base 2 */ while (!(u&1)) { t++; u >>= 1; } { uint64_t A = mont2; if (A) { uint64_t d = mont_powmod64(A, u, montr, n, npi); if (d != montr && d != nr) { for (i=1; i 1 && d < n) return 0; if (jacobi_iu(D, n) == -1) break; if (P == (3+20) && is_perfect_square(n)) return 0; P++; if (P > 65535) croak("lucas_extrastrong_params: P exceeded 65535"); } d = n+1; s = 0; while ( (d & 1) == 0 ) { s++; d >>= 1; } { const uint64_t montP = compute_a_times_2_64_mod_n(P, n, montr); UV W, b; W = submod( mont_prod64( montP, montP, n, npi), mont2, n); V = montP; { UV v = d; b = 1; while (v >>= 1) b++; } while (b-- > 1) { UV T = submod( mont_prod64(V, W, n, npi), montP, n); if ( (d >> (b-1)) & UVCONST(1) ) { V = T; W = submod( mont_prod64(W, W, n, npi), mont2, n); } else { W = T; V = submod( mont_prod64(V, V, n, npi), mont2, n); } } } if (V == mont2 || V == (n-mont2)) return 1; while (s-- > 1) { if (V == 0) return 1; V = submod( mont_prod64(V, V, n, npi), mont2, n); if (V == mont2) return 0; } } return 0; #endif } /* Generic Lucas sequence for any appropriate P and Q */ void lucas_seq(UV* Uret, UV* Vret, UV* Qkret, UV n, IV P, IV Q, UV k) { UV U, V, b, Dmod, Qmod, Pmod, Qk; if (k == 0) { *Uret = 0; *Vret = 2; *Qkret = Q; return; } Qmod = (Q < 0) ? (UV)(Q + (IV)n) : (UV)Q; Pmod = (P < 0) ? (UV)(P + (IV)n) : (UV)P; Dmod = submod( mulmod(Pmod, Pmod, n), mulmod(4, Qmod, n), n); MPUassert(Dmod != 0, "lucas_seq: D is 0"); U = 1; V = Pmod; Qk = Qmod; { UV v = k; b = 0; while (v >>= 1) b++; } if (Q == 1) { while (b--) { U = mulmod(U, V, n); V = mulsubmod(V, V, 2, n); if ( (k >> b) & UVCONST(1) ) { UV t2 = mulmod(U, Dmod, n); U = muladdmod(U, Pmod, V, n); if (U & 1) { U = (n>>1) + (U>>1) + 1; } else { U >>= 1; } V = muladdmod(V, Pmod, t2, n); if (V & 1) { V = (n>>1) + (V>>1) + 1; } else { V >>= 1; } } } } else if (P == 1 && Q == -1) { /* This is about 30% faster than the generic code below. Since 50% of * Lucas and strong Lucas tests come here, I think it's worth doing. */ int sign = Q; while (b--) { U = mulmod(U, V, n); if (sign == 1) V = mulsubmod(V, V, 2, n); else V = muladdmod(V, V, 2, n); sign = 1; /* Qk *= Qk */ if ( (k >> b) & UVCONST(1) ) { UV t2 = mulmod(U, Dmod, n); U = addmod(U, V, n); if (U & 1) { U = (n>>1) + (U>>1) + 1; } else { U >>= 1; } V = addmod(V, t2, n); if (V & 1) { V = (n>>1) + (V>>1) + 1; } else { V >>= 1; } sign = -1; /* Qk *= Q */ } } if (sign == 1) Qk = 1; } else { while (b--) { U = mulmod(U, V, n); V = mulsubmod(V, V, addmod(Qk,Qk,n), n); Qk = sqrmod(Qk, n); if ( (k >> b) & UVCONST(1) ) { UV t2 = mulmod(U, Dmod, n); U = muladdmod(U, Pmod, V, n); if (U & 1) { U = (n>>1) + (U>>1) + 1; } else { U >>= 1; } V = muladdmod(V, Pmod, t2, n); if (V & 1) { V = (n>>1) + (V>>1) + 1; } else { V >>= 1; } Qk = mulmod(Qk, Qmod, n); } } } *Uret = U; *Vret = V; *Qkret = Qk; } /* Lucas tests: * 0: Standard * 1: Strong * 2: Extra Strong (Mo/Jones/Grantham) * * None of them have any false positives for the BPSW test. Also see the * "almost extra strong" test. */ int _XS_is_lucas_pseudoprime(UV n, int strength) { IV P, Q, D; UV U, V, Qk, d, s; if (n < 7) return (n == 2 || n == 3 || n == 5); if ((n % 2) == 0 || n == UV_MAX) return 0; if (strength < 2) { UV Du = 5; IV sign = 1; while (1) { D = Du * sign; if (gcd_ui(Du, n) > 1 && gcd_ui(Du, n) != n) return 0; if (jacobi_iu(D, n) == -1) break; if (Du == 21 && is_perfect_square(n)) return 0; Du += 2; sign = -sign; } P = 1; Q = (1 - D) / 4; } else { P = 3; Q = 1; while (1) { D = P*P - 4; if (gcd_ui(D, n) > 1 && gcd_ui(D, n) != n) return 0; if (jacobi_iu(D, n) == -1) break; if (P == 21 && is_perfect_square(n)) return 0; P++; } } MPUassert( D == (P*P - 4*Q) , "is_lucas_pseudoprime: incorrect DPQ"); d = n+1; s = 0; if (strength > 0) while ( (d & 1) == 0 ) { s++; d >>= 1; } #if USE_MONT_PRIMALITY if (n > UVCONST(4294967295)) { const uint64_t npi = modular_inverse64(-((int64_t)n)); const uint64_t mont1 = compute_modn64(n); const uint64_t mont2 = compute_2_65_mod_n(n, mont1); const uint64_t montP = (P == 1) ? mont1 : (P >= 0) ? compute_a_times_2_64_mod_n(P, n, mont1) : n - compute_a_times_2_64_mod_n(-P, n, mont1); const uint64_t montD = (D >= 0) ? compute_a_times_2_64_mod_n(D, n, mont1) : n - compute_a_times_2_64_mod_n(-D, n, mont1); UV b; { UV v = d; b = 0; while (v >>= 1) b++; } /* U, V, Qk, and mont* are in Montgomery space */ U = mont1; V = montP; if (Q == 1 || Q == -1) { /* Faster code for |Q|=1, also opt for P=1 */ int sign = Q; while (b--) { U = mont_prod64(U, V, n, npi); if (sign == 1) V = submod( mont_square64(V,n,npi), mont2, n); else V = addmod( mont_square64(V,n,npi), mont2, n); sign = 1; if ( (d >> b) & UVCONST(1) ) { UV t2 = mont_prod64(U, montD, n, npi); if (P == 1) { U = addmod(U, V, n); V = addmod(V, t2, n); } else { U = addmod( mont_prod64(U, montP, n, npi), V, n); V = addmod( mont_prod64(V, montP, n, npi), t2, n); } if (U & 1) { U = (n>>1) + (U>>1) + 1; } else { U >>= 1; } if (V & 1) { V = (n>>1) + (V>>1) + 1; } else { V >>= 1; } sign = Q; } } Qk = (sign == 1) ? mont1 : n-mont1; } else { const uint64_t montQ = (Q >= 0) ? compute_a_times_2_64_mod_n(Q, n, mont1) : n - compute_a_times_2_64_mod_n(-Q, n, mont1); Qk = montQ; while (b--) { U = mont_prod64(U, V, n, npi); V = submod( mont_square64(V,n,npi), addmod(Qk,Qk,n), n); Qk = mont_square64(Qk,n,npi); if ( (d >> b) & UVCONST(1) ) { UV t2 = mont_prod64(U, montD, n, npi); U = addmod( mont_prod64(U, montP, n, npi), V, n); if (U & 1) { U = (n>>1) + (U>>1) + 1; } else { U >>= 1; } V = addmod( mont_prod64(V, montP, n, npi), t2, n); if (V & 1) { V = (n>>1) + (V>>1) + 1; } else { V >>= 1; } Qk = mont_prod64(Qk, montQ, n, npi); } } } if (strength == 0) { if (U == 0) return 1; } else if (strength == 1) { if (U == 0) return 1; while (s--) { if (V == 0) return 1; if (s) { V = submod( mont_square64(V,n,npi), addmod(Qk,Qk,n), n); Qk = mont_square64(Qk,n,npi); } } } else { if ( U == 0 && (V == mont2 || V == (n-mont2)) ) return 1; s--; while (s--) { if (V == 0) return 1; if (s) V = submod( mont_square64(V,n,npi), mont2, n); } } return 0; } #endif lucas_seq(&U, &V, &Qk, n, P, Q, d); if (strength == 0) { if (U == 0) return 1; } else if (strength == 1) { if (U == 0) return 1; /* Now check to see if V_{d*2^r} == 0 for any 0 <= r < s */ while (s--) { if (V == 0) return 1; if (s) { V = mulsubmod(V, V, addmod(Qk,Qk,n), n); Qk = sqrmod(Qk, n); } } } else { if ( U == 0 && (V == 2 || V == (n-2)) ) return 1; /* Now check to see if V_{d*2^r} == 0 for any 0 <= r < s-1 */ s--; while (s--) { if (V == 0) return 1; if (s) V = mulsubmod(V, V, 2, n); } } return 0; } /* A generalization of Pari's shortcut to the extra-strong Lucas test. * I've added a gcd check at the top, which needs to be done and also results * in fewer pseudoprimes. Pari always does trial division to 100 first so * is unlikely to come up there. This only calculate V, which can be done * faster, but that means we have more pseudoprimes than the standard * extra-strong test. * * increment: 1 for Baillie OEIS, 2 for Pari. * * With increment = 1, these results will be a subset of the extra-strong * Lucas pseudoprimes. With increment = 2, we produce Pari's results. */ int _XS_is_almost_extra_strong_lucas_pseudoprime(UV n, UV increment) { UV P, V, W, d, s, b; if (n < 7) return (n == 2 || n == 3 || n == 5); if ((n % 2) == 0 || n == UV_MAX) return 0; if (increment < 1 || increment > 256) croak("Invalid lucas parameter increment: %"UVuf"\n", increment); P = 3; while (1) { UV D = P*P - 4; d = gcd_ui(D, n); if (d > 1 && d < n) return 0; if (jacobi_iu(D, n) == -1) break; if (P == (3+20*increment) && is_perfect_square(n)) return 0; P += increment; if (P > 65535) croak("lucas_extrastrong_params: P exceeded 65535"); } if (P >= n) P %= n; /* Never happens with increment < 4 */ d = n+1; s = 0; while ( (d & 1) == 0 ) { s++; d >>= 1; } { UV v = d; b = 0; while (v >>= 1) b++; } #if USE_MONT_PRIMALITY if (n > UVCONST(4294967295)) { const uint64_t npi = modular_inverse64(-((int64_t)n)); const uint64_t montr = compute_modn64(n); const uint64_t mont2 = compute_2_65_mod_n(n, montr); const uint64_t montP = compute_a_times_2_64_mod_n(P, n, montr); W = submod( mont_prod64( montP, montP, n, npi), mont2, n); V = montP; while (b--) { UV T = submod( mont_prod64(V, W, n, npi), montP, n); if ( (d >> b) & UVCONST(1) ) { V = T; W = submod( mont_prod64(W, W, n, npi), mont2, n); } else { W = T; V = submod( mont_prod64(V, V, n, npi), mont2, n); } } if (V == mont2 || V == (n-mont2)) return 1; s--; while (s--) { if (V == 0) return 1; if (s) V = submod( mont_prod64(V, V, n, npi), mont2, n); } return 0; } #endif W = mulsubmod(P, P, 2, n); V = P; while (b--) { UV T = mulsubmod(V, W, P, n); if ( (d >> b) & UVCONST(1) ) { V = T; W = mulsubmod(W, W, 2, n); } else { W = T; V = mulsubmod(V, V, 2, n); } } if (V == 2 || V == (n-2)) return 1; while (s-- > 1) { if (V == 0) return 1; V = mulsubmod(V, V, 2, n); if (V == 2) return 0; } return 0; } /* * The Frobenius-Underwood test has no known counterexamples below 10^13, but * has not been extensively tested above that. This is the Minimal Lambda+2 * test from section 9 of "Quadratic Composite Tests" by Paul Underwood. * * It is generally slower than the AES Lucas test, but for large values is * competitive with the BPSW test. Since our BPSW is known to have no * counterexamples under 2^64, while the results of this test are unknown, * it is mainly useful for numbers larger than 2^64 as an additional * non-correlated test. */ int _XS_is_frobenius_underwood_pseudoprime(UV n) { int bit; UV x, result, a, b, np1, len, t1; IV t; if (n < 7) return (n == 2 || n == 3 || n == 5); if ((n % 2) == 0 || n == UV_MAX) return 0; if (is_perfect_square(n)) return 0; x = 0; t = -1; while ( jacobi_iu( t, n ) != -1 ) { x++; t = (IV)(x*x) - 4; } np1 = n+1; { UV v = np1; len = 1; while (v >>= 1) len++; } #if USE_MONT_PRIMALITY if (n > UVCONST(4294967295)) { const uint64_t npi = modular_inverse64(-((int64_t)n)); const uint64_t mont1 = compute_modn64(n); const uint64_t mont2 = compute_2_65_mod_n(n, mont1); const uint64_t mont5 = compute_a_times_2_64_mod_n(5, n, mont1); x = compute_a_times_2_64_mod_n(x, n, mont1); a = mont1; b = mont2; if (x == 0) { result = mont5; for (bit = len-2; bit >= 0; bit--) { t1 = addmod(b, b, n); b = mont_prod64(submod(b, a, n), addmod(b, a, n), n, npi); a = mont_prod64(a, t1, n, npi); if ( (np1 >> bit) & UVCONST(1) ) { t1 = b; b = submod( addmod(b, b, n), a, n); a = addmod( addmod(a, a, n), t1, n); } } } else { UV multiplier = addmod(x, mont2, n); result = addmod( addmod(x, x, n), mont5, n); for (bit = len-2; bit >= 0; bit--) { t1 = addmod( mont_prod64(a, x, n, npi), addmod(b, b, n), n); b = mont_prod64(submod(b, a, n), addmod(b, a, n), n, npi); a = mont_prod64(a, t1, n, npi); if ( (np1 >> bit) & UVCONST(1) ) { t1 = b; b = submod( addmod(b, b, n), a, n); a = addmod( mont_prod64(a, multiplier, n, npi), t1, n); } } } return (a == 0 && b == result); } #endif a = 1; b = 2; if (x == 0) { result = 5; for (bit = len-2; bit >= 0; bit--) { t1 = addmod(b, b, n); b = mulmod( submod(b, a, n), addmod(b, a, n), n); a = mulmod(a, t1, n); if ( (np1 >> bit) & UVCONST(1) ) { t1 = b; b = submod( addmod(b, b, n), a, n); a = addmod( addmod(a, a, n), t1, n); } } } else { UV multiplier = addmod(x, 2, n); result = addmod( addmod(x, x, n), 5, n); for (bit = len-2; bit >= 0; bit--) { t1 = addmod( mulmod(a, x, n), addmod(b, b, n), n); b = mulmod(submod(b, a, n), addmod(b, a, n), n); a = mulmod(a, t1, n); if ( (np1 >> bit) & UVCONST(1) ) { t1 = b; b = submod( addmod(b, b, n), a, n); a = addmod( mulmod(a, multiplier, n), t1, n); } } } if (_XS_get_verbose()>1) printf("%"UVuf" is %s with x = %"UVuf"\n", n, (a == 0 && b == result) ? "probably prime" : "composite", x); if (a == 0 && b == result) return 1; return 0; } /******************************************************************************/ /* Select M-R bases from http://miller-rabin.appspot.com/, 26 July 2013 */ #if BITS_PER_WORD == 32 static const UV mr_bases_small_2[2] = {31, 73}; static const UV mr_bases_small_3[3] = {2, 7, 61}; #else static const UV mr_bases_large_1[1] = { UVCONST( 9345883071009581737 ) }; static const UV mr_bases_large_2[2] = { UVCONST( 336781006125 ), UVCONST( 9639812373923155 ) }; static const UV mr_bases_large_3[3] = { UVCONST( 4230279247111683200 ), UVCONST( 14694767155120705706 ), UVCONST( 16641139526367750375 ) }; static const UV mr_bases_large_7[7] = { 2, 325, 9375, 28178, 450775, 9780504, 1795265022 }; #endif int is_prob_prime(UV n) { int ret; if (n < 11) { if (n == 2 || n == 3 || n == 5 || n == 7) return 2; else return 0; } if (!(n%2) || !(n%3) || !(n%5) || !(n%7)) return 0; if (n < 121) /* 11*11 */ return 2; if (!(n%11) || !(n%13) || !(n%17) || !(n%19) || !(n%23) || !(n%29) || !(n%31) || !(n%37) || !(n%41) || !(n%43) || !(n%47) || !(n%53)) return 0; if (n < 3481) /* 59*59 */ return 2; #if BITS_PER_WORD == 32 /* We could use one base when n < 49191, two when n < 360018361. */ if (n < UVCONST(9080191)) ret = _XS_miller_rabin(n, mr_bases_small_2, 2); else ret = _XS_miller_rabin(n, mr_bases_small_3, 3); #else /* AESLSP test costs about 1.5 Selfridges, vs. ~2.2 for strong Lucas. * So it works out to be faster to do AES-BPSW vs. 3 M-R tests. */ if (n < UVCONST(341531)) ret = _XS_miller_rabin(n, mr_bases_large_1, 1); else if (n < UVCONST(1050535501)) ret = _XS_miller_rabin(n, mr_bases_large_2, 2); else ret = _XS_BPSW(n); /* ret = efficient_mr64(mr_bases_large_7, 7, n); ret = _XS_miller_rabin(n, mr_bases_large_7, 7); */ #endif return 2*ret; } Math-Prime-Util-0.37/Makefile.PL0000644000076400007640000000761512270242116014701 0ustar danadanause ExtUtils::MakeMaker; my $broken64 = (18446744073709550592 == ~0); if ($broken64) { warn < 'Math::Prime::Util', ABSTRACT => 'Utilities related to prime numbers, including fast sieves and factoring', VERSION_FROM => 'lib/Math/Prime/Util.pm', LICENSE => 'perl', AUTHOR => 'Dana A Jacobsen ', OBJECT => 'cache.o ' . 'factor.o ' . 'primality.o '. 'aks.o ' . 'lehmer.o ' . 'lmo.o ' . 'sieve.o ' . 'util.o ' . 'XS.o', LIBS => ['-lm'], EXE_FILES => ['bin/primes.pl', 'bin/factor.pl'], TEST_REQUIRES=> { 'Test::More' => '0.45', 'bignum' => '0.22', # 'use bigint' in tests }, PREREQ_PM => { 'Exporter' => '5.562', 'XSLoader' => '0.01', 'Carp' => ($] < 5.008) ? '1.17' : 0, 'Tie::Array' => 0, 'base' => 0, 'constant' => 0, 'Config' => 0, # 1.99 fixes the FastCalc SvUV bug, we work around it. 'Math::BigInt' => '1.88', 'Math::BigFloat' => '1.59', 'Bytes::Random::Secure' => '0.23', }, META_MERGE => { 'meta-spec' => { version => '2', url => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec', }, resources => { license => [ 'http://dev.perl.org/licenses/' ], homepage => 'https://github.com/danaj/Math-Prime-Util', repository => { url => 'https://github.com/danaj/Math-Prime-Util', }, }, prereqs => { runtime => { recommends => { 'Math::Prime::Util::GMP' => 0.16, 'Math::BigInt::GMP' => 0, 'Math::MPFR' => 2.03, }, }, test => { suggests => { 'Test::Warn' => 0, }, }, }, }, MIN_PERL_VERSION => 5.006002, ); sub WriteMakefile1 { # Cribbed from eumm-upgrade by Alexandr Ciornii my %params = @_; my $eumm_version = $ExtUtils::MakeMaker::VERSION; $eumm_version = eval $eumm_version; if ($params{TEST_REQUIRES} and $eumm_version < 6.6303) { $params{BUILD_REQUIRES}={ %{$params{BUILD_REQUIRES} || {}} , %{$params{TEST_REQUIRES}} }; delete $params{TEST_REQUIRES}; } if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { #EUMM 6.5502 has problems with BUILD_REQUIRES $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; delete $params{BUILD_REQUIRES}; } delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; delete $params{META_MERGE} if $eumm_version < 6.46; delete $params{META_ADD} if $eumm_version < 6.46; delete $params{LICENSE} if $eumm_version < 6.31; delete $params{AUTHOR} if $] < 5.005; delete $params{ABSTRACT_FROM} if $] < 5.005; delete $params{BINARY_LOCATION} if $] < 5.005; WriteMakefile(%params); } Math-Prime-Util-0.37/sieve.h0000644000076400007640000001155712270242116014213 0ustar danadana#ifndef MPU_SIEVE_H #define MPU_SIEVE_H #include "EXTERN.h" #include "perl.h" extern unsigned char* sieve_erat30(UV end); extern int sieve_segment(unsigned char* mem, UV startd, UV endd); extern void* start_segment_primes(UV low, UV high, unsigned char** segmentmem); extern int next_segment_primes(void* vctx, UV* base, UV* low, UV* high); extern void end_segment_primes(void* vctx); static const UV wheel30[] = {1, 7, 11, 13, 17, 19, 23, 29}; /* Used for moving between primes */ static const unsigned char nextwheel30[30] = { 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 }; static const unsigned char prevwheel30[30] = { 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 }; /* The bit mask within a byte */ static const unsigned char masktab30[30] = { 0, 1, 0, 0, 0, 0, 0, 2, 0, 0, 0, 4, 0, 8, 0, 0, 0, 16, 0, 32, 0, 0, 0, 64, 0, 0, 0, 0, 0,128 }; /* Inverse of masktab30 */ static const unsigned char imask30[129] = { 0,1,7,0,11,0,0,0,13,0,0,0,0,0,0,0,17,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,19, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,23, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,29}; /* Add this to a number and you'll ensure you're on a wheel location */ static const unsigned char distancewheel30[30] = {1,0,5,4,3,2,1,0,3,2,1,0,1,0,3,2,1,0,1,0,3,2,1,0,5,4,3,2,1,0}; /* add this to n to get to the next wheel location */ static const unsigned char wheeladvance30[30] = {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}; /* subtract this from n to get to the previous wheel location */ static const unsigned char wheelretreat[30] = {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}; #ifdef FUNC_is_prime_in_sieve static int is_prime_in_sieve(const unsigned char* sieve, UV p) { UV d = p/30; UV m = p - d*30; /* If m isn't part of the wheel, we return 0 */ return ( (masktab30[m] != 0) && ((sieve[d] & masktab30[m]) == 0) ); } #endif #ifdef FUNC_next_prime_in_sieve /* Will return 0 if it goes past lastp */ static UV next_prime_in_sieve(const unsigned char* sieve, UV p, UV lastp) { UV d, m; if (p < 7) return (p < 2) ? 2 : (p < 3) ? 3 : (p < 5) ? 5 : 7; d = p/30; m = p - d*30; do { if (m != 29) { m = nextwheel30[m]; } else { d++; m = 1; if (d*30 >= lastp) return 0; /* sieves have whole bytes filled */ } } while (sieve[d] & masktab30[m]); return d*30+m; } #endif #ifdef FUNC_prev_prime_in_sieve static UV prev_prime_in_sieve(const unsigned char* sieve, UV p) { UV d, m; if (p <= 7) return (p <= 2) ? 0 : (p <= 3) ? 2 : (p <= 5) ? 3 : 5; d = p/30; m = p - d*30; do { m = prevwheel30[m]; if (m==29) { if (d == 0) return 0; d--; } } while (sieve[d] & masktab30[m]); return(d*30+m); } #endif /* Useful macros for the wheel-30 sieve array */ #define START_DO_FOR_EACH_SIEVE_PRIME(sieve, a, b) \ { \ const unsigned char* sieve_ = sieve; \ UV p = a; \ UV l_ = b; \ UV d_ = p/30; \ UV lastd_ = l_/30; \ UV mask_ = masktab30[ p-d_*30 + distancewheel30[ p-d_*30 ] ]; \ UV s_ = sieve_[d_]; \ while (d_ <= lastd_ && (s_ & mask_)) { \ mask_ <<= 1; if (mask_ > 128) { s_ = sieve_[++d_]; mask_ = 1; } \ } \ p = d_*30 + imask30[mask_]; \ while ( p <= l_ ) { \ #define END_DO_FOR_EACH_SIEVE_PRIME \ do { \ mask_ <<= 1; \ if (mask_ > 128) { \ while (++d_ <= lastd_) { s_ = sieve_[d_]; if (s_ != 0xFF) break; } \ if (d_ > lastd_) break; \ mask_ = 1; \ } \ } while (s_ & mask_); \ p = d_*30 + imask30[mask_]; \ } \ } #define START_DO_FOR_EACH_PRIME(a, b) \ { \ const unsigned char* sieve_; \ UV p = a; \ UV l_ = b; \ UV d_ = p/30; \ UV s_, mask_ = 2; \ UV lastd_ = l_/30; \ get_prime_cache(l_, &sieve_); \ s_ = sieve_[d_]; \ if (p <= 5) { \ p = (p <= 2) ? 2 : (p <= 3) ? 3 : 5; \ } else if (p != 7) { \ mask_ = masktab30[ p-d_*30 + distancewheel30[ p-d_*30 ] ]; \ while (d_ <= lastd_ && (s_ & mask_)) { \ mask_ <<= 1; if (mask_ > 128) { s_ = sieve_[++d_]; mask_ = 1; } \ } \ p = d_*30 + imask30[mask_]; \ } \ while ( p <= l_ ) { #define RETURN_FROM_EACH_PRIME(retstmt) \ do { release_prime_cache(sieve_); retstmt; } while (0) #define END_DO_FOR_EACH_PRIME \ if (p < 7) { \ p += 1 + (p > 2); \ } else { \ do { \ mask_ <<= 1; \ if (mask_ > 128) { \ if (++d_ > lastd_) break; \ s_ = sieve_[d_]; \ mask_ = 1; \ } \ } while (s_ & mask_); \ p = d_*30 + imask30[mask_]; \ } \ } \ release_prime_cache(sieve_); \ } #endif Math-Prime-Util-0.37/mulmod.h0000644000076400007640000001103712270242116014366 0ustar danadana#ifndef MPU_MULMOD_H #define MPU_MULMOD_H #include "ptypes.h" #if defined(__GNUC__) #define INLINE inline #elif defined(_MSC_VER) #define INLINE __inline #else #define INLINE #endif /* if n is smaller than this, you can multiply without overflow */ #define HALF_WORD (UVCONST(1) << (BITS_PER_WORD/2)) #if (BITS_PER_WORD == 32) && HAVE_STD_U64 /* We have 64-bit available, but UV is 32-bit. Do the math in 64-bit. * Even if it is emulated, it should be as fast or faster than us doing it. */ #define addmod(a,b,n) (UV)( ((uint64_t)(a) + (b)) % (n) ) #define mulmod(a,b,n) (UV)( ((uint64_t)(a) * (b)) % (n) ) #define sqrmod(a,n) (UV)( ((uint64_t)(a) * (a)) % (n) ) #elif defined(__GNUC__) && defined(__x86_64__) /* GCC on a 64-bit Intel x86, help from WraithX and Wojciech Izykowski */ /* Beware: if (a*b)/c > 2^64, there will be an FP exception */ static INLINE UV _mulmod(UV a, UV b, UV n) { UV d, dummy; /* d will get a*b mod c */ asm ("mulq %3\n\t" /* mul a*b -> rdx:rax */ "divq %4\n\t" /* (a*b)/c -> quot in rax remainder in rdx */ :"=a"(dummy), "=&d"(d) /* output */ :"a"(a), "rm"(b), "rm"(n) /* input */ :"cc" /* mulq and divq can set conditions */ ); return d; } #define mulmod(a,b,n) _mulmod(a,b,n) #define sqrmod(a,n) _mulmod(a,a,n) /* A version for _MSC_VER: * __asm { mov rax, qword ptr a * mul qword ptr b * div qword ptr c * mov qword ptr d, rdx } */ /* addmod from Kruppa 2010 page 67 */ static INLINE UV _addmod(UV a, UV b, UV n) { UV r = a+b; UV t = a-n; asm ("add %2, %1\n\t" /* t := t + b */ "cmovc %1, %0\n\t" /* if (carry) r := t */ :"+r" (r), "+&r" (t) :"rm" (b) :"cc" ); return r; } #define addmod(a,b,n) _addmod(a,b,n) #elif BITS_PER_WORD == 64 && __GNUC__ == 4 && __GNUC_MINOR__ >= 4 && (defined(__x86_64__) || defined(__powerpc64__)) /* We're 64-bit, using a modern gcc, and the target has some 128-bit type. * The actual number of targets that have this implemented are limited. */ #if __GNUC__ == 4 && __GNUC_MINOR__ >= 4 && __GNUC_MINOR__ < 6 typedef unsigned int uint128_t __attribute__ ((__mode__ (TI))); #else typedef unsigned __int128 uint128_t; #endif #define mulmod(a,b,n) (UV)( ((uint128_t)(a) * (b)) % (n) ) #define sqrmod(a,n) (UV)( ((uint128_t)(a) * (a)) % (n) ) #else /* UV is the largest integral type available (that we know of). */ /* Do it by hand */ static INLINE UV _mulmod(UV a, UV b, UV n) { UV r = 0; if (a >= n) a %= n; /* Careful attention from the caller should make */ if (b >= n) b %= n; /* these unnecessary. */ if ((a|b) < HALF_WORD) return (a*b) % n; if (a < b) { UV t = a; a = b; b = t; } if (n <= (UV_MAX>>1)) { while (b > 0) { if (b & 1) { r += a; if (r >= n) r -= n; } b >>= 1; if (b) { a += a; if (a >= n) a -= n; } } } else { while (b > 0) { if (b & 1) r = ((n-r) > a) ? r+a : r+a-n; /* r = (r + a) % n */ b >>= 1; if (b) a = ((n-a) > a) ? a+a : a+a-n; /* a = (a + a) % n */ } } return r; } #define mulmod(a,b,n) _mulmod(a,b,n) #define sqrmod(a,n) _mulmod(a,a,n) #endif #ifndef addmod static INLINE UV addmod(UV a, UV b, UV n) { return ((n-a) > b) ? a+b : a+b-n; } #endif static INLINE UV submod(UV a, UV b, UV n) { UV t = n-b; /* Evaluate as UV, then hand to addmod */ return addmod(a, t, n); } /* a^2 + c mod n */ #define sqraddmod(a, c, n) addmod(sqrmod(a,n), c, n) /* a*b + c mod n */ #define muladdmod(a, b, c, n) addmod(mulmod(a,b,n), c, n) /* a*b - c mod n */ #define mulsubmod(a, b, c, n) submod(mulmod(a,b,n), c, n) /* a^k mod n */ #ifndef HALF_WORD static INLINE UV powmod(UV a, UV k, UV n) { UV t = 1; if (a >= n) a %= n; while (k) { if (k & 1) t = mulmod(t, a, n); k >>= 1; if (k) a = sqrmod(a, n); } return t; } #else static INLINE UV powmod(UV a, UV k, UV n) { UV t = 1; if (a >= n) a %= n; if (n < HALF_WORD) { while (k) { if (k & 1) t = (t*a)%n; k >>= 1; if (k) a = (a*a)%n; } } else { while (k) { if (k & 1) t = mulmod(t, a, n); k >>= 1; if (k) a = sqrmod(a, n); } } return t; } #endif /* a^k + c mod n */ #define powaddmod(a, k, c, n) addmod(powmod(a,k,n),c,n) #endif Math-Prime-Util-0.37/ptypes.h0000644000076400007640000000632012270242116014414 0ustar danadana#ifndef MPU_PTYPES_H #define MPU_PTYPES_H #ifdef _MSC_VER /* No stdint.h for MS C, but all the types can be defined. * * Thanks to Sisyphus and bulk88 for all the help with MSC, * including working patches. */ typedef unsigned __int8 uint8_t; typedef unsigned __int16 uint16_t; typedef unsigned __int32 uint32_t; typedef unsigned __int64 uint64_t; typedef __int64 int64_t; typedef __int32 int32_t; typedef __int16 int16_t; typedef __int8 int8_t; #define inline __inline #ifdef _M_X64 # define __x86_64__ # define __x86_64 # define __amd64__ # define __amd64 #endif #ifdef _M_IX86 # define __i386__ # define __i386 # define i386 # define _X86_ #endif #ifdef _M_IA64 # define __ia64__ # define __ia64 # define __IA64__ # define __itanium__ #endif #elif defined(__sun) || defined(__sun__) /* stdint.h is only in Solaris 10+. */ #if defined(__SunOS_5_10) || defined(__SunOS_5_11) || defined(__SunOS_5_12) #define __STDC_LIMIT_MACROS #include #endif #else #define __STDC_LIMIT_MACROS #include #endif #include "EXTERN.h" #include "perl.h" /* From perl.h, wrapped in PERL_CORE */ #ifndef U32_CONST # if INTSIZE >= 4 # define U32_CONST(x) ((U32TYPE)x##U) # else # define U32_CONST(x) ((U32TYPE)x##UL) # endif #endif /* From perl.h, wrapped in PERL_CORE */ #ifndef U64_CONST # ifdef HAS_QUAD # if INTSIZE >= 8 # define U64_CONST(x) ((U64TYPE)x##U) # elif LONGSIZE >= 8 # define U64_CONST(x) ((U64TYPE)x##UL) # elif QUADKIND == QUAD_IS_LONG_LONG # define U64_CONST(x) ((U64TYPE)x##ULL) # else /* best guess we can make */ # define U64_CONST(x) ((U64TYPE)x##UL) # endif # endif #endif /* See: * http://www.nntp.perl.org/group/perl.perl5.porters/2013/09/msg207524.html * for some discussion. */ #ifdef HAS_QUAD #define BITS_PER_WORD 64 #define UVCONST(x) U64_CONST(x) #else #define BITS_PER_WORD 32 #define UVCONST(x) U32_CONST(x) #endif /* Try to determine if we have 64-bit available via uint64_t */ #define HAVE_STD_U64 0 #if defined(UINT64_MAX) && defined(__UINT64_C) #if (UINT64_MAX >= __UINT64_C(18446744073709551615)) #undef HAVE_STD_U64 #define HAVE_STD_U64 1 #endif #elif defined(_MSC_VER) /* We set up the types earlier */ #undef HAVE_STD_U64 #define HAVE_STD_U64 1 #endif #define MAXBIT (BITS_PER_WORD-1) #define NWORDS(bits) ( ((bits)+BITS_PER_WORD-1) / BITS_PER_WORD ) #define NBYTES(bits) ( ((bits)+8-1) / 8 ) #define MPUassert(c,text) if (!(c)) { croak("Math::Prime::Util internal error: " text); } /* The ASSUME bits are from perl 5.19.6 perl.h */ #ifndef __has_builtin # define __has_builtin(x) 0 /* not a clang style compiler */ #endif #ifndef DEBUGGING # if (__GNUC__ == 4 && __GNUC_MINOR__ >= 5 || __GNUC__ > 5) || __has_builtin(__builtin_unreachable) # define MPUASSUME(x) ((x) ? (void) 0 : __builtin_unreachable()) # elif defined(_MSC_VER) # define MPUASSUME(x) __assume(x) # elif defined(__ARMCC_VERSION) /* untested */ # define MPUASSUME(x) __promise(x) # else /* a random compiler might define assert to its own special optimization token so pass it through to C lib as a last resort */ # define MPUASSUME(x) assert(x) # endif #else # define MPUASSUME(x) assert(x) #endif #define MPUNOT_REACHED MPUASSUME(0) #endif Math-Prime-Util-0.37/xt/0000755000076400007640000000000012271163661013361 5ustar danadanaMath-Prime-Util-0.37/xt/primecount-many.t0000644000076400007640000001645712270242116016702 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/prime_count prime_count_lower prime_count_upper prime_count_approx/; use Digest::SHA qw/sha256_hex/; my $use64 = ~0 > 4294967295; my %pivals = ( 1000 => 168, 10000 => 1229, 100000 => 9592, 1000000 => 78498, 10000000 => 664579, 100000000 => 5761455, 1000000000 => 50847534, 10000000000 => 455052511, 100000000000 => 4118054813, 1000000000000 => 37607912018, 2000000000000 => 73301896139, 3000000000000 => 108340298703, 4000000000000 => 142966208126, 5000000000000 => 177291661649, 6000000000000 => 211381427039, 7000000000000 => 245277688804, 8000000000000 => 279010070811, 9000000000000 => 312600354108, 10000000000000 => 346065536839, 20000000000000 => 675895909271, 30000000000000 => 1000121668853, 40000000000000 => 1320811971702, 50000000000000 => 1638923764567, 60000000000000 => 1955010428258, 70000000000000 => 2269432871304, 80000000000000 => 2582444113487, 90000000000000 => 2894232250783, 100000000000000 => 3204941750802, 200000000000000 => 6270424651315, 300000000000000 => 9287441600280, 400000000000000 => 12273824155491, 500000000000000 => 15237833654620, 600000000000000 => 18184255291570, 700000000000000 => 21116208911023, 800000000000000 => 24035890368161, 900000000000000 => 26944926466221, 1000000000000000 => 29844570422669, 10000000000000000 => 279238341033925, 20000000000000000 => 547863431950008, 40000000000000000 => 1075292778753150, 100000000000000000 => 2623557157654233, 1000000000000000000 => 24739954287740860, 2000000000000000000 => 48645161281738535, 3000000000000000000 => 72254704797687083, 4000000000000000000 => 95676260903887607, 4185296581467695669 => 100000000000000000, 5000000000000000000 => 118959989688273472, 6000000000000000000 => 142135049412622144, 7000000000000000000 => 165220513980969424, 8000000000000000000 => 188229829247429504, 9000000000000000000 => 211172979243258278, 10000000000000000000 => 234057667276344607, 524288 => 43390, 1048576 => 82025, 2097152 => 155611, 4194304 => 295947, 8388608 => 564163, 16777216 => 1077871, 33554432 => 2063689, 67108864 => 3957809, 134217728 => 7603553, 268435456 => 14630843, 536870912 => 28192750, 1073741824 => 54400028, 2147483648 => 105097565, 4294967296 => 203280221, 8589934592 => 393615806, 17179869184 => 762939111, 34359738368 => 1480206279, 68719476736 => 2874398515, 137438953472 => 5586502348, 274877906944 => 10866266172, 549755813888 => 21151907950, 1099511627776 => 41203088796, 2199023255552 => 80316571436, 4398046511104 => 156661034233, 8796093022208 => 305761713237, 17592186044416 => 597116381732, 35184372088832 => 1166746786182, 70368744177664 => 2280998753949, 140737488355328 => 4461632979717, 281474976710656 => 8731188863470, 562949953421312 => 17094432576778, 1125899906842624 => 33483379603407, 2251799813685248 => 65612899915304, 4503599627370496 => 128625503610475, 9007199254740992 => 252252704148404, 18014398509481984 => 494890204904784, 36028797018963968 => 971269945245201, 72057594037927936 => 1906879381028850, 144115188075855872 => 3745011184713964, 288230376151711744 => 7357400267843990, 576460752303423488 => 14458792895301660, 1152921504606846976 => 28423094496953330, 2305843009213693952 => 55890484045084135, 4611686018427387904 => 109932807585469973, 9223372036854775808 => 216289611853439384, # Leading up to 2**32-1 4294000000 => 203236859, 4294900000 => 203277205, 4294960000 => 203279882, 4294967000 => 203280211, 4294967200 => 203280218, 4294967290 => 203280220, 4294967295 => 203280221, # From http://trac.sagemath.org/ticket/7539 plus sieving # 11000000000000000000 => 256890014776557326, # 12000000000000000000 => 279675001309887227, # 13000000000000000000 => 302416755645383081, # 14000000000000000000 => 325118755759814408, # 15000000000000000000 => 347783970566657581, # 16000000000000000000 => 370414963651223281, # 17000000000000000000 => 393013970558176111, # 18000000000000000000 => 415582957615112220, # 18400000000000000000 => 424602543873663577, 18440000000000000000 => 425504257754137607, # verified 18446700000000000000 => 425655290520421050, # verified # 18446740000000000000 => 425656192205366999, # 18446744000000000000 => 425656282373661946, # 18446744030000000000 => 425656283049924141, # 18446744040000000000 => 425656283275356419, # 18446744050000000000 => 425656283500787632, # 18446744070000000000 => 425656283951611098, # 18446744073000000000 => 425656284019227775, # verified # 18446744073700000000 => 425656284035002496, # verified # 18446744073709000000 => 425656284035205391, # verified # 18446744073709550000 => 425656284035217706, # verified # 18446744073709551000 => 425656284035217730, 18446744073709551615 => 425656284035217743, # verified # ); if (!$use64) { delete @pivals{ grep { $_ > ~0 } keys %pivals }; } plan tests => 5 + scalar(keys %pivals); # Test prime counts using sampling diag "Sampling small prime counts, should take < 1 minute"; { my $countstr; $countstr = join(" ", map { prime_count($_) } 1 .. 100000); is(sha256_hex($countstr), "cdbc5c94a927d0d9481cb26b3d3e60c0617a4be65ce9db3075c0363c7a81ef52", "prime counts 1..10^5"); $countstr = join(" ", map { prime_count(100*$_ + ($_%101)) } 1000 .. 100000); is(sha256_hex($countstr), "73a0b71dedff9611e06fd57e52b88c8afd7f86b5351e4950b2dd5c1d68845b6e", "prime counts 10^5..10^7 (sample 100)"); $countstr = join(" ", map { prime_count(10000*$_ + ($_%9973)) } 1000 .. 10000); is(sha256_hex($countstr), "d73736c54362136aa0a48bab44b55004b2e63e0d1d03a6cbe1aab42c6a579d0c", "prime counts 10^7..10^8 (sample 10k)"); $countstr = join(" ", map { prime_count(500000*$_ + 250837 + $_) } 200 .. 2000); is(sha256_hex($countstr), "00a580b2f52b661f065f5ce49bd2aeacb3b169d8903cf824b65731441e40f0b9", "prime counts 10^8..10^9 (sample 500k)"); SKIP: { skip "Skipping 10^9 to 10^10 if 32-bit", 1 unless $use64; $countstr = join(" ", map { prime_count(10000000*$_ + 250837 + $_) } 100 .. 1000); is(sha256_hex($countstr), "9fd78debf4b510ee6d230cabf314ebef5eb253ee63d5df658e45414613f7b8c2", "prime counts 10^9..10^10 (sample 10M)"); } } diag "Selected prime counts, will take hours to complete" if $use64; foreach my $n (sort {$a <=> $b} keys %pivals) { my $pin = $pivals{$n}; is( prime_count($n), $pin, "Pi($n) = $pin" ); } Math-Prime-Util-0.37/xt/totient-range.pl0000755000076400007640000000131712262252474016504 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util qw/euler_phi/; use List::Util qw/sum/; my $limit = shift || 1_000_000; print "Calculating totients from 1 to $limit..."; my @phi = map { euler_phi($_) } 1 .. $limit; print "..."; unshift @phi, 0; print "...done\n"; while (1) { my $beg = 1 + int(rand($limit)); my $end = 1 + int(rand($limit)); ($beg,$end) = ($end,$beg) if $beg > $end; # Does range return the same values? my @phi_range = @phi[ $beg .. $end ]; my @totients = euler_phi($beg,$end); my $sum1 = sum(@phi_range); my $sum2 = sum(@totients); warn "\nbeg $beg end $end sum $sum1 range sum $sum2\n" unless $sum1 == $sum2; print "."; } Math-Prime-Util-0.37/xt/legendre_phi.t0000644000076400007640000000114512270242116016164 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Test::More; use Math::Prime::Util qw/nth_prime prime_count/; my $x = shift || 50000; my $sqrtx = int(sqrt($x)); my $pcx = prime_count($x); my $pcsqrtx = prime_count($sqrtx); my @a = 1 .. $x; foreach my $a (0 .. $sqrtx+1) { if ($a > 0) { my $p = nth_prime($a); @a = grep { $_ % $p } @a; } my $expect = scalar @a; if ($a > $pcsqrtx) { is ( $expect, $pcx - $a + 1, "sieved phi($x,$a) = Pi($x) - $a + 1" ); } my $phixa = Math::Prime::Util::legendre_phi($x, $a); is( $phixa, $expect, "Legendre phi($x,$a) = $expect" ); } done_testing(); Math-Prime-Util-0.37/xt/nthprime.t0000644000076400007640000000772112270011421015364 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/nth_prime/; my %nthvals = ( 1 => 2, 2 => 3, 4 => 7, 8 => 19, 16 => 53, 32 => 131, 64 => 311, 128 => 719, 256 => 1619, 512 => 3671, 1024 => 8161, 2048 => 17863, 4096 => 38873, 8192 => 84017, 16384 => 180503, 32768 => 386093, 65536 => 821641, 131072 => 1742537, 262144 => 3681131, 524288 => 7754077, 1048576 => 16290047, 2097152 => 34136029, 4194304 => 71378569, 8388608 => 148948139, 16777216 => 310248241, 33554432 => 645155197, 67108864 => 1339484197, 134217728 => 2777105129, 268435456 => 5750079047, 536870912 => 11891268401, 1073741824 => 24563311309, 2147483648 => 50685770167, 4294967296 => 104484802057, 8589934592 => 215187847711, 17179869184 => 442795487221, 34359738368 => 910399916939, 68719476736 => 1870358526653, 137438953472 => 3839726846311, 274877906944 => 7877263558621, 549755813888 => 16149760533341, 1099511627776 => 33089240375501, 2199023255552 => 67756520645329, 4398046511104 => 138666449011757, 8796093022208 => 283634652716357, 17592186044416 => 579863159340527, 35184372088832 => 1184895616861903, 70368744177664 => 2420094683001859, 140737488355328 => 4940729268330643, 281474976710656 => 10082409897709157, 562949953421312 => 20566476729238691, 1125899906842624 => 41935796950796653, 2251799813685248 => 85476377250109733, 4503599627370496 => 174160587542317721, 9007199254740992 => 354733509412061993, 18014398509481984 => 722285281729443799, 36028797018963968 => 1470194760556507397, 72057594037927936 => 2991614170035124397, 10 => 29, 100 => 541, 1000 => 7919, 10000 => 104729, 100000 => 1299709, 1000000 => 15485863, 10000000 => 179424673, 100000000 => 2038074743, 1000000000 => 22801763489, 10000000000 => 252097800623, 100000000000 => 2760727302517, 1000000000000 => 29996224275833, 10000000000000 => 323780508946331, 100000000000000 => 3475385758524527, 1000000000000000 => 37124508045065437, 10000000000000000 => 394906913903735329, 100000000000000000 => 4185296581467695669, # 1000000000000000000 => 44211790234832169331, # 10000000000000000000 => 465675465116607065549, ); # Keep things to a reasonable run time, assuming using LMO nth_prime. # Using LMOS or Lehmer, this will take a very long time. Using a normal # sieve method will need a much, much lower limit. delete @nthvals{ grep { $_ > 100_000_000_000_000 } keys %nthvals }; plan tests => scalar(keys %nthvals); foreach my $n (sort {$a <=> $b} keys %nthvals) { my $nth = $nthvals{$n}; is( nth_prime($n), $nth, "Prime($n) = $nth" ); } Math-Prime-Util-0.37/xt/pari-compare.pl0000755000076400007640000002270512270242116016276 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::PariInit qw( primes=10000000 stack=1e8 ); use Math::Pari qw/pari2iv/; use Math::Prime::Util qw/:all/; use Data::Dumper; $|=1; BEGIN { use Config; die "Tests have 64-bit assumptions" if $Config{uvsize} < 8; die "Tests need double floats" if $Config{nvsize} < 8; no Config; } my $small = 100000; print "Comparing for small inputs: 0 - $small\n"; foreach my $n (0 .. $small) { die "isprime($n)" unless Math::Pari::isprime($n) == !!is_prime($n); die "is_prob_prime($n)" unless Math::Pari::isprime($n) == !!is_prob_prime($n); die "next_prime($n)" unless Math::Pari::nextprime($n+1) == next_prime($n); die "prev_prime($n)" unless Math::Pari::precprime($n-1) == prev_prime($n); next if $n == 0; my($pn,$pc) = @{Math::Pari::factorint($n)}; my @f1 = map { [ pari2iv($pn->[$_]), pari2iv($pc->[$_])] } 0 .. $#$pn; array_compare( \@f1, [factor_exp($n)], "factor_exp($n)" ); @f1 = map { ($_->[0]) x $_->[1] } @f1; array_compare( \@f1, [factor($n)], "factor($n)" ); array_compare( [map { pari2iv($_) } @{Math::Pari::divisors($n)}], [divisors($n)], "divisors($n)" ); die "omega($n)" unless Math::Pari::omega($n) == factor_exp($n); die "bigomega($n)" unless Math::Pari::bigomega($n) == factor($n); die "numdiv($n)" unless Math::Pari::numdiv($n) == divisors($n); foreach my $k (0..4) { die "sigma($n,$k)" unless Math::Pari::sigma($n,$k) == divisor_sum($n,$k); } die "moebius($n)" unless Math::Pari::moebius($n) == moebius($n); die "euler_phi($n)" unless Math::Pari::eulerphi($n) == euler_phi($n); my $d = PARI "d"; die "jordan_totient(2,$n)" unless Math::Pari::sumdiv($n,"d","d^2*moebius($n/d)") == jordan_totient(2,$n); die "jordan_totient(3,$n)" unless Math::Pari::sumdiv($n,"d","d^3*moebius($n/d)") == jordan_totient(3,$n); die "nth_prime($n)" unless Math::Pari::prime($n) == nth_prime($n); # All the pari2iv calls are very time-consuming if ($n < 1000) { array_compare( [map { pari2iv($_) } @{Math::Pari::primes($n)}], primes(nth_prime($n)), "primes($n)" ); } # Math Pari's forprime is super slow for some reason. Pari/gp isn't this slow. if ($n < 1000) { my $m = $n+int(rand(10**4)); PARI "s1=0"; PARI "forprime(X=$n,$m,s1=s1+X)"; my $s1 = PARI('s1'); my $s2 = 0; forprimes { $s2 += $_ } $n,$m; die "forprimes($n,$m) $s1 != $s2" unless $s1 == $s2; } { my $d = PARI "d"; my @a1; Math::Pari::fordiv($n, $d, sub { push @a1, pari2iv($d)}); my @a2; fordivisors { push @a2, $_ } $n; array_compare( \@a1, \@a2, "fordivisors($n)" ); } { my $m = int(rand($n-1)); my $mn = PARI "Mod($m,$n)"; my $order = znorder($m, $n); if (defined $order) { die "znorder($m, $n)" unless Math::Pari::znorder($mn) == znorder($m,$n); } else { eval { Math::Pari::znorder($mn); }; die "znorder($m, $n) defined in Pari" unless $@ =~ /not an element/; } } # Pari's znprimroot is iffy for non-primes if (is_prime($n)) { my $g = znprimroot($n); die "znprimroot($n)" unless Math::Pari::znprimroot($n) == $g; my $a = 1 + int(rand($n-2)); my $gn = PARI "Mod($g,$n)"; my $log = znlog($a, $g, $n); die "znlog($a, $g, $n) should be defined" unless defined $log; die "znlog($a, $g, $n)" unless Math::Pari::znlog($a,$gn) == $log; } if ($n < 100) { foreach my $d (0 .. 9) { my $arg = $n + $d/10; next if $arg < 0.1; my $e1 = -Math::Pari::eint1(-$arg); my $e2 = ExponentialIntegral($arg); die "ExponentialIntegral($arg) $e1 != $e2" if abs($e1 - $e2) > $e1*1e-14; } } if ($n > 1) { my $arg = $n; my $e1 = -Math::Pari::eint1(-log($arg)); my $e2 = LogarithmicIntegral($arg); die "LogarithmicIntegral($arg) $e1 != $e2" if abs($e1 - $e2) > $e1*1e-14; } { my $s = 50.0/$small; if ($s != 1.0) { my $zeta1 = Math::Pari::zeta($s) - 1; my $zeta2 = RiemannZeta($s); die "zeta($s) $zeta1 != $zeta2" if abs($zeta1 - $zeta2) > abs($zeta1) * 1e-14; } } print "." unless $n % 1250; } print "\nkronecker, gcd, and lcm for small values\n"; foreach my $a (-400 .. 400) { foreach my $b (-400 .. 400) { # Pari 2.1's gcd doesn't work right for 0,-x and -x,0. Pari 2.2.3 fixed. if ($a != 0 && $b != 0) { die "gcd($a,$b)" unless Math::Pari::gcd($a,$b) == gcd($a,$b); } die "kronecker($a,$b)" unless Math::Pari::kronecker($a,$b) == kronecker($a,$b); die "lcm($a,$b)" unless Math::Pari::lcm($a,$b) == lcm($a,$b); } print "." unless (400+$a) % 20; } print "\nloop forever with random values\n"; # forcomposites in Pari 2.6, not Math::Pari's 2.1 my $loops = 0; while (1) { my $n; { do { $n = (int(rand(2**32)) << 32) + int(rand(2**32)) } while $n < $small; die "isprime($n)" unless Math::Pari::isprime($n) == !!is_prime($n); die "is_prob_prime($n)" unless Math::Pari::isprime($n) == !!is_prob_prime($n); die "next_prime($n)" unless Math::Pari::nextprime($n+1) == next_prime($n); die "prev_prime($n)" unless Math::Pari::precprime($n-1) == prev_prime($n); my($pn,$pc) = @{Math::Pari::factorint($n)}; my @f1 = map { [ pari2iv($pn->[$_]), pari2iv($pc->[$_])] } 0 .. $#$pn; array_compare( \@f1, [factor_exp($n)], "factor_exp($n)" ); @f1 = map { ($_->[0]) x $_->[1] } @f1; array_compare( \@f1, [factor($n)], "factor($n)" ); array_compare( [map { pari2iv($_) } @{Math::Pari::divisors($n)}], [divisors($n)], "divisors($n)" ); die "omega($n)" unless Math::Pari::omega($n) == factor_exp($n); die "bigomega($n)" unless Math::Pari::bigomega($n) == factor($n); die "numdiv($n)" unless Math::Pari::numdiv($n) == divisors($n); foreach my $k (0..4) { die "sigma($n,$k)" unless Math::Pari::sigma($n,$k) == divisor_sum($n,$k); } die "moebius($n)" unless Math::Pari::moebius($n) == moebius($n); die "euler_phi($n)" unless Math::Pari::eulerphi($n) == euler_phi($n); my $d = PARI "d"; # TODO: our jordan_totient should auto-bigint die "jordan_totient(2,$n)" unless Math::Pari::sumdiv($n,"d","d^2*moebius($n/d)") == jordan_totient(2,$n); die "jordan_totient(3,$n)" unless Math::Pari::sumdiv($n,"d","d^3*moebius($n/d)") == jordan_totient(3,$n); # TODO: exp_mangoldt: # Lambda(n)={ # v=factor(n); # if(matsize(v)[1]!=1,return(0),return(log(v[1,1]))); # }; # TODO: chebyshev_theta, chebyshev_psi # Chebyshev Psi(x)=sum(n=2,floor(x),Lambda(n)); # TODO: partitions. new Pari has this as numbpart. # See OEIS A000041 for some alternate Pari functions # TODO: primorial / pn_primorial # TODO: carmichael lambda? Pari doesn't have it. { my $m = int(rand($n-1)); my $mn = PARI "Mod($m,$n)"; my $order = znorder($m, $n); if (defined $order) { die "znorder($m, $n)" unless Math::Pari::znorder($mn) == znorder($m,$n); } else { eval { Math::Pari::znorder($mn); }; die "znorder($m, $n) defined in Pari" unless $@ =~ /not an element/; } } # TODO: znlog with reasonable values if ($n > 1) { my $arg = $n; my $e1 = -Math::Pari::eint1(-log($arg)); my $e2 = LogarithmicIntegral($arg); die "LogarithmicIntegral($arg) $e1 != $e2" if abs($e1 - $e2) > $e1*1e-12; } # TODO: RiemannZeta } { my $a = $small + int(rand(10**6)); my $b = $a+int(rand(10**4)); my $x = PARI "x"; my @a1; Math::Pari::forprime($x,$a,$b,sub { push @a1, pari2iv($x) }); my @a2; forprimes { push @a2, $_ } $a,$b; array_compare( \@a1, \@a2, "forprimes($a,$b)" ); } # forcomposites in Pari 2.6, not Math::Pari's 2.1 { my $n = $small + int(rand(10**12)); my $d = PARI "d"; my @a1; Math::Pari::fordiv($n, $d, sub { push @a1, pari2iv($d) }); my @a2; fordivisors { push @a2, $_ } $n; array_compare( \@a1, \@a2, "fordivisors($n)" ); } # Pari's primepi in 2.1-2.5 is strangely lacking { my $a = (int(rand(2**32)) << 32) + int(rand(2**32)); my $b = (int(rand(2**32)) << 32) + int(rand(2**32)); die "gcd($a,$b)" unless Math::Pari::gcd($a,$b) == gcd($a,$b); die "kronecker($a,$b)" unless Math::Pari::kronecker($a,$b) == kronecker($a,$b); $a >>= 1 if $a > 2**63; die "kronecker(-$a,$b)" unless Math::Pari::kronecker(-$a,$b) == kronecker(-$a,$b); $b >>= 1 if $b > 2**63; die "kronecker($a,-$b)" unless Math::Pari::kronecker($a,-$b) == kronecker($a,-$b); die "kronecker(-$a,-$b)" unless Math::Pari::kronecker(-$a,-$b) == kronecker(-$a,-$b); } { my $a = int(rand(2**32)); my $b = int(rand(2**32)); die "lcm($a,$b)" unless Math::Pari::lcm($a,$b) == lcm($a,$b); } { my $n = random_prime(10000,~0); die "znprimroot($n)" unless Math::Pari::znprimroot($n) == znprimroot($n); } $loops++; print "." unless $loops % 100; } use Bytes::Random::Secure qw/random_string_from/; sub ndigit_rand { my($digits, $howmany) = @_; die "digits must be > 0" if $digits < 1; $howmany = 1 unless defined $howmany; my @nums = map { random_string_from("123456789",1) . random_string_from("0123456789",$digits-1) } 1 .. $howmany; if (10**$digits > ~0) { @nums = map { Math::BigInt->new($_) } @nums; } else { @nums = map { int($_) } @nums; } return wantarray ? @nums : $nums[0]; } sub array_compare { my($a1, $a2, $text) = @_; #eq_or_diff $a1, $a2, $text; die "$text wrong count ",scalar @$a1," ",scalar @$a2 unless @$a1 == @$a2; foreach my $i (0 .. $#$a1) { if (ref($a1->[$i])) { array_compare($a1->[$i],$a2->[$i], "> $text"); } else { #print "a1: ", Dumper($a1), "\na2: ", Dumper($a2), "\n" unless $a1->[$i] == $a2->[$i]; die "$text entry $i $a1->[$i] != $a2->[$i]" unless $a1->[$i] == $a2->[$i]; } } } Math-Prime-Util-0.37/xt/test-factor-mpxs.pl0000755000076400007640000000300412270242116017126 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util qw/factor/; use Math::Factor::XS qw/prime_factors/; use Config; my $nlinear = 1000000; my $nrandom = shift || 1000000; my $randmax = ~0; # MFXS is so slow on 17+ digit numbers, skip them. $randmax = int(2**55) if $randmax > 2**55; my $rgen = sub { my $range = shift; return 0 if $range <= 0; my $rbits = 0; { my $t = $range; while ($t) { $rbits++; $t >>= 1; } } while (1) { my $rbitsleft = $rbits; my $U = 0; while ($rbitsleft > 0) { my $usebits = ($rbitsleft > $Config{randbits}) ? $Config{randbits} : $rbitsleft; $U = ($U << $usebits) + int(rand(1 << $usebits)); $rbitsleft -= $usebits; } return $U if $U <= $range; } }; print "OK for first 1"; my $dig = 1; my $i = 9; foreach my $n (2 .. $nlinear) { my @mfxs = prime_factors($n); my @mpu = factor($n); die "failure for $n" unless scalar @mfxs == scalar @mpu; for (0 .. $#mfxs) { die "failure for $n" unless $mfxs[$_] == $mpu[$_]; } if (--$i == 0) { print "0"; $dig++; $i = (10 ** $dig) - (10 ** ($dig-1)); } } print " numbers\n"; print "Testing random numbers from $nlinear to ", $randmax, "\n"; while ($nrandom-- > 0) { my $n = $nlinear + 1 + $rgen->($randmax - $nlinear); my @mfxs = prime_factors($n); my @mpu = factor($n); die "failure for $n" unless scalar @mfxs == scalar @mpu; for (0 .. $#mfxs) { die "failure for $n" unless $mfxs[$_] == $mpu[$_]; } print "." if ($nrandom % 256) == 0; } print "\n"; Math-Prime-Util-0.37/xt/test-primes-script2.pl0000755000076400007640000000740612270242116017560 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use File::Spec::Functions; use FindBin; use Time::HiRes qw(gettimeofday tv_interval); use bigint; use Math::NumSeq; $|++; #flush the output buffer after every write() or print() function my $use64; BEGIN { no bigint; $use64 = (~0 > 4294967295); } compare('Primes', 10000000, "$FindBin::Bin/../bin/primes.pl 1 LASTNUM", q/perl -MMath::NumSeq::Primes -e 'my $seq = Math::NumSeq::Primes->new; while (1) { my $v = ($seq->next)[1]; last if $v > LASTNUM; print "$v\n"; }'/); compare('Twin', 10000000, "$FindBin::Bin/../bin/primes.pl --twin 1 LASTNUM", q/perl -MMath::NumSeq::TwinPrimes -e 'my $seq = Math::NumSeq::TwinPrimes->new; while (1) { my $v = ($seq->next)[1]; last if $v > LASTNUM; print "$v\n"; }'/); compare('Sophie Germain', 10000000, "$FindBin::Bin/../bin/primes.pl --sophie 1 LASTNUM", q/perl -MMath::NumSeq::SophieGermainPrimes -e 'my $seq = Math::NumSeq::SophieGermainPrimes->new; while (1) { my $v = ($seq->next)[1]; last if $v > LASTNUM; print "$v\n"; }'/); # Why Math::Prime::Util::is_prime instead of Math::Prime::XS::is_prime? # 1) it's much faster for the palindrome tests # 2) it supports bignums, which is required for Fib, Euclid, Lucas, etc. compare('Palindromic', $use64 ? '10**11' : '10**10', "$FindBin::Bin/../bin/primes.pl --palin 1 LASTNUM", q/perl -MMath::Prime::Util=is_prime -MMath::NumSeq::Palindromes -e 'my $seq = Math::NumSeq::Palindromes->new; while (1) { my $v = ($seq->next)[1]; last if $v > LASTNUM; print "$v\n" if is_prime($v); }'/); # Sadly Math::NumSeq::LucasNumbers uses OEIS 204 (1,3) instead of OEIS 32 (-1,2) # and neither package offers a way to adjust. #compare('Lucas', # '10**100', # "$FindBin::Bin/../bin/primes.pl --lucas 1 LASTNUM", # q/perl -MMath::Prime::Util=is_prime -MMath::NumSeq::LucasNumbers -e 'my $seq = Math::NumSeq::LucasNumbers->new; while (1) { my $v = ($seq->next)[1]; last if $v > LASTNUM; print "$v\n" if is_prime($v); }'/); compare('Fibonacci', '10**100', "$FindBin::Bin/../bin/primes.pl --fib 1 LASTNUM", q/perl -MMath::Prime::Util=is_prime -MMath::NumSeq::Fibonacci -e 'my $seq = Math::NumSeq::Fibonacci->new; while (1) { my $v = ($seq->next)[1]; last if $v > LASTNUM; print "$v\n" if is_prime($v); }'/); compare('Euclid', '10**200', "$FindBin::Bin/../bin/primes.pl --euclid 1 LASTNUM", q/perl -MMath::Prime::Util=is_prime -MMath::NumSeq::Primorials -e 'my $seq = Math::NumSeq::Primorials->new; while (1) { my $v = ($seq->next)[1] + 1; last if $v > LASTNUM; print "$v\n" if is_prime($v); }'/); compare('Lucky', '100000', "$FindBin::Bin/../bin/primes.pl --lucky 1 LASTNUM", q/perl -MMath::Prime::Util=is_prime -MMath::NumSeq::LuckyNumbers -e 'my $seq = Math::NumSeq::LuckyNumbers->new; while (1) { my $v = ($seq->next)[1]; last if $v > LASTNUM; print "$v\n" if is_prime($v); }'/); sub compare { my($name, $end, $command_scr, $command_mns) = @_; no bigint; $command_scr =~ s/LASTNUM/$end/; $command_mns =~ s/LASTNUM/$end/; printf "%15s to %8s", $name, $end; my $start_scr = [gettimeofday]; my @scr = split /\s+/, qx/$command_scr/; my $seconds_scr = tv_interval($start_scr); printf " (%7d). primes.pl %6.2fs", scalar @scr, $seconds_scr; my $start_mns = [gettimeofday]; my @mns = split /\s+/, qx/$command_mns/; my $seconds_mns = tv_interval($start_mns); printf " Math::NumSeq %6.2fs\n", $seconds_mns; die "$name: primes.pl generated ", scalar @scr, " results. MNS generated ", scalar @mns, " results." if scalar @scr != scalar @mns; foreach my $i (0 .. $#scr) { die "$name prime $i not equal:\n primes.pl: $scr[$i]\n MNumSeq: $mns[$i]\n" if $scr[$i] != $mns[$i]; } } Math-Prime-Util-0.37/xt/moebius-mertens.pl0000755000076400007640000000156112262252474017043 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util qw/moebius mertens/; use List::Util qw/sum/; my $limit = shift || 1_000_000; print "Calculating moebius from 1 to $limit..."; my @mu = map { moebius($_) } 1 .. $limit; print "..."; unshift @mu, 0; print "...done\n"; while (1) { my $beg = 1 + int(rand($limit)); my $end = 1 + int(rand($limit)); ($beg,$end) = ($end,$beg) if $beg > $end; # Does moebius range return the same values? my @mu_range = @mu[ $beg .. $end ]; my @mobius = moebius($beg,$end); my $mu_sum = sum(@mu_range); my $mo_sum = sum(@mobius); my $mert_sum = mertens($end) - mertens($beg-1); warn "\nbeg $beg end $end sum $mu_sum range sum $mo_sum\n" unless $mu_sum == $mo_sum; warn "\nbeg $beg end $end sum $mu_sum mertsum $mert_sum\n" unless $mu_sum == $mert_sum; print "."; } Math-Prime-Util-0.37/xt/primes-edgecases.pl0000755000076400007640000001131412270242116017131 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util ':all'; use Test::More; my @primes = qw/2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97/; my $end = 20; plan tests => 4*(($end+1)*($end+2)/2) + 4*((101*102)/2) + 10; diag "Checking small numbers"; foreach my $b (0 .. $end) { foreach my $e ($b .. $end) { my @p = grep { $_ >= $b && $_ <= $e } @primes; is_deeply( gen_primes($b,$e), \@p, "primes($b,$e)"); is_deeply( gen_forprimes($b,$e), \@p, "forprimes {} $b,$e"); is_deeply( gen_piterate($b,$e), \@p, "prime_iterator($b) while <= $e"); } } SKIP: { skip "No OO iterator", (($end+1)*($end+2)/2) unless defined &Math::Prime::Util::prime_iterator_object; foreach my $b (0 .. $end) { foreach my $e ($b .. $end) { my @p = grep { $_ >= $b && $_ <= $e } @primes; is_deeply( gen_ooiterate($b,$e), \@p, "prime_iterator object $b to $e"); } } } # TODO We should check boundaries around 1k*30, then segments around 256k*30 and 64k*30 my @lprimes = (~0 > 4294967295) ? (qw/18446744073709550671 18446744073709550681 18446744073709550717 18446744073709550719 18446744073709550771 18446744073709550773 18446744073709550791 18446744073709550873 18446744073709551113 18446744073709551163 18446744073709551191 18446744073709551253 18446744073709551263 18446744073709551293 18446744073709551337 18446744073709551359 18446744073709551427 18446744073709551437 18446744073709551521 18446744073709551533 18446744073709551557/) : (qw/4294966297 4294966337 4294966367 4294966373 4294966427 4294966441 4294966447 4294966477 4294966553 4294966583 4294966591 4294966619 4294966639 4294966651 4294966657 4294966661 4294966667 4294966769 4294966813 4294966829 4294966877 4294966909 4294966927 4294966943 4294966981 4294966997 4294967029 4294967087 4294967111 4294967143 4294967161 4294967189 4294967197 4294967231 4294967279 4294967291/); diag "\nChecking numbers near end with iterator\n"; foreach my $bdelta (reverse 0 .. 100) { foreach my $edelta (reverse 0 .. $bdelta) { my ($b, $e) = (~0 - $bdelta, ~0 - $edelta); my @p = grep { $_ >= $b && $_ <= $e } @lprimes; is_deeply( gen_piterate($b,$e), \@p, "prime_iterator($b) while <= $e"); } } SKIP: { skip "No OO iterator", ((101*102)/2) unless defined &Math::Prime::Util::prime_iterator_object; diag "\nChecking numbers near end with OO iterator\n"; foreach my $bdelta (reverse 0 .. 100) { foreach my $edelta (reverse 0 .. $bdelta) { my ($b, $e) = (~0 - $bdelta, ~0 - $edelta); my @p = grep { $_ >= $b && $_ <= $e } @lprimes; is_deeply( gen_ooiterate($b,$e), \@p, "prime_iterator object $b to $e"); } } } diag "\nChecking numbers near end with primes()\n"; foreach my $bdelta (reverse 0 .. 100) { foreach my $edelta (reverse 0 .. $bdelta) { my ($b, $e) = (~0 - $bdelta, ~0 - $edelta); my @p = grep { $_ >= $b && $_ <= $e } @lprimes; is_deeply( gen_primes($b,$e), \@p, "primes($b,$e)"); } } diag "\nChecking numbers near end with forprimes.\n"; foreach my $bdelta (reverse 0 .. 100) { foreach my $edelta (reverse 0 .. $bdelta) { my ($b, $e) = (~0 - $bdelta, ~0 - $edelta); my @p = grep { $_ >= $b && $_ <= $e } @lprimes; is_deeply( gen_forprimes($b,$e), \@p, "forprimes {} $b,$e"); } } diag "\nChecking numbers near end with segment primes().\n"; { my $b = $lprimes[-1] - 1; my $e = ~0; my @p = ($lprimes[-1]); diag "\n Window around $lprimes[-1]\n"; is_deeply( gen_segment_primes($b, $b), [], "primes($b,$b)"); is_deeply( gen_segment_primes($b, $b+1), \@p, "primes($b,$b+1)"); is_deeply( gen_segment_primes($b, $b+2), \@p, "primes($b,$b+2)"); is_deeply( gen_segment_primes($b+1, $b+1), \@p, "primes($b+1,$b+1)"); is_deeply( gen_segment_primes($b+1, $b+2), \@p, "primes($b+1,$b+2)"); is_deeply( gen_segment_primes($b+2, $b+2), [], "primes($b+2,$b+2)"); diag "\n Window around $e\n"; is_deeply( gen_segment_primes($e-2, $e-2), [], "primes($e-2,$e-2)"); is_deeply( gen_segment_primes($e-2, $e), [], "primes($e-2,$e)"); is_deeply( gen_segment_primes($e-1, $e), [], "primes($e-1,$e)"); is_deeply( gen_segment_primes($e, $e), [], "primes($e,$e)"); } sub gen_primes { return primes(@_); } sub gen_segment_primes { my($low, $high) = @_; return Math::Prime::Util::segment_primes($low,$high); # Private function } sub gen_forprimes { my($b, $e) = @_; my @p; forprimes { push @p, $_ } $b,$e; return \@p; } sub gen_piterate { my($b, $e) = @_; my @p; my $it = prime_iterator($b); my $n; while (1) { $n = $it->(); last if $n > $e || $n == 0; push @p, $n; } return \@p; } sub gen_ooiterate { my($b, $e) = @_; my @p; my $it = prime_iterator_object($b); push @p, $it->iterate while $it->value <= $e; return \@p; } Math-Prime-Util-0.37/xt/rwh_primecount.py0000755000076400007640000000136512262252474017011 0ustar danadana#!/usr/bin/env python from math import sqrt, ceil def rwh_pc(n): # http://stackoverflow.com/questions/2068372/fastest-way-to-list-all-primes-below-n-in-python/3035188#3035188 """ Input n>=6, Returns a list of primes, 2 <= p < n """ correction = (n%6>1) n = {0:n,1:n-1,2:n+4,3:n+3,4:n+2,5:n+1}[n%6] sieve = [True] * (n/3) sieve[0] = False for i in xrange(int(n**0.5)/3+1): if sieve[i]: k=3*i+1|1 sieve[ ((k*k)/3) ::2*k]=[False]*((n/6-(k*k)/6-1)/k+1) sieve[(k*k+4*k-2*k*(i&1))/3::2*k]=[False]*((n/6-(k*k+4*k-2*k*(i&1))/6-1)/k+1) sieve[n/3-correction] = False return 2 + sum(sieve) #return [2,3] + [3*i+1|1 for i in xrange(1,n/3-correction) if sieve[i]] print rwh_pc(800000000) Math-Prime-Util-0.37/xt/test-factor-yafu.pl0000755000076400007640000000654712271137014017123 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/factor/; use File::Temp qw/tempfile/; use Math::BigInt try => 'GMP,Pari'; use Config; use autodie; use Text::Diff; my $maxdigits = 50; $| = 1; # fast pipes my $num = 10000; my $yafu_fname = "yafu_batchfile_$$.txt"; $SIG{'INT'} = \&gotsig; my $rgen = sub { my $range = shift; return 0 if $range <= 0; my $rbits = 0; { my $t = $range; while ($t) { $rbits++; $t >>= 1; } } while (1) { my $rbitsleft = $rbits; my $U = $range - $range; # 0 or bigint 0 while ($rbitsleft > 0) { my $usebits = ($rbitsleft > $Config{randbits}) ? $Config{randbits} : $rbitsleft; $U = ($U << $usebits) + int(rand(1 << $usebits)); $rbitsleft -= $usebits; } return $U if $U <= $range; } }; { # Test from 2 to 10000 print " 2 - 1000"; test_array( 2 .. 1000); print " 1001 - 5000"; test_array( 1001 .. 5000); print " 5001 - 10000"; test_array( 5001 .. 10000); } foreach my $digits (5 .. $maxdigits) { printf "%5d %2d-digit numbers", $num, $digits; my @narray = gendigits($digits, $num); test_array(@narray); $num = int($num * 0.9) + 1; # reduce as we go } sub test_array { my @narray = @_; print "."; my @mpuarray = mpu_factors(@narray); print "."; my @yafuarray = yafu_factors(@narray); print "."; if ($#mpuarray != $#yafuarray) { die "MPU got $#mpuarray factors, YAFU got $#yafuarray\n"; } foreach my $n (@narray) { my @mpu = @{shift @mpuarray}; my @yafu = @{shift @yafuarray}; die "mpu array is for the wrong n?" unless $n == shift @mpu; die "yafu array is for the wrong n?" unless $n == shift @yafu; my $diff = diff \@mpu, \@yafu, { STYLE => 'Table' }; die "factor($n):\n$diff\n" if length($diff) > 0; } print "."; print "OK\n"; } sub gendigits { my $digits = shift; die "Digits must be > 0" unless $digits > 0; my $howmany = shift; my ($base, $max); if ( 10**$digits < ~0) { $base = ($digits == 1) ? 0 : int(10 ** ($digits-1)); $max = int(10 ** $digits); $max = ~0 if $max > ~0; } else { $base = Math::BigInt->new(10)->bpow($digits-1); $max = Math::BigInt->new(10)->bpow($digits) - 1; } my @nums = map { $base + $rgen->($max-$base) } (1 .. $howmany); return @nums; } sub mpu_factors { my @piarray; push @piarray, [$_, factor($_)] for @_; @piarray; } sub yafu_factors { my @ns = @_; my @piarray; #my $fh = File::Temp->new; # .... autodie #print $fh, "$_\n" for @_; #$fh->flush; # Shudder. Yafu must have a file in the current directory. open(my $fh, '>', $yafu_fname); print $fh "$_\n" for @ns; close $fh; open my $yafu, "yafu \"factor(\@)\" -batchfile $yafu_fname |"; my @curfactors; while (<$yafu>) { chomp; if (/^P(RP)?\d+ = (\d+)/) { push @curfactors, $2; } elsif (/^C\d+ = (\d+)/) { # Yafu didn't factor this one completely. Sneakily do it ourselves. push @curfactors, factor( Math::BigInt->new("$1") ); } elsif (/ans = (\d+)/ || /^1$/) { push @piarray, [shift @ns, sort {$a<=>$b} @curfactors]; @curfactors = (); } } close($yafu); @piarray; } sub gotsig { my $sig = shift; die "Die because SIG$sig\n"; } END { unlink $yafu_fname if -e $yafu_fname; # YAFU leaves stuff around unlink "__tmpbatchfile" if -e "__tmpbatchfile"; unlink "session.log" if -e "session.log"; unlink "factor.log" if -e "factor.log"; } Math-Prime-Util-0.37/xt/test-pcapprox.pl0000755000076400007640000000534012270011421016515 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/prime_count prime_count_approx prime_count_lower prime_count_upper LogarithmicIntegral RiemannR/; use Math::BigFloat; $| = 1; # fast pipes my %pivals = ( 10 => 4, 100 => 25, 1000 => 168, 10000 => 1229, 100000 => 9592, 1000000 => 78498, 10000000 => 664579, 100000000 => 5761455, 1000000000 => 50847534, 10000000000 => 455052511, 100000000000 => 4118054813, 1000000000000 => 37607912018, 10000000000000 => 346065536839, 100000000000000 => 3204941750802, '1000000000000000' => 29844570422669, '10000000000000000' => 279238341033925, '100000000000000000' => 2623557157654233, '1000000000000000000' => 24739954287740860, '10000000000000000000' => 234057667276344607, ); printf(" N %12s %12s %12s %12s\n", "pc_approx", "Li", "LiCor", "R"); printf("----- %12s %12s %12s %12s\n", '-'x12,'-'x12,'-'x12,'-'x12); foreach my $n (sort {$a<=>$b} keys %pivals) { my $pin = $pivals{$n}; my $pca = prime_count_approx($n); my $Lisub = sub { my $x = shift; return ($x < 2) ? 0 : (LogarithmicIntegral($x)-LogarithmicIntegral(2)+0.5); }; my $pcli = int($Lisub->($n)); my $pclicor = int( $Lisub->($n) - ($Lisub->(sqrt($n)) / 2) ); my $r = int(RiemannR($n)+0.5); printf "10^%2d %12d %12d %12d %12d\n", length($n)-1, abs($pca-$pin), abs($pcli-$pin), abs($pclicor-$pin), abs($r-$pin); } # Also see http://empslocal.ex.ac.uk/people/staff/mrwatkin/zeta/encoding1.htm # for some ideas one how this could be made even more accurate. print "\n"; print "Lower / Upper bounds. Percentages.\n"; print "\n"; printf(" N %12s %12s %12s %12s\n", "lower", "upper", "SchoenfeldL", "SchoenfeldU"); printf("----- %12s %12s %12s %12s\n", '-'x12,'-'x12,'-'x12,'-'x12); foreach my $n (sort {$a<=>$b} keys %pivals) { my ($pin, $pcl, $pcu, $scl, $scu) = map { Math::BigFloat->new($_) } ($pivals{$n}, prime_count_lower($n), prime_count_upper($n), stoll($n)); #printf "10^%2d %12d %12d\n", length($n)-1, $pin-$pcl, $pcu-$pin; printf "10^%2d %12.7f %12.7f %12.7f %12.7f\n", length($n)-1, 100*($pin-$pcl)/$pin, 100*($pcu-$pin)/$pin, 100*($pin-$scl)/$pin, 100*($scu-$pin)/$pin; } sub schoenfeld { my $x = shift; my $lix = LogarithmicIntegral($x); my $bound = (sqrt($x)*log($x)) / 8*3.1415926535; ($lix-$bound,$lix+$bound); } # http://www.ams.org/journals/mcom/2011-80-276/S0025-5718-2011-02477-4/home.html sub stoll { my $x = shift; my $lix = LogarithmicIntegral($x); my $bound = sqrt($x) * (log(log(log($x))) + exp(1) + 1) / (exp(1)*log($x)); ($lix-$bound,$lix+$bound); } Math-Prime-Util-0.37/xt/pari-totient-moebius.pl0000755000076400007640000000214612270242116017774 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util; use Math::Pari; my $nlinear = 100000; my $nrandom = shift || 100000; my $randmax = 10**16; # Moebius and euler_phi seem about 2-4x faster than Pari. Also, we have # ranged versions that run much faster. # print "OK for first 1"; my $dig = 1; my $i = 9; foreach my $n (2 .. $nlinear) { die "failure for eulerphi($n)" unless Math::Prime::Util::euler_phi($n) == Math::Pari::eulerphi($n); die "failure for moebius($n)" unless Math::Prime::Util::moebius($n) == Math::Pari::moebius($n); if (--$i == 0) { print "0"; $dig++; $i = (10 ** $dig) - (10 ** ($dig-1)); } } print " numbers\n"; print "Testing random numbers from $nlinear to ", $randmax, "\n"; my $mod = int($nrandom / 80); while ($nrandom-- > 0) { my $n = $nlinear + 1 + int(rand($randmax - $nlinear)); die "failure for eulerphi($n)" unless Math::Prime::Util::euler_phi($n) == Math::Pari::eulerphi($n); die "failure for moebius($n)" unless Math::Prime::Util::moebius($n) == Math::Pari::moebius($n); print "." if ($nrandom % $mod) == 0; } print "\n"; Math-Prime-Util-0.37/xt/test-bpsw.pl0000755000076400007640000001253512270242116015647 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util; use Math::Primality; use Config; my $nlinear = 10000; my $nrandom = shift || 20000; my $randmax = ~0; # I was using Math::BigInt::Random::OO, but on my machine: # my $gen = Math::BigInt::Random::OO -> new(length => 23); # generates only even numbers. my $rgen = sub { my $range = shift; return 0 if $range <= 0; my $rbits = 0; { my $t = $range; while ($t) { $rbits++; $t >>= 1; } } while (1) { my $rbitsleft = $rbits; my $U = $range - $range; # 0 or bigint 0 while ($rbitsleft > 0) { my $usebits = ($rbitsleft > $Config{randbits}) ? $Config{randbits} : $rbitsleft; $U = ($U << $usebits) + int(rand(1 << $usebits)); $rbitsleft -= $usebits; } return $U if $U <= $range; } }; my $rand_ndigit_gen = sub { my $digits = shift; die "Digits must be > 0" unless $digits > 0; my $howmany = shift || 1; my ($base, $max); if ( 10**$digits < ~0) { $base = ($digits == 1) ? 0 : int(10 ** ($digits-1)); $max = int(10 ** $digits); $max = ~0 if $max > ~0; } else { $base = Math::BigInt->new(10)->bpow($digits-1); $max = Math::BigInt->new(10)->bpow($digits) - 1; } my @nums = map { $base + $rgen->($max-$base) } (1 .. $howmany); return (wantarray) ? @nums : $nums[0]; }; if (1) { print "OK for first 1"; my $dig = 1; my $i = 9; foreach my $n (2 .. $nlinear) { die "MR(2) failure for $n" unless Math::Prime::Util::is_strong_pseudoprime($n,2) == Math::Primality::is_strong_pseudoprime($n,2); die "SLPSP failure for $n" unless Math::Prime::Util::is_strong_lucas_pseudoprime($n) == Math::Primality::is_strong_lucas_pseudoprime($n); die "Prime failure for $n" unless Math::Prime::Util::is_prime($n) == Math::Primality::is_prime($n); if (--$i == 0) { print "0"; $dig++; $i = (10 ** $dig) - (10 ** ($dig-1)); } } print " numbers\n"; print "Testing random numbers from $nlinear to ", $randmax, "\n"; foreach my $r (1 .. $nrandom) { my $n = $nlinear + 1 + int(rand($randmax - $nlinear)); my $rand_base = 2 + $rgen->($n-4); die "MR(2) failure for $n" unless Math::Prime::Util::is_strong_pseudoprime($n,2) == Math::Primality::is_strong_pseudoprime($n,2); die "MR($rand_base) failure for $n" unless Math::Prime::Util::is_strong_pseudoprime($n,$rand_base) == Math::Primality::is_strong_pseudoprime($n,$rand_base); die "SLPSP failure for $n" unless Math::Prime::Util::is_strong_lucas_pseudoprime($n) == Math::Primality::is_strong_lucas_pseudoprime($n); my $ip1 = Math::Primality::is_prime($n); my $ip2 = Math::Prime::Util::is_prime($n); die "Prime failure for $n ($ip1,$ip2)" unless !!$ip1 == !!$ip2; print "." if ($r % 256) == 0; } print "\n"; } if (1) { use bigint try => 'GMP,Pari'; my $big_base = 2**64 + 1; my $range = 2**1024 - 1; my $end_base = $big_base + $range; print "Testing random numbers from $big_base to $end_base\n"; foreach my $r (1 .. int($nrandom/100)) { my $n = $big_base + $rgen->($range); my $rand_base = 2 + $rgen->($n-4); die "MR(2) failure for $n" unless Math::Prime::Util::is_strong_pseudoprime($n,2) == Math::Primality::is_strong_pseudoprime("$n","2"); die "MR($rand_base) failure for $n" unless Math::Prime::Util::is_strong_pseudoprime($n,$rand_base) == Math::Primality::is_strong_pseudoprime($n,$rand_base); die "SLPSP failure for $n" unless Math::Prime::Util::is_strong_lucas_pseudoprime($n) == Math::Primality::is_strong_lucas_pseudoprime("$n"); die "Prime failure for $n" unless (Math::Prime::Util::is_prime($n)?1:0) == Math::Primality::is_prime("$n"); #print "SUCCESS with $n\n"; print "." if ($r % 16) == 0; } print "\n"; } print "\nBenchmarks\n"; my $num_rns = 100; my $len_rns = 100; my $count = -1; use bigint try => 'GMP,Pari'; my @rns; # make the primality tests at least lift a finger. while (@rns < $num_rns) { my $n = $rand_ndigit_gen->($len_rns); next unless $n%2 && $n%3 && $n%5 && $n%7 && $n%11 && $n%13; push @rns, $n; } use Benchmark qw/:all/; print "Starting benchmarks, $num_rns $len_rns-digit random numbers...\n"; if (1) { print "\nMiller-Rabin, one base:\n"; cmpthese($count, { "MPU:PP" => sub { Math::Prime::Util::PP::is_strong_pseudoprime($_,2) for @rns; }, "MPU:GMP" => sub { Math::Prime::Util::GMP::is_strong_pseudoprime($_,2) for @rns; }, "MPU" => sub { Math::Prime::Util::is_strong_pseudoprime($_,2) for @rns; }, "MP" => sub { Math::Primality::is_strong_pseudoprime("$_","2") for @rns; }, }); } if (1) { print "\nStrong Lucas test:\n"; cmpthese($count, { "MPU:PP" => sub { Math::Prime::Util::PP::is_strong_lucas_pseudoprime($_) for @rns;}, "MPU:GMP" => sub { Math::Prime::Util::GMP::is_strong_lucas_pseudoprime($_) for @rns;}, "MPU" => sub { Math::Prime::Util::is_strong_lucas_pseudoprime($_) for @rns;}, "MP" => sub { Math::Primality::is_strong_lucas_pseudoprime("$_") for @rns;}, }); } if (1) { print "\nBPSW test:\n"; cmpthese($count, { "MPU:PP" => sub { my $sum = 0; do { $sum += ( Math::Prime::Util::PP::is_strong_pseudoprime($_, 2) && Math::Prime::Util::PP::is_strong_lucas_pseudoprime($_) ) ? 1 : 0 } for @rns; }, "MPU:GMP" => sub { Math::Prime::Util::GMP::is_prob_prime($_) for @rns; }, "MPU" => sub { Math::Prime::Util::is_prob_prime($_) for @rns;}, "MP" => sub { Math::Primality::is_prime("$_") for @rns;}, }); } Math-Prime-Util-0.37/xt/test-nthapprox.pl0000755000076400007640000000306412270011421016705 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util ":all"; use Math::BigFloat; $| = 1; # fast pipes my %nthprimes = ( 1 => 2, 10 => 29, 100 => 541, 1000 => 7919, 10000 => 104729, 100000 => 1299709, 1000000 => 15485863, 10000000 => 179424673, 100000000 => 2038074743, 1000000000 => 22801763489, 10000000000 => 252097800623, 100000000000 => 2760727302517, 1000000000000 => 29996224275833, '10000000000000' => 323780508946331, '100000000000000' => 3475385758524527, '1000000000000000' => 37124508045065437, '10000000000000000' => 394906913903735329, '100000000000000000' => 4185296581467695669, ); printf(" N %12s %12s\n", "nth_approx", "percent"); printf("----- %12s %12s\n", '-'x12, '-'x12); foreach my $n (sort {$a<=>$b} keys %nthprimes) { my ($nth, $ntha) = map { Math::BigFloat->new($_) } ($nthprimes{$n}, nth_prime_approx($n)); printf "10^%2d %13s %12.7f\n", length($n)-1, abs($nth-$ntha), 100*($ntha-$nth)/$nth; } print "\n"; print "Lower / Upper bounds. Percentages.\n"; print "\n"; printf(" N %12s %12s\n", "lower", "upper"); printf("----- %12s %12s\n", '-'x12,'-'x12); foreach my $n (sort {$a<=>$b} keys %nthprimes) { my ($nth, $nthl, $nthu) = map { Math::BigFloat->new($_) } ($nthprimes{$n}, nth_prime_lower($n), nth_prime_upper($n)); printf "10^%2d %12.7f %12.7f\n", length($n)-1, 100.0*($nth-$nthl)/$nth, 100.0*($nthu-$nth)/$nth; } Math-Prime-Util-0.37/xt/measure_zeta_accuracy.pl0000755000076400007640000000642012270011421020242 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::BigInt lib=>'GMP'; use Math::BigFloat lib=>'GMP'; use Math::Prime::Util qw/:all/; use Term::ANSIColor; my $acc = shift || 40; die "Max accuracy for this test = 130 digits\n" if $acc > 130; # gp # \p 200 # zeta( ... ) my %rvals = ( '1.1' => '9.584448464950809826386400791735523039948452821749956287341996814480303837459322691616078413409515648694639395119228819064344703916091772977408730498635107285330892384233095746851896144943768106376250', '1.5' => '1.6123753486854883433485675679240716305708006524000634075733282488149277676882728609962438681263119523829763587721497556981576329684344591344383205618083360083393339628054805416629485268482979816864585', '2' => '0.6449340668482264364724151666460251892189499012067984377355582293700074704032008738336289006197587053040043189623371906796287246870050077879351029463308662768317333093677626050952510068721400547968116', '10.6' => '0.0006535124140849160091501143426339766925221571365653473384612636596703480872941784752196831016776418120994086666918881480106625093513591339409876063582144423806112461223442629387528335045020747185807', '40' => '0.0000000000009094947840263889282533118386949087538600009908788285054797101120253686956071035306072205287331384902727431401990215047047204991063494101565431604021268515739713441458101750970056651490623', '40.5' => '0.0000000000006431099185658679387082225425519898498591882791889454081987607830570099179633851971961276745357473820567338532744684721389592539881397336120645131348781330604831257993490233960843733407184', '80' => '0.0000000000000000000000008271806125530344403671105616744072404009681112297828911634240702948673833268263801251794903859145412800678073752551076032591373513167395826219721614628514247211772783817197087', '200' => '0.0000000000000000000000000000000000000000000000000000000000006223015277861141707144064053780124278238871664711431331935339387492776093057166188727575094880097645495454472391197851568776550275806071517', ); my $acctext = ($acc == 40) ? "default 40-digit" : "$acc-digit"; print < 38 digits. EOT foreach my $vstr (sort { $a <=> $b } keys %rvals) { my $zeta_str = $rvals{$vstr}; my $lead = index($zeta_str, '.'); my $v = Math::BigFloat->new($vstr); my $zeta = Math::BigFloat->new($rvals{$vstr}); $v->accuracy($acc) if $acc != 40; #print "zeta($v) = $zeta\n"; my $mpuzeta = RiemannZeta($v); my $mpuzeta_str = ref($mpuzeta) eq 'Math::BigFloat' ? $mpuzeta->bstr : sprintf("%.69Lf", $mpuzeta); my $mzlen = length($mpuzeta_str); # Truncate zeta_str to length of mpuzeta_str, with rounding. { $zeta_str = Math::BigFloat->new($zeta_str)->bmul(1,$acc)->bstr; } if ($zeta_str ne $mpuzeta_str) { my $n = 0; $n++ while substr($zeta_str, $n, 1) eq substr($mpuzeta_str, $n, 1); $mpuzeta_str = substr($mpuzeta_str, 0, $n) . colored(substr($mpuzeta_str, $n), "red"); } printf "%5.1f %s\n", $v, $zeta_str; printf " %s\n", $mpuzeta_str; print "\n"; } Math-Prime-Util-0.37/xt/factor-holf.pl0000755000076400007640000000132012270242116016111 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/is_prime/; use List::Util qw/min max/; my $count = shift || -2; my $is64bit = (~0 > 4294967295); my $maxdigits = ($is64bit) ? 20 : 10; # Noting the range is limited for max. my $hrounds = 64*1024*1024; for (2 .. 100000000) { my @fs; my $s_fact = join(".",sort {$a<=>$b} Math::Prime::Util::factor($_)); my @p_holf; push @fs, $_; while (@fs) { my $n = pop @fs; if (is_prime($n)) { push @p_holf, $n; } else { push @fs, Math::Prime::Util::holf_factor($n); } } my $s_holf = join(".",sort {$a<=>$b} @p_holf); die "$_ $s_fact holf $s_holf\n" unless $s_fact eq $s_holf; print "$_\n" if ($_ % 100000) == 0; } Math-Prime-Util-0.37/xt/small-is-next-prev.pl0000755000076400007640000001326212270011421017355 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/:all/; use Time::HiRes qw(gettimeofday tv_interval); $| = 1; # fast pipes my $nprimes = shift || 50_000_000; # 1. forprimes does a segmented sieve and calls us for each prime. This is # independent of is_prime and the main sieve. So for each entry let's # compare next_prime and prev_prime. { print "Using MPU forprimes to $nprimes\n"; my $start_time = [gettimeofday]; my $nextprint = 5000000; my $n = 0; forprimes { die "next $n not $_" unless next_prime($n) == $_; die "prev $n" unless prev_prime($_) == $n; $n = $_; if ($n > $nextprint) { print "$n.."; $nextprint += 5000000; } } $nprimes; my $seconds = tv_interval($start_time); my $micro_per_call = ($seconds * 1000000) / (2*prime_count($nprimes)); printf "Success using forprimes to $nprimes. %6.2f uSec/call\n", $micro_per_call; } print "\n"; # 2. Just like before, but now we'll call prime_precalc first. This makes the # prev_prime and next_prime functions really fast since they just look in # the cached sieve. { print "Using MPU forprimes to $nprimes with prime_precalc\n"; my $start_time = [gettimeofday]; prime_precalc($nprimes); my $nextprint = 5000000; my $n = 0; forprimes { die "next $n not $_" unless next_prime($n) == $_; die "prev $n" unless prev_prime($_) == $n; $n = $_; if ($n > $nextprint) { print "$n.."; $nextprint += 5000000; } } $nprimes; my $seconds = tv_interval($start_time); my $micro_per_call = ($seconds * 1000000) / (2*prime_count($nprimes)); printf "Success using forprimes/precalc to $nprimes. %6.2f uSec/call\n", $micro_per_call; } print "\n\n"; # Now do some more comparative timing. my @pr = @{primes($nprimes)}; my $numpr = scalar @pr; prime_memfree(); { print "MPU forprimes..."; my $start_time = [gettimeofday]; my $i = 0; forprimes { die "next $_ not ", $pr[$i-1] unless $pr[$i++] == $_; } $nprimes; my $seconds = tv_interval($start_time); my $micro_per_call = ($seconds * 1000000) / (1*prime_count($nprimes)); printf "%8.2f uSec/call\n", $micro_per_call; prime_memfree(); } { print "MPU prev/next..."; my $start_time = [gettimeofday]; my $n = 0; foreach my $p (@pr) { my $next = next_prime($n); my $prev = prev_prime($p); die "MPU next($n) is not $p\n" unless $next == $p; die "MPU prev($p) is not $n\n" unless $prev == $n; $n = $next; } my $seconds = tv_interval($start_time); my $micro_per_call = ($seconds * 1000000) / (2*$numpr); printf "%8.2f uSec/call\n", $micro_per_call; } { print "MPU precalc prev/next..."; my $start_time = [gettimeofday]; prime_precalc($pr[-1]+1000); my $n = 0; foreach my $p (@pr) { my $next = next_prime($n); my $prev = prev_prime($p); die "MPU next($n) is not $p\n" unless $next == $p; die "MPU prev($p) is not $n\n" unless $prev == $n; $n = $next; } my $seconds = tv_interval($start_time); my $micro_per_call = ($seconds * 1000000) / (2*$numpr); printf "%8.2f uSec/call\n", $micro_per_call; prime_memfree(); } # Math::Prime::FastSieve if (eval { require Math::Prime::FastSieve; Math::Prime::FastSieve->import(); Inline->init(); 1; }) { print "Math::Prime::FastSieve......"; my $start_time = [gettimeofday]; my $sieve = Math::Prime::FastSieve::Sieve->new( $pr[-1]+1000 ); my $n = 0; foreach my $p (@pr) { my $next = $sieve->nearest_ge($n+1); my $prev = $sieve->nearest_le($p-1); die "MPFS next($n) is not $p\n" unless $next == $p; die "MPFS prev($p) is not $n\n" unless $prev == $n; $n = $next; } my $seconds = tv_interval($start_time); my $micro_per_call = ($seconds * 1000000) / (2*$numpr); printf "%8.2f uSec/call\n", $micro_per_call; } else { print "Math::Prime::FastSieve not installed. Skipping\n"; } # Math::Pari. if (eval { require Math::Pari; 1; }) { print "Math::Pari prec/next..."; my @pari_pr = grep { $_ < 5_000_000 } @pr; my $pari_numpr = scalar @pari_pr; my $start_time = [gettimeofday]; my $n = 0; foreach my $p (@pari_pr) { my $next = Math::Pari::nextprime($n+1); my $prev = Math::Pari::precprime($p-1); die "Pari next($n) is not $p\n" unless $next == $p; die "Pari prec($p) is not $n\n" unless $prev == $n; $n = $next; } my $seconds = tv_interval($start_time); my $micro_per_call = ($seconds * 1000000) / (2*$pari_numpr); printf "%8.2f uSec/call\n", $micro_per_call; } else { print "Math::Pari not installed. Skipping\n"; } # Math::NumSeq::Primes if (eval { require Math::NumSeq::Primes; 1; }) { print "Math::NumSeq::Primes next..."; my $start_time = [gettimeofday]; my $seq = Math::NumSeq::Primes->new(); my $n = 0; foreach my $p (@pr) { my $next = ($seq->next)[1]; die "MNP next($n) is not $p\n" unless $next == $p; $n = $next; } my $seconds = tv_interval($start_time); my $micro_per_call = ($seconds * 1000000) / (1*$numpr); printf "%8.2f uSec/call\n", $micro_per_call; } else { print "Math::NumSeq::Primes not installed. Skipping\n"; } # Math::Primality if (eval { require Math::Primality; 1; }) { print "Math::Primality prev/next..."; my @mp_pr = grep { $_ < 100_000 } @pr; my $mp_numpr = scalar @mp_pr; my $start_time = [gettimeofday]; my $n = 0; foreach my $p (@mp_pr) { my $next = Math::Primality::next_prime($n); my $prev = ($p == 2) ? 0 : Math::Primality::prev_prime($p); die "MP next($n) is not $p\n" unless $next == $p; die "MP prev($p) is not $n\n" unless $prev == $n; $n = $next; } my $seconds = tv_interval($start_time); my $micro_per_call = ($seconds * 1000000) / (2*$mp_numpr); printf "%8.2f uSec/call\n", $micro_per_call; } else { print "Math::Primality not installed. Skipping\n"; } Math-Prime-Util-0.37/xt/rwh_primecount_numpy.py0000755000076400007640000000115012262252474020231 0ustar danadana#!/usr/bin/env python #from math import sqrt, ceil import numpy as np def rwh_pcn(n): # http://stackoverflow.com/questions/2068372/fastest-way-to-list-all-primes-below-n-in-python/3035188#3035188 """ Input n>=6, Returns a list of primes, 2 <= p < n """ sieve = np.ones(n/3 + (n%6==2), dtype=np.bool) for i in xrange(1,int(n**0.5)/3+1): if sieve[i]: k=3*i+1|1 sieve[ k*k/3 ::2*k] = False sieve[k*(k-2*(i&1)+4)/3::2*k] = False return 1 + np.count_nonzero(sieve) #return np.r_[2,3,((3*np.nonzero(sieve)[0]+1)|1)] print rwh_pcn(800000000) Math-Prime-Util-0.37/xt/primality-aks.pl0000755000076400007640000000125512262252474016513 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes my $limit = shift || 10_000_000; use Math::Prime::Util qw/is_aks_prime/; use Math::Prime::FastSieve; my $sieve = Math::Prime::FastSieve::Sieve->new($limit + 10_000); if (1) { my $n = 2; while ($n <= $limit) { print "$n\n" if $n > 69000; # unless $i++ % 262144; die "$n should be prime" unless is_aks_prime($n); my $next = $sieve->nearest_ge( $n+1 ); my $diff = ($next - $n) >> 1; if ($diff > 1) { foreach my $d (1 .. $diff-1) { my $cn = $n + 2*$d; die "$cn should be composite" if is_aks_prime($cn); } } $n = $next; } print "Success to $limit!\n"; } Math-Prime-Util-0.37/xt/make-script-test-data.pl0000755000076400007640000001225612262252474020033 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use File::Spec::Functions; use FindBin; use bigint try => 'GMP'; use Data::BitStream::XS; use Math::Prime::Util qw/is_prime/; $|++; # Encode all the OEIS text files for our primes.pl testing into a bitstream. # This not only makes the test script run much faster, but it turns 18 text # files of 5MB into one ~300k file. my @test_data = ( # OEIS# TEXT NAME script-arg skip if > this [ 7529, "Triplet", "triplet", 0], [ 7530, "Quadruplet", "quadruplet", 0], [23200, "Cousin", "cousin", 0], [23201, "Sexy", "sexy", 0], [ 1359, "Twin", "twin", 0], [ 5385, "Safe", "safe", 0], [ 5384, "SG", "sophie", 0], [68652, "Circular", "circular", 0], [27862, "Panaitopol", "panaitopol", 0], [ 2407, "Cuban y+1", "cuban1", 0], [ 2648, "Cuban y+2", "cuban2", 0], [ 2385, "Palindromic", "palin", 32_965_656_923], [ 668, "Mersenne", "mersenne", 10**100], [ 5479, "Lucas", "lucas", 0], [ 5478, "Fibonacci", "fibonacci", 0], [63980, "Pillai", "pillai", 0], [28388, "Good", "good", 20000], [31157, "Lucky", "lucky", 0], [ 5234, "Primorial+1", "pnp1", 2500], [ 6794, "Primorial-1", "pnm1", 2500], [18239, "Euclid", "euclid", 0], ); foreach my $test (@test_data) { my $oeis_no = $test->[0]; my $filename = sprintf("b%06d.txt", $oeis_no); my $link = sprintf("http://oeis.org/A%06d/b%06d.txt", $oeis_no, $oeis_no); if (!-r $filename) { warn "Getting $filename from $link\n"; qx/wget $link/; die "Could not retrieve. Bailing\n" unless -r $filename; } my $ref_data = read_oeis(@$test); push @$test, $ref_data; } my $stream = Data::BitStream::XS->new( file => 'script-test-data.bs', mode => 'w' ); foreach my $test (@test_data) { encode_oeis(@$test); } $stream->write_close(); sub read_oeis { my($oeis_no, $name, $script_arg, $restrict) = @_; die "Restrict isn't defined for $oeis_no : $name" unless defined $restrict; my $filename = sprintf("b%06d.txt", $oeis_no); my $link = sprintf("http://oeis.org/A%06d/b%06d.txt", $oeis_no, $oeis_no); my @ref; { open my $fh, '<', $filename or die "Can't read $filename.\nYou should run:\n wget $link\n"; printf "%12s primes: reading %12s...", $name, $filename; my $char = " "; while (<$fh>) { next unless /^(\d+)\s+(\d+)/; my $v = (length($2) < 20) ? $2 : Math::BigInt->new("$2"); if ($restrict > 0 && $v > $restrict) { $char = '*'; last; } push @ref, $v; } close $fh; print "$char"; } printf " %7d.", scalar @ref; print " Testing.."; if ($ref[-1] > 18446744073709551615) { print ","; # Check for monotonic and primeness foreach my $i (0 .. $#ref) { die "non-prime in $oeis_no $name\n" unless is_prime($ref[$i]); if ($i > 0) { die "non-monotonic sequence in $oeis_no $name ($i $ref[$i-1] $ref[$i])\n" if $ref[$i] <= $ref[$i-1]; die "even number in $oeis_no $name\n" if ($ref[$i] % 2) == 0; } } } else { no bigint; print "."; # Check for monotonic and primeness foreach my $i (0 .. $#ref) { die "non-prime in $oeis_no $name\n" unless is_prime($ref[$i]); if ($i > 0) { die "non-monotonic sequence in $oeis_no $name\n" if $ref[$i] <= $ref[$i-1]; die "even number in $oeis_no $name\n" if ($ref[$i] % 2) == 0; } } } print "done\n"; return \@ref; } sub encode_oeis { my($oeis_no, $name, $script_arg, $restrict, $ref_data) = @_; my @ref = @$ref_data; printf "%12s primes: stream..", $name; put_text_string($stream, $script_arg); put_text_string($stream, $name); if ($ref[-1] > 18446744073709551615) { print ","; # Store the first two values, then a list of deltas $stream->put_gamma($oeis_no, 1, scalar @ref, $ref[0], $ref[1]); print "."; my @deltas = map { ($ref[$_] - $ref[$_-1] - 2)/2 } (2..$#ref); print "."; # Ugly... Check for anything really big; my @giant; foreach my $d (@deltas) { if ($d >= 18446744073709551614) { push @giant, $d; $d = 18446744073709551614; } } print "."; my $k = 2; $stream->put_arice($k, @deltas); print "."; # Store giant deltas raw foreach my $d (@giant) { if (ref($d) ne 'Math::BigInt') { warn "big delta $d isn't a bigint.\n"; $d = Math::BigInt->new(0); } my $binstr = substr($d->as_bin, 2); $stream->put_gamma(length($binstr)); $stream->put_string($binstr); } } else { no bigint; print "."; # Store the first two values, then a list of deltas $stream->put_gamma($oeis_no, 0, scalar @ref, $ref[0], $ref[1]); print "."; my @deltas = map { ($ref[$_] - $ref[$_-1] - 2)/2 } (2..$#ref); print "."; my $k = 2; $stream->put_arice($k, @deltas); } print "done\n"; } sub put_text_string { my ($stream, $str) = @_; $stream->put_gamma(ord($_)) for (split "", $str); $stream->put_gamma(0); 1; } sub get_text_string { my ($stream) = @_; my $str = ''; while (my $c = $stream->get_gamma) { $str .= chr($c); } $str; } Math-Prime-Util-0.37/xt/primality-proofs.pl0000755000076400007640000000710212270242116017231 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util ':all'; use Math::BigInt lib=>"GMP,Pari"; if (!Math::Prime::Util::prime_get_config->{gmp}) { print "\nYou should install Math::Prime::Util::GMP.\n\n"; } $|++; print "random prime proofs: 50, 100, 200, 300, 400 +/- 50 digits\n"; test_proofs( 4, 100, 71, 'mpu'); print "\n"; test_proofs( 50, 150, 71, 'mpu'); print "\n"; test_proofs(150, 250, 71, 'mpu'); print "\n"; test_proofs(250, 350, 71, 'mpu'); print "\n"; test_proofs(350, 450, 71, 'mpu'); print "\n"; # size: random primes with bit sizes randomly between 4 and this number # num: this many tests performed. 71 makes a nice 80-column display # method: how to generate random primes: # Ideally we would use some independent code. Time for one thousand # random primes from rand(4-300) or rand(4-600) bits: # 300bits 600bits which # 2sec 6sec mpu (with mpu::gmp installed) # 31sec 124sec pari # 97sec 254sec cpmaurer # We don't seem to have any practical choice other than MPU's # random_nbit_prime as the other random prime code is just so slow. sub test_proofs { my($minsize, $size, $num, $prime_method) = @_; if ($prime_method eq 'cpmaurer') { require Crypt::Primes; } elsif ($prime_method eq 'pari') { require Math::Pari; require Crypt::Random; } elsif ($prime_method eq 'mpu') { # nothing } else { die "Unknown random prime generation method\n"; } my @ns; print "Generate "; $minsize = 4 if $minsize < 4; $minsize = $size if $minsize > $size; die "invalid size, must be > 4" unless $size > 4; foreach my $i (1..$num) { my $bits = int(rand($size-$minsize)) + $minsize; my $n; if ($prime_method eq 'cpmaurer') { $n = Crypt::Primes::maurer(Size=>$bits); } elsif ($prime_method eq 'pari') { # This is ~4x faster, has awful distribution. Still much slower than MPU. # $n = Math::Pari::nextprime( ...makerandom... ); do { $n = Crypt::Random::makerandom(Size=>$bits,Strength=>0); } while !Math::Pari::isprime($n); } else { $n = random_nbit_prime($bits); } push @ns, Math::BigInt->new("$n"); # print a number corresponding to hundreds of bits print int(3.322*length("$n")/100); } print "\n"; my @certs; print "Prove "; foreach my $n (@ns) { my ($isp,$cert) = is_provable_prime_with_cert($n); die "$n is reported as $isp\n" unless $isp == 2; push @certs, [$n, $cert]; print proof_mark($cert); } print "\n"; print "Verify "; prime_set_config(verbose=>1); foreach my $certn (@certs) { my $v = verify_prime($certn->[1]); print proof_mark($certn->[1]); next if $v; print "\n\n$certn->[0] didn't verify!\n\n"; { my $c = $certn->[1]; $c =~ s/^/ /smg; print $c; } die; } prime_set_config(verbose=>0); print "\n"; } sub proof_mark { my $cert = shift; my $type; if (ref($cert) eq 'ARRAY') { $type = (scalar @$cert == 1) ? "bpsw" : $cert->[1]; if ($type =~ /n-1/i) { $type = ($cert->[2]->[0] eq 'B') ? 'BLS7' : 'BLS5'; } } else { return 'E' if $cert =~ /Type\s+ECPP/; ($type) = $cert =~ /Type (\S+)/; } if (!defined $type) { die "\nNo type:\n\n$cert"; } if ($type =~ /bls5/i) { return '5'; } elsif ($type =~ /bls7/i) { return '7'; } if ($type =~ /bls3/i) { return '-'; } elsif ($type =~ /bls15/i) { return '+'; } elsif ($type =~ /bpsw|small/i){ return '.'; } elsif ($type =~ /ecpp|agkm/i) { return 'E'; } warn "type: $type\n"; return '?'; } Math-Prime-Util-0.37/xt/test-primes-script.pl0000755000076400007640000001006612266152412017476 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use File::Spec::Functions; use FindBin; use Time::HiRes qw(gettimeofday tv_interval); use bigint try => 'GMP'; use Data::BitStream::XS; $|++; #flush the output buffer after every write() or print() function # Maps between oeis name and number, filled in as we read sequences. my %oeis_number; # short-name -> no my %oeis_data; # no -> ref to info+data # returned array contains elements of: # [$oeis_no, $name, $script_arg, $num_entries, \@ref_data]; my $test_data = read_script_data('script-test-data.bs'); # Verify additional filters my @additional_filters; foreach my $name (@ARGV) { $name =~ s/^--//; my $oeis_no = $oeis_number{$name}; die "Unknown filter: $name\n" unless defined $oeis_no; push @additional_filters, $oeis_no; } if (@additional_filters > 0) { print "Additional Filters: ", join(" ", map { $oeis_data{$_}->[2] } @additional_filters), "\n"; } foreach my $test (@$test_data) { test_oeis(@$test); } sub read_script_data { my ($filename) = @_; die "Can't find test file: $filename\nRun make-script-test-data.pl\n" unless -r $filename; my $stream = Data::BitStream::XS->new( file => $filename, mode => 'ro' ); my @data; while (!$stream->exhausted) { my $script_arg = get_text_string($stream); my $name = get_text_string($stream); my ($oeis_no, $is_bigint, $num_entries, @ref) = $stream->get_gamma(5); printf "%12s primes (OEIS A%06d): reading %7d entries..", $name, $oeis_no, $num_entries; if ($is_bigint) { print ","; my $k = 2; my @deltas = $stream->get_arice($k, $num_entries-2); print "."; # Check to see if we have any giant deltas foreach my $d (@deltas) { if ( $d >= '18446744073709551614' ) { my $len = $stream->get_gamma; my $binstr = $stream->read_string($len); $d = Math::BigInt->new('0b' . $binstr); } } print "."; my $prev = $ref[1]; push @ref, map { $prev = $_*2+$prev+2; } @deltas; print ".\n"; } else { no bigint; print "."; my $k = 2; my @deltas = $stream->get_arice($k, $num_entries-2); print "."; my $prev = $ref[1]; push @ref, map { $prev = $_*2+$prev+2; } @deltas; print ".\n"; } my $row = [$oeis_no, $name, $script_arg, $num_entries, \@ref]; push @data, $row; $oeis_data{$oeis_no} = $row; $oeis_number{$script_arg} = $oeis_no; } \@data; } sub test_oeis { my($oeis_no, $name, $script_arg, $num_entries, $ref_data) = @_; my @ref = @$ref_data; my $end = $ref[-1]; $script_arg = '--' . $script_arg; foreach my $filter_no (@additional_filters) { #my $row = [$oeis_no, $name, $script_arg, $num_entries, \@ref]; my $filter_name = $oeis_data{$filter_no}->[2]; my $filter_data_ref = $oeis_data{$filter_no}->[4]; my %filter_data_hash; undef @filter_data_hash{ @$filter_data_ref }; my $filter_end = $filter_data_ref->[-1]; @ref = grep { exists $filter_data_hash{$_} } @ref; $script_arg .= " --$filter_name"; $end = $filter_end if $end > $filter_end; # bring endpoint down } printf "%12s primes (OEIS A%06d): generating..", $name, $oeis_no; my $start = [gettimeofday]; my @scr = split /\s+/, qx+$FindBin::Bin/../bin/primes.pl $script_arg 1 $end+; { no bigint; my $num_generated = scalar @scr || 0.1; my $seconds = tv_interval($start); my $msperprime = ($seconds * 1000.0) / $num_generated; printf " %7d. %7.2f ms/prime\n", $num_generated, $msperprime; } if (scalar @ref != scalar @scr) { warn " $FindBin::Bin/../bin/primes.pl $script_arg 1 $end\n"; die "Not equal numbers: ", scalar @ref, " - ", scalar @scr, "\n"; } foreach my $i (0 .. $#ref) { die "$name prime $i not equal: $ref[$i] - $scr[$i]\n" if $ref[$i] != $scr[$i]; } } sub put_text_string { my ($stream, $str) = @_; $stream->put_gamma(ord($_)) for (split "", $str); $stream->put_gamma(0); 1; } sub get_text_string { my ($stream) = @_; my $str = ''; while (my $c = $stream->get_gamma) { $str .= chr($c); } $str; } Math-Prime-Util-0.37/xt/test-nextprime-yafu.pl0000755000076400007640000000456212271137564017665 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/next_prime/; use File::Temp qw/tempfile/; use autodie; my $maxdigits = (~0 <= 4294967295) ? 10 : 20; $| = 1; # fast pipes my $num = shift || 10000; my $yafu_fname = "yafu_batchfile_$$.txt"; $SIG{'INT'} = \&gotsig; foreach my $digits (4 .. $maxdigits) { printf "%2d-digit numbers", $digits; my @narray = gendigits($digits, $num); print "."; my @mpuarray = mpu_next_primes(@narray); print "."; die "mpu_next_primes didn't get enough numbers" unless $#mpuarray == $#narray; my @yafuarray = yafu_next_primes(@narray); die "yafunext_primes didn't get enough numbers" unless $#yafuarray == $#narray; print "."; foreach my $n (@narray) { my $mpu = shift @mpuarray; my $yafu = shift @yafuarray; die "next_prime($n): MPU: $mpu YAFU: $yafu\n" unless $mpu == $yafu; } print "."; print "OK\n"; } sub gendigits { my $digits = shift; die "Digits must be > 0" unless $digits > 0; my $howmany = shift; my $base = ($digits == 1) ? 0 : int(10 ** ($digits-1)); my $max = int(10 ** $digits); $max = ~0 if $max > ~0; my @nums = map { $base+int(rand($max-$base)) } (1 .. $howmany); return @nums; } sub mpu_next_primes { my @nparray; push @nparray, next_prime($_) for @_; @nparray; } sub yafu_next_primes { my @nparray; # Yafu 1.31 seems to go out of its way to make it hard to process more than # one number at a time. The batchfile system will infinite loop if the data # file isn't in the current directory. # It does its darndest to see if you're on a terminal or not, and if not it # just cuts you off after one number. So any sort of tempfile or pipe stuff # just plain doesn't work. Faking it using IO::*tty* would probably work. #my $fh = File::Temp->new; # .... autodie #print $fh, "$_\n" for @_; #$fh->flush; # Shudder. Read comments above about why I have to do this. open(my $fh, '>', $yafu_fname); print $fh "$_\n" for @_; close $fh; open my $yafu, "yafu \"nextprime(\@)\" -batchfile $yafu_fname |"; while (<$yafu>) { if (/^(ans = )?(\d+)\s*$/) { push @nparray, $2; } } close($yafu); @nparray; } sub gotsig { my $sig = shift; die "Die because SIG$sig\n"; } END { unlink $yafu_fname if -e $yafu_fname; # YAFU leaves stuff around unlink "__tmpbatchfile" if -e "__tmpbatchfile"; unlink "session.log" if -e "session.log"; } Math-Prime-Util-0.37/xt/primality-small.pl0000755000076400007640000000226512266152412017042 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes # Make sure the is_prob_prime functionality is working for small inputs. # Good for making sure the first few M-R bases are set up correctly. my $limit = shift || 1_000_000_000; use Math::Prime::Util qw/is_prob_prime/; # Use another code base for comparison. # Math::Prime::FastSieve is very fast -- far faster than Math::Primality use Math::Prime::FastSieve; my $sieve = Math::Prime::FastSieve::Sieve->new($limit + 10_000); if (0) { # just primes using Math::Prime::FastSieve my $n = 2; my $i = 1; while ($n < $limit) { die "$n" unless is_prob_prime($n); $n = $sieve->nearest_ge( $n+1 ); print "$i $n\n" unless $i++ % 16384; } } # Test every number up to $limit if (1) { my $n = 2; my $i = 1; while ($n <= $limit) { die "$n should be prime" unless is_prob_prime($n); print "$i $n\n" unless $i++ % 262144; my $next = $sieve->nearest_ge( $n+1 ); my $diff = ($next - $n) >> 1; if ($diff > 1) { foreach my $d (1 .. $diff-1) { my $cn = $n + 2*$d; die "$cn should be composite" if is_prob_prime($cn); } } $n = $next; } print "Success to $limit!\n"; } Math-Prime-Util-0.37/xt/primecount-approx.t0000644000076400007640000001413412271163017017240 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/prime_count prime_count_lower prime_count_upper prime_count_approx/; use Digest::SHA qw/sha256_hex/; my %pivals = ( 1000 => 168, 10000 => 1229, 100000 => 9592, 1000000 => 78498, 10000000 => 664579, 100000000 => 5761455, 1000000000 => 50847534, 10000000000 => 455052511, 100000000000 => 4118054813, 1000000000000 => 37607912018, 2000000000000 => 73301896139, 3000000000000 => 108340298703, 4000000000000 => 142966208126, 5000000000000 => 177291661649, 6000000000000 => 211381427039, 7000000000000 => 245277688804, 8000000000000 => 279010070811, 9000000000000 => 312600354108, 10000000000000 => 346065536839, 20000000000000 => 675895909271, 30000000000000 => 1000121668853, 40000000000000 => 1320811971702, 50000000000000 => 1638923764567, 60000000000000 => 1955010428258, 70000000000000 => 2269432871304, 80000000000000 => 2582444113487, 90000000000000 => 2894232250783, 100000000000000 => 3204941750802, 200000000000000 => 6270424651315, 300000000000000 => 9287441600280, 400000000000000 => 12273824155491, 500000000000000 => 15237833654620, 600000000000000 => 18184255291570, 700000000000000 => 21116208911023, 800000000000000 => 24035890368161, 900000000000000 => 26944926466221, 1000000000000000 => 29844570422669, 10000000000000000 => 279238341033925, 20000000000000000 => 547863431950008, 40000000000000000 => 1075292778753150, 100000000000000000 => 2623557157654233, 1000000000000000000 => 24739954287740860, 2000000000000000000 => 48645161281738535, 3000000000000000000 => 72254704797687083, 4000000000000000000 => 95676260903887607, 4185296581467695669 => 100000000000000000, 5000000000000000000 => 118959989688273472, 6000000000000000000 => 142135049412622144, 7000000000000000000 => 165220513980969424, 8000000000000000000 => 188229829247429504, 9000000000000000000 => 211172979243258278, 10000000000000000000 => 234057667276344607, 524288 => 43390, 1048576 => 82025, 2097152 => 155611, 4194304 => 295947, 8388608 => 564163, 16777216 => 1077871, 33554432 => 2063689, 67108864 => 3957809, 134217728 => 7603553, 268435456 => 14630843, 536870912 => 28192750, 1073741824 => 54400028, 2147483648 => 105097565, 4294967296 => 203280221, 8589934592 => 393615806, 17179869184 => 762939111, 34359738368 => 1480206279, 68719476736 => 2874398515, 137438953472 => 5586502348, 274877906944 => 10866266172, 549755813888 => 21151907950, 1099511627776 => 41203088796, 2199023255552 => 80316571436, 4398046511104 => 156661034233, 8796093022208 => 305761713237, 17592186044416 => 597116381732, 35184372088832 => 1166746786182, 70368744177664 => 2280998753949, 140737488355328 => 4461632979717, 281474976710656 => 8731188863470, 562949953421312 => 17094432576778, 1125899906842624 => 33483379603407, 2251799813685248 => 65612899915304, 4503599627370496 => 128625503610475, 9007199254740992 => 252252704148404, 18014398509481984 => 494890204904784, 36028797018963968 => 971269945245201, 72057594037927936 => 1906879381028850, 144115188075855872 => 3745011184713964, 288230376151711744 => 7357400267843990, 576460752303423488 => 14458792895301660, 1152921504606846976 => 28423094496953330, 2305843009213693952 => 55890484045084135, 4611686018427387904 => 109932807585469973, 9223372036854775808 => 216289611853439384, # From http://trac.sagemath.org/ticket/7539 plus sieving 11000000000000000000 => 256890014776557326, 12000000000000000000 => 279675001309887227, 13000000000000000000 => 302416755645383081, 14000000000000000000 => 325118755759814408, 15000000000000000000 => 347783970566657581, 16000000000000000000 => 370414963651223281, 17000000000000000000 => 393013970558176111, 18000000000000000000 => 415582957615112220, 18400000000000000000 => 424602543873663577, 18440000000000000000 => 425504257754137607, 18446700000000000000 => 425655290520421050, 18446740000000000000 => 425656192205366999, 18446744000000000000 => 425656282373661946, 18446744030000000000 => 425656283049924141, 18446744040000000000 => 425656283275356419, 18446744050000000000 => 425656283500787632, 18446744070000000000 => 425656283951611098, 18446744073000000000 => 425656284019227775, 18446744073700000000 => 425656284035002496, 18446744073709000000 => 425656284035205391, 18446744073709550000 => 425656284035217706, 18446744073709551000 => 425656284035217730, 18446744073709551615 => 425656284035217743, ); plan tests => 3*scalar(keys %pivals); foreach my $n (sort {$a <=> $b} keys %pivals) { my $pin = $pivals{$n}; cmp_ok( prime_count_upper($n), '>=', $pin, "Pi($n) <= upper estimate" ); cmp_ok( prime_count_lower($n), '<=', $pin, "Pi($n) >= lower estimate" ); my $approx = prime_count_approx($n); my $percent_limit = ($n > 1000000000000) ? 0.00005 : ($n > 10000000000) ? 0.0002 : ($n > 100000000) ? 0.002 : ($n > 1000000) ? 0.02 : 0.2; cmp_ok( abs($pin - $approx) * (100.0 / $percent_limit), '<=', $pin, "prime_count_approx($n) within $percent_limit\% of Pi($n)"); } Math-Prime-Util-0.37/Changes0000644000076400007640000007427412271162772014241 0ustar danadanaRevision history for Perl module Math::Prime::Util 0.37 2014-01-26 [FUNCTIONALITY AND PERFORMANCE] - Simplified primes(). No longer takes an optional hashref as first arg, which was awkward and never documented. - Dynamically loads the PP code and Math::BigInt only when needed. This removes a lot of bloat for the usual cases: 2.0 MB perl -E 'say 1' 4.2 MB MPU 0.37 4.5 MB Math::Prime::XS + Math::Factor::XS 5.3 MB Math::Pari 7.6 MB MPU 0.34 9.6 MB MPU 0.36 9.7 MB MPU 0.35 - Combined with the above, this reduces startup overhead a lot (~3x). - Adjusted factor script to lower startup costs. Over 2x faster with native integer (non-expression) arguments. This is just not loading thousands of lines of Perl code that aren't used, which was more time-consuming than the actual factoring. - nth_prime_{lower,upper,approx} and prime_count_{lower,upper,approx} moved to XS->PP. This helps us slim down and cut startup overhead. - Fix doc for znlog: znlog(a,g,p) finds k s.t. a = g^k mod p 0.36 2014-01-13 [API Changes] - factor behavior for 0 and 1 more consistent. The results for factor, factor_exp, divisors, and divisor_sum now match Pari, and the omega(1)/Omega(1) exception is removed. Thanks to Hugo van der Sanden for bringing this up. - all_factors changed to divisors. The old name still remains aliased. [ADDED] - forcomposites like forprimes, but on composites. See Pari 2.6.x. - fordivisors calls a block for each divisor - kronecker Kronecker symbol (extension of Jacobi symbol) - znprimroot Primitive root modulo n - gcd Greatest common divisor - lcm Least common multiple - legendre_phi Legendre's sum [FUNCTIONALITY AND PERFORMANCE] - Win32 fixes from bulk88 / bulkdd. Thanks! - XS redundancy removal and fixes from bulk88 and leont. Smaller DLL. This almost includes not compiling a number of prime count methods (Legendre, Meissel, Lehmer, and LMOS) that are not used. Using "-DLEHMER" in the Makefile will compile them, but there should not be any reason to do so. - Big XS interface reorg. Most functions now go straight to XS, which reduces their overhead. Input number validation is much faster for the general case. Those two combined meant the '-nobigint' import no longer serves any good purpose. - More functions will go from XS directly to the GMP module, bypassing the Perl layer entirely. The upside is less overhead, both for the case of having GMP, and without. In the contrived case of having XS turned off but the GMP module enabled, things will run slower since they no longer go to GMP. - Test suite should run faster. Combination of small speedups to hot spots as well as pushing a few slow tasks to EXTENDED_TESTING (these are generally things never used, like pure Perl AKS). - Some 5.6.2-is-broken workarounds. - Some LMO edge cases: small numbers that only show up if a #define is changed, and counts > 18440000000000000000. Tested through 2^64-1 now. - LMO much faster if -march=native is used for gcc on a platform with asm popcnt (e.g. Nahalem+, Barcelona+, ARM Neon, SPARC, Power7, etc.). - divisors (all_factors) faster for native size numbers with many factors. - Switch from mapes to a cached primorial/totient small phi method in lehmer.c. Significant for LMOS and Legendre (no longer used or compiled, see earlier. Thanks to Kim Walisch for questioning my earlier decision. - Rewrite sieve composite map. Segment sieving is faster. It's a little faster than primegen for me, but still slower than primesieve and yafu. - znorder uses Carmichael Lambda instead of Euler Phi. Faster. - While Math::BigInt has the bgcd and blcm functions, they are slow for native numbers, even with the Pari or GMP back ends. The gcd/lcm here are 20-100x faster. LCM also returns results consistent with Pari. - Removed the old SQUFOF code, so the racing version is the only one. It was already the only one being used. 0.35 2013-12-08 [API Changes] - We now use Math::BigInt in the module rather than dynamically loading it, and will switch to BigInts as needed. The most noticeable effect of this is that next_prime() / prev_prime() will switch between BigInt and native int at the boundary without regard to the input type or whether bigint is in effect, and next_prime will never return 0. Additionally, all functions will convert large decimal number strings to BigInts if needed. $pref = primes("1000000000000000000000", "1000000000000000000999"); is_prime("882249208105452588824618008529"); $a = euler_phi("801294088771394680000412"); [FUNCTIONALITY AND PERFORMANCE] - Switched to extended LMO algorithm for prime_count. Much better memory use and much faster for large values. Speeds up nth_prime also. Huge thanks to Christian Bau's excellent paper and examples. - Some fixes for 32-bit. - prime_count_approx, upper, and lower return exact answers in more cases. - Fixed a problem with Lehmer prime_count introduced in 0.34. - nth_prime changed from RiemannR to inverse Li (with partial addition). This makes some of the big nth_prime calculations (e.g. 10^15, 10^16) run quite a bit faster as they sieve less on average. 0.34 2013-11-19 - Fixed test that was using a 64-bit number on 32-bit machines. - Switch a couple internal arrays from UV to uint32 in prime count. This reduces memory consumption a little with big counts. Total memory use for counts > 10^15 is about 5x less than in version 0.31. 0.33 2013-11-18 [API Changes] - all_factors now includes 1 and n, making it identical to Pari's divisors(n) function, but no longer identical to Math::Factor::XS's factors(n) function. This change allows consistency between divisor_sum(n,0) and scalar all_factors(n). [ADDED] - factor_exp returns factors as ([p,e],[p,e],...) - liouville -1^(Omega(n)), OEIS A008836 - partitions partition function p(n), OEIS A000041 [FUNCTIONALITY AND PERFORMANCE] - all_factors in scalar context returns sigma_0(n). - exp_mangoldt defaults to XS for speed. - Fixed Pure Perl 33- to 64-bit is_pseudoprime. - prime_count uses Lehmer below a threshold (8000M), LMO above. This keeps good performance while still using low memory. A small speedup for small (3-6M) inputs has been added. Overall memory use has been reduced by 2-4x for large inputs. - Perl RiemannZeta changes: - Borwein Zeta calculations done in BigInt instead of BigFloat (speed). - Patch submitted for the frustrating Math::BigFloat defect RT 43692. With the patch applied, we get much, much better accuracy. - Accuracy updates, especially with fixed BigFloat. - Lucas sequence called with bigints will return bigint objects. - prime_iterator_object should now work with Iterator::Simple. - chebyshev_theta and chebyshev_psi use segmented sieves. - More aggressive pruning of tests with 64-bit Perl 5.6. I'd like to just kill support for systems that can't even add two numbers correctly, but too many other modules want 5.6 support, and lots of our functionality *does* work (e.g. primes, prime count, etc.). 0.32 2013-10-13 [ADDED] - is_provable_prime - is_provable_prime_with_cert - carmichael_lambda - znorder - prime_iterator_object - miller_rabin_random [NEW FEATURES] - Added Math::Prime::Util::PrimeIterator. A more feature-rich iterator than the simple closure one from prime_iterator. Experimental. - Make very simple LMO primecount work, and switch prime_count to use it. It is slower for large inputs, but uses much less memory. For smaller inputs it it as fast or faster. Lehmer code modified to constrain memory use at the expense of speed (starts taking effect at ~ 10^16). Thanks to Kim Walisch for discussions about this. Note that this is a very simple implementation -- better code could run 10x faster and use even less memory. - divisor_sum can take an integer 'k' in the second argument to compute sigma_k. This is much faster than using subs, especially when the result can be computed in XS using native precision. For integer second arguments, the result will automatically be a bigint if needed. It is also much faster for larger inputs. - factor() can be called in scalar context to give the number of prime factors. The XS function was ignoring the context, and now is more consistent. It also slightly speeds up looking at the number of factors, e.g. Omega(x) A001222. [FUNCTIONALITY AND PERFORMANCE] - Use MPU::GMP::pn_primorial if we have it. - Input validation accepts bigint objects and converts them to scalars entirely in XS. - random_nbit_prime now uses Fouque and Tibouchi A1 for 65+ bits. Slightly better uniformity and typically a bit faster. - Incorporate Montgomery reduction for primality testing, thanks to Wojciech Izykowski. This is a 1.3 to 1.5x speedup for is_prob_prime, is_prime, and is_strong_pseudoprime for numbers > 2^32 on x86_64. This also help things like prime_iterator for values > 2^32. - Montgomery reduction used in Lucas and Frobenius tests. Up to 2x speedup for 33 to 64-bit inputs on x86_64/gcc platforms. - Some fixes around near maxint primes, forprimes, etc. Includes more workarounds for Math::BigInt::GMP's constructor sign bug. - Bytes::Random::Secure is loaded only when random prime functionality is used. Shaves a few milliseconds and bytes off of startup. - Speedups for Perl (no GMP) primality and random primes. [MISC] - Primality functions moved to their own file primality.c. 0.31 2013-08-07 - Change proof certificate documentation to reflect the new text format. - Some platforms were using __int128 when it wasn't supported. Only x86_64 and Power64 use it now. - Small speedup for ranged totient internals. - Patch MPU::GMP 0.13 giving us not quite what we expected from a small certificate. Fixed in MPU::GMP 0.14, worked around here regardless. 0.30 2013-08-06 [API Changes] - Primality proofs now use the new "MPU Certificate" format, which is text rather than a nested Perl data structure. This is much better for external interaction, especially with non-Perl tools. It is not quite as convenient for all-Perl manipulation. [Functions Added] - is_frobenius_underwood_pseudoprime - is_almost_extra_strong_lucas_pseudoprime - lucas_sequence - pplus1_factor [Enhancements] - Documentation and PP is_prime changed to use extra strong Lucas test from the strong test. This matches what the newest MPU::GMP does. This has no effect at all for numbers < 2^64. No counter-example is known for the standard, strong, extra strong, or almost extra strong (increment 1 or 2) tests. The extra strong test is faster than the strong test and produces fewer pseudoprimes. It retains the residue class properties of the strong Lucas test (where the SPSP-2 pseudoprimes favor residue class 1 and the Lucas pseudoprimes favor residue class -1), hence should retain the BPSW test strength. - XS code for all 4 Lucas tests. - Clean up is_prob_prime, also ~10% faster for n >= 885594169. - Small mulmod speedup for non-gcc/x86_64 platforms, and for any platform with gcc 4.4 or newer. [Bug Fixes] - Fixed a rare refcount / bignum / callback issue in next_prime. 0.29 2013-05-30 [Functions Added] - is_pseudoprime (Fermat probable prime test) - is_lucas_pseudoprime (standard Lucas-Selfridge test) - is_extra_strong_lucas_pseudoprime (Mo/Jones/Grantham E.S. Lucas test) - Fix a signed vs. unsigned char issue in ranged moebius. Thanks to the Debian testers for finding this. - XS is_prob_prime / is_prime now use a BPSW-style test (SPRP2 plus extra strong Lucas test) for values over 2^32. This results in up to 2.5x faster performance for large 64-bit values on most machines. All PSP2s have been verified with Jan Feitsma's database. - forprimes now uses a segmented sieve. This (1) allows arbitrary 64-bit ranges with good memory use, and (2) allows nesting on threaded perls. - prime_count_approx for very large values (> 10^36) was very slow without Math::MPFR. Switch to Li+correction for large values if Math::MPFR is not available. - Workaround for MSVC compiler. 0.28 2013-05-23 - An optimization to nth_prime caused occasional threaded Win32 faults. Adjust so this is avoided. - Yet another XS micro-speedup (PERL_NO_GET_CONTEXT) - forprimes { block } [begin,]end. e.g. forprimes { say } 100; $sum = 0; forprimes { $sum += $_ } 1000,50000; say $sum; forprimes { say if is_prime($_+2) } 10000; # print twin primes - my $it = prime_iterator(10000); say $it->(); This is experimental (that is, the interface may change). 0.27 2013-05-20 - is_prime, is_prob_prime, next_prime, and prev_prime now all go straight to XS if possible. This makes them much faster for small inputs without having to use the -nobigint flag. - XS simple number validation to lower function call overhead. Still a lot more overhead compared to directly calling the XS functions, but it shaves a little bit of time off every call. - Speedup pure Perl factoring of small numbers. - is_prob_prime / is_prime about 10% faster for composites. - Allow '+N' as the second parameter to primes.pl. This allows: primes.pl 100 +30 to return the primes between 100 and 130. Or: primes.pl 'nth_prime(1000000000)' +2**8 - Use EXTENDED_TESTING to turn on extra tests. 0.26 2013-04-21 [Pure Perl Factoring] - real p-1 -- much faster and more effective - Fermat (no better than HOLF) - speedup for pbrent - simple ECM - redo factoring mix [Functions Added] prime_certificate produces a certificate of primality. verify_prime checks a primality certificate. - Pure perl primality proof now uses BLS75 instead of Lucas, so some numbers will be much faster [n-1 only needs factoring to (n/2)^1/3]. - Math::Prime::Util::ECAffinePoint and ECProjectivePoint modules for dealing with elliptic curves. 0.25 2013-03-19 - Speed up p-1 stage 2 factoring. Combined with some minor changes to the general factoring combination, ~20% faster for 19 digit semiprimes. - New internal macro to loop over primary sieve starting at 2. Simplifies code in quite a few places. - Forgot to skip one of the tests with broken 5.6.2. 0.24 2013-03-10 - Fix compilation with old pre-C99 strict compilers (decl after statement). - euler_phi on a range wasn't working right with some ranges. - More XS prime count improvements to speed and space. Add some tables to the sieve count so it runs a bit faster. Transition from sieve later. - PP prime count for 10^9 and larger is ~2x faster and uses much less memory. Similar impact for nth_prime 10^8 or larger. - Let factor.pl accept expressions just like primes.pl. 0.23 2013-03-05 - Replace XS Zeta for x > 5 with series from Cephes. It is 1 eps more accurate for a small fraction of inputs. More importantly, it is much faster in range 5 < x < 10. This only affects non-integer inputs. - PP Zeta code replaced (for no-MPFR, non-bignums) with new series. The new code is much more accurate for small values, and *much* faster. - Add consecutive_integer_lcm function, just like MPU::GMP's (though we define ci_lcm(0) = 0, which should get propogated). - Implement binary search on RiemannR for XS nth_prime when n > 2e11. Runs ~2x faster for 1e12, 3x faster for 1e13. Thanks to Programming Praxis for the idea and motivation. - Add the first and second Chebyshev functions (theta and psi). - put isqrt(n) in util.h, use it everywhere. put icbrt(n) in lehmer.h, use it there. - Start on Lagarias-Miller-Odlyzko prime count. - A new data structure for the phi(x,a) function used by all the fast prime count routines. Quite a bit faster and most importantly, uses half the memory of the old structure. [Performance] - Divisor sum with no sub is ~10x faster. - Speed up PP version of exp_mangoldt, create XS version. - Zeta much faster as mentioned above. - faster nth_prime as mentioned above. - AKS about 10% faster. - Unroll a little more in sieve inner loop. A couple percent faster. - Faster prime_count and nth_prime due to new phi(x,a) (about 1.25x). 0.22 2013-02-26 - Move main factor loop out of xs and into factor.c. - Totient and Moebius now have complete XS implementations. - Ranged totient uses less memory when segmented. - Switch thread locking to pthreads condition variables. 0.21 2013-02-22 - Switch to using Bytes::Random::Secure for random primes. This is a big change in that it is the first non-CORE module used. However, it gets rid of lots of possible stupidness from system rand. - Spelling fixes in documentation. - primes.pl: Add circular and Panaitopol primes. - euler_phi and moebius now will compute over a range. - Add mertens function: 1000+ times faster than summing moebius($_). - Add exp_mangoldt function: exponential of von Mangoldt's function. - divisor_sum defaults to sigma if no sub is given (i.e. it sums). [Performance] - Speedup factoring small numbers. With -nobigint factoring from 1 to 10M, it's 1.2x faster. 1.5x faster than Math::Factor::XS. - Totient and Möbius over a range are much faster than separate calls. - divisor_sum is 2x faster. - primes.pl is much faster with Pillai primes. - Reduce overhead in euler_phi -- about 2x faster for individual calls. 0.20 2013-02-03 - Speedup for PP AKS, and turn off test on 32-bit machines. - Replaced fast sqrt detection in PP.pm with a slightly slower version. The bloom filter doesn't work right in 32-bit Perl. Having a non-working detector led to really bad performance. Hence this and the AKS change should speed up testing on some 32-bit machines by a huge amount. - Fix is_perfect_power in XS AKS. 0.19 2013-02-01 - Update MR bases with newest from http://miller-rabin.appspot.com/. - Fixed some issues when using bignum and Calc BigInt backend, and bignum and Perl 5.6. - Added tests for bigint is_provable_prime. - Added a few tests to give better coverage. - Adjust some validation subroutines to cut down on overhead. 0.18 2013-01-14 - Add random_strong_prime. - Fix builds with Solaris 9 and older. - Add some debug info to perhaps find out why old ActiveState Perls are dying in Math::BigInt::Calc, as if they were using really old versions that run out of memory trying to calculate '2 ** 66'. http://code.activestate.com/ppm/Math-Prime-Util/ 0.17 2012-12-20 - Perl 5.8.1 - 5.8.7 miscalculates 12345 ** 4, which I used in a test. - Fix (hopefully) for MSC compilation. - Unroll sieve loop for another 20% or so speedup. It won't have much practical application now that we use Lehmer's method for counts, but there are some cases that can still show speedups. - Changed the rand functionality yet again. Sorry. This should give better support for plugging in crypto RNG's when used from other modules. 0.16 2012-12-11 - randbits >= 32 on some 32-bit systems was messing us up. Restrict our internal randbits to wordsize-1. 0.15 2012-12-09 [Enhancements to Ei, li, Zeta, R functions] - Native Zeta and R have slightly more accurate results. - For bignums, use Math::MPFR if possible. MUCH faster. Also allows extended precision while still being fast. - Better accuracy for standard bignums. - All four functions do: - XS if native input. - MPFR to whatever accuracy is desired, if Math::MPFR installed. - BigFloat versions if no MPFR and BigFloat input. - standard version if no MPFR and not a BigFloat. [Other Changes] - Add tests for primorial, jordan_totient, and divisor_sum. - Revamp of the random_prime internals. Also fixes some issues with random n-bit and maurer primes. - The random prime and primorial functions now will return a Math::BigInt object if the result is greater than the native size. This includes loading up the Math::BigInt library if necessary. 0.14 2012-11-29 [Compilation / Test Issues] - Fix compilation on NetBSD - Try to fix compilation on Win32 + MSVC - Speed up some testing, helps a lot with Cygwin on slow machines - Speed up a lot of slow PP areas, especially used by test suite [Functions Added] - jordan_totient generalization of Euler Totient - divisor_sum run coderef for every divisor [Other Changes] - XS AKS extended from half-word to full-word. - Allow environment variables MPU_NO_XS and MPU_NO_GMP to turn off XS and GMP support respectively if they are defined and equal to 1. - Lehmer prime count for Pure Perl code, including use in nth_prime. prime count 10^9 using sieve: 71.9s PP sieve 0.47s XS sieve prime count 10^9 using Lehmer: 0.70s PP lehmer 0.03s XS lehmer - Moved bignum Zeta and R to separate file, only loaded when needed. Helpful to get the big rarely-used tables out of the main loading. - Quote arguments to Math::Big{Int,Float} in a few places it wasn't. Math::Big* coerces the input to a signed value if it isn't a string, which causes us all sorts of grief. 0.13 2012-11-19 - Fix an issue with prime count, and make prime count available as a standalone program using primesieve. 0.12 2012-11-17 [Programs Added] - bin/primes.pl - bin/factor.pl [Functions Added] - primorial product of primes <= n - pn_primorial product of first n primes - prime_set_config set config options - RiemannZeta export and make accurate for small reals - is_provable_prime prove primes after BPSW - is_aks_prime prove prime via AKS [Other Changes] - Add 'assume_rh' configuration option (default: false) which can be set to allow functions to assume the Riemann Hypothesis. - Use the Schoenfeld bound for Pi(x) (x large) if assume_rh is true. - valgrind testing - Use long doubles for math functions. - Some fixes and speedups for ranged primes(). - In the PP code, use 2 MR bases for more numbers when possible. - Fixup of racing SQUFOF, and switch to use it in factor(). - Complete rewrite of XS p-1 factor routine, includes second stage. - bug fix for prime_count on edge of cache. - prime_count will use Lehmer prime counting algorithm for largish sizes (above 4 million). This is MUCH faster than sieving. - nth_prime now uses the fast Lehmer prime count below the lower limit, then sieves up from there. This makes a big speed difference for inputs over 10^6 or so -- over 100x faster for 10^9 and up. 0.11 2012-07-23 - Turn off threading tests on Cygwin, as threads on some Cygwin platforms give random panics (my Win7 64-bit works fine, XP 32-bit does not). - Use pow instead of exp2 -- some systems don't have exp2. - Fix compile issues on MSC, thanks to Sisyphus. - some bigint/bignum changes (next_prime and math functions). - speed up and enhance some tests. - Test version of racing SQUFOF (not used in main code yet). Also add a little more up-front trial division for main factor routine. 0.10 2012-07-16 - full bigint support for everything. Use '-nobigint' as an import to shortcut straight to XS for better speed on some of the very fast functions. This involved moving a lot of functions into Util.pm. - added BPSW primality test for large (>2^64) is_prob_prime and is_prime. - Add tests for pp and bignum, cleanup of many tests. - New bounds for prime_count and nth_prime. Dusart 2010 for larger values, tuned nth_prime_upper for small values. Much tighter. [Functions Added] - prime_get_config to get configuration options - is_strong_pseudoprime better name for miller_rabin - is_strong_lucas_pseudoprime strong lucas-selfridge psp test - random_nbit_prime for n-bit primes - random_maurer_prime provable n-bit primes - moebius Mo:bius function - euler_phi Euler's phi aka totient [Minor Changes] - Make miller_rabin return 0 if given even number. - The XS miller_rabin code now works with large base > n. - factor always returns sorted results - miller_rabin() deprecated. Use is_strong_pseudoprime instead. [Support all functionality of:] - Math::Prime::XS (MPU: more functions, a bit faster) - Math::Prime::FastSieve (MPU: more functions, a bit faster) - Math::Prime::TiedArray (MPU: a *lot* faster) - Math::Factor::XS (MPU: bignums, faster, missing multiplicity) - Math::Big::Factors (MPU: orders of magnitude faster) - Math::Primality (MPU: more portable, fast native, slow bigint) (MPU+MPU::GMP: faster) - Crypt::Primes (MPU: more portable, slower & no fancy options) [Support some functionality of:] - Math::Big (MPU's primes is *much* faster) - Bit::Vector (MPU's primes is ~10x faster) 0.09 2012-06-25 - Pure Perl code added. Passes all tests. Used only if the XSLoader fails. It's 1-120x slower than the C code. When forced to use the PP code, the test suite is 38x slower on 64-bit, 16x slower on 32-bit (in 64-bit, the test suite runs some large numbers through routines like prime_count and nth_prime that are much faster in C). - Modifications to threading test: - some machines were failing because they use non-TS rand. Fix by making our own rand. - Win32 was failing because of unique threading issues. It barfs if you free memory on a different thread than allocated it. - is_prime could return 1 in some cases. Fixed to only return 0 or 2. 0.08 2012-06-22 - Added thread safety and tested good concurrency. - Accuracy improvement and measurements for math functions. - Remove simple sieve -- it wasn't being used, and was just around for performance comparisons. - Static presieve for 7, 11, and 13. 1k of ROM used for prefilling sieve memory, meaning we can skip the 7, 11, and 13 loops. ~15% speedup. - Add all_factors function and added tests to t/50-factoring.t. - Add tied array module Math::Prime::Util::PrimeArray. - 5.6.2 64-bit now disables the 64-bit factoring tests instead of failing the module. The main issue is that we can't verify the factors since Perl can't properly multiply them. 0.07 2012-06-17 - Fixed a bug in next_prime found by Lou Godio (thank you VERY much!). Added more tests for this. This had been changed in another area but hadn't been brought into next_prime. 0.06 2012-06-14 - Change to New/Safefree from malloc. Oops. 0.05 2012-06-11 - Speed up mulmod: asm for GCC + x86_64, native 64-bit for 32-bit Perl is uint64_t is available, and range tests for others. This speeds up some of the factoring as well as Miller-Rabin, which in turn speeds up is_prime. is_prime is used quite commonly, so this is good. - nth_prime routines should now all croak on overflow in the same way. - Segmented prime_count, things like this are reasonably efficient: say prime_count( 10**16, 10**16 + 2**20 ) - Add Ei(x), li(x), and R(x) functions. - prime_count_approx uses R(x), making it vastly more accurate. - Let user override rand for random_prime. - Add many more tests with the help of Devel::Cover. 0.04 2012-06-07 - Didn't do tests on 32-bit machine before release. Test suite caught problem with next_prime overflow. - Try to use 64-bit modulo math even when Perl is 32-bit. It can make is_prime run up to 10x faster (which impacts next_prime, factoring, etc.) - replace all assert with croak indicating an internal error. - Add random_prime and random_ndigit_prime - renamed prime_free to prime_memfree. 0.03 2012-06-06 - Speed up factoring. - fixed powmod routine, speedup for smaller numbers - Add Miller-Rabin and deterministic probable prime functions. These are now used for is_prime and factoring, giving a big speedup for numbers > 32-bit. - Add HOLF factoring (just for demo) - Next prime returns 0 on overflow 0.02 2012-06-05 - Back off new_ok to new/isa_ok to keep Test::More requirements low. - Some documentation updates. - I accidently used long in SQUFOF, which breaks LLP64. - Test for broken 64-bit Perl. - Fix overflow issues in segmented sieving. - Switch to using UVuf for croaks. What I should have done all along. - prime_count uses a segment sieve with 256k chunks (~7.9M numbers). Not memory intensive any more, and faster for large inputs. The time growth is slightly over linear however, so expect to wait a long time for 10^12 or more. - nth_prime also transitioned to segmented sieve. 0.01 2012-06-04 - Initial release Math-Prime-Util-0.37/util.h0000644000076400007640000001447312270242116014055 0ustar danadana#ifndef MPU_UTIL_H #define MPU_UTIL_H #include "ptypes.h" extern int _XS_get_verbose(void); extern void _XS_set_verbose(int v); extern int _XS_get_callgmp(void); extern void _XS_set_callgmp(int v); extern int _XS_is_prime(UV x); extern UV next_prime(UV x); extern UV prev_prime(UV x); extern UV _XS_prime_count(UV low, UV high); extern UV nth_prime(UV x); extern UV nth_prime_upper(UV x); extern UV nth_prime_lower(UV x); extern UV nth_prime_approx(UV x); extern UV prime_count_lower(UV x); extern UV prime_count_upper(UV x); extern UV prime_count_approx(UV x); extern signed char* _moebius_range(UV low, UV high); extern UV* _totient_range(UV low, UV high); extern IV mertens(UV n); extern long double chebyshev_function(UV n, int which); /* 0 = theta, 1 = psi */ extern long double _XS_ExponentialIntegral(long double x); extern long double _XS_LogarithmicIntegral(long double x); extern long double ld_riemann_zeta(long double x); extern long double _XS_RiemannR(long double x); extern UV _XS_Inverse_Li(UV x); extern int kronecker_uu(UV a, UV b); extern int kronecker_su(IV a, UV b); extern int kronecker_ss(IV a, IV b); extern UV modinverse(UV a, UV p); /* Returns 1/a mod p */ extern UV divmod(UV a, UV b, UV n); /* Returns a/b mod n */ extern UV totient(UV n); extern int moebius(UV n); extern UV exp_mangoldt(UV n); extern UV carmichael_lambda(UV n); extern UV jordan_totient(UV k, UV n); extern UV znprimroot(UV n); extern UV znorder(UV a, UV n); extern UV znlog(UV a, UV g, UV p); #if defined(FUNC_isqrt) static UV isqrt(UV n) { UV root; #if BITS_PER_WORD == 32 if (n >= UVCONST(4294836225)) return UVCONST(65535); #else if (n >= UVCONST(18446744065119617025)) return UVCONST(4294967295); #endif root = (UV) sqrt((double)n); while (root*root > n) root--; while ((root+1)*(root+1) <= n) root++; return root; } #endif #ifdef FUNC_icbrt static UV icbrt(UV n) { UV b, root = 0; #if BITS_PER_WORD == 32 int s = 30; if (n >= UVCONST(4291015625)) return UVCONST(1625); #else int s = 63; if (n >= UVCONST(18446724184312856125)) return UVCONST(2642245); #endif for ( ; s >= 0; s -= 3) { root += root; b = 3*root*(root+1)+1; if ((n >> s) >= b) { n -= b << s; root++; } } return root; } #endif #if defined(FUNC_gcd_ui) || defined(FUNC_lcm_ui) static UV gcd_ui(UV x, UV y) { UV t; if (y < x) { t = x; x = y; y = t; } while (y > 0) { t = y; y = x % y; x = t; /* y1 <- x0 % y0 ; x1 <- y0 */ } return x; } #endif #ifdef FUNC_lcm_ui static UV lcm_ui(UV x, UV y) { /* Can overflow if lcm(x,y) > 2^64 (e.g. two primes each > 2^32) */ return x * (y / gcd_ui(x,y)); } #endif #ifdef FUNC_is_perfect_square /* See: http://mersenneforum.org/showpost.php?p=110896 */ static int is_perfect_square(UV n) { UV m; m = n & 127; if ((m*0x8bc40d7d) & (m*0xa1e2f5d1) & 0x14020a) return 0; /* If your sqrt is particularly slow, this cuts out another 80%: m = n % 63; if ((m*0x3d491df7) & (m*0xc824a9f9) & 0x10f14008) return 0; and this cuts out some more: m = n % 25; if ((m*0x1929fc1b) & (m*0x4c9ea3b2) & 0x51001005) return 0; */ m = (UV) ( sqrt((double) n) + 0.5 ); return m*m == n; } #endif #if defined(FUNC_clz) || defined(FUNC_ctz) || defined(FUNC_log2floor) /* log2floor(n) gives the location of the first set bit (starting from left) * ctz(n) gives the number of times n is divisible by 2 * clz(n) gives the number of zeros on the left */ #if defined(__GNUC__) #if BITS_PER_WORD == 64 #define ctz(n) ((n) ? __builtin_ctzll(n) : 64) #define clz(n) ((n) ? __builtin_clzll(n) : 64) #define log2floor(n) ((n) ? 63-__builtin_clzll(n) : 0) #else #define ctz(n) ((n) ? __builtin_ctzl(n) : 32) #define clz(n) ((n) ? __builtin_clzl(n) : 32) #define log2floor(n) ((n) ? 31-__builtin_clzl(n) : 0) #endif /* For MSC, we need to use _BitScanForward and _BitScanReverse. The way to * get to them has changed, so we're going to only use them on new systems. * The performance of these functions are not super critical. * What is: popcnt, mulmod, and muladd. */ #elif defined (_MSC_VER) && _MSC_VER >= 1400 #include #ifdef FUNC_ctz static int ctz(UV n) { UV tz = 0; #if BITS_PER_WORD == 64 if (_BitScanForward64(&tz, n)) return tz; else return 64; #else if (_BitScanForward(&tz, n)) return tz; else return 32; #endif } #endif #if defined(FUNC_clz) || defined(FUNC_log2floor) static int log2floor(UV n) { UV lz = 0; #if BITS_PER_WORD == 64 if (_BitScanReverse64(&lz, n)) return lz; else return 0; #else if (_BitScanReverse(&lz, n)) return lz; else return 0; #endif } #endif #elif BITS_PER_WORD == 64 static const unsigned char _debruijn64[64] = { 63, 0,58, 1,59,47,53, 2, 60,39,48,27,54,33,42, 3, 61,51,37,40,49,18,28,20, 55,30,34,11,43,14,22, 4, 62,57,46,52,38,26,32,41, 50,36,17,19,29,10,13,21, 56,45,25,31,35,16, 9,12, 44,24,15, 8,23, 7, 6, 5 }; #ifdef FUNC_ctz static unsigned int ctz(UV n) { return n ? _debruijn64[((n & -n)*UVCONST(0x07EDD5E59A4E28C2)) >> 58] : 64; } #endif #if defined(FUNC_clz) || defined(FUNC_log2floor) static unsigned int log2floor(UV n) { if (n == 0) return 0; n |= n >> 1; n |= n >> 2; n |= n >> 4; n |= n >> 8; n |= n >> 16; n |= n >> 32; return _debruijn64[((n-(n>>1))*UVCONST(0x07EDD5E59A4E28C2)) >> 58]; } #endif #else #ifdef FUNC_ctz static const unsigned char _trail_debruijn32[32] = { 0, 1,28, 2,29,14,24, 3,30,22,20,15,25,17, 4, 8, 31,27,13,23,21,19,16, 7,26,12,18, 6,11, 5,10, 9 }; static unsigned int ctz(UV n) { return n ? _trail_debruijn32[((n & -n) * UVCONST(0x077CB531)) >> 27] : 32; } #endif #if defined(FUNC_clz) || defined(FUNC_log2floor) static const unsigned char _lead_debruijn32[32] = { 0, 9, 1, 10, 13, 21, 2, 29, 11, 14, 16, 18, 22, 25, 3, 30, 8, 12, 20, 28, 15, 17, 24, 7, 19, 27, 23, 6, 26, 5, 4, 31 }; static unsigned int log2floor(UV n) { if (n == 0) return 0; n |= n >> 1; n |= n >> 2; n |= n >> 4; n |= n >> 8; n |= n >> 16; return _lead_debruijn32[(n * UVCONST(0x07C4ACDD)) >> 27]; } #endif #endif #if defined(FUNC_clz) && !defined(clz) #define clz(n) ( (n) ? BITS_PER_WORD-1-log2floor(n) : BITS_PER_WORD ) #endif #endif /* End of log2floor, clz, and ctz */ #endif Math-Prime-Util-0.37/primality.h0000644000076400007640000000125012270242116015077 0ustar danadana#ifndef MPU_PRIMALITY_H #define MPU_PRIMALITY_H #include "ptypes.h" #if BITS_PER_WORD == 64 && HAVE_STD_U64 && defined(__GNUC__) && defined(__x86_64__) #define USE_MONT_PRIMALITY 1 #else #define USE_MONT_PRIMALITY 0 #endif extern int _XS_is_pseudoprime(UV const n, UV a); extern int _XS_miller_rabin(UV const n, const UV *bases, int nbases); extern void lucas_seq(UV* U, UV* V, UV* Qk, UV n, IV P, IV Q, UV k); extern int _XS_is_lucas_pseudoprime(UV n, int strength); extern int _XS_is_frobenius_underwood_pseudoprime(UV n); extern int _XS_is_almost_extra_strong_lucas_pseudoprime(UV n, UV increment); extern int _XS_BPSW(UV const n); extern int is_prob_prime(UV n); #endif Math-Prime-Util-0.37/constants.h0000644000076400007640000000123212270242116015101 0ustar danadana#ifndef MPU_CONSTANTS_H #define MPU_CONSTANTS_H #include "EXTERN.h" #include "perl.h" #if BITS_PER_WORD == 32 #define MPU_MAX_PRIME UVCONST(4294967291) #define MPU_MAX_PRIME_IDX UVCONST(203280221) #else #define MPU_MAX_PRIME UVCONST(18446744073709551557) #define MPU_MAX_PRIME_IDX UVCONST(425656284035217743) #endif /****************************************************************************/ /* Configuration */ /* To avoid thrashing, sieve a little farther than needed */ #define _MPU_FILL_EXTRA_N (128*30) /* The initial cache size. 30k primes per 1k of cache. */ #define _MPU_INITIAL_CACHE_SIZE ((4096-16)*30 - _MPU_FILL_EXTRA_N) #endif Math-Prime-Util-0.37/factor.c0000644000076400007640000006445212270624726014366 0ustar danadana#include #include #include #include #include "ptypes.h" #include "factor.h" #include "sieve.h" #include "mulmod.h" #include "cache.h" #include "primality.h" #define FUNC_isqrt 1 #define FUNC_gcd_ui 1 #define FUNC_is_perfect_square 1 #define FUNC_clz 1 #include "util.h" /* factor will do trial division through this prime index, must be in table */ #define TRIAL_TO_PRIME 84 /* * You need to remember to use UV for unsigned and IV for signed types that * are large enough to hold our data. * If you use int, that's 32-bit on LP64 and LLP64 machines. You lose. * If you use long, that's 32-bit on LLP64 machines. You lose. * If you use long long, you may be too large which isn't so bad, but some * compilers may not understand the type at all. * perl.h already figured all this out, and provided us with these types which * match the native integer type used inside our Perl, so just use those. */ static const unsigned short primes_small[] = {0,2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97, 101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191, 193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283, 293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401, 409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,509, 521,523,541,547,557,563,569,571,577,587,593,599,601,607,613,617,619,631, 641,643,647,653,659,661,673,677,683,691,701,709,719,727,733,739,743,751, 757,761,769,773,787,797,809,811,821,823,827,829,839,853,857,859,863,877, 881,883,887,907,911,919,929,937,941,947,953,967,971,977,983,991,997,1009, 1013,1019,1021,1031,1033,1039,1049,1051,1061,1063,1069,1087,1091,1093, 1097,1103,1109,1117,1123,1129,1151,1153,1163,1171,1181,1187,1193,1201, 1213,1217,1223,1229,1231,1237,1249,1259,1277,1279,1283,1289,1291,1297, 1301,1303,1307,1319,1321,1327,1361,1367,1373,1381,1399,1409,1423,1427, 1429,1433,1439,1447,1451,1453,1459,1471,1481,1483,1487,1489,1493,1499, 1511,1523,1531,1543,1549,1553,1559,1567,1571,1579,1583,1597,1601,1607, 1609,1613,1619,1621,1627,1637,1657,1663,1667,1669,1693,1697,1699,1709, 1721,1723,1733,1741,1747,1753,1759,1777,1783,1787,1789,1801,1811,1823, 1831,1847,1861,1867,1871,1873,1877,1879,1889,1901,1907,1913,1931,1933, 1949,1951,1973,1979,1987,1993,1997,1999,2003,2011}; #define NPRIMES_SMALL (sizeof(primes_small)/sizeof(primes_small[0])) /* The main factoring loop */ /* Puts factors in factors[] and returns the number found. */ int factor(UV n, UV *factors) { int nfactors = 0; /* Number of factored in factors result */ UV f = 7; if (n > 1) { while ( (n & 1) == 0 ) { factors[nfactors++] = 2; n /= 2; } while ( (n % 3) == 0 ) { factors[nfactors++] = 3; n /= 3; } while ( (n % 5) == 0 ) { factors[nfactors++] = 5; n /= 5; } if (f*f <= n) { UV sp = 3; while (++sp < TRIAL_TO_PRIME) { f = primes_small[sp]; if (f*f > n) break; while ( (n%f) == 0 ) { factors[nfactors++] = f; n /= f; } } } } if (n < f*f) { if (n != 1) factors[nfactors++] = n; return nfactors; } { UV tofac_stack[MPU_MAX_FACTORS+1]; int i, j, ntofac = 0; int nsmallfactors = nfactors; int const verbose = _XS_get_verbose(); /* loop over each remaining factor, until ntofac == 0 */ do { //while ( (n >= f*f) && (!_XS_is_prime(n)) ) { while ( (n >= f*f) && (!is_prob_prime(n)) ) { int split_success = 0; /* Adjust the number of rounds based on the number size */ UV const br_rounds = ((n>>29) < 100000) ? 1500 : 4000; UV const sq_rounds =100000; /* 20k 91%, 40k 98%, 80k 99.9%, 120k 99.99% */ /* 99.7% of 32-bit, 94% of 64-bit random inputs factored here */ if (!split_success) { split_success = pbrent_factor(n, tofac_stack+ntofac, br_rounds, 3)-1; if (verbose) { if (split_success) printf("pbrent 1: %"UVuf" %"UVuf"\n", tofac_stack[ntofac], tofac_stack[ntofac+1]); else printf("pbrent 0\n"); } } /* SQUFOF with these parameters gets 99.9% of everything left */ if (!split_success && n < (UV_MAX>>2)) { split_success = squfof_factor(n,tofac_stack+ntofac, sq_rounds)-1; if (verbose) printf("squfof %d\n", split_success); } /* At this point we should only have 16+ digit semiprimes. */ if (!split_success) { split_success = pminus1_factor(n, tofac_stack+ntofac, 8000, 120000)-1; if (verbose) printf("pminus1 %d\n", split_success); /* Get the stragglers */ if (!split_success) { split_success = prho_factor(n, tofac_stack+ntofac, 120000)-1; if (verbose) printf("long prho %d\n", split_success); if (!split_success) { split_success = pbrent_factor(n, tofac_stack+ntofac, 500000, 7)-1; if (verbose) printf("long pbrent %d\n", split_success); } } } if (split_success) { MPUassert( split_success == 1, "split factor returned more than 2 factors"); ntofac++; /* Leave one on the to-be-factored stack */ if ((tofac_stack[ntofac] == n) || (tofac_stack[ntofac] == 1)) croak("bad factor\n"); n = tofac_stack[ntofac]; /* Set n to the other one */ } else { /* Factor via trial division. Nothing should ever get here. */ UV m = f % 30; UV limit = isqrt(n); if (verbose) printf("doing trial on %"UVuf"\n", n); while (f <= limit) { if ( (n%f) == 0 ) { do { n /= f; factors[nfactors++] = f; } while ( (n%f) == 0 ); limit = isqrt(n); } f += wheeladvance30[m]; m = nextwheel30[m]; } break; /* We just factored n via trial division. Exit loop. */ } } /* n is now prime (or 1), so add to already-factored stack */ if (n != 1) factors[nfactors++] = n; /* Pop the next number off the to-factor stack */ if (ntofac > 0) n = tofac_stack[ntofac-1]; } while (ntofac-- > 0); /* Sort the non-small factors */ for (i = nsmallfactors+1; i < nfactors; i++) { UV f = factors[i]; for (j = i; j > 0 && factors[j-1] > f; j--) factors[j] = factors[j-1]; factors[j] = f; } } return nfactors; } int factor_exp(UV n, UV *factors, UV* exponents) { int i, j, nfactors; if (n == 1) return 0; /* MPUassert(factors != 0, "factors array is null"); */ nfactors = factor(n, factors); if (exponents == 0) { for (i = 1, j = 1; i < nfactors; i++) if (factors[i] != factors[i-1]) factors[j++] = factors[i]; } else { exponents[0] = 1; for (i = 1, j = 1; i < nfactors; i++) { if (factors[i] != factors[i-1]) { exponents[j] = 1; factors[j++] = factors[i]; } else { exponents[j-1]++; } } } return j; } int trial_factor(UV n, UV *factors, UV maxtrial) { int nfactors = 0; if (maxtrial == 0) maxtrial = UV_MAX; /* Cover the cases 0/1/2/3 now */ if (n < 4 || maxtrial < 2) { factors[0] = n; return (n == 1) ? 0 : 1; } /* Trial division for 2, 3, 5 immediately */ while ( (n & 1) == 0 ) { factors[nfactors++] = 2; n /= 2; } if (3<=maxtrial) while ( (n % 3) == 0 ) { factors[nfactors++] = 3; n /= 3; } if (5<=maxtrial) while ( (n % 5) == 0 ) { factors[nfactors++] = 5; n /= 5; } if (7*7 <= n) { UV f, sp = 3; while (++sp < NPRIMES_SMALL) { f = primes_small[sp]; if (f*f > n || f > maxtrial) break; while ( (n%f) == 0 ) { factors[nfactors++] = f; n /= f; } } /* Trial division using a mod-30 wheel for larger values */ if (f*f <= n && f <= maxtrial) { UV m, newlimit, limit = isqrt(n); if (limit > maxtrial) limit = maxtrial; m = f % 30; while (f <= limit) { if ( (n%f) == 0 ) { do { factors[nfactors++] = f; n /= f; } while ( (n%f) == 0 ); newlimit = isqrt(n); if (newlimit < limit) limit = newlimit; } f += wheeladvance30[m]; m = nextwheel30[m]; } } } /* All done! */ if (n != 1) factors[nfactors++] = n; return nfactors; } static int _divisors_from_factors(UV v, UV npe, UV* fp, UV* fe, UV* res) { UV p, e, i; if (npe == 0) return 0; p = *fp++; e = *fe++; if (npe == 1) { for (i = 0; i <= e; i++) { *res++ = v; v *= p; } return e+1; } else { int nret = 0;; for (i = 0; i <= e; i++) { int nres = _divisors_from_factors(v, npe-1, fp, fe, res); v *= p; res += nres; nret += nres; } return nret; } } UV* _divisor_list(UV n, UV *num_divisors) { UV factors[MPU_MAX_FACTORS+1]; UV exponents[MPU_MAX_FACTORS+1]; UV* divs; int i, j, nfactors, ndivisors; if (n <= 1) { New(0, divs, 2, UV); if (n == 0) { divs[0] = 0; divs[1] = 1; *num_divisors = 2; } if (n == 1) { divs[0] = 1; *num_divisors = 1; } return divs; } /* Factor and convert to factor/exponent pair */ nfactors = factor_exp(n, factors, exponents); /* Calculate number of divisors, allocate space, fill with divisors */ ndivisors = exponents[0] + 1; for (i = 1; i < nfactors; i++) ndivisors *= (exponents[i] + 1); New(0, divs, ndivisors, UV); (void) _divisors_from_factors(1, nfactors, factors, exponents, divs); { /* Sort (Shell sort is easy and efficient) */ static int gaps[] = {301, 132, 57, 23, 10, 4, 1, 0}; int gap, gapi = 0; for (gap = gaps[gapi]; gap > 0; gap = gaps[++gapi]) { for (i = gap; i < ndivisors; i++) { UV v = divs[i]; for (j = i; j >= gap && divs[j-gap] > v; j -= gap) divs[j] = divs[j-gap]; divs[j] = v; } } } *num_divisors = ndivisors; return divs; } /* The usual method, on OEIS for instance, is: * (p^(k*(e+1))-1) / (p^k-1) * but that overflows quicky. Instead we rearrange as: * 1 + p^k + p^k^2 + ... p^k^e * Return 0 if the result overflowed. */ static const UV sigma_overflow[5] = #if BITS_PER_WORD == 64 {UVCONST(3000000000000000000),UVCONST(3000000000),2487240,64260,7026}; #else {UVCONST( 845404560), 52560, 1548, 252, 84}; #endif UV divisor_sum(UV n, UV k) { UV factors[MPU_MAX_FACTORS+1]; int nfac, i, j; UV product = 1; if (k > 5 || (k > 0 && n >= sigma_overflow[k-1])) return 0; if (n <= 1) /* n=0 divisors are [0,1] */ return (n == 1) ? 1 : (k == 0) ? 2 : 1; /* n=1 divisors are [1] */ nfac = factor(n,factors); if (k == 0) { for (i = 0; i < nfac; i++) { UV e = 1, f = factors[i]; while (i+1 < nfac && f == factors[i+1]) { e++; i++; } product *= (e+1); } } else if (k == 1) { for (i = 0; i < nfac; i++) { UV f = factors[i]; UV pke = f, fmult = 1 + f; while (i+1 < nfac && f == factors[i+1]) { pke *= f; fmult += pke; i++; } product *= fmult; } } else { for (i = 0; i < nfac; i++) { UV f = factors[i]; UV fmult, pke, pk = f; for (j = 1; j < (int)k; j++) pk *= f; fmult = 1 + pk; pke = pk; while (i+1 < nfac && f == factors[i+1]) { pke *= pk; fmult += pke; i++; } product *= fmult; } } return product; } /* Knuth volume 2, algorithm C. * Very fast for small numbers, grows rapidly. * SQUFOF is better for numbers nearing the 64-bit limit. */ int fermat_factor(UV n, UV *factors, UV rounds) { IV sqn, x, y, r; MPUassert( (n >= 3) && ((n%2) != 0) , "bad n in fermat_factor"); sqn = isqrt(n); x = 2 * sqn + 1; y = 1; r = (sqn*sqn) - n; while (r != 0) { if (rounds-- == 0) { factors[0] = n; return 1; } r += x; x += 2; do { r -= y; y += 2; } while (r > 0); } r = (x-y)/2; if ( (r != 1) && ((UV)r != n) ) { factors[0] = r; factors[1] = n/r; MPUassert( factors[0] * factors[1] == n , "incorrect factoring"); return 2; } factors[0] = n; return 1; } /* Hart's One Line Factorization. * Missing premult (hard to do in native precision without overflow) */ int holf_factor(UV n, UV *factors, UV rounds) { UV i, s, m, f; MPUassert( (n >= 3) && ((n%2) != 0) , "bad n in holf_factor"); for (i = 1; i <= rounds; i++) { s = (UV) sqrt( (double)n * (double)i ); /* Assume s^2 isn't a perfect square. We're rapidly losing precision * so we won't be able to accurately detect it anyway. */ s++; /* s = ceil(sqrt(n*i)) */ m = sqrmod(s, n); if (is_perfect_square(m)) { f = isqrt(m); f = gcd_ui( (s>f) ? s-f : f-s, n); /* This should always succeed, but with overflow concerns.... */ if ((f == 1) || (f == n)) break; factors[0] = f; factors[1] = n/f; MPUassert( factors[0] * factors[1] == n , "incorrect factoring"); return 2; } } factors[0] = n; return 1; } /* Pollard / Brent. Brent's modifications to Pollard's Rho. Maybe faster. */ int pbrent_factor(UV n, UV *factors, UV rounds, UV a) { UV f, m, r; UV Xi = 2; UV Xm = 2; const UV inner = 64; MPUassert( (n >= 3) && ((n%2) != 0) , "bad n in pbrent_factor"); r = 1; while (rounds > 0) { UV rleft = (r > rounds) ? rounds : r; UV saveXi; /* Do rleft rounds, inner at a time */ while (rleft > 0) { UV dorounds = (rleft > inner) ? inner : rleft; saveXi = Xi; rleft -= dorounds; rounds -= dorounds; Xi = sqraddmod(Xi, a, n); /* First iteration, no mulmod needed */ m = (Xi>Xm) ? Xi-Xm : Xm-Xi; while (--dorounds > 0) { /* Now do inner-1=63 more iterations */ Xi = sqraddmod(Xi, a, n); f = (Xi>Xm) ? Xi-Xm : Xm-Xi; m = mulmod(m, f, n); } f = gcd_ui(m, n); if (f != 1) break; } /* If f == 1, then we didn't find a factor. Move on. */ if (f == 1) { r *= 2; Xm = Xi; continue; } if (f == n) { /* back up, with safety */ Xi = saveXi; do { Xi = sqraddmod(Xi, a, n); f = gcd_ui( (Xi>Xm) ? Xi-Xm : Xm-Xi, n); } while (f == 1 && r-- != 0); if ( (f == 1) || (f == n) ) break; } factors[0] = f; factors[1] = n/f; MPUassert( factors[0] * factors[1] == n , "incorrect factoring"); return 2; } factors[0] = n; return 1; } /* Pollard's Rho. */ int prho_factor(UV n, UV *factors, UV rounds) { UV a, f, i, m, oldU, oldV; const UV inner = 64; UV U = 7; UV V = 7; MPUassert( (n >= 3) && ((n%2) != 0) , "bad n in prho_factor"); /* We could just as well say a = 1 */ switch (n%8) { case 1: a = 1; break; case 3: a = 2; break; case 5: a = 3; break; case 7: a = 5; break; default: a = 7; break; } rounds = (rounds + inner - 1) / inner; while (rounds-- > 0) { m = 1; oldU = U; oldV = V; for (i = 0; i < inner; i++) { U = sqraddmod(U, a, n); V = sqraddmod(V, a, n); V = sqraddmod(V, a, n); f = (U > V) ? U-V : V-U; m = mulmod(m, f, n); } f = gcd_ui(m, n); if (f == 1) continue; if (f == n) { /* back up to find a factor*/ U = oldU; V = oldV; i = inner; do { U = sqraddmod(U, a, n); V = sqraddmod(V, a, n); V = sqraddmod(V, a, n); f = gcd_ui( (U > V) ? U-V : V-U, n); } while (f == 1 && i-- != 0); if ( (f == 1) || (f == n) ) break; } factors[0] = f; factors[1] = n/f; MPUassert( factors[0] * factors[1] == n , "incorrect factoring"); return 2; } factors[0] = n; return 1; } /* Pollard's P-1 */ int pminus1_factor(UV n, UV *factors, UV B1, UV B2) { UV f; UV q = 2; UV a = 2; UV savea = 2; UV saveq = 2; UV j = 1; UV sqrtB1 = isqrt(B1); MPUassert( (n >= 3) && ((n%2) != 0) , "bad n in pminus1_factor"); START_DO_FOR_EACH_PRIME(2, sqrtB1) { UV k = p*p; UV kmin = B1/p; while (k <= kmin) k *= p; a = powmod(a, k, n); q = p; } END_DO_FOR_EACH_PRIME if (a == 0) { factors[0] = n; return 1; } f = gcd_ui(a-1, n); if (f == 1) { savea = a; saveq = q; START_DO_FOR_EACH_PRIME(q+1, B1) { q = p; a = powmod(a, q, n); if ( (j++ % 32) == 0) { if (a == 0 || gcd_ui(a-1, n) != 1) break; savea = a; saveq = q; } } END_DO_FOR_EACH_PRIME if (a == 0) { factors[0] = n; return 1; } f = gcd_ui(a-1, n); } /* If we found more than one factor in stage 1, backup and single step */ if (f == n) { a = savea; START_DO_FOR_EACH_PRIME(saveq, B1) { UV k = p; UV kmin = B1/p; while (k <= kmin) k *= p; a = powmod(a, k, n); f = gcd_ui(a-1, n); q = p; if (f != 1) break; } END_DO_FOR_EACH_PRIME /* If f == n again, we could do: * for (savea = 3; f == n && savea < 100; savea = next_prime(savea)) { * a = savea; * for (q = 2; q <= B1; q = next_prime(q)) { * ... * } * } * but this could be a huge time sink if B1 is large, so just fail. */ } /* STAGE 2 */ if (f == 1 && B2 > B1) { UV bm = a; UV b = 1; UV bmdiff; UV precomp_bm[111] = {0}; /* Enough for B2 = 189M */ /* calculate (a^q)^2, (a^q)^4, etc. */ bmdiff = sqrmod(bm, n); precomp_bm[0] = bmdiff; for (j = 1; j < 20; j++) { bmdiff = mulmod(bmdiff,bm,n); bmdiff = mulmod(bmdiff,bm,n); precomp_bm[j] = bmdiff; } a = powmod(a, q, n); j = 1; START_DO_FOR_EACH_PRIME( q+1, B2 ) { UV lastq = q; UV qdiff; q = p; /* compute a^q = a^lastq * a^(q-lastq) */ qdiff = (q - lastq) / 2 - 1; if (qdiff >= 111) { bmdiff = powmod(bm, q-lastq, n); /* Big gap */ } else { bmdiff = precomp_bm[qdiff]; if (bmdiff == 0) { if (precomp_bm[qdiff-1] != 0) bmdiff = mulmod(mulmod(precomp_bm[qdiff-1],bm,n),bm,n); else bmdiff = powmod(bm, q-lastq, n); precomp_bm[qdiff] = bmdiff; } } a = mulmod(a, bmdiff, n); if (a == 0) break; b = mulmod(b, a-1, n); /* if b == 0, we found multiple factors */ if ( (j++ % 64) == 0 ) { f = gcd_ui(b, n); if (f != 1) break; } } END_DO_FOR_EACH_PRIME f = gcd_ui(b, n); } if ( (f != 1) && (f != n) ) { factors[0] = f; factors[1] = n/f; MPUassert( factors[0] * factors[1] == n , "incorrect factoring"); return 2; } factors[0] = n; return 1; } /* Simple Williams p+1 */ static void pp1_pow(UV *cX, UV exp, UV n) { UV X0 = *cX; UV X = *cX; UV Y = mulsubmod(X, X, 2, n); UV bit = UVCONST(1) << (clz(exp)-1); while (bit) { UV T = mulsubmod(X, Y, X0, n); if ( exp & bit ) { X = T; Y = mulsubmod(Y, Y, 2, n); } else { Y = T; X = mulsubmod(X, X, 2, n); } bit >>= 1; } *cX = X; } int pplus1_factor(UV n, UV *factors, UV B1) { UV X1, X2, f; UV sqrtB1 = isqrt(B1); MPUassert( (n >= 3) && ((n%2) != 0) , "bad n in pplus1_factor"); X1 = 7 % n; X2 = 11 % n; f = 1; START_DO_FOR_EACH_PRIME(2, B1) { UV k = p; if (p < sqrtB1) { UV kmin = B1/p; while (k <= kmin) k *= p; } pp1_pow(&X1, k, n); if (X1 != 2) { f = gcd_ui( submod(X1, 2, n) , n); if (f != 1 && f != n) break; } pp1_pow(&X2, k, n); if (X2 != 2) { f = gcd_ui( submod(X2, 2, n) , n); if (f != 1 && f != n) break; } } END_DO_FOR_EACH_PRIME if ( (f != 1) && (f != n) ) { factors[0] = f; factors[1] = n/f; MPUassert( factors[0] * factors[1] == n , "incorrect factoring"); return 2; } factors[0] = n; return 1; } /* SQUFOF, based on Ben Buhrow's racing version. */ typedef struct { int valid; UV P; UV bn; UV Qn; UV Q0; UV b0; UV it; UV imax; } mult_t; /* N < 2^63 (or 2^31). Returns 0 or a factor */ static UV squfof_unit(UV n, mult_t* mult_save) { UV imax,i,Q0,b0,Qn,bn,P,bbn,Ro,S,So,t1,t2; P = mult_save->P; bn = mult_save->bn; Qn = mult_save->Qn; Q0 = mult_save->Q0; b0 = mult_save->b0; i = mult_save->it; imax = i + mult_save->imax; #define SQUARE_SEARCH_ITERATION \ t1 = P; \ P = bn*Qn - P; \ t2 = Qn; \ Qn = Q0 + bn*(t1-P); \ Q0 = t2; \ bn = (b0 + P) / Qn; \ i++; while (1) { int j = 0; if (i & 0x1) { SQUARE_SEARCH_ITERATION; } /* i is now even */ while (1) { /* We need to know P, bn, Qn, Q0, iteration count, i from prev */ if (i >= imax) { /* save state and try another multiplier. */ mult_save->P = P; mult_save->bn = bn; mult_save->Qn = Qn; mult_save->Q0 = Q0; mult_save->it = i; return 0; } SQUARE_SEARCH_ITERATION; /* Even iteration. Check for square: Qn = S*S */ if (is_perfect_square(Qn)) break; /* Odd iteration. */ SQUARE_SEARCH_ITERATION; } S = isqrt(Qn); /* printf("found square %lu after %lu iterations with mult %d\n", Qn, i, mult_save->mult); */ /* Reduce to G0 */ Ro = P + S*((b0 - P)/S); t1 = Ro; So = (n - t1*t1)/S; bbn = (b0+Ro)/So; /* Search for symmetry point */ #define SYMMETRY_POINT_ITERATION \ t1 = Ro; \ Ro = bbn*So - Ro; \ t2 = So; \ So = S + bbn*(t1-Ro); \ S = t2; \ bbn = (b0+Ro)/So; \ if (Ro == t1) break; j = 0; while (1) { SYMMETRY_POINT_ITERATION; SYMMETRY_POINT_ITERATION; SYMMETRY_POINT_ITERATION; SYMMETRY_POINT_ITERATION; if (j++ > 2000000) { mult_save->valid = 0; return 0; } } t1 = gcd_ui(Ro, n); if (t1 > 1) return t1; } } /* Gower and Wagstaff 2008: * http://www.ams.org/journals/mcom/2008-77-261/S0025-5718-07-02010-8/ * Section 5.3. I've added some with 13,17,19. Sorted by F(). */ static const UV squfof_multipliers[] = /* { 3*5*7*11, 3*5*7, 3*5*11, 3*5, 3*7*11, 3*7, 5*7*11, 5*7, 3*11, 3, 5*11, 5, 7*11, 7, 11, 1 }; */ { 3*5*7*11, 3*5*7, 3*5*7*11*13, 3*5*7*13, 3*5*7*11*17, 3*5*11, 3*5*7*17, 3*5, 3*5*7*11*19, 3*5*11*13,3*5*7*19, 3*5*7*13*17, 3*5*13, 3*7*11, 3*7, 5*7*11, 3*7*13, 5*7, 3*5*17, 5*7*13, 3*5*19, 3*11, 3*7*17, 3, 3*11*13, 5*11, 3*7*19, 3*13, 5, 5*11*13, 5*7*19, 5*13, 7*11, 7, 3*17, 7*13, 11, 1 }; #define NSQUFOF_MULT (sizeof(squfof_multipliers)/sizeof(squfof_multipliers[0])) int squfof_factor(UV n, UV *factors, UV rounds) { const UV big2 = UV_MAX; mult_t mult_save[NSQUFOF_MULT]; int still_racing; UV i, nn64, mult, f64; UV rounds_done = 0; /* Caller should have handled these trivial cases */ MPUassert( (n >= 3) && ((n%2) != 0) , "bad n in squfof_factor"); /* Too big */ if (n > big2) { factors[0] = n; return 1; } for (i = 0; i < NSQUFOF_MULT; i++) mult_save[i].valid = -1; /* Process the multipliers a little at a time: 0.33*(n*mult)^1/4: 20-20k */ do { still_racing = 0; for (i = 0; i < NSQUFOF_MULT; i++) { if (mult_save[i].valid == 0) continue; mult = squfof_multipliers[i]; nn64 = n * mult; if (mult_save[i].valid == -1) { if ((big2 / mult) < n) { mult_save[i].valid = 0; /* This multiplier would overflow 64-bit */ continue; } mult_save[i].valid = 1; mult_save[i].b0 = isqrt(nn64); mult_save[i].imax = (UV) (sqrt(mult_save[i].b0) / 16); if (mult_save[i].imax < 20) mult_save[i].imax = 20; if (mult_save[i].imax > rounds) mult_save[i].imax = rounds; mult_save[i].Q0 = 1; mult_save[i].P = mult_save[i].b0; mult_save[i].Qn = nn64 - (mult_save[i].b0 * mult_save[i].b0); if (mult_save[i].Qn == 0) { factors[0] = mult_save[i].b0; factors[1] = n / mult_save[i].b0; MPUassert( factors[0] * factors[1] == n , "incorrect factoring"); return 2; } mult_save[i].bn = (mult_save[i].b0 + mult_save[i].P) / mult_save[i].Qn; mult_save[i].it = 0; } f64 = squfof_unit(nn64, &mult_save[i]); if (f64 > 1) { if (f64 != mult) { f64 /= gcd_ui(f64, mult); if (f64 != 1) { factors[0] = f64; factors[1] = n / f64; MPUassert( factors[0] * factors[1] == n , "incorrect factoring"); return 2; } } /* Found trivial factor. Quit working with this multiplier. */ mult_save[i].valid = 0; } if (mult_save[i].valid == 1) still_racing = 1; rounds_done += mult_save[i].imax; if (rounds_done >= rounds) break; } } while (still_racing && rounds_done < rounds); /* No factors found */ factors[0] = n; return 1; } UV dlp_trial(UV a, UV g, UV p, UV maxrounds) { UV t, k = 1; if (maxrounds > p) maxrounds = p; for (k = 1; k < maxrounds; k++) { t = powmod(g, k, p); if (t == a) return k; } return 0; } #define pollard_rho_cycle(u,v,w,p,n,a,g) \ switch (u % 3) { \ case 0: u = mulmod(u,u,p); v = mulmod(v,2,n); w = mulmod(w,2,n); break;\ case 1: u = mulmod(u,a,p); v = addmod(v,1,n); break;\ case 2: u = mulmod(u,g,p); w = addmod(w,1,n); break;\ } UV dlp_prho(UV a, UV g, UV p, UV maxrounds) { UV i; UV n = znorder(g, p); UV u=1, v=0, w=0; UV U=u, V=v, W=w; int const verbose = _XS_get_verbose(); if (verbose > 1 && n != p-1) printf("for g=%lu p=%lu, order is %lu\n", g, p, n); if (maxrounds > n) maxrounds = n; for (i = 1; i < maxrounds; i++) { pollard_rho_cycle(u,v,w,p,n,a,g); /* xi, ai, bi */ pollard_rho_cycle(U,V,W,p,n,a,g); pollard_rho_cycle(U,V,W,p,n,a,g); /* x2i, a2i, b2i */ if (verbose > 3) printf( "%3"UVuf" %4"UVuf" %3"UVuf" %3"UVuf" %4"UVuf" %3"UVuf" %3"UVuf"\n", i, u, v, w, U, V, W ); if (u == U) { UV r1, r2, k; r1 = submod(v, V, n); if (r1 == 0) { if (verbose) printf("DLP Rho failure, r=0\n"); return 0; } r2 = submod(W, w, n); k = divmod(r2, r1, n); if (powmod(g,k,p) != a) { if (verbose > 2) printf("r1 = %"UVuf" r2 = %"UVuf" k = %"UVuf"\n", r1, r2, k); if (verbose) printf("Incorrect DLP Rho solution: %"UVuf"\n", k); return 0; } if (verbose) printf("DLP Rho solution found after %"UVuf" steps\n", i); return k; } } return 0; } Math-Prime-Util-0.37/lehmer.c0000644000076400007640000006735112270242116014352 0ustar danadana#if defined(LEHMER) || defined(PRIMESIEVE_STANDALONE) #include #include #include #include /***************************************************************************** * * Lehmer prime counting utility. Calculates pi(x), count of primes <= x. * * Copyright (c) 2012-2013 Dana Jacobsen (dana@acm.org). * This is free software; you can redistribute it and/or modify it under * the same terms as the Perl 5 programming language system itself. * * This file is part of the Math::Prime::Util Perl module, but also can be * compiled as a standalone UNIX program using primesieve 5.x. * * g++ -O3 -DPRIMESIEVE_STANDALONE lehmer.c -o prime_count -lprimesieve * * The phi(x,a) calculation is unique, to the best of my knowledge. It uses * two lists of all x values + signed counts for the given 'a' value, and walks * 'a' down until it is small enough to calculate directly using a table. * This is relatively fast and low memory compared to many other solutions. * As with all Lehmer-Meissel-Legendre algorithms, memory use will be a * constraint with large values of x. * * Math::Prime::Util now includes an extended LMO implementation, which will * be quite a bit faster and much less memory than this code. It is the * default method for large counts. Timing comparisons are in that file. * * Times and memory use for prime_count(10^15) on a Haswell 4770K, asterisk * indicates parallel operation. The standalone versions of my code use * Kim Walisch's excellent primesieve, which is faster than my sieve. * His Lehmer/Meissel/Legendre seem a bit slower in serial, but * parallelize much better. * * 4.74s 1.3MB LMO * 24.53s* 137.9MB Lehmer Walisch primecount v0.9, 8 threads * 38.74s* 150.3MB LMOS Walisch primecount v0.9, 8 threads * 42.52s* 159.4MB Lehmer standalone, 8 threads * 42.82s* 137.9MB Meissel Walisch primecount v0.9, 8 threads * 51.88s 153.9MB LMOS standalone, 1 thread * 52.01s* 145.5MB Legendre Walisch primecount v0.9, 8 threads * 64.96s 160.3MB Lehmer standalone, 1 thread * 67.16s 67.0MB LMOS * 80.42s 286.6MB Meissel * 99.70s 159.6MB Lehmer * 107.43s 28.5MB Lehmer Walisch primecount v0.9, 1 thread * 174.51s 83.5MB Legendre * 185.11s 25.6MB LMOS Walisch primecount v0.9, 1 thread * 191.19s 24.8MB Meissel Walisch primecount v0.9, 1 thread * 868.96s 1668.1MB Lehmer pix4 by T.R. Nicely * * Reference: Hans Riesel, "Prime Numbers and Computer Methods for * Factorization", 2nd edition, 1994. */ /* Below this size, just sieve (with table speedup). */ #define SIEVE_LIMIT 60000000 #define MAX_PHI_MEM (896*1024*1024) static int const verbose = 0; #define STAGE_TIMING 0 #if STAGE_TIMING #include #define DECLARE_TIMING_VARIABLES struct timeval t0, t1; #define TIMING_START gettimeofday(&t0, 0); #define TIMING_END_PRINT(text) \ { unsigned long long t; \ gettimeofday(&t1, 0); \ t = (t1.tv_sec-t0.tv_sec) * 1000000 + (t1.tv_usec - t0.tv_usec); \ printf("%s: %10.5f\n", text, ((double)t) / 1000000); } #else #define DECLARE_TIMING_VARIABLES #define TIMING_START #define TIMING_END_PRINT(text) #endif #ifdef PRIMESIEVE_STANDALONE /* countPrimes can be pretty slow for small ranges, so sieve more small primes * and count using binary search. Uses a lot of memory though. For big * ranges, countPrimes is really fast. If you use primesieve 4.2, the * crossover point is lower (better). */ #define SIEVE_MULT 10 /* Translations from Perl + Math::Prime::Util to C/C++ + primesieve */ typedef unsigned long UV; typedef signed long IV; #define UV_MAX ULONG_MAX #define UVCONST(x) ((unsigned long)x##UL) #define New(id, mem, size, type) mem = (type*) malloc((size)*sizeof(type)) #define Newz(id, mem, size, type) mem = (type*) calloc(size, sizeof(type)) #define Renew(mem, size, type) mem = (type*) realloc(mem,(size)*sizeof(type)) #define Safefree(mem) free((void*)mem) #define croak(fmt,...) { printf(fmt,##__VA_ARGS__); exit(1); } #define prime_precalc(n) /* */ #define BITS_PER_WORD ((ULONG_MAX <= 4294967295UL) ? 32 : 64) static UV isqrt(UV n) { UV root; if (sizeof(UV) == 8 && n >= 18446744065119617025UL) return 4294967295UL; if (sizeof(UV) == 4 && n >= 4294836225UL) return 65535UL; root = (UV) sqrt((double)n); while (root*root > n) root--; while ((root+1)*(root+1) <= n) root++; return root; } static UV icbrt(UV n) { UV b, root = 0; int s; if (sizeof(UV) == 8) { s = 63; if (n >= 18446724184312856125UL) return 2642245UL; } else { s = 30; if (n >= 4291015625UL) return 1625UL; } for ( ; s >= 0; s -= 3) { root += root; b = 3*root*(root+1)+1; if ((n >> s) >= b) { n -= b << s; root++; } } return root; } /* Use version 5.x of PrimeSieve */ #include #include #include #include #ifdef _OPENMP #include #endif #define _XS_prime_count(a, b) primesieve::parallel_count_primes(a, b) /* Generate an array of n small primes, where the kth prime is element p[k]. * Remember to free when done. */ #define TINY_PRIME_SIZE 20000 static uint32_t* tiny_primes = 0; static uint32_t* generate_small_primes(UV n) { uint32_t* primes; New(0, primes, n+1, uint32_t); if (n < TINY_PRIME_SIZE) { if (tiny_primes == 0) tiny_primes = generate_small_primes(TINY_PRIME_SIZE+1); memcpy(primes, tiny_primes, (n+1) * sizeof(uint32_t)); return primes; } primes[0] = 0; { std::vector v; primesieve::generate_n_primes(n, &v); memcpy(primes+1, &v[0], n * sizeof(uint32_t)); } return primes; } #else /* We will use pre-sieving to speed up counting for small ranges */ #define SIEVE_MULT 1 #define FUNC_isqrt 1 #define FUNC_icbrt 1 #include "lehmer.h" #include "util.h" #include "cache.h" #include "sieve.h" /* Generate an array of n small primes, where the kth prime is element p[k]. * Remember to free when done. */ static uint32_t* generate_small_primes(UV n) { uint32_t* primes; UV i = 0; double fn = (double)n; double flogn = log(fn); double flog2n = log(flogn); UV nth_prime = /* Dusart 2010 for > 179k, custom for 18-179k */ (n >= 688383) ? (UV) ceil(fn*(flogn+flog2n-1.0+((flog2n-2.00)/flogn))) : (n >= 178974) ? (UV) ceil(fn*(flogn+flog2n-1.0+((flog2n-1.95)/flogn))) : (n >= 18) ? (UV) ceil(fn*(flogn+flog2n-1.0+((flog2n+0.30)/flogn))) : 59; if (n > 203280221) croak("generate small primes with argument too large: %lu\n", (unsigned long)n); New(0, primes, n+1, uint32_t); primes[0] = 0; START_DO_FOR_EACH_PRIME(2, nth_prime) { if (i >= n) break; primes[++i] = p; } END_DO_FOR_EACH_PRIME if (i < n) croak("Did not generate enough small primes.\n"); if (verbose > 1) printf("generated %lu small primes, from 2 to %lu\n", i, (unsigned long)primes[i]); return primes; } #endif /* Given an array of primes[1..lastprime], return Pi(n) where n <= lastprime. * This is actually quite fast, and definitely faster than sieving. By using * this we can avoid caching prime counts and also skip most calls to the * segment siever. */ static UV bs_prime_count(uint32_t n, uint32_t const* const primes, uint32_t lastidx) { UV i, j; if (n <= 2) return (n == 2); /* If n is out of range, we could: * 1. return _XS_prime_count(2, n); * 2. if (n == primes[lastidx]) return lastidx else croak("bspc range"); * 3. if (n >= primes[lastidx]) return lastidx; */ if (n >= primes[lastidx]) return lastidx; j = lastidx; if (n < 8480) { i = 1 + (n>>4); if (j > 1060) j = 1060; } else if (n < 25875000) { i = 793 + (n>>5); if (j > (n>>3)) j = n>>3; } else { i = 1617183; if (j > (n>>4)) j = n>>4; } while (i < j) { UV mid = i + (j-i)/2; if (primes[mid] <= n) i = mid+1; else j = mid; } /* if (i-1 != _XS_prime_count(2, n)) croak("wrong count for %lu: %lu vs. %lu\n", n, i-1, _XS_prime_count(2, n)); */ return i-1; } #define FAST_DIV(x,y) \ ( ((x) <= 4294967295U) ? (uint32_t)(x)/(uint32_t)(y) : (x)/(y) ) /* static uint32_t sprime[] = {0,2, 3, 5, 7, 11, 13, 17, 19, 23}; */ /* static uint32_t sprimorial[] = {1,2,6,30,210,2310,30030,510510}; */ /* static uint32_t stotient[] = {1,1,2, 8, 48, 480, 5760, 92160}; */ static const uint16_t _s0[ 1] = {0}; static const uint16_t _s1[ 2] = {0,1}; static const uint16_t _s2[ 6] = {0,1,1,1,1,2}; static const uint16_t _s3[30] = {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}; static uint16_t _s4[210]; static uint16_t _s5[2310]; static uint16_t _s6[30030]; static const uint16_t* sphicache[7] = { _s0,_s1,_s2,_s3,_s4,_s5,_s6 }; static int sphi_init = 0; #define PHIC 7 static UV tablephi(UV x, uint32_t a) { switch (a) { case 0: return x; case 1: return x-x/2; case 2: return x-x/2-x/3+x/6; case 3: return (x/ 30U) * 8U + sphicache[3][x % 30U]; case 4: return (x/ 210U) * 48U + sphicache[4][x % 210U]; case 5: return (x/ 2310U) * 480U + sphicache[5][x % 2310U]; case 6: return (x/ 30030U) * 5760U + sphicache[6][x % 30030U]; #if PHIC >= 7 case 7: { UV xp = x / 17U; return ((x /30030U) * 5760U + sphicache[6][x % 30030U]) - ((xp/30030U) * 5760U + sphicache[6][xp % 30030U]); } #endif #if PHIC >= 8 case 8: { UV xp = x / 17U; UV x2 = x / 19U; UV x2p = x2 / 17U; return ((x /30030U) * 5760U + sphicache[6][x % 30030U]) - ((xp /30030U) * 5760U + sphicache[6][xp % 30030U]) - ((x2 /30030U) * 5760U + sphicache[6][x2 % 30030U]) + ((x2p/30030U) * 5760U + sphicache[6][x2p% 30030U]); } #endif default: croak("a %u too large for tablephi\n", a); } } static void phitableinit(void) { if (sphi_init == 0) { int x; for (x = 0; x < 210; x++) _s4[x] = ((x/ 30)* 8+_s3[x% 30])-(((x/ 7)/ 30)* 8+_s3[(x/ 7)% 30]); for (x = 0; x < 2310; x++) _s5[x] = ((x/ 210)* 48+_s4[x% 210])-(((x/11)/ 210)* 48+_s4[(x/11)% 210]); for (x = 0; x < 30030; x++) _s6[x] = ((x/2310)*480+_s5[x%2310])-(((x/13)/2310)*480+_s5[(x/13)%2310]); sphi_init = 1; } } /* Max memory = 2*X*A bytes, e.g. 2*65536*256 = 32 MB */ #define PHICACHEA 512 #define PHICACHEX 65536 typedef struct { uint32_t max[PHICACHEA]; int16_t* val[PHICACHEA]; } cache_t; static void phicache_init(cache_t* cache) { int a; for (a = 0; a < PHICACHEA; a++) { cache->val[a] = 0; cache->max[a] = 0; } phitableinit(); } static void phicache_free(cache_t* cache) { int a; for (a = 0; a < PHICACHEA; a++) { if (cache->val[a] != 0) Safefree(cache->val[a]); cache->val[a] = 0; cache->max[a] = 0; } } #define PHI_CACHE_POPULATED(x, a) \ ((a) < PHICACHEA && (UV) cache->max[a] > (x) && cache->val[a][x] != 0) static void phi_cache_insert(uint32_t x, uint32_t a, IV sum, cache_t* cache) { uint32_t cap = ( (x+32) >> 5) << 5; /* If sum is too large for the cache, just ignore it. */ if (sum < SHRT_MIN || sum > SHRT_MAX) return; if (cache->val[a] == 0) { Newz(0, cache->val[a], cap, int16_t); cache->max[a] = cap; } else if (cache->max[a] < cap) { uint32_t i; Renew(cache->val[a], cap, int16_t); for (i = cache->max[a]; i < cap; i++) cache->val[a][i] = 0; cache->max[a] = cap; } cache->val[a][x] = (int16_t) sum; } static IV _phi3(UV x, UV a, int sign, const uint32_t* const primes, const uint32_t lastidx, cache_t* cache) { IV sum; if (a <= 1) return sign * ((a == 0) ? x : x-x/2); else if (PHI_CACHE_POPULATED(x, a)) return sign * cache->val[a][x]; else if (a <= PHIC) sum = sign * tablephi(x,a); else if (x < primes[a+1]) sum = sign; else if (x <= primes[lastidx] && x < primes[a+1]*primes[a+1]) sum = sign * (bs_prime_count(x, primes, lastidx) - a + 1); else { UV a2, iters = (a*a > x) ? bs_prime_count( isqrt(x), primes, a) : a; UV c = (iters > PHIC) ? PHIC : iters; IV phixc = PHI_CACHE_POPULATED(x, c) ? cache->val[c][x] : (IV)tablephi(x,c); sum = sign * (iters - a + phixc); for (a2 = c+1; a2 <= iters; a2++) sum += _phi3(FAST_DIV(x,primes[a2]), a2-1, -sign, primes, lastidx, cache); } if (a < PHICACHEA && x < PHICACHEX) phi_cache_insert(x, a, sign * sum, cache); return sum; } #define phi_small(x, a, primes, lastidx, cache) _phi3(x, a, 1, primes, lastidx, cache) /******************************************************************************/ /* In-order lists for manipulating our UV value / IV count pairs */ /******************************************************************************/ typedef struct { UV v; IV c; } vc_t; typedef struct { vc_t* a; UV size; UV n; } vcarray_t; static vcarray_t vcarray_create(void) { vcarray_t l; l.a = 0; l.size = 0; l.n = 0; return l; } static void vcarray_destroy(vcarray_t* l) { if (l->a != 0) { if (verbose > 2) printf("FREE list %p\n", l->a); Safefree(l->a); } l->size = 0; l->n = 0; } /* Insert a value/count pair. We do this indirection because about 80% of * the calls result in a merge with the previous entry. */ static void vcarray_insert(vcarray_t* l, UV val, IV count) { UV n = l->n; if (n > 0 && l->a[n-1].v < val) croak("Previous value was %lu, inserting %lu out of order\n", l->a[n-1].v, val); if (n >= l->size) { UV new_size; if (l->size == 0) { new_size = 20000; if (verbose>2) printf("ALLOCing list, size %lu (%luk)\n", new_size, new_size*sizeof(vc_t)/1024); New(0, l->a, new_size, vc_t); } else { new_size = (UV) (1.5 * l->size); if (verbose>2) printf("REALLOCing list %p, new size %lu (%luk)\n",l->a,new_size, new_size*sizeof(vc_t)/1024); Renew( l->a, new_size, vc_t ); } l->size = new_size; } /* printf(" inserting %lu %ld\n", val, count); */ l->a[n].v = val; l->a[n].c = count; l->n++; } /* Merge the two sorted lists A and B into A. Each list has no duplicates, * but they may have duplications between the two. We're quite interested * in saving memory, so first remove all the duplicates, then do an in-place * merge. */ static void vcarray_merge(vcarray_t* a, vcarray_t* b) { long ai, bi, bj, k, kn; long an = a->n; long bn = b->n; vc_t* aa = a->a; vc_t* ba = b->a; /* Merge anything in B that appears in A. */ for (ai = 0, bi = 0, bj = 0; bi < bn; bi++) { UV bval = ba[bi].v; /* Skip forward in A until empty or aa[ai].v <= ba[bi].v */ while (ai+8 < an && aa[ai+8].v > bval) ai += 8; while (ai < an && aa[ai ].v > bval) ai++; /* if A empty then copy the remaining elements */ if (ai >= an) { if (bi == bj) bj = bn; else while (bi < bn) ba[bj++] = ba[bi++]; break; } if (aa[ai].v == bval) aa[ai].c += ba[bi].c; else ba[bj++] = ba[bi]; } if (verbose>3) printf(" removed %lu duplicates from b\n", bn - bj); bn = bj; if (bn == 0) { /* In case they were all duplicates */ b->n = 0; return; } /* kn = the final merged size. All duplicates are gone, so this is exact. */ kn = an+bn; if ((long)a->size < kn) { /* Make A big enough to hold kn elements */ UV new_size = (UV) (1.2 * kn); if (verbose>2) printf("REALLOCing list %p, new size %lu (%luk)\n", a->a, new_size, new_size*sizeof(vc_t)/1024); Renew( a->a, new_size, vc_t ); aa = a->a; /* this could have been changed by the realloc */ a->size = new_size; } /* merge A and B. Very simple using reverse merge. */ ai = an-1; bi = bn-1; for (k = kn-1; k >= 0 && bi >= 0; k--) { UV bval = ba[bi].v; long startai = ai; while (ai >= 15 && aa[ai-15].v < bval) ai -= 16; while (ai >= 3 && aa[ai- 3].v < bval) ai -= 4; while (ai >= 0 && aa[ai ].v < bval) ai--; if (startai > ai) { k = k - (startai - ai) + 1; memmove(aa+k, aa+ai+1, (startai-ai) * sizeof(vc_t)); } else { if (ai >= 0 && aa[ai].v == bval) croak("deduplication error"); aa[k] = ba[bi--]; } } a->n = kn; /* A now has this many items */ b->n = 0; /* B is marked empty */ } static void vcarray_remove_zeros(vcarray_t* a) { long ai = 0; long aj = 0; long an = a->n; vc_t* aa = a->a; while (aj < an) { if (aa[aj].c != 0) { if (ai != aj) aa[ai] = aa[aj]; ai++; } aj++; } a->n = ai; } /* * The main phi(x,a) algorithm. In this implementation, it takes under 10% * of the total time for the Lehmer algorithm, but is a big memory consumer. */ #define NTHRESH (MAX_PHI_MEM/16) static UV phi(UV x, UV a) { UV i, val, sval, lastidx, lastprime; UV sum = 0; IV count; const uint32_t* primes; vcarray_t a1, a2; vc_t* arr; cache_t pcache; /* Cache for recursive phi */ phitableinit(); if (a == 1) return ((x+1)/2); if (a <= PHIC) return tablephi(x, a); lastidx = a+1; primes = generate_small_primes(lastidx); lastprime = primes[lastidx]; if (x < lastprime) { Safefree(primes); return (x > 0) ? 1 : 0; } phicache_init(&pcache); a1 = vcarray_create(); a2 = vcarray_create(); vcarray_insert(&a1, x, 1); while (a > PHIC) { UV primea = primes[a]; UV sval_last = 0; IV sval_count = 0; arr = a1.a; for (i = 0; i < a1.n; i++) { count = arr[i].c; val = arr[i].v; sval = FAST_DIV(val, primea); if (sval < primea) break; /* stop inserting into a2 if small */ if (sval != sval_last) { /* non-merged value. Insert into a2 */ if (sval_last != 0) { if (sval_last <= lastprime && sval_last < primes[a-1]*primes[a-1]) sum += sval_count*(bs_prime_count(sval_last,primes,lastidx)-a+2); else vcarray_insert(&a2, sval_last, sval_count); } sval_last = sval; sval_count = 0; } sval_count -= count; /* Accumulate count for this sval */ } if (sval_last != 0) { /* Insert the last sval */ if (sval_last <= lastprime && sval_last < primes[a-1]*primes[a-1]) sum += sval_count*(bs_prime_count(sval_last,primes,lastidx)-a+2); else vcarray_insert(&a2, sval_last, sval_count); } /* For each small sval, add up the counts */ for ( ; i < a1.n; i++) sum -= arr[i].c; /* Merge a1 and a2 into a1. a2 will be emptied. */ vcarray_merge(&a1, &a2); /* If we've grown too large, use recursive phi to clip. */ if ( a1.n > NTHRESH ) { arr = a1.a; if (verbose > 0) printf("clipping small values at a=%lu a1.n=%lu \n", a, a1.n); #ifdef _OPENMP /* #pragma omp parallel for reduction(+: sum) firstprivate(pcache) schedule(dynamic, 16) */ #endif for (i = 0; i < a1.n-NTHRESH+NTHRESH/50; i++) { UV j = a1.n - 1 - i; IV count = arr[j].c; if (count != 0) { sum += count * phi_small( arr[j].v, a-1, primes, lastidx, &pcache ); arr[j].c = 0; } } } vcarray_remove_zeros(&a1); a--; } phicache_free(&pcache); vcarray_destroy(&a2); arr = a1.a; #ifdef _OPENMP #pragma omp parallel for reduction(+: sum) schedule(dynamic, 16) #endif for (i = 0; i < a1.n; i++) sum += arr[i].c * tablephi( arr[i].v, PHIC ); vcarray_destroy(&a1); Safefree(primes); return (UV) sum; } extern UV _XS_meissel_pi(UV n); /* b = prime_count(isqrt(n)) */ static UV Pk_2_p(UV n, UV a, UV b, const uint32_t* primes, uint32_t lastidx) { UV lastw, lastwpc, i, P2; UV lastpc = primes[lastidx]; /* Ensure we have a large enough base sieve */ prime_precalc(isqrt(n / primes[a+1])); P2 = lastw = lastwpc = 0; for (i = b; i > a; i--) { UV w = n / primes[i]; lastwpc = (w <= lastpc) ? bs_prime_count(w, primes, lastidx) : lastwpc + _XS_prime_count(lastw+1, w); lastw = w; P2 += lastwpc; } P2 -= ((b+a-2) * (b-a+1) / 2) - a + 1; return P2; } static UV Pk_2(UV n, UV a, UV b) { UV lastprime = ((b*3+1) > 203280221) ? 203280221 : b*3+1; const uint32_t* primes = generate_small_primes(lastprime); UV P2 = Pk_2_p(n, a, b, primes, lastprime); Safefree(primes); return P2; } /* Legendre's method. Interesting and a good test for phi(x,a), but Lehmer's * method is much faster (Legendre: a = pi(n^.5), Lehmer: a = pi(n^.25)) */ UV _XS_legendre_pi(UV n) { UV a, phina; if (n < SIEVE_LIMIT) return _XS_prime_count(2, n); a = _XS_legendre_pi(isqrt(n)); /* phina = phi(n, a); */ { /* The small phi routine is faster for large a */ cache_t pcache; const uint32_t* primes = 0; primes = generate_small_primes(a+1); phicache_init(&pcache); phina = phi_small(n, a, primes, a+1, &pcache); phicache_free(&pcache); Safefree(primes); } return phina + a - 1; } /* Meissel's method. */ UV _XS_meissel_pi(UV n) { UV a, b, sum; if (n < SIEVE_LIMIT) return _XS_prime_count(2, n); a = _XS_meissel_pi(icbrt(n)); /* a = Pi(floor(n^1/3)) [max 192725] */ b = _XS_meissel_pi(isqrt(n)); /* b = Pi(floor(n^1/2)) [max 203280221] */ sum = phi(n, a) + a - 1 - Pk_2(n, a, b); return sum; } /* Lehmer's method. This is basically Riesel's Lehmer function (page 22), * with some additional code to help optimize it. */ UV _XS_lehmer_pi(UV n) { UV z, a, b, c, sum, i, j, lastprime, lastpc, lastw, lastwpc; const uint32_t* primes = 0; /* small prime cache, first b=pi(z)=pi(sqrt(n)) */ DECLARE_TIMING_VARIABLES; if (n < SIEVE_LIMIT) return _XS_prime_count(2, n); /* Protect against overflow. 2^32-1 and 2^64-1 are both divisible by 3. */ if (n == UV_MAX) { if ( (n%3) == 0 || (n%5) == 0 || (n%7) == 0 || (n%31) == 0 ) n--; else return _XS_prime_count(2,n); } if (verbose > 0) printf("lehmer %lu stage 1: calculate a,b,c \n", n); TIMING_START; z = isqrt(n); a = _XS_lehmer_pi(isqrt(z)); /* a = Pi(floor(n^1/4)) [max 6542] */ b = _XS_lehmer_pi(z); /* b = Pi(floor(n^1/2)) [max 203280221] */ c = _XS_lehmer_pi(icbrt(n)); /* c = Pi(floor(n^1/3)) [max 192725] */ TIMING_END_PRINT("stage 1") if (verbose > 0) printf("lehmer %lu stage 2: phi(x,a) (z=%lu a=%lu b=%lu c=%lu)\n", n, z, a, b, c); TIMING_START; sum = phi(n, a) + ((b+a-2) * (b-a+1) / 2); TIMING_END_PRINT("phi(x,a)") /* We get an array of the first b primes. This is used in stage 4. If we * get more than necessary, we can use them to speed up some. */ lastprime = b*SIEVE_MULT+1; if (lastprime > 203280221) lastprime = 203280221; if (verbose > 0) printf("lehmer %lu stage 3: %lu small primes\n", n, lastprime); TIMING_START; primes = generate_small_primes(lastprime); lastpc = primes[lastprime]; TIMING_END_PRINT("small primes") TIMING_START; /* Speed up all the prime counts by doing a big base sieve */ prime_precalc( (UV) pow(n, 3.0/5.0) ); /* Ensure we have the base sieve for big prime_count ( n/primes[i] ). */ /* This is about 75k for n=10^13, 421k for n=10^15, 2.4M for n=10^17 */ prime_precalc(isqrt(n / primes[a+1])); TIMING_END_PRINT("sieve precalc") if (verbose > 0) printf("lehmer %lu stage 4: loop %lu to %lu, pc to %lu\n", n, a+1, b, n/primes[a+1]); TIMING_START; /* Reverse the i loop so w increases. Count w in segments. */ lastw = 0; lastwpc = 0; for (i = b; i >= a+1; i--) { UV w = n / primes[i]; lastwpc = (w <= lastpc) ? bs_prime_count(w, primes, lastprime) : lastwpc + _XS_prime_count(lastw+1, w); lastw = w; sum = sum - lastwpc; if (i <= c) { UV bi = bs_prime_count( isqrt(w), primes, lastprime ); for (j = i; j <= bi; j++) { sum = sum - bs_prime_count(w / primes[j], primes, lastprime) + j - 1; } /* We could wrap the +j-1 in: sum += ((bi+1-i)*(bi+i))/2 - (bi-i+1); */ } } TIMING_END_PRINT("stage 4") Safefree(primes); return sum; } /* The Lagarias-Miller-Odlyzko method. * Naive implementation without optimizations. * About the same speed as Lehmer, a bit less memory. * A better implementation can be 10-50x faster and much less memory. */ UV _XS_LMOS_pi(UV n) { UV n13, a, b, sum, i, j, k, lastprime, P2, S1, S2; const uint32_t* primes = 0; /* small prime cache */ signed char* mu = 0; /* moebius to n^1/3 */ uint32_t* lpf = 0; /* least prime factor to n^1/3 */ cache_t pcache; /* Cache for recursive phi */ DECLARE_TIMING_VARIABLES; if (n < SIEVE_LIMIT) return _XS_prime_count(2, n); n13 = icbrt(n); /* n13 = floor(n^1/3) [max 2642245] */ a = _XS_lehmer_pi(n13); /* a = Pi(floor(n^1/3)) [max 192725] */ b = _XS_lehmer_pi(isqrt(n)); /* b = Pi(floor(n^1/2)) [max 203280221] */ lastprime = b*SIEVE_MULT+1; if (lastprime > 203280221) lastprime = 203280221; if (lastprime < n13) lastprime = n13; primes = generate_small_primes(lastprime); New(0, mu, n13+1, signed char); memset(mu, 1, sizeof(signed char) * (n13+1)); Newz(0, lpf, n13+1, uint32_t); mu[0] = 0; for (i = 1; i <= n13; i++) { UV primei = primes[i]; for (j = primei; j <= n13; j += primei) { mu[j] = -mu[j]; if (lpf[j] == 0) lpf[j] = primei; } k = primei * primei; for (j = k; j <= n13; j += k) mu[j] = 0; } lpf[1] = UVCONST(4294967295); /* Set lpf[1] to max */ /* Remove mu[i] == 0 using lpf */ for (i = 1; i <= n13; i++) if (mu[i] == 0) lpf[i] = 0; /* Thanks to Kim Walisch for help with the S1+S2 calculations. */ k = (a < 7) ? a : 7; S1 = 0; S2 = 0; phicache_init(&pcache); TIMING_START; for (i = 1; i <= n13; i++) if (lpf[i] > primes[k]) /* S1 += mu[i] * phi_small(n/i, k, primes, lastprime, &pcache); */ S1 += mu[i] * phi(n/i, k); TIMING_END_PRINT("S1") TIMING_START; for (i = k; i+1 < a; i++) { uint32_t p = primes[i+1]; /* TODO: #pragma omp parallel for reduction(+: S2) firstprivate(pcache) schedule(dynamic, 16) */ for (j = (n13/p)+1; j <= n13; j++) if (lpf[j] > p) S2 += -mu[j] * phi_small(n / (j*p), i, primes, lastprime, &pcache); } TIMING_END_PRINT("S2") phicache_free(&pcache); Safefree(lpf); Safefree(mu); TIMING_START; prime_precalc( (UV) pow(n, 2.9/5.0) ); P2 = Pk_2_p(n, a, b, primes, lastprime); TIMING_END_PRINT("P2") Safefree(primes); /* printf("S1 = %lu\nS2 = %lu\na = %lu\nP2 = %lu\n", S1, S2, a, P2); */ sum = (S1 + S2) + a - 1 - P2; return sum; } #ifdef PRIMESIEVE_STANDALONE int main(int argc, char *argv[]) { UV n, pi; double t; const char* method; struct timeval t0, t1; if (argc <= 1) { printf("usage: %s []\n", argv[0]); return(1); } n = strtoul(argv[1], 0, 10); if (n < 2) { printf("Pi(%lu) = 0\n", n); return(0); } if (argc > 2) method = argv[2]; else method = "lehmer"; gettimeofday(&t0, 0); if (!strcasecmp(method, "lehmer")) { pi = _XS_lehmer_pi(n); } else if (!strcasecmp(method, "meissel")) { pi = _XS_meissel_pi(n); } else if (!strcasecmp(method, "legendre")) { pi = _XS_legendre_pi(n); } else if (!strcasecmp(method, "lmo")) { pi = _XS_LMOS_pi(n); } else if (!strcasecmp(method, "sieve")) { pi = _XS_prime_count(2, n); } else { printf("method must be one of: lehmer, meissel, legendre, lmo, or sieve\n"); return(2); } gettimeofday(&t1, 0); t = (t1.tv_sec-t0.tv_sec); t *= 1000000.0; t += (t1.tv_usec - t0.tv_usec); printf("%8s Pi(%lu) = %lu in %10.5fs\n", method, n, pi, t / 1000000.0); return(0); } #endif #else #include "lehmer.h" UV _XS_LMOS_pi(UV n) { if (n==0) return 0; croak("Not compiled with Lehmer support"); } UV _XS_lehmer_pi(UV n) { if (n==0) return 0; croak("Not compiled with Lehmer support"); } UV _XS_meissel_pi(UV n) { if (n==0) return 0; croak("Not compiled with Lehmer support"); } UV _XS_legendre_pi(UV n) { if (n==0) return 0; croak("Not compiled with Lehmer support"); } #endif Math-Prime-Util-0.37/lehmer.h0000644000076400007640000000030512270242116014341 0ustar danadana#ifndef MPU_LEHMER_H #define MPU_LEHMER_H #include "ptypes.h" extern UV _XS_legendre_pi(UV n); extern UV _XS_meissel_pi(UV n); extern UV _XS_lehmer_pi(UV n); extern UV _XS_LMOS_pi(UV n); #endif Math-Prime-Util-0.37/multicall.h0000644000076400007640000001076612266152412015073 0ustar danadana/* multicall.h (version 1.0) * * Implements a poor-man's MULTICALL interface for old versions * of perl that don't offer a proper one. Intended to be compatible * with 5.6.0 and later. * */ #ifdef dMULTICALL #define REAL_MULTICALL #else #undef REAL_MULTICALL /* In versions of perl where MULTICALL is not defined (i.e. prior * to 5.9.4), Perl_pad_push is not exported either. It also has * an extra argument in older versions; certainly in the 5.8 series. * So we redefine it here. */ #ifndef AVf_REIFY # ifdef SVpav_REIFY # define AVf_REIFY SVpav_REIFY # else # error Neither AVf_REIFY nor SVpav_REIFY is defined # endif #endif #ifndef AvFLAGS # define AvFLAGS SvFLAGS #endif static void multicall_pad_push(pTHX_ AV *padlist, int depth) { if (depth <= AvFILLp(padlist)) return; { SV** const svp = AvARRAY(padlist); AV* const newpad = newAV(); SV** const oldpad = AvARRAY(svp[depth-1]); I32 ix = AvFILLp((AV*)svp[1]); const I32 names_fill = AvFILLp((AV*)svp[0]); SV** const names = AvARRAY(svp[0]); AV *av; for ( ;ix > 0; ix--) { if (names_fill >= ix && names[ix] != &PL_sv_undef) { const char sigil = SvPVX(names[ix])[0]; if ((SvFLAGS(names[ix]) & SVf_FAKE) || sigil == '&') { /* outer lexical or anon code */ av_store(newpad, ix, SvREFCNT_inc(oldpad[ix])); } else { /* our own lexical */ SV *sv; if (sigil == '@') sv = (SV*)newAV(); else if (sigil == '%') sv = (SV*)newHV(); else sv = NEWSV(0, 0); av_store(newpad, ix, sv); SvPADMY_on(sv); } } else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) { av_store(newpad, ix, SvREFCNT_inc(oldpad[ix])); } else { /* save temporaries on recursion? */ SV * const sv = NEWSV(0, 0); av_store(newpad, ix, sv); SvPADTMP_on(sv); } } av = newAV(); av_extend(av, 0); av_store(newpad, 0, (SV*)av); AvFLAGS(av) = AVf_REIFY; av_store(padlist, depth, (SV*)newpad); AvFILLp(padlist) = depth; } } #define dMULTICALL \ SV **newsp; /* set by POPBLOCK */ \ PERL_CONTEXT *cx; \ CV *multicall_cv; \ OP *multicall_cop; \ bool multicall_oldcatch; \ U8 hasargs = 0 /* Between 5.9.1 and 5.9.2 the retstack was removed, and the return op is now stored on the cxstack. */ #define HAS_RETSTACK (\ PERL_REVISION < 5 || \ (PERL_REVISION == 5 && PERL_VERSION < 9) || \ (PERL_REVISION == 5 && PERL_VERSION == 9 && PERL_SUBVERSION < 2) \ ) /* PUSHSUB is defined so differently on different versions of perl * that it's easier to define our own version than code for all the * different possibilities. */ #if HAS_RETSTACK # define PUSHSUB_RETSTACK(cx) #else # define PUSHSUB_RETSTACK(cx) cx->blk_sub.retop = Nullop; #endif #define MULTICALL_PUSHSUB(cx, the_cv) \ cx->blk_sub.cv = the_cv; \ cx->blk_sub.olddepth = CvDEPTH(the_cv); \ cx->blk_sub.hasargs = hasargs; \ cx->blk_sub.lval = PL_op->op_private & \ (OPpLVAL_INTRO|OPpENTERSUB_INARGS); \ PUSHSUB_RETSTACK(cx) \ if (!CvDEPTH(the_cv)) { \ (void)SvREFCNT_inc(the_cv); \ (void)SvREFCNT_inc(the_cv); \ SAVEFREESV(the_cv); \ } #define PUSH_MULTICALL(the_cv) \ STMT_START { \ CV *_nOnclAshIngNamE_ = the_cv; \ AV* padlist = CvPADLIST(_nOnclAshIngNamE_); \ multicall_cv = _nOnclAshIngNamE_; \ ENTER; \ multicall_oldcatch = CATCH_GET; \ SAVESPTR(CvROOT(multicall_cv)->op_ppaddr); \ CvROOT(multicall_cv)->op_ppaddr = PL_ppaddr[OP_NULL]; \ SAVETMPS; SAVEVPTR(PL_op); \ CATCH_SET(TRUE); \ PUSHSTACKi(PERLSI_SORT); \ PUSHBLOCK(cx, CXt_SUB, PL_stack_sp); \ MULTICALL_PUSHSUB(cx, multicall_cv); \ if (++CvDEPTH(multicall_cv) >= 2) { \ PERL_STACK_OVERFLOW_CHECK(); \ multicall_pad_push(aTHX_ padlist, CvDEPTH(multicall_cv)); \ } \ SAVECOMPPAD(); \ PL_comppad = (AV*) (AvARRAY(padlist)[CvDEPTH(multicall_cv)]); \ PL_curpad = AvARRAY(PL_comppad); \ multicall_cop = CvSTART(multicall_cv); \ } STMT_END #define MULTICALL \ STMT_START { \ PL_op = multicall_cop; \ CALLRUNOPS(aTHX); \ } STMT_END #define POP_MULTICALL \ STMT_START { \ CvDEPTH(multicall_cv)--; \ LEAVESUB(multicall_cv); \ POPBLOCK(cx,PL_curpm); \ POPSTACK; \ CATCH_SET(multicall_oldcatch); \ LEAVE; \ SPAGAIN; \ } STMT_END #endif

such that C= n>. For relatively small inputs (below 1 million or so), this does a sieve over a range containing the nth prime, then counts up to the number. This is fairly efficient in time and memory. For larger values, create a low-biased estimate using the inverse logarithmic integral, use a fast prime count, then sieve in the small difference. While this method is thousands of times faster than generating primes, and doesn't involve big tables of precomputed values, it still can take a fair amount of time for large inputs. Calculating the C<10^12th> prime takes about 1 second, the C<10^13th> prime takes under 10 seconds, and the C<10^14th> prime (3475385758524527) takes under one minute. Think about whether a bound or approximation would be acceptable, as they can be computed analytically. If the result is larger than a native integer size (32-bit or 64-bit), the result will take a very long time. A later version of L may include this functionality which would help for 32-bit machines. =head2 nth_prime_upper =head2 nth_prime_lower my $lower_limit = nth_prime_lower($n); my $upper_limit = nth_prime_upper($n); # $lower_limit <= nth_prime(n) <= $upper_limit Returns an analytical upper or lower bound on the Nth prime. These are very fast as they do not need to sieve or search through primes or tables. An exact answer is returned for tiny values of C. The lower limit uses the Dusart 2010 bound for all C, while the upper bound uses one of the two Dusart 2010 bounds for C= 178974>, a Dusart 1999 bound for C= 39017>, and a simple bound of C for small C. =head2 nth_prime_approx say "The one trillionth prime is ~ ", nth_prime_approx(10**12); Returns an approximation to the C function, without having to generate any primes. Uses the Cipolla 1902 approximation with two polynomials, plus a correction for small values to reduce the error. =head2 is_pseudoprime Takes a positive number C and a base C as input, and returns 1 if C is a probable prime to base C. This is the simple Fermat primality test. Removing primes, given base 2 this produces the sequence L. =head2 is_strong_pseudoprime my $maybe_prime = is_strong_pseudoprime($n, 2); my $probably_prime = is_strong_pseudoprime($n, 2, 3, 5, 7, 11, 13, 17); Takes a positive number as input and one or more bases. The bases must be greater than C<1>. Returns 1 if the input is a strong probable prime to all of the bases, and 0 if not. If 0 is returned, then the number really is a composite. If 1 is returned, then it is either a prime or a strong pseudoprime to all the given bases. Given enough distinct bases, the chances become very, very strong that the number is actually prime. This is usually used in combination with other tests to make either stronger tests (e.g. the strong BPSW test) or deterministic results for numbers less than some verified limit (e.g. it has long been known that no more than three selected bases are required to give correct primality test results for any 32-bit number). Given the small chances of passing multiple bases, there are some math packages that just use multiple MR tests for primality testing. Even inputs other than 2 will always return 0 (composite). While the algorithm does run with even input, most sources define it only on odd input. Returning composite for all non-2 even input makes the function match most other implementations including L's C function. =head2 miller_rabin An alias for C. This name is deprecated. =head2 is_lucas_pseudoprime Takes a positive number as input, and returns 1 if the input is a standard Lucas probable prime using the Selfridge method of choosing D, P, and Q (some sources call this a Lucas-Selfridge pseudoprime). Removing primes, this produces the sequence L. =head2 is_strong_lucas_pseudoprime Takes a positive number as input, and returns 1 if the input is a strong Lucas probable prime using the Selfridge method of choosing D, P, and Q (some sources call this a strong Lucas-Selfridge pseudoprime). This is one half of the BPSW primality test (the Miller-Rabin strong pseudoprime test with base 2 being the other half). Removing primes, this produces the sequence L. =head2 is_extra_strong_lucas_pseudoprime Takes a positive number as input, and returns 1 if the input passes the extra strong Lucas test (as defined in L). This test has more stringent conditions than the strong Lucas test, and produces about 60% fewer pseudoprimes. Performance is typically 20-30% I than the strong Lucas test. The parameters are selected using the L method: increment C