Math-Prime-Util-0.73/0000755000076400007640000000000013373340013012716 5ustar danadanaMath-Prime-Util-0.73/montmath.h0000644000076400007640000000553013204400603014714 0ustar danadana#ifndef MPU_MONTMATH_H #define MPU_MONTMATH_H #include "ptypes.h" #include "mulmod.h" #if BITS_PER_WORD == 64 && HAVE_STD_U64 && defined(__GNUC__) && defined(__x86_64__) #define USE_MONTMATH 1 #else #define USE_MONTMATH 0 #endif #if USE_MONTMATH #define mont_get1(n) _u64div(1,n) /* Must have npi = mont_inverse(n), mont1 = mont_get1(n) */ #define mont_get2(n) addmod(mont1,mont1,n) #define mont_geta(a,n) mulmod(a,mont1,n) #define mont_mulmod(a,b,n) _mulredc(a,b,n,npi) #define mont_sqrmod(a,n) _mulredc(a,a,n,npi) #define mont_powmod(a,k,n) _powredc(a,k,mont1,n,npi) #define mont_recover(a,n) mont_mulmod(a,1,n) /* Save one branch if desired by calling directly */ #define mont_mulmod63(a,b,n) _mulredc63(a,b,n,npi) #define mont_mulmod64(a,b,n) _mulredc64(a,b,n,npi) /* See https://arxiv.org/pdf/1303.0328.pdf for lots of details on this. * The 128-entry table solution is about 20% faster */ static INLINE uint64_t mont_inverse(const uint64_t n) { uint64_t ret = (3*n) ^ 2; ret *= (uint64_t)2 - n * ret; ret *= (uint64_t)2 - n * ret; ret *= (uint64_t)2 - n * ret; ret *= (uint64_t)2 - n * ret; return (uint64_t)0 - ret; } /* MULREDC asm from Ben Buhrow */ static INLINE uint64_t _mulredc63(uint64_t a, uint64_t b, uint64_t n, uint64_t npi) { asm("mulq %2 \n\t" "movq %%rax, %%r10 \n\t" "movq %%rdx, %%r11 \n\t" "mulq %3 \n\t" "mulq %4 \n\t" "addq %%r10, %%rax \n\t" "adcq %%r11, %%rdx \n\t" "xorq %%rax, %%rax \n\t" "subq %4, %%rdx \n\t" "cmovc %4, %%rax \n\t" "addq %%rdx, %%rax \n\t" : "=a"(a) : "0"(a), "r"(b), "r"(npi), "r"(n) : "rdx", "r10", "r11", "cc"); return a; } static INLINE uint64_t _mulredc64(uint64_t a, uint64_t b, uint64_t n, uint64_t npi) { asm("mulq %1 \n\t" "movq %%rax, %%r10 \n\t" "movq %%rdx, %%r11 \n\t" "movq $0, %%r12 \n\t" "mulq %2 \n\t" "mulq %3 \n\t" "addq %%r10, %%rax \n\t" "adcq %%r11, %%rdx \n\t" "cmovae %3, %%r12 \n\t" "xorq %%rax, %%rax \n\t" "subq %3, %%rdx \n\t" "cmovc %%r12, %%rax \n\t" "addq %%rdx, %%rax \n\t" : "+&a"(a) : "r"(b), "r"(npi), "r"(n) : "rdx", "r10", "r11", "r12", "cc"); return a; } #define _mulredc(a,b,n,npi) ((n & 0x8000000000000000ULL) ? _mulredc64(a,b,n,npi) : _mulredc63(a,b,n,npi)) static INLINE UV _powredc(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_mulmod(t, a, n); k >>= 1; if (k) a = mont_sqrmod(a, n); } return t; } static INLINE uint64_t _u64div(uint64_t c, uint64_t n) { asm("divq %4" : "=a"(c), "=d"(n) : "1"(c), "0"(0), "r"(n)); return n; } #endif /* use_montmath */ #endif Math-Prime-Util-0.73/META.json0000664000076400007640000000553713373340013014353 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 7.34, CPAN::Meta::Converter version 2.150010", "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" : { "Digest::SHA" : "5.87", "Math::BigInt::GMP" : "0", "Math::Prime::Util::GMP" : "0.51" }, "requires" : { "Carp" : "0", "Config" : "0", "Exporter" : "5.57", "Math::BigFloat" : "1.59", "Math::BigInt" : "1.88", "Math::Prime::Util::GMP" : "0.50", "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" } } }, "provides" : { "Math::Prime::Util" : { "file" : "lib/Math/Prime/Util.pm", "version" : "0.73" }, "Math::Prime::Util::ChaCha" : { "file" : "lib/Math/Prime/Util/ChaCha.pm", "version" : "0.73" }, "Math::Prime::Util::Entropy" : { "file" : "lib/Math/Prime/Util/Entropy.pm", "version" : "0.73" }, "Math::Prime::Util::MemFree" : { "file" : "lib/Math/Prime/Util/MemFree.pm", "version" : "0.73" }, "Math::Prime::Util::PP" : { "file" : "lib/Math/Prime/Util/PP.pm", "version" : "0.73" }, "Math::Prime::Util::PrimeArray" : { "file" : "lib/Math/Prime/Util/PrimeArray.pm", "version" : "0.73" }, "Math::Prime::Util::PrimeIterator" : { "file" : "lib/Math/Prime/Util/PrimeIterator.pm", "version" : "0.73" }, "ntheory" : { "file" : "lib/ntheory.pm", "version" : "0.73" } }, "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.73", "x_serialization_backend" : "JSON::PP version 2.97001" } Math-Prime-Util-0.73/chacha.h0000644000076400007640000000151713204400603014275 0ustar danadana#ifndef MPU_CHACHA_H #define MPU_CHACHA_H #include "ptypes.h" /* State info */ #define STATESZ 16 /* words: 4 constant, 8 key, 2 counter, 2 nonce */ #define KEYSZ 40 /* bytes of user supplied key+nonce */ #define CORESZ 64 /* bytes output by core */ #define BUFSZ 16*CORESZ /* bytes we get at a time (1024) */ typedef struct { uint32_t state[STATESZ]; unsigned char buf[BUFSZ]; uint16_t have; char goodseed; } chacha_context_t; /* API */ extern void chacha_seed(chacha_context_t *cs, uint32_t bytes, const unsigned char* data, char good); extern void chacha_rand_bytes(chacha_context_t *cs, uint32_t bytes, unsigned char* data); extern uint32_t chacha_irand32(chacha_context_t *cs); extern UV chacha_irand64(chacha_context_t *cs); extern int chacha_selftest(void); #endif Math-Prime-Util-0.73/.travis.yml0000644000076400007640000000152313341727534015044 0ustar danadanalanguage: "perl" perl: - "5.26" - "5.16" # There is little reason to have travis run multiple Perls. # - "5.14" # - "5.12" # - "5.10" addons: apt: packages: - libgmp-dev - libmpfr-dev before_install: # - sudo apt-get install libgmp-dev # - sudo apt-get install libmpfr-dev - cpanm Test::Pod # optional dependency - cpanm Math::Prime::Util::GMP env: - - MPU_NO_GMP=1 - MPU_NO_XS=1 MPU_NO_GMP=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.73/entropy.c0000644000076400007640000000420313204400603014554 0ustar danadana#include #include "entropy.h" /* A fallback timer entropy method that will probably never be used. */ #if defined(_WIN32_WCE) static UV timer_entropy(UV bytes, unsigned char* buf) { return 0; } #else #include static uint32_t mix32(uint32_t r0) { /* Similar to PCG 32 */ uint32_t word = ((r0 >> ((r0 >> 28u) + 4u)) ^ r0) * 277803737u; return (word >> 22u) ^ word; } static uint32_t timer_mix8(uint32_t acc) { clock_t t1; uint32_t bit, a; for (bit = a = 0; bit < 8; bit++) { t1 = clock(); while (t1 == clock()) a ^= 1; acc = (acc << 1) | a; } return mix32(acc); } static UV timer_entropy(UV bytes, unsigned char* buf) { UV byte; uint32_t acc = 0; for (byte = 0; byte < 4; byte++) acc = timer_mix8(acc); for (byte = 0; byte < bytes; byte++) { acc = timer_mix8( timer_mix8( acc ) ); buf[byte] = (acc >> 24) & 0xFF; } return bytes; } #endif UV get_entropy_bytes(UV bytes, unsigned char* buf) { UV len = 0; #if defined(_WIN32) || defined(_WIN32_WCE) #ifndef _WIN32_WINNT #define _WIN32_WINNT 0x0400 #endif #ifdef _WIN32_WCE #define UNDER_CE #define ARM #endif #define WIN32_LEAN_AND_MEAN #include #include /* TODO: Calling RtlGenRandom is faster */ HCRYPTPROV hProv = 0; if (!CryptAcquireContext(&hProv, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_SILENT | CRYPT_VERIFYCONTEXT | CRYPT_MACHINE_KEYSET) && !CryptAcquireContext (&hProv, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_SILENT | CRYPT_VERIFYCONTEXT | CRYPT_MACHINE_KEYSET | CRYPT_NEWKEYSET)) return 0; if (CryptGenRandom(hProv, bytes, buf) == TRUE) len = bytes; CryptReleaseContext(hProv, 0); #else /* ^^^^^^ Windows ^^^^^^ vvvvvv /dev/urandom vvvvvvv */ FILE *f = fopen("/dev/urandom", "rb"); if (f == NULL) f = fopen("/dev/random", "rb"); if (f != NULL) { if (setvbuf(f, NULL, _IONBF, 0) == 0) { /* disable buffering */ len = (UV)fread(buf, 1, (size_t)bytes, f); } fclose(f); } #endif /* Do a fallback method if something didn't work right. */ if (len != bytes) len = timer_entropy(bytes, buf); return len; } Math-Prime-Util-0.73/TODO0000644000076400007640000001632213373330217013417 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, Cygwin, Win32. * Test on gcc70 (NetBSD), gcc119 (AIX/Power8), gcc22 (MIPS64), gcc115 (aarch) * prove -b -I../Math-Prime-Util-GMP/blib/lib -I../Math-Prime-Util-GMP/blib/arch - For new functions: XS, .h, .c, PP, PPFE, export, t exports, lib/ntheory.pm, doc, test - 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. The method at: http://codegolf.stackexchange.com/a/26747/30069 ends up very similar. For the monolithic results the main bottleneck seems to be the array return. - 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?). - 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 - Fenwick trees for prefix sums - 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. - Benchmark simple SoEs, SoA. Include Sisyphus SoE hidden in Math::GMPz. - 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. - We don't use legendre_phi for other functions any more, but it'd be nice to speed it up using some ideas from the Ohana 2011 SAGE branch. For example (10**13,10**5) takes 2.5x longer, albeit with 6x less memory. - More Pari: parforprime - znlog: = GMP BSGS for znlog. = Clean up znlog (PH, BSGS, Rho). = Experiment with Wang/Zhang 2012 Rho cycle finding - consider using Ramanujan Li for PP code. - xt/pari-compare: add chinese, factorial, vecmin, vecmax, bernfrac, bernreal, LambertW. - Proth test using LLR. Change mersenne test file to test both. Note: what does this mean? Both LLR and Proth are in GMP now. - harmreal and harmfrac for general $k - For PP, do something like the fibprime examples. At load time, look for the best library (GMPz, GMP, Pari, BigInt) and set $BICLASS. Then we should use that class for everything. Go ahead and return that type. Make a config variable to allow get/set. - Support FH for print_primes. PerlIO_write is giving me fits. - Test for print_primes. Not as easy with filenos. - sum primes better than current method. Especially using less memory. - divsum and divsummult as block functions. The latter does sum = vecprod(1 + f(p_i) + f(p_i^2) + ... f(p_i^e) for all p. - Consider Lim-Lee random prime generation, optionally with proof. https://pdfs.semanticscholar.org/fd1d/864a95d7231eaf133b00a1757ee5d0bf0e07.pdf libgcrypt/cipher/primegen.c - More formal random prime generation for pedantic FIPS etc. users, with guarantee of specific algorithm. - surround_primes - More Montgomery: znlog, catalan - polymul, polyadd, polydiv, polyneg, polyeval, polyorder, polygcd, polylcm, polyroots, ... A lot of our ops do these mod n, we could make ..mod versions of each. - poly_is_reducible - use word-based for-sieve for non-segment. - remove start/end partial word tests from inner loop in for-sieve. - sieve.h and util.h should get along better. - compare wheel_t with primes separated and possibly cached. - urandomm with bigints could be faster. 7.7s my $f=factorial(144); urandomm($f) for 1..5e5; 6.2s my $f=factorial(144); urandomm("$f") for 1..5e5; 4.8s my $f="".factorial(144); urandomm($f) for 1..5e5; 5.3s use Math::GMP qw/:constant/; my $f=factorial(144); urandomm($f) for 1..5e5; 1.7s my $f=Math::Prime::Util::GMP::factorial(144); Math::Prime::Util::GMP::urandomm($f) for 1..5e5; In the first case, we're calling ""->bstr->_str once for validation in MPU and and once for use in MPU::GMP. The last case is all strings with no read/write bigint objects anywhere. - Destroy csprng context on thread destruction. - submit bug report for Perl error in 30b8ab3 - localized a/b in vecreduce, see: https://metacpan.org/diff/file?target=REHSACK/List-MoreUtils-XS-0.428/&source=HERMES%2FList-MoreUtils-XS-0.427_001#XS.xs perl #92264 (sort in 5.27.7) - consider #define PERL_REENTRANT - add back formultiperm optimization if we can get around lastfor issue. - make a uint128_t version of montmath. Needs to handle 64-bit. - sieve_range does trial division - srand with no args should be calling GMP's srand with the selected seed value. This is all a hacky artifact of having the two codebases. - Look at using Ramanujan series for PP Li. - _reftyped as XS call - update prime count lower/upper from https://arxiv.org/pdf/1703.08032.pdf - urandomr - circular primes ... just use repdigits after 1M? https://oeis.org/A068652 - perhaps square-free flag for factor for early stop. Use in moebius etc. - make a NVCONST, define log, sqrt, etc. for quadmath vs. long double - move most of our long double routines to NVCONST (see above). - Change from Kalai to Bach's algorithm for random factored integers https://maths-people.anu.edu.au/~brent/pd/multiplication-HK.pdf - Adjust crossover in random_factored_integer PP code for Kalai vs. naive - Pari/GP 2.12 beta has rewritten (much faster) Bernoulli. Check it out. - semiprime_count PP just walk if small range. - limit for semiprime and ramanujan prime - consider adding multifactorial. See MPU::GMP. - multicall in forpart/forcomp. - check memory use for non-multicall. We need enter/leave which were removed. - consider the various *mod, two arg or 0 for last arg means no mod. we could use this for e.g. numseqs.pl powerflip to do powmod. - Add aliquot sum Math-Prime-Util-0.73/bin/0000755000076400007640000000000013373340013013466 5ustar danadanaMath-Prime-Util-0.73/bin/primes.pl0000755000076400007640000005054513335125715015346 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 twin_primes sieve_prime_cluster mulmod is_pillai is_prime is_provable_prime is_mersenne_prime lucasu lucasv 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.06s 0.13s # 10M 0.21 2.91 # 100M 1.52 396 # 1000M 13.7 > a day # # 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. @ARGV = (0,@ARGV) if @ARGV == 1; 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; } } # This is OEIS A000032, Lucas numbers beginning at 2. sub lucas_primes { my ($start, $end) = @_; my ($k, $Lk, @lprimes) = (0); do { $Lk = lucasv(1,-1,$k); push @lprimes, $Lk if $Lk >= $start && is_prime($Lk); $k++; } while $Lk < $end; @lprimes; } sub fibonacci_primes { my ($start, $end) = @_; my ($k, $Fk, @fprimes) = (3); do { $Fk = lucasu(1,-1,$k); push @fprimes, $Fk if $Fk >= $start && is_prime($Fk); $k = ($k <= 4) ? $k+1 : next_prime($k); } while $Fk < $end; @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)->bdec; last if $Mp > $end; push @mprimes, $Mp if $Mp >= $start && is_mersenne_prime($p); } @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 lucky number sieve to generate A000959. my @_lf63; # Lucky: 1,3,7,9,13,15,... 63=7*9. $_lf63[$_] = 1 for (qw/2 5 8 11 14 17 18 19 20 23 26 27 28 29 32 35 38 39 40 41 44 47 50 53 56 57 58 59 60 61 62/); my @lucky; my $n = 1; while ($n <= $end) { my $m63 = $n % 63; push @lucky, $n unless $_lf63[$m63]; push @lucky, $n+2 unless $_lf63[$m63+2]; $n += 6; } delete $lucky[-1] if $lucky[-1] > $end; for (my $k = 4; $k < scalar @lucky && $lucky[$k]-1 <= $#lucky; $k++) { my $skip = $lucky[$k]-1; my $index = $skip; while ($index <= $#lucky) { splice(@lucky, $index, 1); $index += $skip; } } shift @lucky while $lucky[0] < $start; # Then restrict to primes to get A031157. 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; my @pp; for my $pre (1,3,7,9) { my $beg = $pre * int(10**$rhdig); my $end = ($pre+1) * int(10**$rhdig); while ($beg < $end) { my $c = $beg . reverse substr($beg,0,$rhdig); push @pp,$c if is_prime($c); $beg++; } } return @pp; } # 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; } } # Combine the cluster types and use an efficient cluster sieve if possible if (!defined $gen) { my @cluster; if (defined $opts{'twin'}) { $cluster[2] = 1; } if (defined $opts{'cousin'}) { $cluster[4] = 1; } if (defined $opts{'sexy'}) { $cluster[6] = 1; } if (defined $opts{'triplet'}) { $cluster[6] = 1; } if (defined $opts{'quadruplet'}) { $cluster[$_] = 1 for (2,6,8); } @cluster = grep { defined $cluster[$_] } 0 .. $#cluster; if (scalar @cluster) { if (scalar(@cluster) == 1 && $cluster[0] == 2) { $p = twin_primes($start, $end); } else { $p = [sieve_prime_cluster($start, $end, @cluster)]; } $gen = 'cluster'; } } 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 we didn't generate the list with a cluster sieve, grep them out if ($gen ne 'cluster') { if (exists $opts{'twin'}) { @$p = grep { is_prime( $_+2 ); } @$p; } if (exists $opts{'quadruplet'}) { @$p = grep { is_prime($_+2) && is_prime($_+6) && is_prime($_+8); } @$p; } if (exists $opts{'triplet'}) { @$p = grep { is_prime($_+6) && (is_prime($_+2) || is_prime($_+4)); } @$p; } if (exists $opts{'cousin'}) { @$p = grep { is_prime($_+4); } @$p; } if (exists $opts{'sexy'}) { @$p = grep { is_prime($_+6); } @$p; } } else { # Cluster sieve for triplet gives us just p+6. if (exists $opts{'triplet'} && !exists $opts{'twin'} && !exists $opts{'cousin'} && !exists $opts{'quadruplet'}) { @$p = grep { is_prime($_+2) || is_prime($_+4); } @$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'}) { # See: http://en.wikipedia.org/wiki/Pillai_prime @$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; } { 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 ); sub find_mod210_restriction { my %mods_left; undef @mods_left{ grep { ($_%2) && ($_%3) && ($_%5) && ($_%7) } (0..209) }; 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.73/bin/factor.pl0000755000076400007640000000625712532503145015321 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 primality algorithm for native integers. * * There are three versions here: * V6 The v6 algorithm from the latest AKS paper. * https://www.cse.iitk.ac.in/users/manindra/algebra/primality_v6.pdf * BORNEMANN Improvements from Bernstein, Voloch, and a clever r/s * selection from Folkmar Bornemann. Similar to Bornemann's * 2003 Pari/GP implementation: * https://homepage.univie.ac.at/Dietrich.Burde/pari/aks.gp * BERN41 My implementation of theorem 4.1 from Bernstein's 2003 paper. * https://cr.yp.to/papers/aks.pdf * * Each one is orders of magnitude faster than the previous, and by default * we use Bernstein 4.1 as it is by far the fastest. * * Note that AKS is very, very slow compared to other methods. It is, however, * polynomial in log(N), and log-log performance graphs show nice straight * lines for both implementations. However APR-CL and ECPP both start out * much faster and the slope will be less for any sizes of N that we're * interested in. * * For native 64-bit integers this is purely a coding exercise, as BPSW is * a million times faster and gives proven results. * * * 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-2016, Dana Jacobsen. */ #define SQRTN_SHORTCUT 1 #define IMPL_V6 0 /* From the primality_v6 paper */ #define IMPL_BORNEMANN 0 /* From Bornemann's 2002 implementation */ #define IMPL_BERN41 1 /* From Bernstein's early 2003 paper */ #include "ptypes.h" #include "aks.h" #define FUNC_isqrt 1 #define FUNC_gcd_ui 1 #include "util.h" #include "cache.h" #include "mulmod.h" #include "factor.h" #if IMPL_BORNEMANN || IMPL_BERN41 /* We could use lgamma, but it isn't in MSVC and not in pre-C99. The only * sure way to find if it is available is test compilation (ala autoconf). * Instead, we'll just use our own implementation. * See http://mrob.com/pub/ries/lanczos-gamma.html for alternates. */ static double log_gamma(double x) { static const double log_sqrt_two_pi = 0.91893853320467274178; static const double lanczos_coef[8+1] = { 0.99999999999980993, 676.5203681218851, -1259.1392167224028, 771.32342877765313, -176.61502916214059, 12.507343278686905, -0.13857109526572012, 9.9843695780195716e-6, 1.5056327351493116e-7 }; double base = x + 7.5, sum = 0; int i; for (i = 8; i >= 1; i--) sum += lanczos_coef[i] / (x + (double)i); sum += lanczos_coef[0]; sum = log_sqrt_two_pi + log(sum/x) + ( (x+0.5)*log(base) - base ); return sum; } /* Note: For lgammal we need logl in the above. * Max error drops from 2.688466e-09 to 1.818989e-12. */ #undef lgamma #define lgamma(x) log_gamma(x) #endif #if IMPL_BERN41 static double log_binomial(UV n, UV k) { return log_gamma(n+1) - log_gamma(k+1) - log_gamma(n-k+1); } static double log_bern41_binomial(UV r, UV d, UV i, UV j, UV s) { return log_binomial( 2*s, i) + log_binomial( d, i) + log_binomial( 2*s-i, j) + log_binomial( r-2-d, j); } static int bern41_acceptable(UV n, UV r, UV s) { double scmp = ceil(sqrt( (r-1)/3.0 )) * log(n); UV d = (UV) (0.5 * (r-1)); UV i = (UV) (0.475 * (r-1)); UV j = i; if (d > r-2) d = r-2; if (i > d) i = d; if (j > (r-2-d)) j = r-2-d; return (log_bern41_binomial(r,d,i,j,s) >= scmp); } #endif #if 0 /* Naive znorder. Works well if limit is small. Note arguments. */ 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; } 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; /* 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) { /* res will be written completely, so no need to set */ 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 { memset(res, 0, r * sizeof(UV)); /* Zero result accumulator */ 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; int native_sqr = (mod > isqrt(UV_MAX/(2*r))) ? 0 : 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; if (native_sqr) { 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; #if HAVE_UINT128 } else { uint128_t max = ((uint128_t)1 << 127) - 1; uint128_t c128, sum128 = 0; while (pp1 < ppend) { c128 = ((uint128_t)*pp1++) * ((uint128_t)*pp2--); if (c128 > max) c128 %= mod; c128 <<= 1; if (c128 > max) c128 %= mod; sum128 += c128; if (sum128 > max) sum128 %= mod; } c128 = px[s_end]; if (s_end*2 == d) { c128 *= c128; } else { c128 *= px[d-s_end]; if (c128 > max) c128 %= mod; c128 <<= 1; } if (c128 > max) c128 %= mod; sum128 += c128; if (sum128 > max) sum128 %= mod; rindex = (d < r) ? d : d-r; /* d % r */ res[rindex] = ((uint128_t)res[rindex] + sum128) % mod; #else } else { while (pp1 < ppend) { UV p1 = *pp1++; UV p2 = *pp2--; sum = addmod(sum, mulmod(2, mulmod(p1, p2, mod), mod), mod); } c = px[s_end]; if (s_end*2 == d) sum = addmod(sum, sqrmod(c, mod), mod); else sum = addmod(sum, mulmod(2, mulmod(c, px[d-s_end], mod), mod), mod); rindex = (d < r) ? d : d-r; /* d % r */ res[rindex] = addmod(res[rindex], sum, mod); #endif } } 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, *temp; Newz(0, res, r, UV); New(0, temp, r, UV); res[0] = 1; while (power) { if (power & 1) poly_mod_mul(res, pn, temp, r, mod); power >>= 1; if (power) poly_mod_sqr(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); 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; } /* * Avanzi and Mihǎilescu, 2007 * http://www.uni-math.gwdg.de/preda/mihailescu-papers/ouraks3.pdf * "As a consequence, one cannot expect the present variants of AKS to * compete with the earlier primality proving methods like ECPP and * cyclotomy." - conclusion regarding memory consumption */ int is_aks_prime(UV n) { UV r, s, a, starta = 1; if (n < 2) return 0; if (n == 2) return 1; if (is_power(n, 0)) return 0; if (n > 11 && ( !(n%2) || !(n%3) || !(n%5) || !(n%7) || !(n%11) )) return 0; /* if (!is_prob_prime(n)) return 0; */ #if IMPL_V6 { UV sqrtn = isqrt(n); double log2n = log(n) / log(2); /* C99 has a log2() function */ UV limit = (UV) floor(log2n * log2n); MPUverbose(1, "# 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 (znorder(n, r) > limit) break; } if (r >= n) return 1; s = (UV) floor(sqrt(r-1) * log2n); } #endif #if IMPL_BORNEMANN { UV fac[MPU_MAX_FACTORS+1]; UV slim; double c1, c2, x; double const t = 48; double const t1 = (1.0/((t+1)*log(t+1)-t*log(t))); double const dlogn = log(n); r = next_prime( (UV) (t1*t1 * dlogn*dlogn) ); while (!is_primitive_root(n,r,1)) r = next_prime(r); slim = (UV) (2*t*(r-1)); c1 = lgamma(r-1); c2 = dlogn * floor(sqrt(r)); { /* Binary search for first s in [1,slim] where x >= 0 */ UV i = 1; UV j = slim; while (i < j) { s = i + (j-i)/2; x = (lgamma(r-1+s) - c1 - lgamma(s+1)) / c2 - 1.0; if (x < 0) i = s+1; else j = s; } s = i-1; } s = (s+3) >> 1; /* Bornemann checks factors up to (s-1)^2, we check to max(r,s) */ /* slim = (s-1)*(s-1); */ slim = (r > s) ? r : s; MPUverbose(2, "# aks trial to %lu\n", slim); if (trial_factor(n, fac, 2, slim) > 1) return 0; if (slim >= HALF_WORD || (slim*slim) >= n) return 1; } #endif #if IMPL_BERN41 { UV slim, fac[MPU_MAX_FACTORS+1]; double const log2n = log(n) / log(2); /* Tuning: Initial 'r' selection. Search limit for 's'. */ double const r0 = ((log2n > 32) ? 0.010 : 0.003) * log2n * log2n; UV const rmult = (log2n > 32) ? 6 : 30; r = next_prime(r0 < 2 ? 2 : (UV)r0); /* r must be at least 3 */ while ( !is_primitive_root(n,r,1) || !bern41_acceptable(n,r,rmult*(r-1)) ) r = next_prime(r); { /* Binary search for first s in [1,slim] where conditions met */ UV bi = 1; UV bj = rmult * (r-1); while (bi < bj) { s = bi + (bj-bi)/2; if (!bern41_acceptable(n, r, s)) bi = s+1; else bj = s; } s = bj; if (!bern41_acceptable(n, r, s)) croak("AKS: bad s selected"); /* S goes from 2 to s+1 */ starta = 2; s = s+1; } /* Check divisibility to s * (s-1) to cover both gcd conditions */ slim = s * (s-1); MPUverbose(2, "# aks trial to %lu\n", (unsigned long)slim); if (trial_factor(n, fac, 2, slim) > 1) return 0; if (slim >= HALF_WORD || (slim*slim) >= n) return 1; /* Check b^(n-1) = 1 mod n for b in [2..s] */ for (a = 2; a <= s; a++) { if (powmod(a, n-1, n) != 1) return 0; } } #endif MPUverbose(1, "# aks r = %lu s = %lu\n", (unsigned long) r, (unsigned long) s); /* Almost every composite will get recognized by the first test. * However, we need to run 's' tests to have the result proven for all n * based on the theorems we have available at this time. */ for (a = starta; a <= s; a++) { if (! test_anr(a, n, r) ) return 0; MPUverbose(2, "."); } MPUverbose(2, "\n"); return 1; } Math-Prime-Util-0.73/LICENSE0000644000076400007640000004367513204400603013735 0ustar danadanaThis software is Copyright (c) 2011-2016 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-2016 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-2016 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.73/random_prime.h0000644000076400007640000000057413204400603015544 0ustar danadana#ifndef MPU_RANDOM_PRIME_H #define MPU_RANDOM_PRIME_H #include "ptypes.h" extern UV random_nbit_prime(void* ctx, UV b); extern UV random_ndigit_prime(void* ctx, UV d); extern UV random_prime(void* ctx, UV lo, UV hi); extern int is_mr_random(void* ctx, UV n, UV k); extern UV random_semiprime(void* ctx, UV b); extern UV random_unrestricted_semiprime(void* ctx, UV b); #endif Math-Prime-Util-0.73/README0000644000076400007640000000344713373337725013626 0ustar danadanaMath::Prime::Util version 0.73 A module for number theory in Perl. This includes prime sieving, primality tests, primality proofs, integer factoring, counts / bounds / approximations for primes, nth primes, and twin primes, random prime generation, and much 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 Math::ModInt::ChineseRemainder 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::Tiny 1.002 or later. COPYRIGHT AND LICENCE Copyright (C) 2011-2018 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.73/util.c0000644000076400007640000030550113373332062014050 0ustar danadana#include #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). Note that 'long double' on many platforms is * identical to 'double so it may buy us nothing. But it's worth trying. * * While the type was in C89, math functions using it are in C99. Some * systems didn't really get it right (e.g. NetBSD which left out some * functions for 13 years). */ #include #if _MSC_VER || defined(__IBMC__) | defined(__IBMCPP__) || (defined(__STDC_VERSION__) && __STDC_VERSION >= 199901L) /* math.h should give us these as functions or macros. * * extern long double fabsl(long double); * extern long double floorl(long double); * extern long double ceill(long double); * extern long double sqrtl(long double); * extern long double powl(long double, long double); * extern long double expl(long double); * extern long double logl(long double); */ #else #define fabsl(x) (long double) fabs( (double) (x) ) #define floorl(x) (long double) floor( (double) (x) ) #define ceill(x) (long double) ceil( (double) (x) ) #define sqrtl(x) (long double) sqrt( (double) (x) ) #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) ) #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 #ifndef LDBL_MAX #define LDBL_MAX DBL_MAX #endif #include "ptypes.h" #define FUNC_isqrt 1 #define FUNC_icbrt 1 #define FUNC_lcm_ui 1 #define FUNC_ctz 1 #define FUNC_log2floor 1 #define FUNC_is_perfect_square #define FUNC_is_perfect_cube #define FUNC_is_perfect_fifth #define FUNC_is_perfect_seventh #define FUNC_next_prime_in_sieve 1 #define FUNC_prev_prime_in_sieve 1 #define FUNC_ipow 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" #include "montmath.h" #include "csprng.h" #include "keyval.h" #define KAHAN_INIT(s) \ LNV s ## _y, s ## _t; \ LNV s ## _c = 0.0; \ LNV 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) int _numcmp(const void *a, const void *b) { const UV *x = a, *y = b; return (*x > *y) ? 1 : (*x < *y) ? -1 : 0; } 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; } static int _secure = 0; void _XS_set_secure(void) { _secure = 1; } int _XS_get_secure(void) { return _secure; } /* 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])) static const unsigned short primes_tiny[] = {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}; #define NPRIMES_TINY (sizeof(primes_tiny)/sizeof(primes_tiny[0])) /* Return of 2 if n is prime, 0 if not. Do it fast. */ int 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; /* 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 */ if (n <= get_prime_cache(0,0)) { int 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, next; 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 */ if (n < get_prime_cache(0,0)) { const unsigned char* sieve; UV 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) { UV m, prev; if (n < 30*NPRIME_SIEVE30) return prev_prime_in_sieve(prime_sieve30, n); if (n < get_prime_cache(0,0)) { const unsigned char* sieve; UV sieve_size = get_prime_cache(0, &sieve); prev = (n < sieve_size) ? prev_prime_in_sieve(sieve, n) : 0; release_prime_cache(sieve); if (prev != 0) return prev; } m = n % 30; do { /* Move back one. */ n -= wheelretreat30[m]; m = prevwheel30[m]; } while (!is_prob_prime(n)); return n; } /******************************************************************************/ /* PRINTING */ /******************************************************************************/ static int my_sprint(char* ptr, UV val) { int nchars; UV t; char *s = ptr; do { t = val / 10; *s++ = (char) ('0' + val - 10 * t); } while ((val = t)); nchars = s - ptr + 1; *s = '\n'; while (--s > ptr) { char c = *s; *s = *ptr; *ptr++ = c; } return nchars; } static char* write_buf(int fd, char* buf, char* bend) { int res = (int) write(fd, buf, bend-buf); if (res == -1) croak("print_primes write error"); return buf; } void print_primes(UV low, UV high, int fd) { char buf[8000+25]; char* bend = buf; if ((low <= 2) && (high >= 2)) bend += my_sprint(bend,2); if ((low <= 3) && (high >= 3)) bend += my_sprint(bend,3); if ((low <= 5) && (high >= 5)) bend += my_sprint(bend,5); if (low < 7) low = 7; if (low <= high) { 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_base, seg_low, seg_high ) bend += my_sprint(bend,p); if (bend-buf > 8000) { bend = write_buf(fd, buf, bend); } END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } if (bend > buf) { bend = write_buf(fd, buf, bend); } } /******************************************************************************/ /* TOTIENT, MOEBIUS, MERTENS */ /******************************************************************************/ /* 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(ip,p,lo) ((ip)>=(lo)) ? (ip) : ((p)*((lo)/(p)) + (((lo)%(p))?(p):0)) signed char* range_moebius(UV lo, UV hi) { signed char* mu; UV i, sqrtn = isqrt(hi), count = hi-lo+1; /* 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, nextlogi; Newz(0, mu, count, signed char); if (sqrtn*sqrtn != hi && sqrtn < (UVCONST(1)<<(BITS_PER_WORD/2))-1) sqrtn++; /* For small ranges, do it by hand */ if (hi < 100 || count <= 10 || (hi > (1UL<<25) && count < icbrt(hi)/4)) { for (i = 0; i < count; i++) mu[i] = moebius(lo+i); return mu; } 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, p, lo); i >= lo && i <= hi; i += p) mu[i-lo] += logp; for (i = PGTLO(p2, p2, lo); i >= lo && i <= hi; i += p2) mu[i-lo] = 0x80; } END_DO_FOR_EACH_PRIME logp = log2floor(lo); nextlogi = (UVCONST(2) << logp) - lo; for (i = 0; i < count; i++) { unsigned char a = mu[i]; if (i >= nextlogi) nextlogi = (UVCONST(2) << ++logp) - lo; if (a & 0x80) { a = 0; } else if (a >= logp) { a = 1 - 2*(a&1); } else { a = -1 + 2*(a&1); } mu[i] = a; } if (lo == 0) mu[0] = 0; return mu; } UV* range_totient(UV lo, UV hi) { UV* totients; UV i, seg_base, seg_low, seg_high, count = hi-lo+1; unsigned char* segment; void* ctx; if (hi < lo) croak("range_totient error hi %"UVuf" < lo %"UVuf"\n", hi, lo); New(0, totients, count, UV); /* Do via factoring if very small or if we have a small range */ if (hi < 100 || count <= 10 || hi/count > 1000) { for (i = 0; i < count; i++) totients[i] = totient(lo+i); return totients; } if (hi == UV_MAX) { totients[--count] = totient(UV_MAX); hi--; } /* If doing a full sieve, do it monolithic. Faster. */ if (lo == 0) { UV* prime; double loghi = log(hi); UV max_index = (hi < 67) ? 18 : (hi < 355991) ? 15+(hi/(loghi-1.09)) : (hi/loghi) * (1.0+1.0/loghi+2.51/(loghi*loghi)); UV j, index, nprimes = 0; New(0, prime, max_index, UV); /* could use prime_count_upper(hi) */ memset(totients, 0, count * sizeof(UV)); for (i = 2; i <= hi/2; i++) { index = 2*i; if ( !(i&1) ) { if (i == 2) { totients[2] = 1; prime[nprimes++] = 2; } totients[index] = totients[i]*2; } else { if (totients[i] == 0) { totients[i] = i-1; prime[nprimes++] = i; } for (j=0; j < nprimes && index <= hi; index = i*prime[++j]) { if (i % prime[j] == 0) { totients[index] = totients[i]*prime[j]; break; } else { totients[index] = totients[i]*(prime[j]-1); } } } } Safefree(prime); /* All totient values have been filled in except the primes. Mark them. */ for (i = ((hi/2) + 1) | 1; i <= hi; i += 2) if (totients[i] == 0) totients[i] = i-1; totients[1] = 1; totients[0] = 0; return totients; } for (i = 0; i < count; i++) { UV v = lo+i, nv = v; if (v % 2 == 0) nv -= nv/2; if (v % 3 == 0) nv -= nv/3; if (v % 5 == 0) nv -= nv/5; totients[i] = nv; } 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_base, seg_low, seg_high ) { for (i = PGTLO(2*p,p,lo); i >= 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) - lo; i < count; i += 2) if (totients[i] == i+lo) totients[i]--; if (lo <= 1) totients[1-lo] = 1; 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, j, m, nmk, maxmu; signed char* mu; short* M; /* 16 bits is enough range for all 32-bit M => 64-bit n */ 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 = range_moebius(0, maxmu); New(0, M, maxmu+1, short); /* Works up to maxmu < 7613644886 */ M[0] = 0; for (j = 1; j <= maxmu; j++) M[j] = M[j-1] + mu[j]; 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; inner_sum += M[nmk] * (this_k - next_k); } sum += (mu[m] > 0) ? -inner_sum : inner_sum; } } Safefree(M); Safefree(mu); return sum; } /******************************************************************************/ /* POWERS and ROOTS */ /******************************************************************************/ /* There are at least 4 ways to do this, plus hybrids. * 1) use a table. Great for 32-bit, too big for 64-bit. * 2) Use pow() to check. Relatively slow and FP is always dangerous. * 3) factor or trial factor. Slow for 64-bit. * 4) Dietzfelbinger algorithm 2.3.5. Quite slow. * This currently uses a hybrid of 1 and 2. */ int powerof(UV n) { UV t; if ((n <= 3) || (n == UV_MAX)) return 1; if ((n & (n-1)) == 0) return ctz(n); /* powers of 2 */ if (is_perfect_square(n)) return 2 * powerof(isqrt(n)); if (is_perfect_cube(n)) return 3 * powerof(icbrt(n)); /* Simple rejection filter for non-powers of 5-37. Rejects 47.85%. */ t = n & 511; if ((t*77855451) & (t*4598053) & 862) return 1; if (is_perfect_fifth(n)) return 5 * powerof(rootof(n,5)); if (is_perfect_seventh(n)) return 7 * powerof(rootof(n,7)); if (n > 177146 && n <= UVCONST(1977326743)) { switch (n) { /* Check for powers of 11, 13, 17, 19 within 32 bits */ case 177147: case 48828125: case 362797056: case 1977326743: return 11; case 1594323: case 1220703125: return 13; case 129140163: return 17; case 1162261467: return 19; default: break; } } #if BITS_PER_WORD == 64 if (n >= UVCONST(8589934592)) { /* The Bloom filters reject about 90% of inputs each, about 99% for two. * Bach/Sorenson type sieves do about as well, but are much slower due * to using a powmod. */ if ( (t = n %121, !((t*19706187) & (t*61524433) & 876897796)) && (t = n % 89, !((t*28913398) & (t*69888189) & 2705511937U)) ) { /* (t = n % 67, !((t*117621317) & (t*48719734) & 537242019)) ) { */ UV root = rootof(n,11); if (n == ipow(root,11)) return 11; } if ( (t = n %131, !((t*1545928325) & (t*1355660813) & 2771533888U)) && (t = n % 79, !((t*48902028) & (t*48589927) & 404082779)) ) { /* (t = n % 53, !((t*79918293) & (t*236846524) & 694943819)) ) { */ UV root = rootof(n,13); if (n == ipow(root,13)) return 13; } switch (n) { case UVCONST(762939453125): case UVCONST(16926659444736): case UVCONST(232630513987207): case UVCONST(100000000000000000): case UVCONST(505447028499293771): case UVCONST(2218611106740436992): case UVCONST(8650415919381337933): return 17; case UVCONST(19073486328125): case UVCONST(609359740010496): case UVCONST(11398895185373143): case UVCONST(10000000000000000000): return 19; case UVCONST(94143178827): case UVCONST(11920928955078125): case UVCONST(789730223053602816): return 23; case UVCONST(68630377364883): return 29; case UVCONST(617673396283947): return 31; case UVCONST(450283905890997363): return 37; default: break; } } #endif return 1; } int is_power(UV n, UV a) { int ret; if (a > 0) { if (a == 1 || n <= 1) return 1; if ((a % 2) == 0) return !is_perfect_square(n) ? 0 : (a == 2) ? 1 : is_power(isqrt(n),a>>1); if ((a % 3) == 0) return !is_perfect_cube(n) ? 0 : (a == 3) ? 1 : is_power(icbrt(n),a/3); if ((a % 5) == 0) return !is_perfect_fifth(n) ? 0 : (a == 5) ? 1 :is_power(rootof(n,5),a/5); } ret = powerof(n); if (a != 0) return !(ret % a); /* Is the max power divisible by a? */ return (ret == 1) ? 0 : ret; } #if BITS_PER_WORD == 64 #define ROOT_MAX_3 41 static const uint32_t root_max[ROOT_MAX_3] = {0,0,0,2642245,65535,7131,1625,565,255,138,84,56,40,30,23,19,15,13,11,10,9,8,7,6,6,5,5,5,4,4,4,4,3,3,3,3,3,3,3,3,3}; #else #define ROOT_MAX_3 21 static const uint32_t root_max[ROOT_MAX_3] = {0,0,0,1625,255,84,40,23,15,11,9,7,6,5,4,4,3,3,3,3,3}; #endif UV rootof(UV n, UV k) { UV lo, hi, max; if (k == 0) return 0; if (k == 1) return n; if (k == 2) return isqrt(n); if (k == 3) return icbrt(n); /* Bracket between powers of 2, but never exceed max power so ipow works */ max = 1 + ((k >= ROOT_MAX_3) ? 2 : root_max[k]); lo = UVCONST(1) << (log2floor(n)/k); hi = ((lo*2) < max) ? lo*2 : max; /* Binary search */ while (lo < hi) { UV mid = lo + (hi-lo)/2; if (ipow(mid,k) <= n) lo = mid+1; else hi = mid; } return lo-1; } int primepower(UV n, UV* prime) { int power = 0; if (n < 2) return 0; /* Check for small divisors */ if (!(n&1)) { if (n & (n-1)) return 0; *prime = 2; return ctz(n); } if ((n%3) == 0) { /* if (UVCONST(12157665459056928801) % n) return 0; */ do { n /= 3; power++; } while (n > 1 && (n%3) == 0); if (n != 1) return 0; *prime = 3; return power; } if ((n%5) == 0) { do { n /= 5; power++; } while (n > 1 && (n%5) == 0); if (n != 1) return 0; *prime = 5; return power; } if ((n%7) == 0) { do { n /= 7; power++; } while (n > 1 && (n%7) == 0); if (n != 1) return 0; *prime = 7; return power; } if (is_prob_prime(n)) { *prime = n; return 1; } /* Composite. Test for perfect power with prime root. */ power = powerof(n); if (power == 1) power = 0; if (power) { UV root = rootof(n, (UV)power); if (is_prob_prime(root)) *prime = root; else power = 0; } return power; } UV valuation(UV n, UV k) { UV v = 0; UV kpower = k; if (k < 2 || n < 2) return 0; if (k == 2) return ctz(n); while ( !(n % kpower) ) { kpower *= k; v++; } return v; } UV logint(UV n, UV b) { /* UV e; for (e=0; n; n /= b) e++; return e-1; */ UV v, e = 0; if (b == 2) return log2floor(n); if (n > UV_MAX/b) { n /= b; e = 1; } for (v = b; v <= n; v *= b) e++; return e; } UV mpu_popcount_string(const char* ptr, uint32_t len) { uint32_t count = 0, i, j, d, v, power, slen, *s, *sptr; while (len > 0 && (*ptr == '0' || *ptr == '+' || *ptr == '-')) { ptr++; len--; } /* Create s as array of base 10^8 numbers */ slen = (len + 7) / 8; Newz(0, s, slen, uint32_t); for (i = 0; i < slen; i++) { /* Chunks of 8 digits */ for (j = 0, d = 0, power = 1; j < 8 && len > 0; j++, power *= 10) { v = ptr[--len] - '0'; if (v > 9) croak("Parameter '%s' must be a positive integer",ptr); d += power * v; } s[slen - 1 - i] = d; } /* Repeatedly count and divide by 2 across s */ while (slen > 1) { if (s[slen-1] & 1) count++; sptr = s; if (s[0] == 1) { if (--slen == 0) break; *++sptr += 100000000; } for (i = 0; i < slen; i++) { if ( (i+1) < slen && sptr[i] & 1 ) sptr[i+1] += 100000000; s[i] = sptr[i] >> 1; } } /* For final base 10^8 number just do naive popcnt */ for (d = s[0]; d > 0; d >>= 1) if (d & 1) count++; Safefree(s); return count; } /* 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 factorial(UV n) { UV i, r = 1; if ( (n > 12 && sizeof(UV) <= 4) || (n > 20 && sizeof(UV) <= 8) ) return 0; for (i = 2; i <= n; i++) r *= i; return r; } UV binomial(UV n, UV k) { /* Thanks to MJD and RosettaCode for ideas */ UV d, g, r = 1; if (k == 0) return 1; if (k == 1) return n; if (k >= n) return (k == n); if (k > n/2) k = n-k; for (d = 1; d <= k; d++) { if (r >= UV_MAX/n) { /* Possible overflow */ UV nr, dr; /* reduced numerator / denominator */ g = gcd_ui(n, d); nr = n/g; dr = d/g; g = gcd_ui(r, dr); r = r/g; dr = dr/g; if (r >= UV_MAX/nr) return 0; /* Unavoidable overflow */ r *= nr; r /= dr; n--; } else { r *= n--; r /= d; } } return r; } UV stirling3(UV n, UV m) { /* Lah numbers */ UV f1, f2; if (m == n) return 1; if (n == 0 || m == 0 || m > n) return 0; if (m == 1) return factorial(n); f1 = binomial(n, m); if (f1 == 0) return 0; f2 = binomial(n-1, m-1); if (f2 == 0 || f1 >= UV_MAX/f2) return 0; f1 *= f2; f2 = factorial(n-m); if (f2 == 0 || f1 >= UV_MAX/f2) return 0; return f1 * f2; } IV stirling2(UV n, UV m) { UV f; IV j, k, t, s = 0; if (m == n) return 1; if (n == 0 || m == 0 || m > n) return 0; if (m == 1) return 1; if ((f = factorial(m)) == 0) return 0; for (j = 1; j <= (IV)m; j++) { t = binomial(m, j); for (k = 1; k <= (IV)n; k++) { if (t == 0 || j >= IV_MAX/t) return 0; t *= j; } if ((m-j) & 1) t *= -1; s += t; } return s/f; } IV stirling1(UV n, UV m) { IV k, t, b1, b2, s2, s = 0; if (m == n) return 1; if (n == 0 || m == 0 || m > n) return 0; if (m == 1) { UV f = factorial(n-1); if (f>(UV)IV_MAX) return 0; return (n&1) ? ((IV)f) : -((IV)f); } for (k = 1; k <= (IV)(n-m); k++) { b1 = binomial(k + n - 1, n - m + k); b2 = binomial(2 * n - m, n - m - k); s2 = stirling2(n - m + k, k); if (b1 == 0 || b2 == 0 || s2 == 0 || b1 > IV_MAX/b2) return 0; t = b1 * b2; if (s2 > IV_MAX/t) return 0; t *= s2; s += (k & 1) ? -t : t; } return s; } UV totient(UV n) { UV i, nfacs, totient, lastf, facs[MPU_MAX_FACTORS+1]; if (n <= 1) return n; totient = 1; /* phi(2m) = 2phi(m) if m even, phi(m) if m odd */ while ((n & 0x3) == 0) { n >>= 1; totient <<= 1; } if ((n & 0x1) == 0) { n >>= 1; } /* factor and calculate totient */ nfacs = factor(n, facs); 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 totient; if (k == 0 || n <= 1) return (n == 1); if (k > 6 || (k > 1 && n >= jordan_overflow[k-2])) return 0; totient = 1; /* Similar to Euler totient, shortcut even inputs */ while ((n & 0x3) == 0) { n >>= 1; totient *= (1<>= 1; totient *= ((1<> 2; i = ctz(n); if (i > 0) { n >>= i; lambda <<= (i>2) ? i-2 : i-1; } nfactors = factor(n, fac); for (i = 0; i < nfactors; i++) { UV p = fac[i], pk = p-1; while (i+1 < nfactors && p == fac[i+1]) { i++; pk *= p; } lambda = lcm_ui(lambda, pk); } return lambda; } int is_carmichael(UV n) { UV fac[MPU_MAX_FACTORS+1]; UV exp[MPU_MAX_FACTORS+1]; int i, nfactors; /* Small or even is not a Carmichael number */ if (n < 561 || !(n&1)) return 0; /* Simple pre-test for square free (odds only) */ if (!(n% 9) || !(n%25) || !(n%49) || !(n%121) || !(n%169)) return 0; /* Check Korselt's criterion for small divisors */ if (!(n% 5) && ((n-1) % 4 != 0)) return 0; if (!(n% 7) && ((n-1) % 6 != 0)) return 0; if (!(n%11) && ((n-1) % 10 != 0)) return 0; if (!(n%13) && ((n-1) % 12 != 0)) return 0; if (!(n%17) && ((n-1) % 16 != 0)) return 0; if (!(n%19) && ((n-1) % 18 != 0)) return 0; if (!(n%23) && ((n-1) % 22 != 0)) return 0; /* Fast check without having to factor */ if (n > 5000000) { if (!(n%29) && ((n-1) % 28 != 0)) return 0; if (!(n%31) && ((n-1) % 30 != 0)) return 0; if (!(n%37) && ((n-1) % 36 != 0)) return 0; if (!(n%41) && ((n-1) % 40 != 0)) return 0; if (!(n%43) && ((n-1) % 42 != 0)) return 0; if (!is_pseudoprime(n,2)) return 0; } nfactors = factor_exp(n, fac, exp); if (nfactors < 3) return 0; for (i = 0; i < nfactors; i++) { if (exp[i] > 1 || ((n-1) % (fac[i]-1)) != 0) return 0; } return 1; } static int is_quasi_base(int nfactors, UV *fac, UV p, UV b) { int i; for (i = 0; i < nfactors; i++) { UV d = fac[i] - b; if (d == 0 || (p % d) != 0) return 0; } return 1; } /* Returns number of bases that pass */ UV is_quasi_carmichael(UV n) { UV nbases, fac[MPU_MAX_FACTORS+1], exp[MPU_MAX_FACTORS+1]; UV spf, lpf, ndivisors, *divs; int i, nfactors; if (n < 35) return 0; /* Simple pre-test for square free */ if (!(n% 4) || !(n% 9) || !(n%25) || !(n%49) || !(n%121) || !(n%169)) return 0; nfactors = factor_exp(n, fac, exp); /* Must be composite */ if (nfactors < 2) return 0; /* Must be square free */ for (i = 0; i < nfactors; i++) if (exp[i] > 1) return 0; nbases = 0; spf = fac[0]; lpf = fac[nfactors-1]; /* Algorithm from Hiroaki Yamanouchi, 2015 */ if (nfactors == 2) { divs = _divisor_list(n / spf - 1, &ndivisors); for (i = 0; i < (int)ndivisors; i++) { UV d = divs[i]; UV k = spf - d; if (d >= spf) break; if (is_quasi_base(nfactors, fac, n-k, k)) nbases++; } } else { divs = _divisor_list(lpf * (n / lpf - 1), &ndivisors); for (i = 0; i < (int)ndivisors; i++) { UV d = divs[i]; UV k = lpf - d; if (lpf > d && k >= spf) continue; if (k != 0 && is_quasi_base(nfactors, fac, n-k, k)) nbases++; } } Safefree(divs); return nbases; } int is_semiprime(UV n) { UV sp, p, n3, factors[2]; if (n < 6) return (n == 4); if (!(n&1)) return !!is_prob_prime(n>>1); if (!(n%3)) return !!is_prob_prime(n/3); if (!(n%5)) return !!is_prob_prime(n/5); /* 27% of random inputs left */ n3 = icbrt(n); for (sp = 4; sp < 60; sp++) { p = primes_tiny[sp]; if (p > n3) break; if ((n % p) == 0) return !!is_prob_prime(n/p); } /* 9.8% of random inputs left */ if (is_def_prime(n)) return 0; if (p > n3) return 1; /* past this, n is a composite and larger than p^3 */ /* 4-8% of random inputs left */ if (factor_one(n, factors, 0, 0) != 2) return 0; return (is_def_prime(factors[0]) && is_def_prime(factors[1])); } int is_fundamental(UV n, int neg) { UV r = n & 15; if (r) { if (!neg) { switch (r & 3) { case 0: return (r == 4) ? 0 : is_square_free(n >> 2); case 1: return is_square_free(n); default: break; } } else { switch (r & 3) { case 0: return (r == 12) ? 0 : is_square_free(n >> 2); case 3: return is_square_free(n); default: break; } } } return 0; } static int _totpred(UV n, UV maxd) { UV i, ndivisors, *divs; int res; if (n & 1) return 0; n >>= 1; if (n == 1) return 1; if (n < maxd && is_prime(2*n+1)) return 1; divs = _divisor_list(n, &ndivisors); for (i = 0, res = 0; i < ndivisors && divs[i] < maxd && res == 0; i++) { UV r, d = divs[i], p = 2*d+1; if (!is_prime(p)) continue; r = n/d; while (1) { if (r == p || _totpred(r, d)) { res = 1; break; } if (r % p) break; r /= p; } } Safefree(divs); return res; } int is_totient(UV n) { return (n == 0 || (n & 1)) ? (n==1) : _totpred(n,n); } UV inverse_totient_count(UV n) { set_t set, sumset; keyval_t keyval; UV res, i, ndivisors, *divs; if (n == 1) return 2; if (n < 1 || n & 1) return 0; if (is_prime(n >> 1)) { /* Coleman Remark 3.3 (Thm 3.1) and Prop 6.2 */ if (!is_prime(n+1)) return 0; if (n >= 10) return 2; } divs = _divisor_list(n, &ndivisors); init_set(&set, 2*ndivisors); keyval.key = 1; keyval.val = 1; set_addsum(&set, keyval); for (i = 0; i < ndivisors; i++) { UV d = divs[i], p = d+1; if (is_prime(p)) { UV j, np = d, v = valuation(n, p); init_set(&sumset, ndivisors/2); for (j = 0; j <= v; j++) { UV k, ndiv = n/np; /* Loop over divisors of n/np */ if (np == 1) { keyval_t kv; kv.key = 1; kv.val = 1; set_addsum(&sumset, kv); } else { for (k = 0; k < ndivisors && divs[k] <= ndiv; k++) { UV val, d2 = divs[k]; if ((ndiv % d2) != 0) continue; val = set_getval(set, d2); if (val > 0) { keyval_t kv; kv.key = d2*np; kv.val = val; set_addsum(&sumset, kv); } } } /* if (j < v && np > UV_MAX/p) croak("overflow np d %lu", d); */ np *= p; } set_merge(&set, sumset); free_set(&sumset); } } Safefree(divs); res = set_getval(set, n); free_set(&set); return res; } UV* inverse_totient_list(UV *ntotients, UV n) { set_list_t setlist, divlist; UV i, ndivisors, *divs, *tlist; UV *totlist = 0; MPUassert(n <= UV_MAX/7.5, "inverse_totient_list n too large"); if (n == 1) { New(0, totlist, 2, UV); totlist[0] = 1; totlist[1] = 2; *ntotients = 2; return totlist; } if (n < 1 || n & 1) { *ntotients = 0; return totlist; } if (is_prime(n >> 1)) { /* Coleman Remark 3.3 (Thm 3.1) and Prop 6.2 */ if (!is_prime(n+1)) { *ntotients = 0; return totlist; } if (n >= 10) { New(0, totlist, 2, UV); totlist[0] = n+1; totlist[1] = 2*n+2; *ntotients = 2; return totlist; } } divs = _divisor_list(n, &ndivisors); init_setlist(&setlist, 2*ndivisors); setlist_addval(&setlist, 1, 1); /* Add 1 => [1] */ for (i = 0; i < ndivisors; i++) { UV d = divs[i], p = d+1; if (is_prime(p)) { UV j, dp = d, pp = p, v = valuation(n, p); init_setlist(&divlist, ndivisors/2); for (j = 0; j <= v; j++) { UV k, ndiv = n/dp; /* Loop over divisors of n/dp */ if (dp == 1) { setlist_addval(&divlist, 1, 2); /* Add 1 => [2] */ } else { for (k = 0; k < ndivisors && divs[k] <= ndiv; k++) { UV nvals, *vals, d2 = divs[k]; if ((ndiv % d2) != 0) continue; vals = setlist_getlist(&nvals, setlist, d2); if (vals != 0) setlist_addlist(&divlist, d2 * dp, nvals, vals, pp); } } dp *= p; pp *= p; } setlist_merge(&setlist, divlist); free_setlist(&divlist); } } Safefree(divs); tlist = setlist_getlist(ntotients, setlist, n); if (tlist != 0 && *ntotients > 0) { New(0, totlist, *ntotients, UV); memcpy(totlist, tlist, *ntotients * sizeof(UV)); qsort(totlist, *ntotients, sizeof(UV), _numcmp); } free_setlist(&setlist); return totlist; } UV pillai_v(UV n) { UV v, fac; if (n == 0) return 0; for (v = 8, fac = 5040 % n; v < n-1 && fac != 0; v++) { fac = (n < HALF_WORD) ? (fac*v) % n : mulmod(fac,v,n); if (fac == n-1 && (n % v) != 1) return v; } return 0; } int moebius(UV n) { UV factors[MPU_MAX_FACTORS+1]; int i, nfactors; if (n <= 5) return (n == 1) ? 1 : (n % 4) ? -1 : 0; if (n >= 49 && (!(n % 4) || !(n % 9) || !(n % 25) || !(n % 49))) return 0; if (n >= 361 && (!(n % 121) || !(n % 169) || !(n % 289) || !(n % 361))) return 0; if (n >= 961 && (!(n % 529) || !(n % 841) || !(n % 961))) 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) { UV p; if (!primepower(n,&p)) return 1; /* Not a prime power */ return p; } UV znorder(UV a, UV n) { UV fac[MPU_MAX_FACTORS+1]; UV exp[MPU_MAX_FACTORS+1]; int i, nfactors; UV k, phi; 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; /* Cohen 1.4.3 using Carmichael Lambda */ phi = carmichael_lambda(n); nfactors = factor_exp(phi, fac, exp); k = phi; #if USE_MONTMATH if (n & 1) { const uint64_t npi = mont_inverse(n), mont1 = mont_get1(n); UV ma = mont_geta(a, n); for (i = 0; i < nfactors; i++) { UV b, a1, ek, pi = fac[i], ei = exp[i]; b = ipow(pi,ei); k /= b; a1 = mont_powmod(ma, k, n); for (ek = 0; a1 != mont1 && ek++ <= ei; a1 = mont_powmod(a1, pi, n)) k *= pi; if (ek > ei) return 0; } } else #endif for (i = 0; i < nfactors; i++) { UV b, a1, ek, pi = fac[i], ei = exp[i]; b = ipow(pi,ei); k /= b; a1 = powmod(a, k, n); for (ek = 0; a1 != 1 && ek++ <= ei; a1 = powmod(a1, pi, n)) k *= pi; if (ek > ei) return 0; } return k; } UV znprimroot(UV n) { UV fac[MPU_MAX_FACTORS+1]; UV phi_div_fac[MPU_MAX_FACTORS+1]; UV a, phi, on, r; int i, nfactors; if (n <= 4) return (n == 0) ? 0 : n-1; if (n % 4 == 0) return 0; on = (n&1) ? n : (n>>1); a = powerof(on); r = rootof(on, a); if (!is_prob_prime(r)) return 0; /* c^a or 2c^a */ phi = (r-1) * (on/r); /* p^a or 2p^a */ nfactors = factor_exp(phi, fac, 0); for (i = 0; i < nfactors; i++) phi_div_fac[i] = phi / fac[i]; #if USE_MONTMATH if (n & 1) { const uint64_t npi = mont_inverse(n), mont1 = mont_get1(n); for (a = 2; a < n; a++) { if (a == 4 || a == 8 || a == 9) continue; /* Skip some perfect powers */ /* Skip values we know can't be right: (a|n) = 0 (or 1 for odd primes) */ if (phi == n-1) { if (kronecker_uu(a, n) != -1) continue; } else { if (gcd_ui(a,n) != 1) continue; } r = mont_geta(a, n); for (i = 0; i < nfactors; i++) if (mont_powmod(r, phi_div_fac[i], n) == mont1) break; if (i == nfactors) return a; } } else #endif for (a = 2; a < n; a++) { if (a == 4 || a == 8 || a == 9) continue; /* Skip some perfect powers */ /* Skip values we know can't be right: (a|n) = 0 (or 1 for odd primes) */ if (phi == n-1) { if (kronecker_uu(a, n) != -1) continue; } else { if (gcd_ui(a,n) != 1) continue; } for (i = 0; i < nfactors; i++) if (powmod(a, phi_div_fac[i], n) == 1) break; if (i == nfactors) return a; } return 0; } int is_primitive_root(UV a, UV n, int nprime) { UV s, fac[MPU_MAX_FACTORS+1]; int i, nfacs; if (n <= 1) return n; if (a >= n) a %= n; if (n <= 4) return a == n-1; if (n % 4 == 0) return 0; /* Very simple, but not fast: * s = nprime ? n-1 : totient(n); * return s == znorder(a, n); */ if (gcd_ui(a,n) != 1) return 0; if (nprime) { s = n-1; } else { UV on = (n&1) ? n : (n>>1); UV k = powerof(on); UV r = rootof(on, k); if (!is_prob_prime(r)) return 0; /* c^a or 2c^a */ s = (r-1) * (on/r); /* p^a or 2p^a */ } if (s == n-1 && kronecker_uu(a,n) != -1) return 0; /* a^x can be a primitive root only if gcd(x,s) = 1 */ i = is_power(a,0); if (i > 1 && gcd_ui(i, s) != 1) return 0; #if USE_MONTMATH if (n & 1) { const uint64_t npi = mont_inverse(n), mont1 = mont_get1(n); a = mont_geta(a, n); /* Quick check for small factors before full factor */ if ((s % 2) == 0 && mont_powmod(a, s/2, n) == mont1) return 0; if ((s % 3) == 0 && mont_powmod(a, s/3, n) == mont1) return 0; if ((s % 5) == 0 && mont_powmod(a, s/5, n) == mont1) return 0; nfacs = factor_exp(s, fac, 0); for (i = 0; i < nfacs; i++) if (fac[i] > 5 && mont_powmod(a, s/fac[i], n) == mont1) return 0; } else #endif { /* Quick check for small factors before full factor */ if ((s % 2) == 0 && powmod(a, s/2, n) == 1) return 0; if ((s % 3) == 0 && powmod(a, s/3, n) == 1) return 0; if ((s % 5) == 0 && powmod(a, s/5, n) == 1) return 0; /* Complete factor and check each one not found above. */ nfacs = factor_exp(s, fac, 0); for (i = 0; i < nfacs; i++) if (fac[i] > 5 && powmod(a, s/fac[i], n) == 1) return 0; } return 1; } IV gcdext(IV a, IV b, IV* u, IV* v, IV* cs, IV* ct) { IV s = 0; IV os = 1; IV t = 1; IV ot = 0; IV r = b; IV or = a; if (a == 0 && b == 0) { os = 0; t = 0; } while (r != 0) { IV quot = or / r; { IV tmp = r; r = or - quot * r; or = tmp; } { IV tmp = s; s = os - quot * s; os = tmp; } { IV tmp = t; t = ot - quot * t; ot = tmp; } } if (or < 0) /* correct sign */ { or = -or; os = -os; ot = -ot; } if (u != 0) *u = os; if (v != 0) *v = ot; if (cs != 0) *cs = s; if (ct != 0) *ct = t; return or; } /* Calculate 1/a mod n. */ UV modinverse(UV a, UV n) { IV t = 0; UV nt = 1; UV r = n; UV nr = a; while (nr != 0) { UV quot = r / nr; { UV tmp = nt; nt = t - quot*nt; t = tmp; } { UV tmp = nr; nr = r - quot*nr; r = tmp; } } if (r > 1) return 0; /* No inverse */ if (t < 0) t += n; return t; } 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); } static UV _powfactor(UV p, UV d, UV m) { UV e = 0; do { d /= p; e += d; } while (d > 0); return powmod(p, e, m); } UV factorialmod(UV n, UV m) { /* n! mod m */ UV i, d = n, res = 1; if (n >= m || m == 1) return 0; if (n <= 10) { /* Keep things simple for small n */ for (i = 2; i <= n && res != 0; i++) res = (res * i) % m; return res; } if (n > m/2 && is_prime(m)) /* Check if we can go backwards */ d = m-n-1; if (d < 2) return (d == 0) ? m-1 : 1; /* Wilson's Theorem: n = m-1 and n = m-2 */ if (d == n && d > 5000000) { /* Check for composite m that leads to 0 */ UV fac[MPU_MAX_FACTORS+1], exp[MPU_MAX_FACTORS+1]; int j, k, nfacs = factor_exp(m, fac, exp); for (j = 0; j < nfacs; j++) { UV t = fac[j]; for (k = 1; (UV)k < exp[j]; k++) t *= fac[j]; if (n >= t) return 0; } } #if USE_MONTMATH if (m & 1 && d < 40000) { const uint64_t npi = mont_inverse(m), mont1 = mont_get1(m); uint64_t monti = mont1; res = mont1; for (i = 2; i <= d && res != 0; i++) { monti = addmod(monti,mont1,m); res = mont_mulmod(res,monti,m); } res = mont_recover(res, m); } else #endif if (d < 10000) { for (i = 2; i <= d && res != 0; i++) res = mulmod(res,i,m); } else { #if 0 /* Monolithic prime walk */ START_DO_FOR_EACH_PRIME(2, d) { UV k = (p > (d>>1)) ? p : _powfactor(p, d, m); res = mulmod(res, k, m); if (res == 0) break; } END_DO_FOR_EACH_PRIME; #else /* Segmented prime walk */ unsigned char* segment; UV seg_base, seg_low, seg_high; void* ctx = start_segment_primes(7, d, &segment); for (i = 1; i <= 3; i++) /* Handle 2,3,5 assume d>10*/ res = mulmod(res, _powfactor(2*i - (i>1), d, m), m); while (res != 0 && next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_base, seg_low, seg_high ) UV k = (p > (d>>1)) ? p : _powfactor(p, d, m); res = mulmod(res, k, m); if (res == 0) break; END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); #endif } if (d != n && res != 0) { /* Handle backwards case */ if (!(d&1)) res = submod(m,res,m); res = modinverse(res,m); } return res; } static int verify_sqrtmod(UV s, UV *rs, UV a, UV p) { if (p-s < s) s = p-s; if (mulmod(s, s, p) != a) return 0; *rs = s; return 1; } #if !USE_MONTMATH UV _sqrtmod_prime(UV a, UV p) { if ((p % 4) == 3) { return powmod(a, (p+1)>>2, p); } if ((p % 8) == 5) { /* Atkin's algorithm. Faster than Legendre. */ UV a2, alpha, beta, b; a2 = addmod(a,a,p); alpha = powmod(a2,(p-5)>>3,p); beta = mulmod(a2,sqrmod(alpha,p),p); b = mulmod(alpha, mulmod(a, (beta ? beta-1 : p-1), p), p); return b; } if ((p % 16) == 9) { /* Müller's algorithm extending Atkin */ UV a2, alpha, beta, b, d = 1; a2 = addmod(a,a,p); alpha = powmod(a2, (p-9)>>4, p); beta = mulmod(a2, sqrmod(alpha,p), p); if (sqrmod(beta,p) != p-1) { do { d += 2; } while (kronecker_uu(d,p) != -1 && d < p); alpha = mulmod(alpha, powmod(d,(p-9)>>3,p), p); beta = mulmod(a2, mulmod(sqrmod(d,p),sqrmod(alpha,p),p), p); } b = mulmod(alpha, mulmod(a, mulmod(d,(beta ? beta-1 : p-1),p),p),p); return b; } /* Verify Euler condition for odd p */ if ((p & 1) && powmod(a,(p-1)>>1,p) != 1) return 0; { UV x, q, e, t, z, r, m, b; q = p-1; e = valuation(q, 2); q >>= e; t = 3; while (kronecker_uu(t, p) != -1) { t += 2; if (t == 201) { /* exit if p looks like a composite */ if ((p % 2) == 0 || powmod(2, p-1, p) != 1 || powmod(3, p-1, p) != 1) return 0; } else if (t >= 20000) { /* should never happen */ return 0; } } z = powmod(t, q, p); b = powmod(a, q, p); r = e; q = (q+1) >> 1; x = powmod(a, q, p); while (b != 1) { t = b; for (m = 0; m < r && t != 1; m++) t = sqrmod(t, p); if (m >= r) break; t = powmod(z, UVCONST(1) << (r-m-1), p); x = mulmod(x, t, p); z = mulmod(t, t, p); b = mulmod(b, z, p); r = m; } return x; } return 0; } #else UV _sqrtmod_prime(UV a, UV p) { const uint64_t npi = mont_inverse(p), mont1 = mont_get1(p); a = mont_geta(a,p); if ((p % 4) == 3) { UV b = mont_powmod(a, (p+1)>>2, p); return mont_recover(b, p); } if ((p % 8) == 5) { /* Atkin's algorithm. Faster than Legendre. */ UV a2, alpha, beta, b; a2 = addmod(a,a,p); alpha = mont_powmod(a2,(p-5)>>3,p); beta = mont_mulmod(a2,mont_sqrmod(alpha,p),p); beta = submod(beta, mont1, p); b = mont_mulmod(alpha, mont_mulmod(a, beta, p), p); return mont_recover(b, p); } if ((p % 16) == 9) { /* Müller's algorithm extending Atkin */ UV a2, alpha, beta, b, d = 1; a2 = addmod(a,a,p); alpha = mont_powmod(a2, (p-9)>>4, p); beta = mont_mulmod(a2, mont_sqrmod(alpha,p), p); if (mont_sqrmod(beta,p) != submod(0,mont1,p)) { do { d += 2; } while (kronecker_uu(d,p) != -1 && d < p); d = mont_geta(d,p); alpha = mont_mulmod(alpha, mont_powmod(d,(p-9)>>3,p), p); beta = mont_mulmod(a2, mont_mulmod(mont_sqrmod(d,p),mont_sqrmod(alpha,p),p), p); beta = mont_mulmod(submod(beta,mont1,p), d, p); } else { beta = submod(beta, mont1, p); } b = mont_mulmod(alpha, mont_mulmod(a, beta, p), p); return mont_recover(b, p); } /* Verify Euler condition for odd p */ if ((p & 1) && mont_powmod(a,(p-1)>>1,p) != mont1) return 0; { UV x, q, e, t, z, r, m, b; q = p-1; e = valuation(q, 2); q >>= e; t = 3; while (kronecker_uu(t, p) != -1) { t += 2; if (t == 201) { /* exit if p looks like a composite */ if ((p % 2) == 0 || powmod(2, p-1, p) != 1 || powmod(3, p-1, p) != 1) return 0; } else if (t >= 20000) { /* should never happen */ return 0; } } t = mont_geta(t, p); z = mont_powmod(t, q, p); b = mont_powmod(a, q, p); r = e; q = (q+1) >> 1; x = mont_powmod(a, q, p); while (b != mont1) { t = b; for (m = 0; m < r && t != mont1; m++) t = mont_sqrmod(t, p); if (m >= r) break; t = mont_powmod(z, UVCONST(1) << (r-m-1), p); x = mont_mulmod(x, t, p); z = mont_mulmod(t, t, p); b = mont_mulmod(b, z, p); r = m; } return mont_recover(x, p); } return 0; } #endif int sqrtmod(UV *s, UV a, UV p) { if (p == 0) return 0; if (a >= p) a %= p; if (p <= 2 || a <= 1) return verify_sqrtmod(a, s,a,p); return verify_sqrtmod(_sqrtmod_prime(a,p), s,a,p); } int sqrtmod_composite(UV *s, UV a, UV n) { UV fac[MPU_MAX_FACTORS+1]; UV exp[MPU_MAX_FACTORS+1]; UV sqr[MPU_MAX_FACTORS+1]; UV p, j, k, gcdan; int i, nfactors; if (n == 0) return 0; if (a >= n) a %= n; if (n <= 2 || a <= 1) return verify_sqrtmod(a, s,a,n); /* Simple existence check. It's still possible no solution exists.*/ if (kronecker_uu(a, ((n%4) == 2) ? n/2 : n) == -1) return 0; /* if 8|n 'a' must = 1 mod 8, else if 4|n 'a' must = 1 mod 4 */ if ((n % 4) == 0) { if ((n % 8) == 0) { if ((a % 8) != 1) return 0; } else { if ((a % 4) != 1) return 0; } } /* More detailed existence check before factoring. Still possible. */ gcdan = gcd_ui(a, n); if (gcdan == 1) { if ((n % 3) == 0 && kronecker_uu(a, 3) != 1) return 0; if ((n % 5) == 0 && kronecker_uu(a, 5) != 1) return 0; if ((n % 7) == 0 && kronecker_uu(a, 7) != 1) return 0; } /* Factor n */ nfactors = factor_exp(n, fac, exp); /* If gcd(a,n)==1, this answers comclusively if a solution exists. */ if (gcdan == 1) { for (i = 0; i < nfactors; i++) if (fac[i] > 7 && kronecker_uu(a, fac[i]) != 1) return 0; } for (i = 0; i < nfactors; i++) { /* Powers of 2 */ if (fac[i] == 2) { if (exp[i] == 1) { sqr[i] = a & 1; } else if (exp[i] == 2) { sqr[i] = 1; /* and 3 */ } else { UV this_roots[256], next_roots[256]; UV nthis = 0, nnext = 0; this_roots[nthis++] = 1; this_roots[nthis++] = 3; for (j = 2; j < exp[i]; j++) { p = UVCONST(1) << (j+1); nnext = 0; for (k = 0; k < nthis && nnext < 254; k++) { UV r = this_roots[k]; if (sqrmod(r,p) == (a % p)) next_roots[nnext++] = r; if (sqrmod(p-r,p) == (a % p)) next_roots[nnext++] = p-r; } if (nnext == 0) return 0; /* copy next exponent's found roots to this one */ nthis = nnext; for (k = 0; k < nnext; k++) this_roots[k] = next_roots[k]; } sqr[i] = this_roots[0]; } continue; } /* p is an odd prime */ p = fac[i]; if (!sqrtmod(&(sqr[i]), a, p)) return 0; /* Lift solution of x^2 = a mod p to x^2 = a mod p^e */ for (j = 1; j < exp[i]; j++) { UV xk2, yk, expect, sol; xk2 = addmod(sqr[i],sqr[i],p); yk = modinverse(xk2, p); expect = mulmod(xk2,yk,p); p *= fac[i]; sol = submod(sqr[i], mulmod(submod(sqrmod(sqr[i],p), a % p, p), yk, p), p); if (expect != 1 || sqrmod(sol,p) != (a % p)) { /* printf("a %lu failure to lift to %lu^%d\n", a, fac[i], j+1); */ return 0; } sqr[i] = sol; } } /* raise fac[i] */ for (i = 0; i < nfactors; i++) fac[i] = ipow(fac[i], exp[i]); p = chinese(sqr, fac, nfactors, &i); return (i == 1) ? verify_sqrtmod(p, s, a, n) : 0; } /* works only for co-prime inputs and also slower than the algorithm below, * but handles the case where IV_MAX < lcm <= UV_MAX. */ static UV _simple_chinese(UV* a, UV* n, UV num, int* status) { UV i, lcm = 1, res = 0; *status = 0; if (num == 0) return 0; for (i = 0; i < num; i++) { UV ni = n[i]; UV gcd = gcd_ui(lcm, ni); if (gcd != 1) return 0; /* not coprime */ ni /= gcd; if (ni > (UV_MAX/lcm)) return 0; /* lcm overflow */ lcm *= ni; } for (i = 0; i < num; i++) { UV p, inverse, term; p = lcm / n[i]; inverse = modinverse(p, n[i]); if (inverse == 0) return 0; /* n's coprime so should never happen */ term = mulmod(p, mulmod(a[i], inverse, lcm), lcm); res = addmod(res, term, lcm); } *status = 1; return res; } /* status: 1 ok, -1 no inverse, 0 overflow */ UV chinese(UV* a, UV* n, UV num, int* status) { static unsigned short sgaps[] = {7983,3548,1577,701,301,132,57,23,10,4,1,0}; UV gcd, i, j, lcm, sum, gi, gap; *status = 1; if (num == 0) return 0; /* Sort modulii, largest first */ for (gi = 0, gap = sgaps[gi]; gap >= 1; gap = sgaps[++gi]) { for (i = gap; i < num; i++) { UV tn = n[i], ta = a[i]; for (j = i; j >= gap && n[j-gap] < tn; j -= gap) { n[j] = n[j-gap]; a[j] = a[j-gap]; } n[j] = tn; a[j] = ta; } } if (n[0] > IV_MAX) return _simple_chinese(a,n,num,status); lcm = n[0]; sum = a[0] % n[0]; for (i = 1; i < num; i++) { IV u, v, t, s; UV vs, ut; gcd = gcdext(lcm, n[i], &u, &v, &s, &t); if (gcd != 1 && ((sum % gcd) != (a[i] % gcd))) { *status = -1; return 0; } if (s < 0) s = -s; if (t < 0) t = -t; if (s > (IV)(IV_MAX/lcm)) return _simple_chinese(a,n,num,status); lcm *= s; if (u < 0) u += lcm; if (v < 0) v += lcm; vs = mulmod((UV)v, (UV)s, lcm); ut = mulmod((UV)u, (UV)t, lcm); sum = addmod( mulmod(vs, sum, lcm), mulmod(ut, a[i], lcm), lcm ); } return sum; } NV chebyshev_psi(UV n) { UV k; KAHAN_INIT(sum); for (k = log2floor(n); k > 0; k--) { KAHAN_SUM(sum, chebyshev_theta(rootof(n,k))); } return sum; } #if BITS_PER_WORD == 64 typedef struct { UV n; LNV theta; } cheby_theta_t; static const cheby_theta_t _cheby_theta[] = { /* >= quad math precision */ { UVCONST( 67108864),LNVCONST( 67100507.6357700963903836828562472350035880) }, { UVCONST( 100000000),LNVCONST( 99987730.0180220043832124342600487053812729) }, { UVCONST( 134217728),LNVCONST( 134204014.5735572091791081610859055728165544) }, { UVCONST( 268435456),LNVCONST( 268419741.6134308193112682817754501071404173) }, { UVCONST( 536870912),LNVCONST( 536842885.8045763840625719515011160692495056) }, { UVCONST( 1000000000),LNVCONST( 999968978.5775661447991262386023331863364793) }, { UVCONST( 1073741824),LNVCONST( 1073716064.8860663337617909073555831842945484) }, { UVCONST( 2147483648),LNVCONST( 2147432200.2475857676814950053003448716360822) }, { UVCONST( 4294967296),LNVCONST( 4294889489.1735446386752045191908417183337361) }, { UVCONST( 8589934592),LNVCONST( 8589863179.5654263491545135406516173629373070) }, { UVCONST( 10000000000),LNVCONST( 9999939830.6577573841592219954033850595228736) }, { UVCONST( 12884901888),LNVCONST( 12884796620.4324254952601520445848183460347362) }, { UVCONST( 17179869184),LNVCONST( 17179757715.9924077567777285147574707468995695) }, { UVCONST( 21474836480),LNVCONST( 21474693322.0998273969188369449626287713082943) }, { UVCONST( 25769803776),LNVCONST( 25769579799.3751535467593954636665656772211515) }, { UVCONST( 30064771072),LNVCONST( 30064545001.2305211029215168703433831598544454) }, { UVCONST( 34359738368),LNVCONST( 34359499180.0126643918259085362039638823175054) }, { UVCONST( 51539607552),LNVCONST( 51539356394.9531019037592855639826469993402730) }, { UVCONST( 68719476736),LNVCONST( 68719165213.6369838785284711480925219076501720) }, { UVCONST( 85899345920),LNVCONST( 85899083852.3471545629838432726841470626910905) }, { UVCONST( 100000000000),LNVCONST( 99999737653.1074446948519125729820679772770146) }, { UVCONST( 103079215104),LNVCONST(103079022007.113299711630969211422868856259124) }, { UVCONST( 120259084288),LNVCONST(120258614516.787336970535750737470005730125261) }, { UVCONST( 137438953472),LNVCONST(137438579206.444595884982301543904849253294539) }, { UVCONST( 171798691840),LNVCONST(171798276885.585945657918751085729734540334501) }, { UVCONST( 206158430208),LNVCONST(206158003808.160276853604927822609009916573462) }, { UVCONST( 240518168576),LNVCONST(240517893445.995868018331936763125264759516048) }, { UVCONST( 274877906944),LNVCONST(274877354651.045354829956619821889825596300686) }, { UVCONST( 309237645312),LNVCONST(309237050379.850690561796126460858271984023198) }, { UVCONST( 343597383680),LNVCONST(343596855806.595496630500062749631211394707114) }, { UVCONST( 377957122048),LNVCONST(377956498560.227794386327526022452943941537993) }, { UVCONST( 412316860416),LNVCONST(412316008796.349553568121442261222464590518293) }, { UVCONST( 446676598784),LNVCONST(446675972485.936512329625489223180824947531484) }, { UVCONST( 481036337152),LNVCONST(481035608287.572961376833237046440177624505864) }, { UVCONST( 515396075520),LNVCONST(515395302740.633513931333424447688399032397200) }, { UVCONST( 549755813888),LNVCONST(549755185085.539613556787409928561107952681488) }, { UVCONST( 584115552256),LNVCONST(584115015741.698143680148976236958207248900725) }, { UVCONST( 618475290624),LNVCONST(618474400071.621528348965919774195984612254220) }, { UVCONST( 652835028992),LNVCONST(652834230470.583317059774197550110194348469358) }, { UVCONST( 687194767360),LNVCONST(687193697328.927006867624832386534836384752774) }, { UVCONST( 721554505728),LNVCONST(721553211683.605313067593521060195071837766347) }, { UVCONST( 755914244096),LNVCONST(755913502349.878525212441903698096011352015192) }, { UVCONST( 790273982464),LNVCONST(790273042590.053075430445971969285969445183076) }, { UVCONST( 824633720832),LNVCONST(824633080997.428352876758261549475609957696369) }, { UVCONST( 858993459200),LNVCONST(858992716288.318498931165663742671579465316192) }, { UVCONST( 893353197568),LNVCONST(893352235882.851072417721659027263613727927680) }, { UVCONST( 927712935936),LNVCONST(927711881043.628817668337317445143018372892386) }, { UVCONST( 962072674304),LNVCONST(962071726126.508938539006575212272731584070786) }, { UVCONST( 996432412672),LNVCONST(996431411588.361462717402562171913706963939018) }, { UVCONST( 1099511627776),LNVCONST(1099510565082.05800550569923209414874779035972) }, { UVCONST( 1168231104512),LNVCONST(1168230478726.83399452743801182220790107593115) }, { UVCONST( 1236950581248),LNVCONST(1236949680081.02610603189530371762093291521116) }, { UVCONST( 1305670057984),LNVCONST(1305668780900.04255251887970870257110498423202) }, { UVCONST( 1374389534720),LNVCONST(1374388383792.63751003694755359184583212193880) }, { UVCONST( 1443109011456),LNVCONST(1443107961091.80955496949174183091839841371227) }, { UVCONST( 1511828488192),LNVCONST(1511827317611.91227277802426032456922797572429) }, { UVCONST( 1580547964928),LNVCONST(1580546753969.30607547506449941085747942395437) }, { UVCONST( 1649267441664),LNVCONST(1649265973878.75361554498682516738256005501353) }, { UVCONST( 1717986918400),LNVCONST(1717985403764.24562741452793071287954107946922) }, { UVCONST( 1786706395136),LNVCONST(1786704769212.04241689416220650800274263053933) }, { UVCONST( 1855425871872),LNVCONST(1855425013030.54920163513184322741954734357404) }, { UVCONST( 1924145348608),LNVCONST(1924143701943.02957992419280264060220278182021) }, { UVCONST( 1992864825344),LNVCONST(1992863373568.84039296068619447120308124302086) }, { UVCONST( 2061584302080),LNVCONST(2061583632335.91985095534685076604018573279204) }, { UVCONST( 2130303778816),LNVCONST(2113122935598.01727180199783433992649406589029) }, { UVCONST( 2199023255552),LNVCONST(2199021399611.18488312543276191461914978761981) }, { UVCONST( 2267742732288),LNVCONST(2267740947106.05038218811506263712808318234921) }, { UVCONST( 2336462209024),LNVCONST(2336460081480.34962633829077377680844065198307) }, { UVCONST( 2405181685760),LNVCONST(2405179969505.38642629423585641169740223940265) }, { UVCONST( 2473901162496),LNVCONST(2473899311193.37872375168104562948639924654178) }, { UVCONST( 2542620639232),LNVCONST(2542619362554.88893589220737167756411653816418) }, { UVCONST( 2611340115968),LNVCONST(2611338370515.94936514022501267847930999670553) }, { UVCONST( 2680059592704),LNVCONST(2680057722824.52981820001574883706268873541107) }, { UVCONST( 2748779069440),LNVCONST(2748777610452.18903407570165081726781627254885) }, { UVCONST( 2817498546176),LNVCONST(2817497017165.31924616507392971415494161401775) }, { UVCONST( 2886218022912),LNVCONST(2886216579432.32232322707222172612181994322081) }, { UVCONST( 2954937499648),LNVCONST(2954936100812.97301730406598982753121204977388) }, { UVCONST( 3023656976384),LNVCONST(3023654789503.82041452274471455184651411931920) }, { UVCONST( 3298534883328),LNVCONST(3298533215621.76606493931157388037915263658637) }, { UVCONST( 3573412790272),LNVCONST(3573411344351.74163523704886736624674718378131) }, { UVCONST( 3848290697216),LNVCONST(3848288415701.82534219216958446478503907262807) }, { UVCONST( 4123168604160),LNVCONST(4123166102085.86116301709394219323327831487542) }, { UVCONST( 4398046511104),LNVCONST(4398044965678.05143041707871320554940671182665) }, { UVCONST( 4672924418048),LNVCONST(4672922414672.04998927945349278916525727295687) }, { UVCONST( 4947802324992),LNVCONST(4947800056419.04384937181159608905993450182729) }, { UVCONST( 5222680231936),LNVCONST(5222678728087.69487334278665824384732845008859) }, { UVCONST( 5497558138880),LNVCONST(5497555766573.55159115560501595606332808978878) }, { UVCONST( 5772436045824),LNVCONST(5772433560746.27053256770924553245647027548204) }, { UVCONST( 6047313952768),LNVCONST(6047310750621.24497633828761530843255989494448) }, { UVCONST( 6322191859712),LNVCONST(6322189275338.39747421237532473168802646234745) }, { UVCONST( 6597069766656),LNVCONST(6579887620000.56226807898107616294821989189226) }, { UVCONST( 6871947673600),LNVCONST(6871945430474.61791600096091374271286154432006) }, { UVCONST( 7146825580544),LNVCONST(7146823258390.34361980709600216319269118247416) }, { UVCONST( 7421703487488),LNVCONST(7421700443390.35536080251964387835425662360121) }, { UVCONST( 7696581394432),LNVCONST(7696578975137.73249441643024336954233783264803) }, { UVCONST( 7971459301376),LNVCONST(7971457197928.90863708984184849978605273042512) }, { UVCONST( 8246337208320),LNVCONST(8246333982863.77146812177727648999195989358960) }, { UVCONST( 8521215115264),LNVCONST(8529802085075.55635100929751669785228592926043) }, { UVCONST( 8796093022208),LNVCONST(8796089836425.34909684634625258535266362465034) }, { UVCONST( 9345848836096),LNVCONST(9345845828116.77456046925508587313) }, { UVCONST( 9895604649984),LNVCONST(9895601077915.26821447819584407150) }, { UVCONST(10000000000000),LNVCONST(9999996988293.03419965318214160284) }, { UVCONST(15000000000000),LNVCONST(14999996482301.7098815115045166858) }, { UVCONST(20000000000000),LNVCONST(19999995126082.2286880312461318496) }, { UVCONST(25000000000000),LNVCONST(24999994219058.4086216020475916538) }, { UVCONST(30000000000000),LNVCONST(29999995531389.8454274046657200568) }, { UVCONST(35000000000000),LNVCONST(34999992921190.8049427456456479005) }, { UVCONST(40000000000000),LNVCONST(39999993533724.3168289589273168844) }, { UVCONST(45000000000000),LNVCONST(44999993567606.9795798378256194424) }, { UVCONST(50000000000000),LNVCONST(49999992543194.2636545758235373677) }, { UVCONST(55000000000000),LNVCONST(54999990847877.2435105757522625171) }, { UVCONST(60000000000000),LNVCONST(59999990297033.6261976055811111726) }, { UVCONST(65000000000000),LNVCONST(64999990861395.5522142429859245014) }, { UVCONST(70000000000000),LNVCONST(69999994316409.8717306521862685981) }, { UVCONST(75000000000000),LNVCONST(74999990126219.8344899338374090165) }, { UVCONST(80000000000000),LNVCONST(79999990160858.3042387288372250950) }, { UVCONST(85000000000000),LNVCONST(84999987096970.5915212896832780715) }, { UVCONST(90000000000000),LNVCONST(89999989501395.0738966599857919767) }, { UVCONST(95000000000000),LNVCONST(94999990785908.6672552042792168144) }, { UVCONST(100000000000000),LNVCONST(99999990573246.9785384070303475639) }, }; #define NCHEBY_VALS (sizeof(_cheby_theta)/sizeof(_cheby_theta[0])) #endif NV chebyshev_theta(UV n) { uint16_t i = 0; UV tp, startn, seg_base, seg_low, seg_high; unsigned char* segment; void* ctx; LNV initial_sum, prod = LNV_ONE; KAHAN_INIT(sum); if (n < 500) { for (i = 1; (tp = primes_tiny[i]) <= n; i++) { KAHAN_SUM(sum, loglnv(tp)); } return sum; } #if defined NCHEBY_VALS if (n >= _cheby_theta[0].n) { for (i = 1; i < NCHEBY_VALS; i++) if (n < _cheby_theta[i].n) break; startn = _cheby_theta[i-1].n; initial_sum = _cheby_theta[i-1].theta; } else #endif { KAHAN_SUM(sum, loglnv(2*3*5*7*11*13)); startn = 17; initial_sum = 0; } ctx = start_segment_primes(startn, n, &segment); #if 0 while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_base, seg_low, seg_high ) { KAHAN_SUM(sum, loglnv(p)); } END_DO_FOR_EACH_SIEVE_PRIME } #else while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_base, seg_low, seg_high ) { prod *= (LNV) p; if (++i >= (LNV_IS_QUAD ? 64 : 8)) { KAHAN_SUM(sum, loglnv(prod)); prod = LNV_ONE; i = 0; } } END_DO_FOR_EACH_SIEVE_PRIME } if (prod > 1.0) { KAHAN_SUM(sum, loglnv(prod)); prod = LNV_ONE; } #endif end_segment_primes(ctx); if (initial_sum > 0) KAHAN_SUM(sum, initial_sum); 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 LNV const euler_mascheroni = LNVCONST(0.57721566490153286060651209008240243104215933593992); static LNV const li2 = LNVCONST(1.045163780117492784844588889194613136522615578151); NV Ei(NV x) { LNV val, term; unsigned int n; KAHAN_INIT(sum); if (x == 0) croak("Invalid input to ExponentialIntegral: x must be != 0"); /* Protect against messed up rounding modes */ if (x >= 12000) return INFINITY; if (x <= -12000) return 0; if (x < -1) { /* Continued fraction, good for x < -1 */ LNV lc = 0; LNV ld = LNV_ONE / (LNV_ONE - (LNV)x); val = ld * (-explnv(x)); for (n = 1; n <= 100000; n++) { LNV old, t, n2; t = (LNV)(2*n + 1) - (LNV) x; n2 = n * n; lc = LNV_ONE / (t - n2 * lc); ld = LNV_ONE / (t - n2 * ld); old = val; val *= ld/lc; if ( fabslnv(val-old) <= LNV_EPSILON*fabslnv(val) ) break; } } else if (x < 0) { /* Rational Chebyshev approximation (Cody, Thacher), good for -1 < x < 0 */ static const LNV C6p[7] = { LNVCONST(-148151.02102575750838086), LNVCONST( 150260.59476436982420737), LNVCONST( 89904.972007457256553251), LNVCONST( 15924.175980637303639884), LNVCONST( 2150.0672908092918123209), LNVCONST( 116.69552669734461083368), LNVCONST( 5.0196785185439843791020) }; static const LNV C6q[7] = { LNVCONST( 256664.93484897117319268), LNVCONST( 184340.70063353677359298), LNVCONST( 52440.529172056355429883), LNVCONST( 8125.8035174768735759866), LNVCONST( 750.43163907103936624165), LNVCONST( 40.205465640027706061433), LNVCONST( 1.0000000000000000000000) }; LNV sumn = C6p[0]-x*(C6p[1]-x*(C6p[2]-x*(C6p[3]-x*(C6p[4]-x*(C6p[5]-x*C6p[6]))))); LNV sumd = C6q[0]-x*(C6q[1]-x*(C6q[2]-x*(C6q[3]-x*(C6q[4]-x*(C6q[5]-x*C6q[6]))))); val = loglnv(-x) - sumn/sumd; } else if (x < (-2 * loglnv(LNV_EPSILON))) { /* Convergent series. Accurate but slow especially with large x. */ LNV fact_n = x; for (n = 2; n <= 200; n++) { LNV invn = LNV_ONE / n; fact_n *= (LNV)x * invn; term = fact_n * invn; KAHAN_SUM(sum, term); /* printf("C after adding %.20Lf, val = %.20Lf\n", term, sum); */ if (term < LNV_EPSILON*sum) break; } KAHAN_SUM(sum, euler_mascheroni); KAHAN_SUM(sum, loglnv(x)); KAHAN_SUM(sum, x); val = sum; } else if (x >= 24) { /* Cody / Thacher rational Chebyshev */ static const LNV P2[10] = { LNVCONST( 1.75338801265465972390E02), LNVCONST(-2.23127670777632409550E02), LNVCONST(-1.81949664929868906455E01), LNVCONST(-2.79798528624305389340E01), LNVCONST(-7.63147701620253630855E00), LNVCONST(-1.52856623636929636839E01), LNVCONST(-7.06810977895029358836E00), LNVCONST(-5.00006640413131002475E00), LNVCONST(-3.00000000320981265753E00), LNVCONST( 1.00000000000000485503E00) }; static const LNV Q2[9] = { LNVCONST( 3.97845977167414720840E04), LNVCONST( 3.97277109100414518365E00), LNVCONST( 1.37790390235747998793E02), LNVCONST( 1.17179220502086455287E02), LNVCONST( 7.04831847180424675988E01), LNVCONST(-1.20187763547154743238E01), LNVCONST(-7.99243595776339741065E00), LNVCONST(-2.99999894040324959612E00), LNVCONST( 1.99999999999048104167E00) }; LNV invx = LNV_ONE / x, frac = 0.0; for (n = 0; n <= 8; n++) frac = Q2[n] / (P2[n] + x + frac); frac += P2[9]; val = explnv(x) * (invx + invx*invx*frac); } else { /* Asymptotic divergent series */ LNV invx = LNV_ONE / x; term = 1.0; for (n = 1; n <= 200; n++) { LNV last_term = term; term = term * ( (LNV)n * invx ); if (term < LNV_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; } } KAHAN_SUM(sum, LNV_ONE); val = explnv(x) * sum * invx; } return val; } NV Li(NV 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"); if (x >= NV_MAX) return INFINITY; /* Calculate directly using Ramanujan's series. */ if (x > 1) { const LNV logx = loglnv(x); LNV sum = 0, inner_sum = 0, old_sum, factorial = 1, power2 = 1; LNV q, p = -1; int k = 0, n = 0; for (n = 1, k = 0; n < 200; n++) { factorial *= n; p *= -logx; q = factorial * power2; power2 *= 2; for (; k <= (n - 1) / 2; k++) inner_sum += LNV_ONE / (2 * k + 1); old_sum = sum; sum += (p / q) * inner_sum; if (fabslnv(sum - old_sum) <= LNV_EPSILON) break; } return euler_mascheroni + loglnv(logx) + sqrtlnv(x) * sum; } return Ei(loglnv(x)); } static long double ld_inverse_li(long double lx) { int i; long double t, term, old_term = 0; /* Iterate Halley's method until error grows. */ t = (lx <= 2) ? 2 : lx * logl(lx); for (i = 0; i < 4; i++) { long double dn = Li(t) - lx; term = dn*logl(t) / (1.0L + dn/(2*t)); if (i > 0 && fabsl(term) >= fabsl(old_term)) { t -= term/4; break; } old_term = term; t -= term; } return t; } UV inverse_li(UV x) { UV r, i; long double lx = (long double) x; if (x <= 2) return x + (x > 0); r = (UV) ceill( ld_inverse_li(lx) ); /* Meet our more stringent goal of an exact answer. */ i = (x > 4e16) ? 2048 : 128; if (Li(r-1) >= lx) { while (Li(r-i) >= lx) r -= i; for (i = i/2; i > 0; i /= 2) if (Li(r-i) >= lx) r -= i; } else { while (Li(r+i-1) < lx) r += i; for (i = i/2; i > 0; i /= 2) if (Li(r+i-1) < lx) r += i; } return r; } static long double ld_inverse_R(long double lx) { int i; long double t, dn, term, old_term = 0; /* Rough estimate */ if (lx <= 3.5) { t = lx + 2.24*(lx-1)/2; } else { t = lx * logl(lx); if (lx < 50) { t *= 1.2; } else if (lx < 1000) { t *= 1.15; } else { /* use inverse Li (one iteration) for first inverse R approx */ dn = Li(t) - lx; term = dn * logl(t) / (1.0L + dn/(2*t)); t -= term; } } /* Iterate 1-n rounds of Halley, usually only 3 needed. */ for (i = 0; i < 100; i++) { dn = RiemannR(t) - lx; #if 1 /* Use f(t) = li(t) for derivatives */ term = dn * logl(t) / (1.0L + dn/(2*t)); #else /* Use f(t) = li(t) - li(sqrt(t))/2 for derivatives */ long double logt = logl(t); long double sqrtt = sqrtl(t); long double FA = 2 * sqrtt * logt; long double FB = 2 * sqrtt - 1; long double ifz = FA / FB; long double iffz = (logt - 2*FB) / (2 * sqrtt * FA * FA * FA * FA); term = dn * ifz * (1.0L - dn * iffz); #endif if (i > 0 && fabsl(term) >= fabsl(old_term)) { t -= term/4; break; } old_term = term; t -= term; } return t; } UV inverse_R(UV x) { if (x < 2) return x + (x > 0); return (UV) ceill( ld_inverse_R( (long double) x) ); } /* * 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: * for(i=1,13,printf("%.38g\n",(2*i)!/bernreal(2*i))) * MPU: * use bignum; * say +(factorial(2*$_)/bernreal(2*$_))->bround(38) for 1..13; */ static const long double A[] = { 12.0L, -720.0L, 30240.0L, -1209600.0L, 47900160.0L, -1892437580.3183791606367583212735166425L, 74724249600.0L, -2950130727918.1642244954382084600497650L, 116467828143500.67248729113000661089201L, -4597978722407472.6105457273596737891656L, 181521054019435467.73425331153534235290L, -7166165256175667011.3346447367083352775L, 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 RiemannR(long double x) { long double part_term, term, flogx, ki, old_sum; unsigned int k; KAHAN_INIT(sum); if (x <= 0) croak("Invalid input to RiemannR: x must be > 0"); if (x > 1e19) { const signed char* amob = range_moebius(0, 100); KAHAN_SUM(sum, Li(x)); for (k = 2; k <= 100; k++) { if (amob[k] == 0) continue; ki = 1.0L / (long double) k; part_term = powl(x,ki); if (part_term > LDBL_MAX) return INFINITY; term = amob[k] * ki * Li(part_term); old_sum = sum; KAHAN_SUM(sum, term); if (fabsl(sum - old_sum) <= LDBL_EPSILON) break; } Safefree(amob); return sum; } KAHAN_SUM(sum, 1.0); flogx = logl(x); part_term = 1; for (k = 1; k <= 10000; k++) { ki = (k-1 < NPRECALC_ZETA) ? riemann_zeta_table[k-1] : ld_riemann_zeta(k+1); part_term *= flogx / k; term = part_term / (k + k * ki); old_sum = sum; KAHAN_SUM(sum, term); /* printf("R %5d after adding %.18Lg, sum = %.19Lg (%Lg)\n", k, term, sum, fabsl(sum-old_sum)); */ if (fabsl(sum - old_sum) <= LDBL_EPSILON) break; } return sum; } static long double _lambertw_approx(long double x) { /* See Veberic 2009 for other approximations */ if (x < -0.060) { /* Pade(3,2) */ long double ti = 5.4365636569180904707205749L * x + 2.0L; long double t = (ti <= 0.0L) ? 0.0L : sqrtl(ti); long double t2 = t*t; long double t3 = t*t2; return (-1.0L + (1.0L/6.0L)*t + (257.0L/720.0L)*t2 + (13.0L/720.0L)*t3) / (1.0L + (5.0L/6.0L)*t + (103.0L/720.0L)*t2); } else if (x < 1.363) { /* Winitzki 2003 section 3.5 */ long double l1 = logl(1.0L+x); return l1 * (1.0L - logl(1.0L+l1) / (2.0L+l1)); } else if (x < 3.7) { /* Modification of Vargas 2013 */ long double l1 = logl(x); long double l2 = logl(l1); return l1 - l2 - logl(1.0L - l2/l1)/2.0L; } else { /* Corless et al. 1993, page 22 */ long double l1 = logl(x); long double l2 = logl(l1); long double d1 = 2.0L*l1*l1; long double d2 = 3.0L*l1*d1; long double d3 = 2.0L*l1*d2; long double d4 = 5.0L*l1*d3; long double w = l1 - l2 + l2/l1 + l2*(l2-2.0L)/d1; w += l2*(6.0L+l2*(-9.0L+2.0L*l2))/d2; w += l2*(-12.0L+l2*(36.0L+l2*(-22.0L+3.0L*l2)))/d3; w += l2*(60.0L+l2*(-300.0L+l2*(350.0L+l2*(-125.0L+12.0L*l2))))/d4; return w; } } NV lambertw(NV x) { long double w; int i; if (x < -0.36787944117145L) croak("Invalid input to LambertW: x must be >= -1/e"); if (x == 0.0L) return 0.0L; /* Estimate initial value */ w = _lambertw_approx(x); /* If input is too small, return .99999.... */ if (w <= -1.0L) return -1.0L + 8*LDBL_EPSILON; /* For very small inputs, don't iterate, return approx directly. */ if (x < -0.36783) return w; #if 0 /* Halley */ lastw = w; for (i = 0; i < 100; i++) { long double ew = expl(w); long double wew = w * ew; long double wewx = wew - x; long double w1 = w + 1; w = w - wewx / (ew * w1 - (w+2) * wewx/(2*w1)); if (w != 0.0L && fabsl((w-lastw)/w) <= 8*LDBL_EPSILON) break; lastw = w; } #else /* Fritsch, see Veberic 2009. 1-2 iterations are enough. */ for (i = 0; i < 6 && w != 0.0L; i++) { long double w1 = 1 + w; long double zn = logl((long double)x/w) - w; long double qn = 2 * w1 * (w1+(2.0L/3.0L)*zn); long double en = (zn/w1) * (qn-zn)/(qn-2.0L*zn); /* w *= 1.0L + en; if (fabsl(en) <= 16*LDBL_EPSILON) break; */ long double wen = w * en; w += wen; if (fabsl(wen) <= 64*LDBL_EPSILON) break; } #endif #if LNV_IS_QUAD /* For quadmath, one high precision correction */ if (w != LNV_ZERO) { LNV lw = w; LNV w1 = LNV_ONE + lw; LNV zn = loglnv((LNV)x/lw) - lw; LNV qn = LNVCONST(2.0) * w1 * (w1+(LNVCONST(2.0)/LNVCONST(3.0))*zn); LNV en = (zn/w1) * (qn-zn)/(qn-LNVCONST(2.0)*zn); return lw + lw * en; } #endif return w; } #if HAVE_STD_U64 #define U64T uint64_t #else #define U64T UV #endif /* Spigot from Arndt, Haenel, Winter, and Flammenkamp. */ /* Modified for larger digits and rounding by Dana Jacobsen */ char* pidigits(int digits) { char* out; uint32_t *a, b, c, d, e, g, i, d4, d3, d2, d1; uint32_t const f = 10000; U64T d64; /* 64-bit intermediate for 2*2*10000*b > 2^32 (~30k digits) */ if (digits <= 0) return 0; if (digits <= DBL_DIG && digits <= 18) { Newz(0, out, 19, char); (void)sprintf(out, "%.*lf", (digits-1), 3.141592653589793238); return out; } digits++; /* For rounding */ c = 14*(digits/4 + 2); New(0, out, digits+5+1, char); *out++ = '3'; /* We'll turn "31415..." into "3.1415..." */ New(0, a, c, uint32_t); for (b = 0; b < c; b++) a[b] = 2000; d = i = 0; while ((b = c -= 14) > 0 && i < (uint32_t)digits) { d = e = d % f; if (b > 107000) { /* Use 64-bit intermediate while necessary. */ for (d64 = d; --b > 107000; ) { g = (b << 1) - 1; d64 = d64 * b + f * (U64T)a[b]; a[b] = d64 % g; d64 /= g; } d = d64; b++; } while (--b > 0) { g = (b << 1) - 1; d = d * b + f * a[b]; a[b] = d % g; d /= g; } /* sprintf(out+i, "%04d", e+d/f); i += 4; */ d4 = e + d/f; if (d4 > 9999) { d4 -= 10000; out[i-1]++; for (b=i-1; out[b] == '0'+1; b--) { out[b]='0'; out[b-1]++; } } d3 = d4/10; d2 = d3/10; d1 = d2/10; out[i++] = '0' + d1; out[i++] = '0' + d2-d1*10; out[i++] = '0' + d3-d2*10; out[i++] = '0' + d4-d3*10; } Safefree(a); if (out[digits-1] >= '5') out[digits-2]++; /* Round */ for (i = digits-2; out[i] == '9'+1; i--) /* Keep rounding */ { out[i] = '0'; out[i-1]++; } digits--; /* Undo the extra digit we used for rounding */ out[digits] = '\0'; *out-- = '.'; return out; } /* 1. Perform signed integer validation on b/blen. * 2. Compare to a/alen using min or max based on first arg. * 3. Return 0 to select a, 1 to select b. */ int strnum_minmax(int min, char* a, STRLEN alen, char* b, STRLEN blen) { int aneg, bneg; STRLEN i; /* a is checked, process b */ if (b == 0 || blen == 0) croak("Parameter must be a positive integer"); bneg = (b[0] == '-'); if (b[0] == '-' || b[0] == '+') { b++; blen--; } while (blen > 0 && *b == '0') { b++; blen--; } for (i = 0; i < blen; i++) if (!isDIGIT(b[i])) break; if (blen == 0 || i < blen) croak("Parameter must be a positive integer"); if (a == 0) return 1; aneg = (a[0] == '-'); if (a[0] == '-' || a[0] == '+') { a++; alen--; } while (alen > 0 && *a == '0') { a++; alen--; } if (aneg != bneg) return min ? (bneg == 1) : (aneg == 1); if (aneg == 1) min = !min; if (alen != blen) return min ? (alen > blen) : (blen > alen); for (i = 0; i < blen; i++) if (a[i] != b[i]) return min ? (a[i] > b[i]) : (b[i] > a[i]); return 0; /* equal */ } int from_digit_string(UV* rn, const char* s, int base) { UV max, n = 0; int i, len; /* Skip leading -/+ and zeros */ if (s[0] == '-' || s[0] == '+') s++; while (s[0] == '0') s++; len = strlen(s); max = (UV_MAX-base+1)/base; for (i = 0, len = strlen(s); i < len; i++) { const char c = s[i]; int d = !isalnum(c) ? 255 : (c <= '9') ? c-'0' : (c <= 'Z') ? c-'A'+10 : c-'a'+10; if (d >= base) croak("Invalid digit for base %d", base); if (n > max) return 0; /* Overflow */ n = n * base + d; } *rn = n; return 1; } int from_digit_to_UV(UV* rn, UV* r, int len, int base) { UV d, n = 0; int i; if (len < 0 || len > BITS_PER_WORD) return 0; for (i = 0; i < len; i++) { d = r[i]; if (n > (UV_MAX-d)/base) break; /* overflow */ n = n * base + d; } *rn = n; return (i >= len); } int from_digit_to_str(char** rstr, UV* r, int len, int base) { char *so, *s; int i; if (len < 0 || !(base == 2 || base == 10 || base == 16)) return 0; if (r[0] >= (UV) base) return 0; /* TODO: We don't apply extended carry */ New(0, so, len + 3, char); s = so; if (base == 2 || base == 16) { *s++ = '0'; *s++ = (base == 2) ? 'b' : 'x'; } for (i = 0; i < len; i++) { UV d = r[i]; s[i] = (d < 10) ? '0'+d : 'a'+d-10; } s[len] = '\0'; *rstr = so; return 1; } int to_digit_array(int* bits, UV n, int base, int length) { int d; if (base < 2 || length > 128) return -1; if (base == 2) { for (d = 0; n; n >>= 1) bits[d++] = n & 1; } else { for (d = 0; n; n /= base) bits[d++] = n % base; } if (length < 0) length = d; while (d < length) bits[d++] = 0; return length; } int to_digit_string(char* s, UV n, int base, int length) { int digits[128]; int i, len = to_digit_array(digits, n, base, length); if (len < 0) return -1; if (base > 36) croak("invalid base for string: %d", base); for (i = 0; i < len; i++) { int dig = digits[len-i-1]; s[i] = (dig < 10) ? '0'+dig : 'a'+dig-10; } s[len] = '\0'; return len; } int to_string_128(char str[40], IV hi, UV lo) { int i, slen = 0, isneg = 0; if (hi < 0) { isneg = 1; hi = -(hi+1); lo = UV_MAX - lo + 1; } #if BITS_PER_WORD == 64 && HAVE_UINT128 { uint128_t dd, sum = (((uint128_t) hi) << 64) + lo; do { dd = sum / 10; str[slen++] = '0' + (sum - dd*10); sum = dd; } while (sum); } #else { UV d, r; uint32_t a[4]; a[0] = hi >> (BITS_PER_WORD/2); a[1] = hi & (UV_MAX >> (BITS_PER_WORD/2)); a[2] = lo >> (BITS_PER_WORD/2); a[3] = lo & (UV_MAX >> (BITS_PER_WORD/2)); do { r = a[0]; d = r/10; r = ((r-d*10) << (BITS_PER_WORD/2)) + a[1]; a[0] = d; d = r/10; r = ((r-d*10) << (BITS_PER_WORD/2)) + a[2]; a[1] = d; d = r/10; r = ((r-d*10) << (BITS_PER_WORD/2)) + a[3]; a[2] = d; d = r/10; r = r-d*10; a[3] = d; str[slen++] = '0'+(r%10); } while (a[0] || a[1] || a[2] || a[3]); } #endif /* Reverse the order */ for (i=0; i < slen/2; i++) { char t=str[i]; str[i]=str[slen-i-1]; str[slen-i-1] = t; } /* Prepend a negative sign if needed */ if (isneg) { for (i = slen; i > 0; i--) str[i] = str[i-1]; str[0] = '-'; slen++; } /* Add terminator */ str[slen] = '\0'; return slen; } /* Oddball primality test. * In this file rather than primality.c because it uses factoring (!). * Algorithm from Charles R Greathouse IV, 2015 */ static INLINE uint32_t _catalan_v32(uint32_t n, uint32_t p) { uint32_t s = 0; while (n /= p) s += n % 2; return s; } static INLINE uint32_t _catalan_v(UV n, UV p) { uint32_t s = 0; while (n /= p) s += n % 2; return s; } static UV _catalan_mult(UV m, UV p, UV n, UV a) { if (p > a) { m = mulmod(m, p, n); } else { UV pow = (n <= 4294967295UL) ? _catalan_v32(a<<1,p) : _catalan_v(a<<1,p); m = (pow == 0) ? m : (pow == 1) ? mulmod(m,p,n) : mulmod(m,powmod(p,pow,n),n); } return m; } static int _catalan_vtest(UV n, UV p) { while (n /= p) if (n % 2) return 1; return 0; } int is_catalan_pseudoprime(UV n) { UV m, a; int i; if (n < 2 || ((n % 2) == 0 && n != 2)) return 0; if (is_prob_prime(n)) return 1; m = 1; a = n >> 1; /* * Ideally we could use some of the requirements for a mod 4/8/64 here: * http://www.combinatorics.net/conf/Z60/sp/sp/Shu-Chung%20Liu.pdf * But, how do we make +/-2 = X mod n into a solution for x = X mod 8? * * We could also exploit the exhaustive testing that shows there only * exist three below 1e10: 5907, 1194649, and 12327121. */ { UV factors[MPU_MAX_FACTORS+1]; int nfactors = factor_exp(n, factors, 0); #if BITS_PER_WORD == 32 if (nfactors == 2) return 0; /* Page 9, all 32-bit semiprimes */ #else if (nfactors == 2) { /* Conditions from Aebi and Cairns (2008) */ if (n < UVCONST(10000000000)) return 0; /* Page 9 */ if (2*factors[0]+1 >= factors[1]) return 0; /* Corollary 2 and 3 */ } #endif /* Test every factor */ for (i = 0; i < nfactors; i++) { if (_catalan_vtest(a << 1, factors[i])) return 0; } } { UV seg_base, seg_low, seg_high; unsigned char* segment; void* ctx; m = _catalan_mult(m, 2, n, a); m = _catalan_mult(m, 3, n, a); m = _catalan_mult(m, 5, n, a); 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_base, seg_low, seg_high ) { m = _catalan_mult(m, p, n, a); } END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } return (a & 1) ? (m==(n-1)) : (m==1); } /* If we have fast CTZ, use this GCD. See Brent Alg V and FLINT Abhinav Baid */ UV gcdz(UV x, UV y) { UV f, x2, y2; if (x == 0) return y; if (y & 1) { /* Optimize y odd */ x >>= ctz(x); while (x != y) { if (x < y) { y -= x; y >>= ctz(y); } else { x -= y; x >>= ctz(x); } } return x; } if (y == 0) return x; /* Alternately: f = ctz(x|y); x >>= ctz(x); y >>= ctz(y); */ x2 = ctz(x); y2 = ctz(y); f = (x2 <= y2) ? x2 : y2; x >>= x2; y >>= y2; while (x != y) { if (x < y) { y -= x; y >>= ctz(y); } else { x -= y; x >>= ctz(x); } } return x << f; } /* The intermediate values are so large that we can only stay in 64-bit * up to 53 or so using the divisor_sum calculations. So just use a table. * Save space by just storing the 32-bit values. */ static const int32_t tau_table[] = { 0,1,-24,252,-1472,4830,-6048,-16744,84480,-113643,-115920,534612,-370944,-577738,401856,1217160,987136,-6905934,2727432,10661420,-7109760,-4219488,-12830688,18643272,21288960,-25499225,13865712,-73279080,24647168,128406630,-29211840,-52843168,-196706304,134722224,165742416,-80873520,167282496,-182213314,-255874080,-145589976,408038400,308120442,101267712,-17125708,-786948864,-548895690,-447438528 }; #define NTAU (sizeof(tau_table)/sizeof(tau_table[0])) IV ramanujan_tau(UV n) { return (n < NTAU) ? tau_table[n] : 0; } static UV _count_class_div(UV s, UV b2) { UV h = 0, i, ndivisors, *divs, lim; lim = isqrt(b2); if (lim*lim == b2) lim--; if (s > lim) return 0; if ((lim-s) < 70) { /* Iterate looking for divisors */ for (i = s; i <= lim; i++) if (b2 % i == 0) h++; } else { /* Walk through all the divisors */ divs = _divisor_list(b2, &ndivisors); for (i = 0; i < ndivisors && divs[i] <= lim; i++) if (divs[i] >= s) h++; Safefree(divs); } return h; } /* Returns 12 * H(n). See Cohen 5.3.5 or Pari/GP. * Pari/GP uses a different method for n > 500000, which is quite a bit * faster, but assumes the GRH. */ IV hclassno(UV n) { UV nmod4 = n % 4, b2, b, h; int square; if (n == 0) return -1; if (nmod4 == 1 || nmod4 == 2) return 0; if (n == 3) return 4; b = n & 1; b2 = (n+1) >> 2; square = is_perfect_square(b2); h = divisor_sum(b2,0) >> 1; if (b == 1) h = 1 + square + ((h - 1) << 1); b += 2; for (; b2 = (n + b*b) >> 2, 3*b2 < n; b += 2) { h += (b2 % b == 0) + is_perfect_square(b2) + (_count_class_div(b+1, b2) << 1); } return 12*h + ((b2*3 == n) ? 4 : square && !(n&1) ? 6 : 0); } UV polygonal_root(UV n, UV k, int* overflow) { UV D, R; MPUassert(k >= 3, "is_polygonal root < 3"); *overflow = 0; if (n <= 1) return n; if (k == 4) return is_perfect_square(n) ? isqrt(n) : 0; if (k == 3) { if (n >= UV_MAX/8) *overflow = 1; D = n << 3; R = 1; } else { if (k > UV_MAX/k || n > UV_MAX/(8*k-16)) *overflow = 1; D = (8*k-16) * n; R = (k-4) * (k-4); } if (D+R <= D) *overflow = 1; D += R; if (*overflow || !is_perfect_square(D)) return 0; D = isqrt(D) + (k-4); R = 2*k - 4; if ((D % R) != 0) return 0; return D/R; } /* These rank/unrank are O(n^2) algorithms using O(n) in-place space. * Bonet 2008 gives O(n log n) algorithms using a bit more space. */ int num_to_perm(UV k, int n, int *vec) { int i, j, t, si = 0; UV f = factorial(n-1); while (f == 0) /* We can handle n! overflow if we have a valid k */ f = factorial(n - 1 - ++si); if (k/f >= (UV)n) k %= f*n; for (i = 0; i < n; i++) vec[i] = i; for (i = si; i < n-1; i++) { UV p = k/f; k -= p*f; f /= n-i-1; if (p > 0) { for (j = i+p, t = vec[j]; j > i; j--) vec[j] = vec[j-1]; vec[i] = t; } } return 1; } int perm_to_num(int n, int *vec, UV *rank) { int i, j, k; UV f, num = 0; f = factorial(n-1); if (f == 0) return 0; for (i = 0; i < n-1; i++) { for (j = i+1, k = 0; j < n; j++) if (vec[j] < vec[i]) k++; if ((UV)k > (UV_MAX-num)/f) return 0; /* overflow */ num += k*f; f /= n-i-1; } *rank = num; return 1; } /* * For k n) k = n; if (k == 0) { /* 0 of n */ } else if (k == 1) { /* 1 of n. Pick one at random */ S[0] = urandomm64(ctx,n); } else if (k == 2 && n == 2) { /* 2 of 2. Flip a coin */ S[0] = urandomb(ctx,1); S[1] = 1-S[0]; } else if (k == 2) { /* 2 of n. Pick 2 skipping dup */ S[0] = urandomm64(ctx,n); S[1] = urandomm64(ctx,n-1); if (S[1] >= S[0]) S[1]++; } else if (k < n/100 && k < 30) { /* k of n. Pick k with loop */ for (i = 0; i < k; i++) { do { S[i] = urandomm64(ctx,n); for (j = 0; j < i; j++) if (S[j] == S[i]) break; } while (j < i); } } else if (k < n/100 && n > 1000000) {/* k of n. Pick k with dedup retry */ for (j = 0; j < k; ) { for (i = j; i < k; i++) /* Fill S[j .. k-1] then sort S */ S[i] = urandomm64(ctx,n); qsort(S, k, sizeof(UV), _numcmp); for (j = 0, i = 1; i < k; i++) /* Find and remove dups. O(n). */ if (S[j] != S[i]) S[++j] = S[i]; j++; } /* S is sorted unique k-selection of 0 to n-1. Shuffle. */ for (i = 0; i < k; i++) { j = urandomm64(ctx,k-i); { UV t = S[i]; S[i] = S[i+j]; S[i+j] = t; } } } else if (k < n/4) { /* k of n. Pick k with mask */ uint32_t *mask, smask[8] = {0}; if (n <= 32*8) mask = smask; else Newz(0, mask, n/32 + ((n%32)?1:0), uint32_t); for (i = 0; i < k; i++) { do { j = urandomm64(ctx,n); } while ( mask[j>>5] & (1U << (j&0x1F)) ); S[i] = j; mask[j>>5] |= (1U << (j&0x1F)); } if (mask != smask) Safefree(mask); } else if (k < n) { /* k of n. FYK shuffle n, pick k */ UV *T; New(0, T, n, UV); for (i = 0; i < n; i++) T[i] = i; for (i = 0; i < k && i <= n-2; i++) { j = urandomm64(ctx,n-i); S[i] = T[i+j]; T[i+j] = T[i]; } Safefree(T); } else { /* n of n. FYK shuffle. */ for (i = 0; i < n; i++) S[i] = i; for (i = 0; i < k && i <= n-2; i++) { j = urandomm64(ctx,n-i); { UV t = S[i]; S[i] = S[i+j]; S[i+j] = t; } } } } UV random_factored_integer(void* ctx, UV n, int *nf, UV *factors) { UV r, s, nfac; if (n < 1) return 0; #if BITS_PER_WORD == 64 && (USE_MONTMATH || MULMODS_ARE_FAST) if (1) /* Our factoring is very fast, just use it */ #elif BITS_PER_WORD == 64 if (n < UVCONST(1000000000000)) #endif { r = 1 + urandomm64(ctx, n); *nf = factor(r, factors); return r; } do { /* Kalai's algorithm */ for (s = n, r = 1, nfac = 0; s > 1; ) { s = 1 + urandomm64(ctx, s); if (!is_prime(s)) continue; if (s > n / r) { r = 0; break; } /* overflow */ r *= s; factors[nfac++] = s; } } while (r == 0 || r > n || (1 + urandomm64(ctx,n)) > r); *nf = nfac; return r; } Math-Prime-Util-0.73/random_prime.c0000644000076400007640000001011613204400603015530 0ustar danadana#include #include #include "csprng.h" #include "primality.h" #include "util.h" #include "prime_nth_count.h" #include "lmo.h" #include "mulmod.h" #include "constants.h" #include "random_prime.h" UV random_nbit_prime(void* ctx, UV b) { uint32_t start = 0, range; UV n, p; switch (b) { case 0: case 1: return 0; case 2: return urandomb(ctx,1) ? 2 : 3; case 3: return urandomb(ctx,1) ? 5 : 7; case 4: return urandomb(ctx,1) ? 11 : 13; case 5: start = 7; range = 5; break; case 6: start = 12; range = 7; break; case 7: start = 19; range = 13; break; case 8: start = 32; range = 23; break; case 9: start = 55; range = 43; break; default: break; } if (start) return nth_prime(start + urandomm32(ctx,range)); if (b > BITS_PER_WORD) return 0; /* Trivial method */ p = (UVCONST(1) << (b-1)) + 1; while (1) { n = p + (urandomb(ctx,b-2) << 1); if (is_prob_prime(n)) return n; } } UV random_ndigit_prime(void* ctx, UV d) { UV lo, hi; if ( (d == 0) || (BITS_PER_WORD == 32 && d >= 10) || (BITS_PER_WORD == 64 && d >= 20) ) return 0; if (d == 1) return nth_prime(1 + urandomm32(ctx,4)); if (d == 2) return nth_prime(5 + urandomm32(ctx,21)); lo = powmod(10,d-1,UV_MAX)+1; hi = 10*lo-11; while (1) { UV n = (lo + urandomm64(ctx,hi-lo+1)) | 1; if (is_prob_prime(n)) return n; } } UV random_prime(void* ctx, UV lo, UV hi) { UV n, oddrange; if (lo > hi) return 0; /* Pull edges in to nearest primes */ lo = (lo <= 2) ? 2 : next_prime(lo-1); hi = (hi >= MPU_MAX_PRIME) ? MPU_MAX_PRIME : prev_prime(hi+1); if (lo > hi) return 0; /* There must be at least one prime in the range */ if (!(lo&1)) lo--; /* treat 2 as 1 */ oddrange = ((hi-lo)>>1) + 1; /* look for odds */ while (1) { n = lo + 2 * urandomm64(ctx, oddrange); if (n == 1 || is_prob_prime(n)) return (n == 1) ? 2 : n; } } /* Note that 7 chosen bases or the first 12 prime bases are enough * to guarantee sucess. We could choose to limit to those. */ int is_mr_random(void* ctx, UV n, UV k) { if (k >= 3*(n/4)) return is_prob_prime(n); /* TODO: do 16 at a time */ while (k--) { UV base = 2 + urandomm64(ctx, n-2); if (!miller_rabin(n, &base, 1)) return 0; } return 1; } UV random_semiprime(void* ctx, UV b) { /* Even split of bits */ static const uint16_t small_semi[] = {35,35,49,65,77,91,143,143,169,299,319,341,377,403}; UV min, max, n, L, N; if (b < 4 || b > BITS_PER_WORD) return 0; switch (b) { case 4: return 9; case 5: return 21; case 6: return small_semi[ 0 + urandomm32(ctx,3) ]; case 7: return small_semi[ 3 + urandomm32(ctx,3) ]; case 8: return small_semi[ 6 + urandomm32(ctx,3) ]; case 9: return small_semi[ 9 + urandomm32(ctx,5) ]; default: break; } min = UVCONST(1) << (b-1); max = min + (min-1); L = b / 2; N = b - L; do { n = random_nbit_prime(ctx,L) * random_nbit_prime(ctx,N); } while (n < min || n > max); return n; } UV random_unrestricted_semiprime(void* ctx, UV b) { /* generic semiprime */ static const unsigned char small_semi[] = {4,6,9,10,14,15,21,22,25,26,33,34,35,38,39,46,49,51,55,57,58,62,65,69,74,77,82,85,86,87,91,93,94,95,106,111,115,118,119,121,122,123}; UV min, n; if (b < 3 || b > BITS_PER_WORD) return 0; switch (b) { case 3: return small_semi[ 0 + urandomm32(ctx, 2) ]; case 4: return small_semi[ 2 + urandomm32(ctx, 4) ]; case 5: return small_semi[ 6 + urandomm32(ctx, 4) ]; case 6: return small_semi[ 10 + urandomm32(ctx,12) ]; case 7: return small_semi[ 22 + urandomm32(ctx,20) ]; default: break; } /* There are faster ways to generate if we could be lax on distribution. * Picking a random prime followed by a second that makes a semiprime in * the range seems obvious and is fast, but the distribution is wrong. * With that method, some semiprimes are much more likely than others. */ min = UVCONST(1) << (b-1); do { n = min + urandomb(ctx,b-1); } while (!is_semiprime(n)); return n; } Math-Prime-Util-0.73/cpanfile0000644000076400007640000000076013210634710014425 0ustar danadanarequires 'ExtUtils::MakeMaker'; requires 'Exporter', '5.57'; 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::Tiny', '1.002'; recommends 'Math::Prime::Util::GMP', '0.50'; recommends 'Math::BigInt::GMP'; on test => sub { requires 'Test::More', '0.45'; requires 'bignum', '0.22'; recommends 'Test::Warn'; }; Math-Prime-Util-0.73/sieve.c0000644000076400007640000005053613364541207014216 0ustar danadana#include #include #include #include #define FUNC_isqrt 1 #define FUNC_next_prime_in_sieve #include "sieve.h" #include "ptypes.h" #include "cache.h" #include "util.h" #include "primality.h" #include "montmath.h" #include "prime_nth_count.h" /* Is it better to do a partial sieve + primality tests vs. full sieve? */ static int do_partial_sieve(UV startp, UV endp) { UV range = endp - startp; if (USE_MONTMATH) range /= 8; /* Fast primality tests */ #if BITS_PER_WORD == 64 if ( (startp > UVCONST( 100000000000000) && range < 40000) || (startp > UVCONST( 1000000000000000) && range < 150000) || (startp > UVCONST( 10000000000000000) && range < 600000) || (startp > UVCONST( 100000000000000000) && range < 2500000) || (startp > UVCONST( 1000000000000000000) && range < 10000000) || (startp > UVCONST(10000000000000000000) && range < 40000000) ) return 1; #endif return 0; } /* 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. * * mpu '$g=7*11*13; @b=(0)x$g; for $d (0..$g-1) { $i=0; for $m (1,7,11,13,17,19,23,29) { $n=30*$d+$m; if (gcd($n,$g) != 1) { $b[$d] |= (1<<$i); } $i++; } } for (0..$#b) { printf "0x%02x,",$b[$_]; print "\n" unless ($_+1)%13; } print "\n"' */ #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 UV max_sieve_prime = (BITS_PER_WORD==64) ? 4294967291U : 65521U; /* Tile bytes from source to bytes in dest */ static void memtile(unsigned char* dst, const unsigned char* src, size_t from, size_t to) { if (to < from) from = to; if (dst != src) memcpy(dst, src, from); while (from < to) { size_t bytes = (2*from > to) ? to-from : from; memcpy(dst+from, dst, 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, 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; } /* Marking primes is done the same way we used to do with tables, but * now uses heavily unrolled code based on Kim Walisch's mod-30 sieve. */ #define set_bit(s,n) *(s) |= (1 << n); static const unsigned char masknum30[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 unsigned char qinit30[30] = {0,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}; typedef struct { uint32_t prime; UV offset; uint8_t index; } wheel_t; #define CROSS_INDEX(v, b0,b1,b2,b3,b4,b5,b6,b7, i0,i1,i2,i3,i4,i5,i6,i7, it) \ while (1) { \ case (v+0): if(s>=send){w->index=v+0;break;} set_bit(s,b0); s += r*6+i0; \ case (v+1): if(s>=send){w->index=v+1;break;} set_bit(s,b1); s += r*4+i1; \ case (v+2): if(s>=send){w->index=v+2;break;} set_bit(s,b2); s += r*2+i2; \ case (v+3): if(s>=send){w->index=v+3;break;} set_bit(s,b3); s += r*4+i3; \ case (v+4): if(s>=send){w->index=v+4;break;} set_bit(s,b4); s += r*2+i4; \ case (v+5): if(s>=send){w->index=v+5;break;} set_bit(s,b5); s += r*4+i5; \ case (v+6): if(s>=send){w->index=v+6;break;} set_bit(s,b6); s += r*6+i6; \ case (v+7): if(s>=send){w->index=v+7;break;} set_bit(s,b7); s += r*2+i7; \ while (s + r*28 + it-1 < send) { \ set_bit(s + r * 0 + 0, b0); \ set_bit(s + r * 6 + i0, b1); \ set_bit(s + r * 10 + i0+i1, b2); \ set_bit(s + r * 12 + i0+i1+i2, b3); \ set_bit(s + r * 16 + i0+i1+i2+i3, b4); \ set_bit(s + r * 18 + i0+i1+i2+i3+i4, b5); \ set_bit(s + r * 22 + i0+i1+i2+i3+i4+i5, b6); \ set_bit(s + r * 28 + i0+i1+i2+i3+i4+i5+i6, b7); \ s += r*30 + it; \ } \ } static wheel_t create_wheel(UV startp, uint32_t prime) { wheel_t w; UV q = prime; UV p2 = q*q; if (startp == 0) { wheel_t ws = { prime, p2/30, qinit30[q % 30] + 8*masknum30[prime % 30] }; return ws; } if (p2 < startp) { q = 1+(startp-1)/prime; q += distancewheel30[q % 30]; p2 = prime * q; /* The offset if p2 overflows is still ok, or set to max_sieve_prime+1. */ /* if (p2 < startp) p2 = max_sieve_prime+1; */ } w.offset = (p2-startp) / 30; w.index = qinit30[q % 30] + 8*masknum30[prime % 30]; w.prime = prime; return w; } static void mark_primes(unsigned char* s, UV bytes, wheel_t* w) { if (w->offset >= bytes) { w->offset -= bytes; } else { const unsigned char* send = s + bytes; uint32_t r = w->prime / 30; s += w->offset; switch (w->index) { CROSS_INDEX( 0, 0,1,2,3,4,5,6,7, 0,0,0,0,0,0,0,1, 1); break; CROSS_INDEX( 8, 1,5,4,0,7,3,2,6, 1,1,1,0,1,1,1,1, 7); break; CROSS_INDEX(16, 2,4,0,6,1,7,3,5, 2,2,0,2,0,2,2,1, 11); break; CROSS_INDEX(24, 3,0,6,5,2,1,7,4, 3,1,1,2,1,1,3,1, 13); break; CROSS_INDEX(32, 4,7,1,2,5,6,0,3, 3,3,1,2,1,3,3,1, 17); break; CROSS_INDEX(40, 5,3,7,1,6,0,4,2, 4,2,2,2,2,2,4,1, 19); break; CROSS_INDEX(48, 6,2,3,7,0,4,5,1, 5,3,1,4,1,3,5,1, 23); break; CROSS_INDEX(56, 7,6,5,4,3,2,1,0, 6,4,2,4,2,4,6,1, 29); break; } w->offset = s - send; } } /* Monolithic mod-30 wheel sieve */ 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)) { wheel_t w = create_wheel(0, prime); mark_primes(mem, max_buf, &w); } return mem; } static void _primality_test_sieve(unsigned char* mem, UV startp, UV endp) { START_DO_FOR_EACH_SIEVE_PRIME(mem, 0, 0, endp-startp) { if (!BPSW(startp + p)) /* If the candidate is not prime, */ mem[p/30] |= masktab30[p%30]; /* mark the sieve location. */ } END_DO_FOR_EACH_SIEVE_PRIME; } static void _sieve_range(unsigned char* mem, const unsigned char* sieve, UV startd, UV endd, UV limit) { UV startp = 30*startd; UV start_base_prime = sieve_prefill(mem, startd, endd); START_DO_FOR_EACH_SIEVE_PRIME(sieve, 0, start_base_prime, limit) { /* Sieve */ wheel_t w = create_wheel(startp, p); mark_primes(mem, endd-startd+1, &w); } END_DO_FOR_EACH_SIEVE_PRIME; } int sieve_segment_partial(unsigned char* mem, UV startd, UV endd, UV depth) { const unsigned char* sieve; UV startp = 30*startd, endp = (endd >= (UV_MAX/30)) ? UV_MAX-2 : 30*endd+29; UV limit = isqrt(endp); MPUassert(mem != 0 && endd >= startd && endp >= startp && depth >= 13, "sieve_segment_partial bad arguments"); /* limit = min( sqrt(end), max-64-bit-prime, requested depth ) */ if (limit > max_sieve_prime) limit = max_sieve_prime; if (limit > depth) limit = depth; get_prime_cache(limit, &sieve); /* Get sieving primes */ _sieve_range(mem, sieve, startd, endd, limit); release_prime_cache(sieve); return 1; } /* Segmented mod-30 wheel sieve */ int sieve_segment(unsigned char* mem, UV startd, UV endd) { const unsigned char* sieve; UV startp = 30*startd, endp = (endd >= (UV_MAX/30)) ? UV_MAX-2 : 30*endd+29; UV sieve_size, limit = isqrt(endp); int do_partial = do_partial_sieve(startp, endp); MPUassert(mem != 0 && endd >= startd && endp >= startp, "sieve_segment bad arguments"); sieve_size = get_prime_cache(0, &sieve); if (sieve_size >= endp) { /* We can just use the primary cache */ memcpy(mem, sieve+startd, endd-startd+1); release_prime_cache(sieve); } else if (!do_partial && sieve_size >= limit) { /* Full sieve and we have all sieving primes in hand */ _sieve_range(mem, sieve, startd, endd, limit); release_prime_cache(sieve); } else { release_prime_cache(sieve); if (do_partial) limit >>= ((startp < (UV)1e16) ? 8 : 10); /* sieve_segment_partial(mem, startd, endd, limit); */ get_prime_cache(limit, &sieve); _sieve_range(mem, sieve, startd, endd, limit); release_prime_cache(sieve); if (do_partial) _primality_test_sieve(mem, startp, endp); } return 1; } int sieve_segment_wheel(unsigned char* mem, UV startd, UV endd, wheel_t *warray, uint32_t wsize) { uint32_t i = 0, limit, start_base_prime; uint32_t segsize = endd - startd + 1; 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"); /* possibly use primary cache directly */ /* Fill buffer with marked 7, 11, and 13 */ start_base_prime = sieve_prefill(mem, startd, endd); while (i < wsize && warray[i].prime < start_base_prime) i++; limit = isqrt(endp); if (limit > max_sieve_prime) limit = max_sieve_prime; while (i < wsize && warray[i].prime <= limit) { if (warray[i].index >= 64) warray[i] = create_wheel(startp, warray[i].prime); mark_primes(mem, segsize, &(warray[i++])); } if (limit > warray[wsize-1].prime && warray[wsize-1].prime < max_sieve_prime) _primality_test_sieve(mem, startp, endp); return 1; } /**************************************************************************/ static UV simple_prime_count_upper(UV n) { double pc, logn = log(n); if (n < 5) return 0 + (n>1) + (n>2); if (n < 355991) pc = n / (logn-1.112); else if (n < 2953652287U) pc = n / logn * (1 + 1/logn + 2.51 / (logn*logn)); else pc = n / logn * (1 + 1/logn + 2.334 / (logn*logn)); return (UV) ceil(pc); } typedef struct { UV lod; UV hid; UV low; UV high; UV endp; UV segment_size; unsigned char* segment; unsigned char* base; wheel_t *warray; uint32_t wsize; } 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 nsegments, range; 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; range = ctx->hid - ctx->lod + 1; /* range in bytes */ #if BITS_PER_WORD == 64 if (high > 1e10 && range > 32*1024-16) { UV size, div; /* Use larger segments */ size = isqrt(32*isqrt(high)) * (logint(high,2)-2); if (size < 128*1024) size = 128*1024; /* Evenly split the range into segments */ div = (range+size-1)/size; size = (div <= 1) ? range : (range+div-1)/div; ctx->segment_size = size; New(0, ctx->segment, size, unsigned char); } else #endif ctx->segment = get_prime_segment( &(ctx->segment_size) ); *segmentmem = ctx->segment; nsegments = (((high-low+29)/30)+ctx->segment_size-1) / ctx->segment_size; MPUverbose(3, "segment sieve: byte range %lu split into %lu segments of size %lu\n", (unsigned long)range, (unsigned long)nsegments, (unsigned long)ctx->segment_size); ctx->base = 0; ctx->warray = 0; ctx->wsize = 0; #if 1 { /* Generate wheel data for this segment sieve */ const UV maxsieve = UVCONST(400000000); UV limit, nprimes; wheel_t *warray; wheel_t w = {0,0,128}; uint32_t wsize = 0; /* Number of primes for a full sieve */ limit = isqrt(ctx->endp); /* For small ranges a partial sieve is much faster */ if (do_partial_sieve(low, high)) limit >>= ((low < (UV)1e16) ? 8 : 10); if (limit <= maxsieve) { /* Bump to one more than needed. */ limit = next_prime(limit); /* We'll make space for this many */ nprimes = simple_prime_count_upper(limit); MPUverbose(4, "segment sieve %lu - %lu, primes to %lu (max %lu)\n", (unsigned long)low, (unsigned long)high, (unsigned long)limit, (unsigned long)nprimes); New(0, warray, nprimes, wheel_t); START_DO_FOR_EACH_PRIME(0,limit) { if (wsize >= nprimes) croak("segment bad upper count"); w.prime = p; warray[wsize++] = w; } END_DO_FOR_EACH_PRIME; ctx->warray = warray; ctx->wsize = wsize; } } #endif 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"); if (ctx->warray != 0) sieve_segment_wheel(ctx->segment, ctx->lod, seghigh_d, ctx->warray, ctx->wsize); else 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; } if (ctx->warray != 0) { Safefree(ctx->warray); ctx->warray = 0; } Safefree(ctx); } void* array_of_primes_in_range(UV* count, UV beg, UV end) { UV *P, i = 0; UV cntest = prime_count_upper(end) - prime_count_lower(beg) + 1; New(0, P, cntest, UV); if (beg <= 2 && end >= 2) P[i++] = 2; if (beg <= 3 && end >= 3) P[i++] = 3; if (beg <= 5 && end >= 5) P[i++] = 5; { unsigned char* segment; UV seg_base, seg_low, seg_high; 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_base, seg_low, seg_high ) P[i++] = p; END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } *count = i; return P; } Math-Prime-Util-0.73/cache.h0000644000076400007640000000270013204400603014124 0ustar danadana#ifndef MPU_CACHE_H #define MPU_CACHE_H #include "ptypes.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.73/lmo.h0000644000076400007640000000021013204400603013642 0ustar danadana#ifndef MPU_LMO_H #define MPU_LMO_H #include "ptypes.h" extern UV LMO_prime_count(UV n); extern UV legendre_phi(UV n, UV a); #endif Math-Prime-Util-0.73/t/0000755000076400007640000000000013373340013013161 5ustar danadanaMath-Prime-Util-0.73/t/19-chinese.t0000644000076400007640000000415313204400603015211 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/chinese/; #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'}; #my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; #$use64 = 0 if $use64 && 18446744073709550592 == ~0; my @crts = ( [ [], 0 ], [ [[4,5]], 4 ], [ [[77,11]], 0 ], [ [[0,5],[0,6]], 0 ], [ [[14,5],[0,6]], 24 ], [ [[10,11],[4,22],[9,19]], undef ], [ [[77,13],[79,17]], 181 ], [ [[2,3],[3,5],[2,7]], 23 ], [ [[10,11],[4,12],[12,13]], 1000 ], [ [[42,127],[24,128]], 2328 ], # Some tests from Mod::Int [ [[32,126],[23,129]], 410 ], [ [[2328,16256],[410,5418]], 28450328 ], [ [[1,10],[11,100]], 11 ], [ [[11,100],[22,100]], undef ], [ [[1753051086,3243410059],[2609156951,2439462460]], "6553408220202087311"], [ [ ["6325451203932218304","2750166238021308"], ["5611464489438299732","94116455416164094"] ], "1433171050835863115088946517796" ], [ [ ["1762568892212871168","8554171181844660224"], ["2462425671659520000","2016911328009584640"] ], "188079320578009823963731127992320" ], [ [ ["856686401696104448","11943471150311931904"], ["6316031051955372032","13290002569363587072"] ], "943247297188055114646647659888640" ], [ [[-3105579549,3743000622],[-1097075646,1219365911]], "2754322117681955433"], [ [ ["-925543788386357567","243569243147991"], ["-1256802905822510829","28763455974459440"] ], "837055903505897549759994093811" ], [ [ ["-2155972909982577461","8509855219791386062"], ["-5396280069505638574","6935743629860450393"] ], "12941173114744545542549046204020289525" ], [ [[3,5],[2,0]], undef ], # three tests that we handle zeros. [ [[3,0],[2,3]], undef ], [ [[3,5],[3,0],[2,3]], undef ], ); plan tests => 0 + scalar(@crts); ###### chinese foreach my $carg (@crts) { my($aref, $exp) = @$carg; my $crt = chinese(@$aref); is( $crt, $exp, "crt(".join(",",map { "[@$_]" } @$aref).") = " . ((defined $exp) ? $exp : "") ); } Math-Prime-Util-0.73/t/26-polygonal.t0000644000076400007640000000374613204400603015604 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_polygonal/; #my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; #my $usegmp = Math::Prime::Util::prime_get_config->{'gmp'}; #my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my @expect = ( [1,3,6,10,15,21,28,36,45,55], [1,4,9,16,25,36,49,64,81,100], [1,5,12,22,35,51,70,92,117,145], [1,6,15,28,45,66,91,120,153,190], [1,7,18,34,55,81,112,148,189,235], [1,8,21,40,65,96,133,176,225,280], [1,9,24,46,75,111,154,204,261,325], [1,10,27,52,85,126,175,232,297,370], [1,11,30,58,95,141,196,260,333,415], [1,12,33,64,105,156,217,288,369,460], [1,13,36,70,115,171,238,316,405,505], [1,14,39,76,125,186,259,344,441,550], [1,15,42,82,135,201,280,372,477,595], [1,16,45,88,145,216,301,400,513,640], [1,17,48,94,155,231,322,428,549,685], [1,18,51,100,165,246,343,456,585,730], [1,19,54,106,175,261,364,484,621,775], [1,20,57,112,185,276,385,512,657,820], [1,21,60,118,195,291,406,540,693,865], [1,22,63,124,205,306,427,568,729,910], [1,23,66,130,215,321,448,596,765,955], [1,24,69,136,225,336,469,624,801,1000], [1,25,72,142,235,351,490,652,837,1045], ); plan tests => 0 + 2*scalar(@expect) + 2; ; for my $k (3 .. 25) { my ($n, @p) = (0); while (@p < 10) { fail "seems broken" if $n > 10000; next unless is_polygonal(++$n, $k); push @p, $n; } is_deeply( \@p, $expect[$k-3], "is_polygonal finds first 10 $k-gonal numbers"); } for my $k (3 .. 25) { my ($n, $r, @r) = (0); while (@r < 10) { fail "seems broken" if $n > 10000; next unless is_polygonal(++$n, $k, \$r); push @r, $r; } is_deeply( \@r, [1,2,3,4,5,6,7,8,9,10], "is_polygonal correct $k-gonal n"); } ok(!is_polygonal("724424175519274711242",3), "724424175519274711242 is not a triangular number"); ok(is_polygonal("510622052816898545467859772308206986101878",3), "510622052816898545467859772308206986101878 is a triangular number"); Math-Prime-Util-0.73/t/97-synopsis.t0000644000076400007640000000064412776251142015510 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::Synopsis"; plan skip_all => "Test::Synopsis required for testing POD SYNOPSIS code" if $@; all_synopsis_ok(); Math-Prime-Util-0.73/t/11-sumprimes.t0000644000076400007640000000121413204400603015602 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/sum_primes vecsum primes/; my %sums = ( "189695660 to 189695892" => 0, "0 to 300000" => 3709507114, "12345 to 54321" => 132980191, "10000000 to 10001000" => 610034659, ); plan tests => 1 + scalar(keys %sums); { my @sum; my @exp; for (0..1000) { push @exp, vecsum( @{primes($_)} ); push @sum, sum_primes($_); } is_deeply( \@sum, \@exp, "sum_primes for 0 to 1000" ); } while (my($range, $expect) = each (%sums)) { my($low,$high) = $range =~ /(\d+) to (\d+)/; is( sum_primes($low,$high), $expect, "sum primes from $low to $high" ); } Math-Prime-Util-0.73/t/14-nthprime.t0000644000076400007640000001577013352074136015437 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/primes nth_prime nth_twin_prime nth_prime_lower nth_prime_upper nth_prime_approx nth_twin_prime_approx nth_semiprime is_semiprime inverse_li/; 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 = (undef, @{primes($nth_small_prime)}); my %ntpcs = ( 5 => 29, 50 => 1487, 500 => 32411, 5000 => 557519, 50000 => 8264957, 500000 => 115438667, 5000000 => 1523975909, 50000000 => 19358093939, 500000000 => 239211160649, ); my %nthsemi = ( 1234 => 4497, 12345 => 51019, 123456 => 573355, 1234567 => 6365389, ); $nthsemi{12345678} = 69914722 if $usexs || $extra; $nthsemi{123456789} = 760797011 if $usexs && $extra; $nthsemi{1234567890} = 8214915893 if $usexs && $extra && $use64; $nthsemi{8589934592} = 60662588879 if $usexs && $extra && $use64; $nthsemi{17179869184} = 123806899739 if $usexs && $extra && $use64; plan tests => 0 + 2*scalar(keys %pivals32) + 1 + 3*scalar(keys %nthprimes32) + scalar(keys %nthprimes_small) + $use64 * 3 * scalar(keys %nthprimes64) + 3 # nth_prime_lower with max index + 3 # nth_twin_prime + 3 # inverse_li + scalar(keys %ntpcs) # nth_twin_prime_approx + 2 + scalar(keys %nthsemi) # nth_semiprime + (($extra && $use64 && $usexs) ? 1 : 0); while (my($n, $pin) = each (%pivals32)) { my $next = $pin+1; cmp_ok( $pin ? nth_prime($pin) : 0, '<=', $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); # ensure not a bigint 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)" ); } ####################################3 is( nth_twin_prime(0), undef, "nth_twin_prime(0) = undef" ); is( nth_twin_prime(17), 239, "239 = 17th twin prime" ); is( nth_twin_prime(1234), 101207, "101207 = 1234'th twin prime" ); while (my($n, $nthtpc) = each (%ntpcs)) { my $approx = nth_twin_prime_approx($n); my $errorp = 100 * abs($nthtpc - $approx) / $nthtpc; my $estr = sprintf "%8.6f%%", $errorp; cmp_ok( $errorp, '<=', 2, "nth_twin_prime_approx($n) is $estr (got $approx, expected ~$nthtpc)"); } ####################################3 is( nth_semiprime(0), undef, "nth_semiprime(0) = undef" ); { my $range = $extra ? 10000 : 500; my @semiprimes = grep { is_semiprime($_) } 0 .. $range; my $nsmall = scalar(@semiprimes); my @nth_semis = map { nth_semiprime($_) } 1 .. $nsmall; is_deeply(\@nth_semis, \@semiprimes, "nth_semiprime(1 .. $nsmall)"); } while (my($n, $nthsemi) = each (%nthsemi)) { is( nth_semiprime($n), $nthsemi, "nth_semiprime($n) = $nthsemi" ); } ####################################3 is_deeply( [ map { inverse_li($_) } 0 .. 50 ], [qw/0 2 3 5 6 8 10 12 15 18 21 24 27 30 34 37 41 45 49 53 57 61 65 69 73 78 82 86 91 95 100 105 109 114 119 123 128 133 138 143 148 153 158 163 168 173 179 184 189 194 199/], "inverse_li: Li^-1(0..50)" ); # Allow +/- 2 for floating point differences in LogarithmicIntegral like(inverse_li(1000000000), qr/^2280162741[34567]$/, "inverse_li(1e9)"); like(inverse_li(1100000000000), qr/^3310443690704[01234]$/, "inverse_li(11e11)"); Math-Prime-Util-0.73/t/22-aks-prime.t0000644000076400007640000000343012776251142015471 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; # Note: AKS testing is *extremely* sparse due to its lack of speed. # This does almost nothing to test whether AKS is working properly. # # If you are concerned about AKS correctness, you really need to use # the xt/primality-aks.pl test. 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" ); # This test can take a very long time if mulmods are very slow (e.g. on # UltraSPARC). With the B+V improvements this should be fast enough for # the little example that we are ok. 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; # The least number that performs the full test with either implementation. 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.73/t/19-primroots.t0000644000076400007640000000424313204400603015631 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/ znprimroot is_primitive_root /; #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'}; #my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; $use64 = 0 if $use64 && 18446744073709550592 == ~0; 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 $primroots{9223372036854775837} = 5; # Pari #905 } plan tests => 0 + scalar(keys %primroots) + 1 # znprimroot + scalar(keys %primroots) + 3 # is_primitive_root ; ###### znprimroot while (my($n, $root) = each (%primroots)) { is( znprimroot(0+$n), $root, "znprimroot($n) == " . ((defined $root) ? $root : "") ); } is( znprimroot("-100000898"), 31, "znprimroot(\"-100000898\") == 31" ); # I don't think we should rely on this parsing correctly. #is( znprimroot("+100000898"), 31, "znprimroot(\"+100000898\") == 31" ); ###### is_primitive_root while (my($n, $root) = each (%primroots)) { if (defined $root) { is( is_primitive_root(0+$root,0+$n), 1, "$root is a primitive root mod $n" ); } else { is( is_primitive_root(2,0+$n), 0, "2 is not a primitive root mod $n" ); } } is(is_primitive_root(19,191), 1, "19 is a primitive root mod 191"); is(is_primitive_root(13,191), 0, "13 is not a primitive root mod 191"); is(is_primitive_root(35,982), 0, "35 is not a primitive root mod 982"); Math-Prime-Util-0.73/t/03-init.t0000644000076400007640000000527412532503145014544 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.73/t/11-clusters.t0000644000076400007640000001372013204400603015427 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/sieve_prime_cluster is_prime primes twin_primes/; use Math::BigInt try => "GMP,Pari"; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $usegmp = Math::Prime::Util::prime_get_config->{'gmp'}; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my @tests = ( [ "A001359", [0, 2], [0,200], [3, 5, 11, 17, 29, 41, 59, 71, 101, 107, 137, 149, 179, 191, 197] ], [ "A022004", [0,2,6], [317321,319727], [qw/317321 317771 317957 318677 319127 319727/] ], [ "A022005", [0,4,6], [557857,560293], [qw/557857 558787 559213 560233 560293/] ], ); my @patterns = ( [0,2], [0,2,6], [0,4,6], [0,2,6,8], [0,2,6,8,12], [0,4,6,10,12], [0,4,6,10,12,16], [0,2,8,12,14,18,20], [0,2,6,8,12,18,20], ); my @high_check = ( [ "999999217031", 'A022006', [2,6,8,12] ], [ "999998356957", 'A022007', [4,6,10,12] ], [ "999961920817", 'A022008', [4,6,10,12,16] ], [ "9999956467211", 'A022009', [2,6,8,12,18,20] ], [ "9996858589169", 'A022010', [2,8,12,14,18,20] ], [ "99996813484481", 'A022010', [2,6,8,12,18,20,26] ], [ "99997194198047", 'A022012', [2,6,12,14,20,24,26] ], [ "99996215495153", 'A022013', [6,8,14,18,20,24,26] ], [ "999897629673401", 'A022545', [2,6,8,12,18,20,26,30] ], [ "506946970236647", 'A022546', [2,6,12,14,20,24,26,30] ], [ "291985604331973", 'A022547', [4,6,10,16,18,24,28,30] ], [ "999823346788939", 'A022548', [4,10,12,18,22,24,28,30] ], [ "29997979809623711", 'A027569', [2,6,8,12,18,20,26,30,32] ], [ "29998892234668517", 'A027570', [2,6,12,14,20,24,26,30,32] ], [ "9996248338169127877", 'A213601', [6,10,12,16,22,24,30,34,36,40,42] ], [ "2830868185774228331", 'A213645', [2,6,8,12,18,20,26,30,32,36,42] ], [ "999955337060684083", 'A213646', [4,6,10,16,18,24,28,30,34,36] ], [ "999930334493085881", 'A213647', [2,6,8,12,18,20,26,30,32,36] ], ); #[2,6,8,18,20,30,32,36,38); # Federighi #[2,6,8,12,18,20,26,30,32,36,42,48,50,56); # A257304 #[4,6,10,16,18,24,28,30,34,40,46,48,54,58,60,66); # A257375 #[6,12,16,18,22,28,30,36,40,42,46,48); # A214947 plan tests => scalar(@tests) + 2 + 2 * scalar(@patterns) + scalar(@high_check); for my $t (@tests) { my($what, $tuple, $range, $expect) = @$t; shift @$tuple if $tuple->[0] == 0; my @res = sieve_prime_cluster($range->[0],$range->[1], @$tuple ); is_deeply( \@res, $expect, "$what @$range" ); } is_deeply( [sieve_prime_cluster(1,1e10,2,4)], [3], "Inadmissible pattern (0,2,4) finds (3,5,7)"); is_deeply( [sieve_prime_cluster(1,1e10,2,8,14,26)], [3,5], "Inadmissible pattern (0,2,8,14,26) finds (3,5,11,17,29) and (5,7,13,19,31)"); my($small, $large); # Will hold primes and twin primes in two ranges my($sbeg,$send) = (0, 100000); $send += 1000000 if $extra; $small = [ primes($sbeg,$send), twin_primes($sbeg,$send) ]; my $mbeg = Math::BigInt->new(10)**21; my $mend = $mbeg + 10000 + int(rand(100000)); $mend += 100000 if $extra; if ($usegmp) { $large = [ primes($mbeg,$mend), twin_primes($mbeg,$mend) ]; } else { # Without GMP and using the Calc backend, this is just painful slow $mend = $mbeg + 10000; $large = [ [map { $mbeg+$_ } (qw/117 193 213 217 289 327 367 373 399 409 411 427 433 447 471 553 609 723 733 951 1063 1081 1213 1237 1311 1383 1411 1417 1459 1521 1573 1581 1687 1731 1749 1867 1897 2001 2011 2041 2049 2203 2209 2257 2259 2307 2317 2343 2349 2583 2611 2673 2701 2713 2719 2761 2803 2823 2961 3007 3021 3271 3289 3327 3331 3369 3399 3423 3483 3657 3759 3777 3861 3897 3973 3999 4011 4017 4039 4063 4081 4119 4123 4197 4231 4297 4353 4359 4381 4437 4521 4581 4591 4671 4743 4749 4791 4813 4851 4891 4897 4977 5203 5277 5317 5371 5427 5437 5499 5577 5683 5719 5751 5763 5913 5959 6003 6009 6103 6247 6297 6309 6493 6531 6727 6747 6759 6781 6783 6853 6871 6883 6993 7039 7059 7069 7147 7231 7269 7413 7467 7471 7509 7527 7639 7681 7689 7711 7741 7761 7887 8011 8071 8143 8173 8187 8221 8223 8283 8299 8343 8407 8467 8497 8587 8623 8761 8799 8973 9069 9111 9121 9159 9183 9187 9211 9217 9271 9333 9349 9369 9477 9501 9723 9847 9861 9961 9999/)], [map { $mbeg+$_ } (qw/409 2257 6781 8221/)], ]; } for my $pat (@patterns) { my @pat = @$pat; shift @pat if $pat[0] == 0; my @sieve = sieve_prime_cluster($sbeg,$send,@pat); my @tuple = ktuple($sbeg,$send,$small,@pat); my $num = scalar(@tuple); is_deeply( \@sieve, \@tuple, "Pattern [@pat] $num in range $sbeg .. $send"); } for my $pat (@patterns) { my @pat = @$pat; shift @pat if $pat[0] == 0; my @sieve = sieve_prime_cluster($mbeg,$mend,@pat); my @tuple = ktuple($mbeg,$mend,$large,@pat); my $num = scalar(@tuple); is_deeply( \@sieve, \@tuple, "Pattern [@pat] $num in range $mbeg .. $mend"); } for my $test (@high_check) { use bigint; # For 32-bit testers my($n,$name,$cl) = @$test; my $window = ($usexs && $usegmp) ? 1e6 : 1e3; my @res = sieve_prime_cluster($n-$window, $n+$window, @$cl); is_deeply(\@res, [$n], "Window around $name high cluster finds the cluster"); } sub ktuple { my($beg, $end, $prset, @pat) = @_; my $patstr = join(" ",@pat); if ($beg eq "1000000000000000000000" && $end eq "1000000000000000010000") { return () if $patstr =~ /^(2 6 8 12 18 20|2 8 12 14 18 20|4 6 10 12 16|4 6 10 12|2 6 8 12|2 6 8|4 6|2 6)$/; return (qw/1000000000000000000409 1000000000000000002257 1000000000000000006781 1000000000000000008221/) if $patstr eq '2'; } if ($beg == 0 && $end == 100000) { return (11) if $patstr eq '2 6 8 12 18 20'; return (5639,88799) if $patstr eq '2 8 12 14 18 20'; return (7,97,16057,19417,43777) if $patstr eq '4 6 10 12 16'; return (7,97,1867,3457,5647,15727,16057,19417,43777,79687,88807) if $patstr eq '4 6 10 12'; return (5,11,101,1481,16061,19421,21011,22271,43781,55331) if $patstr eq '2 6 8 12'; } my @p; if (@pat && $pat[0] == 2) { @p = @{$prset->[1]}; shift @pat; } else { @p = @{$prset->[0]}; } for my $c (@pat) { @p = grep { is_prime($_+$c) } @p; } shift @p while @p && $p[0] < $beg; pop @p while @p && $p[-1] > $end; @p; } Math-Prime-Util-0.73/t/32-iterators.t0000644000076400007640000004057413370623653015631 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 foroddcomposites fordivisors forpart forcomp forcomb forperm forderange formultiperm forfactored forsquarefree forsemiprimes forsetproduct lastfor is_power is_semiprime vecsum sqrtint 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 + 7 # forprimes simple + 3 # forcomposites simple + 2 # fordivisors simple + 3 # iterator errors + 7 # iterator simple + 1 # other forprimes + 2 # forprimes/iterator nesting + 3 # forprimes BigInt/BigFloat + 3 # oo iterator errors + 7 # oo iterator simple + 25 # oo iterator methods + 12 # lastfor + 5 # forfactored and forsquarefree + 1 # forsemiprimes + 9 # forsetproduct + 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; forprimes { push @t, $_ } 3842610774,3842611326; is_deeply( [@t], [3842611109,3842611139,3842611163,3842611181,3842611211,3842611229,3842611249,3842611259,3842611261,3842611291,3842611301], "forprimes 3842610774,3842611326" ); } { 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" ); } # Make sure things work when the type of $_ changes { my $sum = 0; forprimes { $sum += int(12345/$_) } 1000; is(27053, $sum, "forprimes handles \$_ type changes"); } # 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" ); } {my $it = prime_iterator(Math::BigInt->new("68719476736")); is_deeply( [map { $it->() } 1..3], [68719476767,68719476851,68719476853], "iterator 3 primes with BigInt start" ); } # 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"); } { my @zn; forprimes { my $p=$_; forprimes { lastfor, push @zn,$_ if $_ % $p == 1; } 1000; } 100; is_deeply( \@zn, [3,7,11,29,23,53,103,191,47,59,311,149,83,173,283,107,709,367,269,569,293,317,167,179,389], "lastfor works in forprimes" ); } { my @zn; forprimes { my $p=$_; forcomposites { lastfor, push @zn,$_ if $_ % $p == 1; } 1000; } 100; is_deeply( \@zn, [9,4,6,8,12,14,18,20,24,30,32,38,42,44,48,54,60,62,68,72,74,80,84,90,98], "lastfor works in forcomposites" ); } { my @zn; forprimes { my $p=$_; foroddcomposites { lastfor, push @zn,$_ if $_ % $p == 1; } 1000; } 100; is_deeply( \@zn, [9,25,21,15,45,27,35,39,93,117,63,75,165,87,95,213,119,123,135,143,147,159,333,357,195], "lastfor works in foroddcomposites" ); } { my @powers; for my $n (1..20) { fordivisors { lastfor,push @powers,$_ if is_power($_) } $n; } is_deeply( \@powers, [4,4,9,4,4,9,4], "lastfor works in fordivisors" ); } { my $firstpart; forpart { lastfor,return if @_ < 4; $firstpart++; } 7; is($firstpart, 6, "lastfor works in forpart"); } { my $firstcomp; forcomp { lastfor,return if @_ < 4; $firstcomp++; } 7; is($firstcomp, 15, "lastfor works in forcomp"); } { my $smallcomb; forcomb { lastfor,return if vecsum(@_) > 11; $smallcomb++; } 7,4; is($smallcomb, 9, "lastfor works in forcomb"); } { my $t; forperm { lastfor,return if $_[3]==5; $t++; } 7; is($t, 12, "lastfor works in forperm"); } { my $t; forderange { lastfor,return if $_[3]==5; $t++; } 7; is($t, 5, "lastfor works in forderange"); } { my $t; formultiperm { lastfor if "miles" eq join("",@_); $t++; } [split(//,"smile")]; is($t, 81, "lastfor works in formultiperm"); } { my @ps; forprimes { lastfor if $_ >= 7; # Note we keep going, unlike "last". push @ps, $_; forcomposites { push @ps,$_; } $_; # Our lastfor indicator is separate from the inside loop. } 20; is_deeply( \@ps, [2,3,5,4,7,4,6], "nested lastfor semantics" ); } { my $t; forcomposites { $t=$_; lastfor if $_ > 2000; } 20000; is($t, 2001, "lastfor in forcomposites stops appropriately"); } sub a053462 { my($s,$n)=(0,10**$_[0]-1); forsquarefree { $s += int($n / ($_*$_)) * ((scalar(@_) & 1)?-1:1); } sqrtint($n); $s; } ################### forfactored { my $s; $s=0; forfactored { $s += $_ } 1; is($s, 1, "forfactored {} 1"); $s=0; forfactored { $s += vecsum($_,@_) } 100; is($s, 7330, "forfactored {} 100"); $s=0; forsquarefree { $s += vecsum($_,@_) } 100; is($s, 4763, "forsquarefree {} 100"); $s=0; forfactored { $s += vecsum($_,@_) } 1e8,1e8+10; is($s, 1208835222, "forfactored {} 10^8,10^8+10"); is( a053462(6), 607926, "A053462 using forsquarefree"); } ################### forsemiprimes { my @got; forsemiprimes { push @got, $_; } 1000; is_deeply(\@got, [grep { is_semiprime($_) } 0 .. 1000], "forsemiprimes 1000"); } ################### forsetproduct { ok(!eval { forsetproduct { } 1,2; }, "forsetproduct not array ref errors"); my(@set,@out); @set=(); @out=();forsetproduct {push @out,"@_"}@set; is_deeply(\@out, [], 'forsetproduct empty input -> empty output'); @set=([1..3]); @out=();forsetproduct {push @out,"@_"}@set; is_deeply(\@out, [1..3], 'forsetproduct single list -> single list'); @set=([1],[2],[3],[4],[5]); @out=();forsetproduct {push @out,"@_"}@set; is_deeply(\@out, ['1 2 3 4 5'], 'forsetproduct five 1-element lists -> single list'); @set=([1,2],[3,4,5],[]); @out=();forsetproduct {push @out,"@_"}@set; is_deeply(\@out, [], 'forsetproduct any empty list -> empty output'); @set=([],[1,2],[3,4,5]); @out=();forsetproduct {push @out,"@_"}@set; is_deeply(\@out, [], 'forsetproduct any empty list -> empty output'); @set=([1,2],[qw/a b c/]); @out=();forsetproduct {push @out,"@_"}@set; is_deeply(\@out, ['1 a','1 b','1 c','2 a','2 b','2 c'], 'forsetproduct simple test'); @set=([1,2],[qw/a b c/]); @out=();forsetproduct {push @out,"@_"; $#_=0; }@set; is_deeply(\@out, ['1 a','1 b','1 c','2 a','2 b','2 c'], 'forsetproduct modify size of @_ in block'); @set=([1,2],[qw/a b c/]); @out=();forsetproduct {push @out,"@_"; @_=(1..10); }@set; is_deeply(\@out, ['1 a','1 b','1 c','2 a','2 b','2 c'], 'forsetproduct replace @_ in sub'); } Math-Prime-Util-0.73/t/20-jordantotient.t0000644000076400007640000001024513204400603016446 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/jordan_totient divisor_sum moebius/; #my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; #my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; #my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; $use64 = 0 if $use64 && 18446744073709550592 == ~0; 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 @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); plan tests => scalar(keys %jordan_totients) + 2 # Dedekind psi calculated two ways + 2 # Calculate J5 two different ways + 2 * $use64 # Jordan totient example ; ###### Jordan Totient while (my($k, $tref) = each (%jordan_totients)) { my @tlist = map { jordan_totient(0+$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, "Dedekind psi(n) = J_2(n)/J_1(n)" ); is_deeply( \@psi_viamobius, \@A001615, "Dedekind 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))" ); } Math-Prime-Util-0.73/t/26-mod.t0000644000076400007640000001311013204400603014341 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/invmod sqrtmod addmod mulmod divmod powmod/; use Math::BigInt try=>"GMP,Pari"; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; $use64 = 0 if $use64 && 18446744073709550592 == ~0; my @invmods = ( [ 0, 0, undef], [ 1, 0, undef], [ 0, 1, undef], [ 1, 1, 0], [ 45, 59, 21], [ 42, 2017, 1969], [ 42, -2017, 1969], [ -42, 2017, 48], [ -42, -2017, 48], [ 14, 28474, undef], ); if ($use64) { push @invmods, [ 13, 9223372036854775808, 5675921253449092805 ]; push @invmods, [ 14, 18446744073709551615, 17129119497016012214 ]; } my @sqrtmods = ( [ 0, 0, undef], [ 1, 0, undef], [ 0, 1, 0], [ 1, 1, 0], [ 58, 101, 19], [ 111, 113, 26], [ 37, 999221, 9946], [ 30, 1000969, 89676], [ "9223372036854775808", "5675921253449092823", "22172359690642254" ], [ "18446744073709551625", "340282366920938463463374607431768211507", "57825146747270203522128844001742059051" ], [ 30, 74, 20 ], [ 56, 1018, 458 ], [ 42, 979986, 356034 ], ); plan tests => 0 + 3 + scalar(@invmods) + scalar(@sqrtmods) + 4*2 + 1 # addmod + 1 # submod + 2 # mulmod + 2 + 1 # divmod + 2 # powmod + 0; ###### invmod ok(!eval { invmod(undef,11); }, "invmod(undef,11)"); ok(!eval { invmod(11,undef); }, "invmod(11,undef)"); ok(!eval { invmod('nan',11); }, "invmod('nan',11)"); foreach my $r (@invmods) { my($a, $n, $exp) = @$r; is( invmod($a,$n), $exp, "invmod($a,$n) = ".((defined $exp)?$exp:"") ); } ###### sqrtmod foreach my $r (@sqrtmods) { my($a, $n, $exp) = @$r; is( sqrtmod($a,$n), $exp, "sqrtmod($a,$n) = ".((defined $exp)?$exp:"") ); } my $num = 99; $num = 29 if Math::BigInt->config()->{lib} !~ /(GMP|Pari)/; my @i1 = map { nrand() } 0 .. $num; my @i2 = map { nrand() } 0 .. $num; my @i2t= map { $i2[$_] >> 1 } 0 .. $num; my @i3 = map { nrand() } 0 .. $num; my(@exp,@res); ###### add/mul/div/pow with small arguments @exp = map { 0 } 0..27; is_deeply(\@exp, [map { addmod($_ & 3, ($_>>2)-3, 0) } 0..27], "addmod(..,0)"); is_deeply(\@exp, [map { mulmod($_ & 3, ($_>>2)-3, 0) } 0..27], "mulmod(..,0)"); is_deeply(\@exp, [map { divmod($_ & 3, ($_>>2)-3, 0) } 0..27], "divmod(..,0)"); is_deeply(\@exp, [map { powmod($_ & 3, ($_>>2)-3, 0) } 0..27], "powmod(..,0)"); is_deeply(\@exp, [map { addmod($_ & 3, ($_>>2)-3, 1) } 0..27], "addmod(..,1)"); is_deeply(\@exp, [map { mulmod($_ & 3, ($_>>2)-3, 1) } 0..27], "mulmod(..,1)"); is_deeply(\@exp, [map { divmod($_ & 3, ($_>>2)-3, 1) } 0..27], "divmod(..,1)"); is_deeply(\@exp, [map { powmod($_ & 3, ($_>>2)-3, 1) } 0..27], "powmod(..,1)"); ###### addmod @exp = (); @res = (); for (0 .. $num) { push @exp, Math::BigInt->new("$i1[$_]")->badd("$i2[$_]")->bmod("$i3[$_]"); push @res, addmod($i1[$_], $i2[$_], $i3[$_]); } is_deeply( \@res, \@exp, "addmod on ".($num+1)." random inputs" ); ###### submod @exp = (); @res = (); for (0 .. $num) { push @exp, Math::BigInt->new("$i1[$_]")->bsub("$i2t[$_]")->bmod("$i3[$_]"); push @res, addmod($i1[$_], -$i2t[$_], $i3[$_]); } is_deeply( \@res, \@exp, "addmod with negative second input on ".($num+1)." random inputs" ); ###### mulmod @exp = (); @res = (); for (0 .. $num) { push @exp, Math::BigInt->new("$i1[$_]")->bmul("$i2[$_]")->bmod("$i3[$_]"); push @res, mulmod($i1[$_], $i2[$_], $i3[$_]); } is_deeply( \@res, \@exp, "mulmod on ".($num+1)." random inputs" ); ###### mulmod (neg) @exp = (); @res = (); for (0 .. $num) { push @exp, Math::BigInt->new("$i1[$_]")->bmul("-$i2t[$_]")->bmod("$i3[$_]"); push @res, mulmod($i1[$_], -$i2t[$_], $i3[$_]); } is_deeply( \@res, \@exp, "mulmod with negative second input on ".($num+1)." random inputs" ); ###### divmod is(divmod(0,14,53), 0, "divmod(0,14,53) = mulmod(0,invmod(14,53),53) = mulmod(0,19,53) = 0"); @exp = (); @res = (); for (0 .. $num) { push @exp, Math::BigInt->new("$i2[$_]")->bmodinv("$i3[$_]")->bmul("$i1[$_]")->bmod("$i3[$_]"); push @res, divmod($i1[$_], $i2[$_], $i3[$_]); } @exp = map { $_->is_nan() ? undef : $_ } @exp; is_deeply( \@res, \@exp, "divmod on ".($num+1)." random inputs" ); ###### divmod (neg) @exp = (); @res = (); # Old Math::BigInt will die with FP exception. Work around. #for (0 .. $num) { # push @exp, Math::BigInt->new("-$i2t[$_]")->bmodinv("$i3[$_]")->bmul("$i1[$_]")->bmod("$i3[$_]"); # push @res, divmod($i1[$_], -$i2t[$_], $i3[$_]); #} #@exp = map { $_->is_nan() ? undef : $_ } @exp; for (0 .. $num) { my $r = divmod($i1[$_], -$i2t[$_], $i3[$_]); push @res, $r; if (defined $r) { push @exp, Math::BigInt->new("-$i2t[$_]")->bmodinv("$i3[$_]")->bmul("$i1[$_]")->bmod("$i3[$_]"); } else { push @exp, undef; } } is_deeply( \@res, \@exp, "divmod with negative second input on ".($num+1)." random inputs" ); ###### powmod @exp = (); @res = (); for (0 .. $num) { push @exp, Math::BigInt->new("$i1[$_]")->bmodpow("$i2[$_]","$i3[$_]"); push @res, powmod($i1[$_], $i2[$_], $i3[$_]); } is_deeply( \@res, \@exp, "powmod on ".($num+1)." random inputs" ); ###### powmod (neg) @exp = (); @res = (); for (0 .. $num) { push @exp, Math::BigInt->new("$i1[$_]")->bmodpow("-$i2t[$_]","$i3[$_]"); push @res, powmod($i1[$_], -$i2t[$_], $i3[$_]); } @exp = map { $_->is_nan() ? undef : $_ } @exp; is_deeply( \@res, \@exp, "powmod with negative exponent on ".($num+1)." random inputs" ); sub nrand { my $r = int(rand(4294967296)); $r = ($r << 32) + int(rand(4294967296)) if $use64; $r; } Math-Prime-Util-0.73/t/16-randomprime.t0000644000076400007640000002073213204400603016106 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_shawe_taylor_prime random_proven_prime random_semiprime random_unrestricted_semiprime factor 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 $do_st = 1; $do_st = 0 unless eval { require Digest::SHA; my $version = $Digest::SHA::VERSION; $version =~ s/[^\d.]//g; $version >= 4.00; }; 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; push @random_nbit_tests, (75); 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+1+1+1+1 + (1 * scalar (keys %range_edge_empty)) + (3 * scalar (keys %range_edge)) + (2 * scalar (keys %ranges)) + (2 * scalar @random_to) + (1 * scalar @random_ndigit_tests) + (4 * scalar @random_nbit_tests) + 4 + 7 # random_semiprime + 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)"); #ok(!eval { random_shawe_taylor_prime(undef); }, "random_shawe_taylor_prime(undef)"); ok(!eval { random_shawe_taylor_prime(0); }, "random_shawe_taylor_prime(0)"); #ok(!eval { random_shawe_taylor_prime(-5); }, "random_shawe_taylor_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 '$n' 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" ); SKIP: { skip "random Shawe-Taylor prime generation requires Digest::SHA",1 unless $do_st; check_bits( random_shawe_taylor_prime($bits), $bits, "Shawe-Taylor" ); } check_bits( random_proven_prime($bits), $bits, "proven" ); } sub check_bits { my($n, $bits, $what) = @_; my($min,$max); use Math::BigInt; if ($bits <= $maxbits) { $min = 1 << ($bits-1); $max = ~0 >> ($maxbits - $bits); $max = Math::BigInt->new("$max") if ref($n) eq 'Math::BigInt'; } else { $min = Math::BigInt->new(2)->bpow($bits-1); $max = Math::BigInt->new(2)->bpow($bits)->bdec; } ok ( $n >= $min && $n <= $max && is_prime($n), "$bits-bit random $what prime '$n' is in range and prime"); } prime_set_config(nobigint=>0); { 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 '$n' 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 '$n' is in range" ); } { my $n; ok(!eval { random_semiprime(3); }, "random_semiprime(3)"); ok(!eval { random_unrestricted_semiprime(2); }, "random_unrestricted_semiprime(2)"); is(random_semiprime(4),9,"random_semiprime(4) = 9"); $n = random_unrestricted_semiprime(3); ok($n ==4 || $n == 6, "random_unrestricted_semiprime(3) is 4 or 6"); $n = random_semiprime(26); ok($n >= 33554432 && $n < 67108864 && scalar(factor($n)) == 2, "random_semiprime(26) is a 26-bit semiprime"); my $min = Math::BigInt->new(2)->bpow(81-1); my $max = Math::BigInt->new(2)->bpow(81)->bdec; $n = random_semiprime(81); ok($n >= $min && $n <= $max, "random_semiprime(81) is 81 bits"); SKIP: { skip "Skipping 81-bit semiprime with broken 64-bit Perl", 1 if $broken64; $n = random_unrestricted_semiprime(81); ok($n >= $min && $n <= $max, "random_unrestricted_semiprime(81) is 81 bits"); } } Math-Prime-Util-0.73/t/28-pi.t0000644000076400007640000000407213204400603014203 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/Pi/; use Math::BigFloat try => "GMP,Pari"; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $Pi = '3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701938521105559644622948954930381964428810975665933446128475648233786783165271201909145648566923460348610454326648213393607260249141273724587006606315588174881520920962829254091715364367892590360011330530548820466521384146951941511609433057270365759591953092186117381932611793105118548074462379962749567351885752724891227938183011949129833673362440656643086021394946395224737190702179860943702770539217176293176752384674818467669405132000568127145263560827785771342757789609173637178721468440901224953430146549585371050792279689258923542019956112129021960864034418159813629774771309960518707211349999998372978049951059731732816096318595024459455346908302642522308253344685035261931188171010003137838752886587533208381420617177669147303598253490428755468731159562863882353787593751957781857780532171226806613001927876611195909216420199'; my $roundt = Math::Prime::Util::prime_get_config->{gmp}; my $ninitial = 50; if ($extra) { $roundt = 0; $ninitial = 1000; } plan tests => 3 + ($roundt ? 11 : 0) + 1; is(Pi(0), 0+$Pi, "Pi(0) gives floating point pi"); is(Pi(1), 3, "Pi(1) = 3"); is_deeply( [map { stringPi($_) } 2 .. $ninitial], [map { roundpi($_) } 2 .. $ninitial], "Pi(2 .. $ninitial)" ); if ($roundt) { for my $len (760 .. 770) { is( stringPi($len), roundpi($len), "Pi($len)" ); } } # Force test of C code SKIP: { skip "Not using XS, skipping XS _pidigits", 1 unless $usexs; is(Math::Prime::Util::_pidigits(82), roundpi(82), "XS _pidigits"); } sub roundpi { my $n = shift; my $pi = Math::BigFloat->new($Pi, $n); $pi =~ s/0*$//; $pi; } sub stringPi { my $n = shift; my $pi = Pi($n); $pi =~ s/0*$//; $pi; } Math-Prime-Util-0.73/t/93-release-spelling.t0000644000076400007640000000334713370623653017054 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 quadmath pseudoprime pseudoprimes primorial primorials semiprime semiprimes precalculated premultiplier benchmarking hardcoded online unoptimized unusably coprime summatory RiemannR LambertW csrand srand irand irand64 drand urandomb urandomm forprimes forcomposites foroddcomposites fordivisors forpart forcomp forcomb forperm forderange formultiperm forsetproduct forsemiprimes forfactored forsquarefree lastfor numtoperm permtonum randperm totient moebius mertens liouville kronecker znorder znprimroot znlog gcd lcm gcdext chinese invmod sqrtmod addmod mulmod powmod divmod bernfrac bernreal harmfrac harmreal stirling hclassno vecsum vecprod vecmin vecmax vecreduce vecextract vecall vecany vecnone vecnotall vecfirst vecfirstidx sqrtint logint rootint factorialmod todigits todigitstring fromdigits sumdigits hammingweight lucasu lucasv pp/); all_pod_files_spelling_ok(); Math-Prime-Util-0.73/t/19-legendrephi.t0000644000076400007640000000166413204400603016065 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/legendre_phi/; #my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; #my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; #my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; #my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; #$use64 = 0 if $use64 && 18446744073709550592 == ~0; my @legendre_sums = ( [ 0, 92372, 0], [ 5, 15, 1], [ 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], [800000, 213, 63739], ); plan tests => scalar(@legendre_sums); ###### Legendre phi foreach my $r (@legendre_sums) { my($x, $a, $exp) = @$r; is( legendre_phi($x, $a), $exp, "legendre_phi($x,$a) = $exp" ); } Math-Prime-Util-0.73/t/19-popcount.t0000644000076400007640000000152513204400603015442 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/hammingweight/; #my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; #my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; #my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; #my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; #$use64 = 0 if $use64 && 18446744073709550592 == ~0; my @popcounts = ( [0, 0], [1, 1], [2, 1], [3, 2], [452398, 12], [-452398, 12], [4294967295, 32], ["777777777777777714523989234823498234098249108234236", 83], ["65520150907877741108803406077280119039314703968014509493068998974809747144933", 118], ); plan tests => scalar(@popcounts); ###### hammingweight foreach my $r (@popcounts) { my($n, $exp) = @$r; is( hammingweight($n), $exp, "hammingweight($n) = $exp" ); } Math-Prime-Util-0.73/t/02-can.t0000644000076400007640000000617513373330217014344 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_euler_pseudoprime is_strong_pseudoprime is_euler_plumb_pseudoprime is_lucas_pseudoprime is_strong_lucas_pseudoprime is_extra_strong_lucas_pseudoprime is_almost_extra_strong_lucas_pseudoprime is_frobenius_pseudoprime is_frobenius_underwood_pseudoprime is_frobenius_khashin_pseudoprime is_perrin_pseudoprime is_catalan_pseudoprime is_aks_prime is_bpsw_prime is_ramanujan_prime is_mersenne_prime is_power is_prime_power is_pillai is_semiprime is_square is_polygonal is_square_free is_primitive_root is_carmichael is_quasi_carmichael is_fundamental is_totient sqrtint rootint logint miller_rabin_random lucas_sequence lucasu lucasv primes twin_primes ramanujan_primes sieve_prime_cluster sieve_range forprimes forcomposites foroddcomposites forsemiprimes fordivisors forpart forcomp forcomb forperm forderange formultiperm forsetproduct forfactored forsquarefree lastfor numtoperm permtonum randperm shuffle prime_iterator prime_iterator_object next_prime prev_prime prime_count semiprime_count prime_count_lower prime_count_upper prime_count_approx nth_prime nth_prime_lower nth_prime_upper nth_prime_approx inverse_li twin_prime_count twin_prime_count_approx nth_twin_prime nth_twin_prime_approx ramanujan_prime_count ramanujan_prime_count_approx ramanujan_prime_count_lower ramanujan_prime_count_upper nth_ramanujan_prime nth_ramanujan_prime_approx nth_ramanujan_prime_lower nth_ramanujan_prime_upper sum_primes print_primes 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 random_shawe_taylor_prime random_shawe_taylor_prime_with_cert random_semiprime random_unrestricted_semiprime random_factored_integer primorial pn_primorial consecutive_integer_lcm gcdext chinese gcd lcm factor factor_exp divisors valuation hammingweight todigits fromdigits todigitstring sumdigits invmod sqrtmod addmod mulmod divmod powmod vecsum vecmin vecmax vecprod vecreduce vecextract vecany vecall vecnotall vecnone vecfirst vecfirstidx moebius mertens euler_phi jordan_totient exp_mangoldt liouville partitions bernfrac bernreal harmfrac harmreal chebyshev_theta chebyshev_psi divisor_sum carmichael_lambda kronecker hclassno inverse_totient ramanujan_tau ramanujan_sum binomial stirling znorder znprimroot znlog legendre_phi factorial factorialmod ExponentialIntegral LogarithmicIntegral RiemannZeta RiemannR LambertW Pi irand irand64 drand urandomb urandomm csrand random_bytes entropy_bytes ); can_ok( 'Math::Prime::Util', @functions); Math-Prime-Util-0.73/t/19-znorder.t0000644000076400007640000000217213204400603015255 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/znorder/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; $use64 = 0 if $use64 && 18446744073709550592 == ~0; 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], ); if ($use64) { push @mult_orders, [2, 2405286912458753, 1073741824]; # Pari #1031 } plan tests => scalar(@mult_orders); ###### 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 : "") ); } Math-Prime-Util-0.73/t/11-ramanujanprimes.t0000644000076400007640000000677213204400603016770 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/ramanujan_primes nth_ramanujan_prime is_ramanujan_prime nth_ramanujan_prime_upper nth_ramanujan_prime_lower nth_ramanujan_prime_approx ramanujan_prime_count_upper ramanujan_prime_count_lower ramanujan_prime_count_approx/; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my @a104272 = (2, 11, 17, 29, 41, 47, 59, 67, 71, 97, 101, 107, 127, 149, 151, 167, 179, 181, 227, 229, 233, 239, 241, 263, 269, 281, 307, 311, 347, 349, 367, 373, 401, 409, 419, 431, 433, 439, 461, 487, 491, 503, 569, 571, 587, 593, 599, 601, 607, 641, 643, 647, 653, 659, 677, 719, 727, 739, 751, 769, 809, 821, 823, 827, 853, 857, 881, 937, 941, 947, 967, 983); my %small_range = ( "182 to 226" => [], "11 to 16" => [11], "11 to 17" => [11,17], "11 to 18" => [11,17], "11 to 19" => [11,17], "11 to 20" => [11,17], "10 to 11" => [11], "11 to 29" => [11,17,29], "3 to 11" => [11], "2 to 11" => [2,11], "1 to 11" => [2,11], "0 to 11" => [2,11], "599 to 599" => [599], "10000 to 10100" => [10061,10067,10079,10091,10093], ); plan tests => 1 + scalar(keys %small_range) + 2 + 1 + 2 + 3 + 2; is_deeply( ramanujan_primes($a104272[-1]), \@a104272, "ramanujan_primes($a104272[-1])" ); while (my($range, $expect) = each (%small_range)) { my($low,$high) = $range =~ /(\d+) to (\d+)/; is_deeply( ramanujan_primes($low, $high), $expect, "ramanujan_primes($low,$high) should return [@{$expect}]"); } my @smalla = grep { $_ < ($usexs ? 1000 : 500) } @a104272; { my @rp; push @rp, nth_ramanujan_prime($_) for 1 .. scalar(@smalla); is_deeply( \@rp, \@smalla, "nth_ramanujan_prime(1 .. ".scalar(@smalla).")"); if ($usexs) { is( nth_ramanujan_prime(123456), 3657037, "The 123,456th Ramanujan prime is 3657037" ); } else { is( nth_ramanujan_prime(1234), 24043, "The 1,234th Ramanujan prime is 24043" ); } } { my @rp; for (0 .. $smalla[-1]) { push @rp, $_ if is_ramanujan_prime($_); } is_deeply( \@rp, \@smalla, "is_ramanujan_prime( 0 .. ".scalar(@smalla).")"); } is(nth_ramanujan_prime(997), 19379, "997th Ramanujan prime is 19379"); SKIP: { skip "Without XS, Ramanujan primes are slow",1 unless $usexs || $extra; is(nth_ramanujan_prime(23744), 617759, "Rn[23744] is 617759"); } is_deeply( [map{cmp_rn($_+1,$a104272[$_])} 0..$#a104272], \@a104272, "small ramanujan prime limits" ); is( cmp_rn(59643,1673993), 1673993, "ramanujan prime limits for 59643" ); is( cmp_rn(5964377,225792607), 225792607, "ramanujan prime limits for 5964377" ); is( approx_in_range(59643,1673993), 1673993, "ramanujan prime approx for 59643" ); is( approx_in_range(5964377,225792607), 225792607, "ramanujan prime approx for 5964377" ); sub cmp_rn { my($n,$rn) = @_; return 'nth lower' unless nth_ramanujan_prime_lower($n) <= $rn; return 'nth upper' unless nth_ramanujan_prime_upper($n) >= $rn; return 'pc lower' unless ramanujan_prime_count_lower($rn) <= $n; return 'pc upper' unless ramanujan_prime_count_upper($rn) >= $n; $rn; } sub approx_in_range { my($n,$rn) = @_; my $arn = nth_ramanujan_prime_approx($n); my $an = ramanujan_prime_count_approx($rn); return 'nth approx too low' if $arn < ($rn-$rn/50); return 'nth approx too high' if $arn > ($rn+$rn/50); return 'count approx too low' if $an < ($n-$n/50); return 'count approx too high' if $an > ($n+$n/50); $rn; } Math-Prime-Util-0.73/t/11-semiprimes.t0000644000076400007640000000615213357250560015757 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/semi_primes semiprime_count semiprime_count_approx nth_semiprime nth_semiprime_approx/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my @small_semis = (4,6,9,10,14,15,21,22,25,26,33,34,35,38,39,46,49,51,55,57,58,62,65,69,74,77,82,85,86,87,91,93,94,95); my %small_range = ( "11 to 13" => [], "10 to 10" => [10], "10 to 11" => [10], "10 to 12" => [10], "10 to 13" => [10], "10 to 14" => [10,14], "5 to 16" => [6,9,10,14,15], "4 to 11" => [4,6,9,10], "3 to 11" => [4,6,9,10], "2 to 11" => [4,6,9,10], "1 to 11" => [4,6,9,10], "0 to 11" => [4,6,9,10], "26 to 33" => [26,33], "25 to 34" => [25,26,33,34], "184279943 to 184280038" => [184279943,184279969,184280038], "184279944 to 184280037" => [184279969], "8589990147 to 8589990167" => [8589990149,8589990157,8589990166], ); my %small_semis = ( 1234 => 4497, 12345 => 51019, 123456 => 573355, ); my %big_semis = ( "2147483648" => "14540737711", "4398046511104" => "36676111297003", "100000000000000000" => "1030179406403917981", "288230376151711744" => "3027432768282284351", ); my %small_counts = ( 1234 => 363, 12345 => 3217, 123456 => 28589, ); my %big_counts = ( "100000000" => "17427258", "100000000000" => "13959990342", "100000000000000" => "11715902308080", "10000000000000000000" => "932300026230174178", ); plan tests => 2 + scalar(keys %small_range) + scalar(keys %small_semis) + scalar(keys %small_counts) + scalar(keys %big_counts) + scalar(keys %big_semis); is_deeply( semi_primes($small_semis[-1]), \@small_semis, "semi_primes($small_semis[-1])" ); { my @tp = map { nth_semiprime($_) } 1 .. scalar(@small_semis); is_deeply( \@tp, \@small_semis, "nth_semiprime for small values" ); } while (my($range, $expect) = each (%small_range)) { my($low,$high) = $range =~ /(\d+) to (\d+)/; is_deeply( semi_primes($low, $high), $expect, "semi_primes($low,$high) should return [@{$expect}]"); } while (my($n, $spc) = each (%small_counts)) { is( semiprime_count($n), $spc, "semiprime_count($n) = $spc"); } while (my($n, $nth) = each (%small_semis)) { SKIP: { skip "PP nth_semiprime is slow",1 unless $n < 10000 || $usexs || $extra; is( nth_semiprime($n), $nth, "nth_semiprime($n) = $nth"); } } while (my($n, $spc) = each (%big_counts)) { # XS routine is within 0.00001. PP within 0.002. cmp_closeto( semiprime_count_approx($n), $spc, 0.002 * abs($spc), "semiprime_count_approx($n) ~ $spc"); } while (my($n, $nth) = each (%big_semis)) { # XS routine is within 0.00001. PP within 0.001. cmp_closeto( nth_semiprime_approx($n), $nth, 0.001 * abs($nth), "nth_semiprime_approx($n) ~ $nth"); } 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.73/t/51-randfactor.t0000644000076400007640000000120113337645743015730 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/random_factored_integer irand factor vecprod/; #my $use64 = (~0 > 4294967295); #my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; #my $maxbits = $use64 ? 64 : 32; plan tests => 4; ######## my($n, $factors) = random_factored_integer(1000000); ok($n > 0, "random_factored_integer did not return 0"); ok($n <= 1000000, "random_factored_integer in requested range"); my @sfactors = sort {$a<=>$b} @$factors; is_deeply( \@sfactors, [factor($n)], "factors match factor routine"); is( vecprod(@$factors), $n, "product of factors = n"); Math-Prime-Util-0.73/t/26-combinatorial.t0000644000076400007640000001612113204400603016412 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/binomial factorial factorialmod forcomb forperm forderange formultiperm numtoperm permtonum randperm shuffle/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; use Math::BigInt try => "GMP,Pari"; my %perms = ( 0 => [[]], 1 => [[0]], 2 => [[0,1],[1,0]], 3 => [[0,1,2],[0,2,1],[1,0,2],[1,2,0],[2,0,1],[2,1,0]], 4 => [[0,1,2,3],[0,1,3,2],[0,2,1,3],[0,2,3,1],[0,3,1,2],[0,3,2,1],[1,0,2,3],[1,0,3,2],[1,2,0,3],[1,2,3,0],[1,3,0,2],[1,3,2,0],[2,0,1,3],[2,0,3,1],[2,1,0,3],[2,1,3,0],[2,3,0,1],[2,3,1,0],[3,0,1,2],[3,0,2,1],[3,1,0,2],[3,1,2,0],[3,2,0,1],[3,2,1,0]], ); my @binomials = ( [ 0,0, 1 ], [ 0,1, 0 ], [ 1,0, 1 ], [ 1,1, 1 ], [ 1,2, 0 ], [ 13,13, 1 ], [ 13,14, 0 ], [ 35,16, 4059928950 ], # We can do this natively even in 32-bit [ 40,19, "131282408400" ], # We can do this in 64-bit [ 67,31, "11923179284862717872" ], # ...and this [ 228,12, "30689926618143230620" ],# But the result of this is too big. [ 177,78, "3314450882216440395106465322941753788648564665022000" ], [ -10,5, -2002 ], [ -11,22, 64512240 ], [ -12,23, -286097760 ], [ -23,-26, -2300 ], # Kronenburg extension [ -12,-23, -705432 ], # same [ 12,-23, 0 ], [ 12,-12, 0 ], [ -12,0, 1 ], [ 0,-1, 0 ], ); # TODO: Add a bunch of combs here: "5,3" => [[..],[..],[..]], plan tests => 1 # Factorial + 1 + 1*$extra # Factorialmod + 2 + scalar(@binomials) # Binomial + 7 + 4 # Combinations + scalar(keys(%perms)) + 1 # Permutations + 4 # Multiset Permutations + 5 # Derangements + 5 + 5 + 1 # numtoperm, permtonum + 5 # randperm + 5 # shuffle ; ###### factorial sub fact { my $n = Math::BigInt->new("$_[0]"); $n->bfac; } { my @result = map { factorial($_) } 0 .. 100; my @expect = map { fact($_) } 0 .. 100; is_deeply( \@result, \@expect, "Factorials 0 to 100" ); } ###### factorialmod { my @result = map { my $m=$_; map { factorialmod($_,$m) } 0..$m-1; } 1 .. 40; my @expect = map { my $m=$_; map { factorial($_) % $m; } 0..$m-1; } 1 .. 40; is_deeply( \@result, \@expect, "factorialmod n! mod m for m 1 to 50, n 0 to m" ); } if ($extra) { is( factorialmod(5000001,"8000036000054000027"), "4179720539133404343", "factorialmod with large n and large composite non-square-free m" ); } ###### binomial foreach my $r (@binomials) { my($n, $k, $exp) = @$r; is( binomial($n,$k), $exp, "binomial($n,$k)) = $exp" ); } is_deeply( [map { binomial(10, $_) } -15 .. 15], [qw/0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 10 45 120 210 252 210 120 45 10 1 0 0 0 0 0/], "binomial(10,n) for n in -15 .. 15" ); is_deeply( [map { binomial(-10, $_) } -15 .. 15], [qw/-2002 715 -220 55 -10 1 0 0 0 0 0 0 0 0 0 1 -10 55 -220 715 -2002 5005 -11440 24310 -48620 92378 -167960 293930 -497420 817190 -1307504/], "binomial(-10,n) for n in -15 .. 15" ); ###### forcomb { my @p = (); forcomb { push @p, [@_] } 0; is_deeply( [@p], [[]], "forcomb 0" ); } { my @p = (); forcomb { push @p, [@_] } 1; is_deeply( [@p], [[],[0]], "forcomb 1" ); } { my @p = (); forcomb { push @p, [@_] } 0,0; is_deeply( [@p], [[]], "forcomb 0,0" ); } { my @p = (); forcomb { push @p, [@_] } 5,0; is_deeply( [@p], [[]], "forcomb 5,0" ); } { my @p = (); forcomb { push @p, [@_] } 5,6; is_deeply( [@p], [], "forcomb 5,6" ); } { my @p = (); forcomb { push @p, [@_] } 5,5; is_deeply( [@p], [[0,1,2,3,4]], "forcomb 5,5" ); } { my @p = (); forcomb { push @p, [@_] } 3; is_deeply( [@p], [[],[0],[1],[2],[0,1],[0,2],[1,2],[0,1,2]], "forcomb 3 (power set)" ); } { my @data = (qw/apple bread curry/); my @p = (); forcomb { push @p, [@data[@_]] } @data,2; my @e = ([qw/apple bread/],[qw/apple curry/],[qw/bread curry/]); is_deeply( \@p,\@e, "forcomb 3,2" ); } { my @data = (qw/ant bee cat dog/); my @p = (); forcomb { push @p, [@data[@_]] } @data,3; my @e = ([qw/ant bee cat/],[qw/ant bee dog/],[qw/ant cat dog/],[qw/bee cat dog/]); is_deeply( \@p,\@e, "forcomb 4,3" ); } { my $b = binomial(20,15); my $s = 0; forcomb { $s++ } 20,15; is($b, 15504, "binomial(20,15) is 15504"); is($s, $b, "forcomb 20,15 yields binomial(20,15) combinations"); } ###### forperm while (my($n, $expect) = each (%perms)) { my @p = (); forperm { push @p, [@_] } $n; is_deeply( \@p, $expect, "forperm $n" ); } { my $s = 0; forperm { $s++ } 7; is($s, factorial(7), "forperm 7 yields factorial(7) permutations"); } ###### formultiperm { my @p; formultiperm { push @p, [@_] } []; is_deeply(\@p, [], "formultiperm []"); } { my @p; formultiperm { push @p, [@_] } [1,2,2]; is_deeply(\@p, [ [1,2,2], [2,1,2], [2,2,1] ], "formultiperm 1,2,2"); } { my @p; formultiperm { push @p, [@_] } [qw/a a b b/]; is_deeply(\@p, [map{[split(//,$_)]} qw/aabb abab abba baab baba bbaa/], "formultiperm a,a,b,b"); } { my @p; formultiperm { push @p, join("",@_) } [qw/a a b b/]; is_deeply(\@p, [qw/aabb abab abba baab baba bbaa/], "formultiperm aabb"); } ###### forderange { my @p; forderange { push @p, [@_] } 0; is_deeply(\@p, [[]], "forderange 0"); } { my @p; forderange { push @p, [@_] } 1; is_deeply(\@p, [], "forderange 1"); } { my @p; forderange { push @p, [@_] } 2; is_deeply(\@p, [[1,0]], "forderange 2"); } { my @p; forderange { push @p, [@_] } 3; is_deeply(\@p, [[1,2,0],[2,0,1]], "forderange 3"); } { my $n=0; forderange { $n++ } 7; is($n, 1854, "forderange 7 count"); } ###### numtoperm / permtonum is_deeply([numtoperm(0,0)],[],"numtoperm(0,0)"); is_deeply([numtoperm(1,0)],[0],"numtoperm(1,0)"); is_deeply([numtoperm(1,1)],[0],"numtoperm(1,1)"); is_deeply([numtoperm(5,15)],[0,3,2,4,1],"numtoperm(5,15)"); is_deeply([numtoperm(24,987654321)],[0,1,2,3,4,5,6,7,8,9,10,13,11,21,14,20,17,15,12,22,18,19,23,16],"numtoperm(24,987654321)"); is(permtonum([]),0,"permtonum([])"); is(permtonum([0]),0,"permtonum([0])"); is(permtonum([6,3,4,2,5,0,1]),4768,"permtonum([6,3,4,2,5,0,1])"); is(permtonum([reverse(0..14),15..19]),"1790774578500738480","permtonum( 20 )"); is(permtonum([reverse(0..12),reverse(13..25)]),"193228515634198442606207999","permtonum( 26 )"); is(permtonum([numtoperm(14,8467582)]),8467582,"permtonum(numtoperm)"); ###### randperm # TODO: better randperm tests is(@{[randperm(0)]},0,"randperm(0)"); is(@{[randperm(1)]},1,"randperm(1)"); is(@{[randperm(100,4)]},4,"randperm(100,4)"); { my @p = 1..100; my @s = @p[randperm(0+@p)]; isnt("@s", "@p", "randperm shuffle has shuffled input"); my @ss = sort { $a<=>$b } @s; is("@ss", "@p", "randperm shuffle contains original data"); } ###### shuffle is_deeply([shuffle()],[],"shuffle with no args"); is_deeply([shuffle("a")],["a"],"shuffle with one arg"); { my @p = 1..100; my @s = shuffle(@p); is(0+@s,0+@p,"argument count is the same for 100 elem shuffle"); isnt("@s", "@p", "shuffle has shuffled input"); my @ss = sort { $a<=>$b } @s; is("@ss", "@p", "shuffle contains original data"); } Math-Prime-Util-0.73/t/25-lucas_sequences.t0000644000076400007640000001152213204400603016750 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/lucas_sequence lucasu lucasv foroddcomposites/; #my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $usegmp = Math::Prime::Util::prime_get_config->{'gmp'}; # Values taken from the OEIS pages. my @lucas_seqs = ( [ [1, -1], 0, "U", "Fibonacci numbers", [0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610] ], [ [1, -1], 0, "V", "Lucas numbers", [2, 1, 3, 4, 7, 11, 18, 29, 47, 76, 123, 199, 322, 521, 843] ], [ [2, -1], 0, "U", "Pell numbers", [0, 1, 2, 5, 12, 29, 70, 169, 408, 985, 2378, 5741, 13860, 33461, 80782] ], [ [2, -1], 0, "V", "Pell-Lucas numbers", [2, 2, 6, 14, 34, 82, 198, 478, 1154, 2786, 6726, 16238, 39202, 94642] ], [ [1, -2], 0, "U", "Jacobsthal numbers", [0, 1, 1, 3, 5, 11, 21, 43, 85, 171, 341, 683, 1365, 2731, 5461, 10923] ], [ [1, -2], 0, "V", "Jacobsthal-Lucas numbers", [2, 1, 5, 7, 17, 31, 65, 127, 257, 511, 1025, 2047, 4097, 8191, 16385] ], [ [2, 2], 1, "U", "sin(x)*exp(x)", [0, 1, 2, 2, 0, -4, -8, -8, 0, 16, 32, 32, 0, -64, -128, -128, 0, 256] ], [ [2, 2], 1, "V", "offset sin(x)*exp(x)", [2, 2, 0, -4, -8, -8, 0, 16, 32, 32, 0, -64, -128, -128, 0, 256, 512,512] ], [ [2, 5], 1, "U", "A045873", [0, 1, 2, -1, -12, -19, 22, 139, 168, -359, -1558, -1321, 5148, 16901] ], [ [3,-5], 0, "U", "3*a(n-1)+5*a(n-2) [0,1]", [0, 1, 3, 14, 57, 241, 1008, 4229, 17727, 74326, 311613, 1306469] ], [ [3,-5], 0, "V", "3*a(n-1)+5*a(n-2) [2,3]", [2, 3, 19, 72, 311, 1293, 5434, 22767, 95471, 400248, 1678099, 7035537] ], [ [3,-4], 0, "U", "3*a(n-1)+4*a(n-2) [0,1]", [0, 1, 3, 13, 51, 205, 819, 3277, 13107, 52429, 209715, 838861, 3355443] ], [ [3,-4], 0, "V", "3*a(n-1)+4*a(n-2) [2,3]", [2, 3, 17, 63, 257, 1023, 4097, 16383, 65537, 262143, 1048577, 4194303] ], [ [3,-1], 0, "U", "A006190", [0, 1, 3, 10, 33, 109, 360, 1189, 3927, 12970, 42837, 141481, 467280] ], [ [3,-1], 0, "V", "A006497", [2, 3, 11, 36, 119, 393, 1298, 4287, 14159, 46764, 154451, 510117,1684802]], [ [3, 1], 0, "U", "Fibonacci(2n)", [0, 1, 3, 8, 21, 55, 144, 377, 987, 2584, 6765, 17711, 46368, 121393] ], [ [3, 1], 0, "V", "Lucas(2n)", [2, 3, 7, 18, 47, 123, 322, 843, 2207, 5778, 15127, 39603, 103682, 271443]], [ [3, 2], 0, "U", "2^n-1 Mersenne numbers (prime and composite)", [0, 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, 4095, 8191, 16383] ], [ [3, 2], 0, "V", "2^n+1", [2, 3, 5, 9, 17, 33, 65, 129, 257, 513, 1025, 2049, 4097, 8193, 16385] ], [ [4,-1], 0, "U", "Denominators of continued fraction convergents to sqrt(5)", [0, 1, 4, 17, 72, 305, 1292, 5473, 23184, 98209, 416020, 1762289, 7465176]], [ [4,-1], 0, "V", "Even Lucas numbers Lucas(3n)", [2, 4, 18, 76, 322, 1364, 5778, 24476, 103682, 439204, 1860498, 7881196] ], [ [4, 1], 0, "U", "A001353", [0, 1, 4, 15, 56, 209, 780, 2911, 10864, 40545, 151316, 564719, 2107560] ], [ [4, 1], 0, "V", "A003500", [2, 4, 14, 52, 194, 724, 2702, 10084, 37634, 140452, 524174, 1956244] ], [ [5, 4], 0, "U", "(4^n-1)/3", [0, 1, 5, 21, 85, 341, 1365, 5461, 21845, 87381, 349525, 1398101, 5592405]], ); # 4,4 has D=0. Old GMP won't handle that. if ($usexs || !$usegmp) { push @lucas_seqs, [ [4, 4], 0, "U", "n*2^(n-1)", [0, 1, 4, 12, 32, 80, 192, 448, 1024, 2304, 5120, 11264, 24576, 53248] ], } my @oeis_81264 = (323, 377, 1891, 3827, 4181, 5777, 6601, 6721, 8149, 10877, 11663, 13201, 13981, 15251, 17119, 17711, 18407, 19043, 23407, 25877, 27323, 30889, 34561, 34943, 35207, 39203, 40501, 50183, 51841, 51983, 52701, 53663, 60377, 64079, 64681); # The PP lucas sequence is really slow. $#oeis_81264 = 2 unless $usexs || $usegmp; plan tests => 0 + 2*scalar(@lucas_seqs) + 1 + 1; foreach my $seqs (@lucas_seqs) { my($apq, $isneg, $uorv, $name, $exp) = @$seqs; my $idx = ($uorv eq 'U') ? 0 : 1; my @seq = map { (lucas_sequence(2**32-1, @$apq, $_))[$idx] } 0 .. $#$exp; do { for (@seq) { $_ -= (2**32-1) if $_ > 2**31; } } if $isneg; is_deeply( [@seq], $exp, "lucas_sequence ${uorv}_n(@$apq) -- $name" ); } foreach my $seqs (@lucas_seqs) { my($apq, $isneg, $uorv, $name, $exp) = @$seqs; if ($uorv eq 'U') { is_deeply([map { lucasu(@$apq,$_) } 0..$#$exp], $exp, "lucasu(@$apq) -- $name"); } else { is_deeply([map { lucasv(@$apq,$_) } 0..$#$exp], $exp, "lucasv(@$apq) -- $name"); } } { my @p; foroddcomposites { my $t = (($_%5)==2||($_%5)==3) ? $_+1 : $_-1; my($U,$V) = lucas_sequence($_,1,-1,$t); push @p, $_ if $U == 0; } $oeis_81264[-1]; is_deeply( \@p, \@oeis_81264, "OEIS 81264: Odd Fibonacci pseudoprimes" ); } { my $n = 8539786; my $e = (0,-1,1,1,-1)[$n%5]; my($U,$V,$Q) = lucas_sequence($n, 1, -1, $n+$e); is_deeply( [$U,$V,$Q], [0,5466722,8539785], "First entry of OEIS A141137: Even Fibonacci pseudoprimes" ); } Math-Prime-Util-0.73/t/51-znlog.t0000644000076400007640000000315113204400603014715 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/znlog/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; $use64 = 0 if $use64 && 18446744073709550592 == ~0; my @znlogs = ( [ [5,2,1019], 10], [ [2,4,17], undef], [ [7,3,8], undef], [ [7,17,36], undef], # No solution (Pari #1463) [ [1,8,9], 0], [ [3,3,8], 1], [ [10,2,101], 25], [ [2,55,101], 73], # 2 = 55^73 mod 101 [ [5,2,401], 48], # 5 = 2^48 mod 401 (Pari #1285) [ [228,2,383], 110], [ [3061666278, 499998, 3332205179], 22], [ [5678,5,10007], 8620], # 5678 = 5^8620 mod 10007 [ [7531,6,8101], 6689], # 7531 = 6^6689 mod 8101 # Some odd cases. Pari pre-2.6 and post 2.6 have issues with them. [ [0,30,100], 2], # 0 = 30^2 mod 100 [ [1,1,101], 0], # 1 = 1^0 mod 101 [ [8,2,102], 3], # 8 = 2^3 mod 102 [ [18,18,102], 1], # 18 = 18^1 mod 102 ); if ($usexs || $extra) { push @znlogs, [[5675,5,10000019], 2003974]; # 5675 = 5^2003974 mod 10000019 push @znlogs, [[18478760,5,314138927], 34034873]; } if ($usexs && $use64) { # Nice case for PH push @znlogs, [[32712908945642193,5,71245073933756341], 5945146967010377]; } plan tests => scalar(@znlogs); ###### 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 : "") ); } Math-Prime-Util-0.73/t/30-relations.t0000644000076400007640000000177612453427654015620 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.73/t/26-istotient.t0000644000076400007640000000237113204400603015613 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_totient/; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $usegmp = Math::Prime::Util::prime_get_config->{'gmp'}; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; plan tests => 0 + 2 + 3 + 3 ; is_deeply( [map { is_totient($_) } 0..40], [0,1,1,0,1,0,1,0,1,0,1,0,1,0,0,0,1,0,1,0,1,0,1,0,1,0,0,0,1,0,1,0,1,0,0,0,1,0,0,0,1], "is_totient 0 .. 40" ); is_deeply( [grep { is_totient( 2**29 + $_ ) } 1 .. 80], [4,10,12,16,32,38,48,64,68,72], "is_fundamental(2^29_1 .. 2^29+80)" ); is( is_totient("9223372036854775836"), 1, "is_totient(2^63+28)" ); SKIP: { skip "Skipping is_totient for 2^63 + ...", 2 unless ~0 > 4294967295; is( is_totient("9223372036854775828"), 1, "is_totient(2^63+20)" ); is( is_totient("9223372036854775832"), 0, "is_totient(2^63+24)" ); } is( is_totient("9671406556917033397649496"), 1, "is_totient(2^83+88)" ); SKIP: { skip "Skipping is_totient for 2^83 + ...", 2 unless $extra; is( is_totient("9671406556917033397649458"), 0, "is_totient(2^83+50)" ); is( is_totient("9671406556917033397649472"), 1, "is_totient(2^83+64)" ); } Math-Prime-Util-0.73/t/24-partitions.t0000644000076400007640000001322313204400603015761 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/partitions forpart forcomp is_prime/; 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)) + 20 + 6; foreach my $n (0..$#parts) { is( partitions($n), $parts[$n], "partitions($n)" ); } while (my($n, $epart) = each (%bparts)) { is( partitions($n), $epart, "partitions($n)" ); } ################### forpart { my @p=(); forpart { push @p, [@_] } 0; is_deeply( [@p], [[]], "forpart 0" ); } { my @p=(); forpart { push @p, [@_] } 1; is_deeply( [@p], [[1]], "forpart 1" ); } { my @p=(); forpart { push @p, [@_] } 2; is_deeply( [@p], [[1,1],[2]], "forpart 2" ); } { my @p=(); forpart { push @p, [@_] } 3; is_deeply( [@p], [[1,1,1],[1,2],[3]], "forpart 3" ); } { my @p=(); forpart { push @p, [@_] } 4; is_deeply( [@p], [[1,1,1,1],[1,1,2],[1,3],[2,2],[4]], "forpart 4" ); } { my @p=(); forpart { push @p, [@_] } 6; is_deeply( [@p], [[1,1,1,1,1,1],[1,1,1,1,2],[1,1,1,3],[1,1,2,2],[1,1,4],[1,2,3],[1,5],[2,2,2],[2,4],[3,3],[6]], "forpart 6" ); } { my @p=(); forpart { push @p, [@_] } 17,{n=>2}; is_deeply( [@p], [[1,16],[2,15],[3,14],[4,13],[5,12],[6,11],[7,10],[8,9]], "forpart 17 restricted n=[2,2]" ); } { my @p1 = (); my @p2 = (); forpart { push @p1, [@_] if @_ <= 5 } 27; forpart { push @p2, [@_] } 27, {nmax=>5}; is_deeply( [@p1], [@p2], "forpart 27 restricted nmax 5" ); } { my @p1 = (); my @p2 = (); forpart { push @p1, [@_] if @_ >= 20 } 27; forpart { push @p2, [@_] } 27, {nmin=>20}; is_deeply( [@p1], [@p2], "forpart 27 restricted nmin 20" ); } { my @p1 = (); my @p2 = (); forpart { push @p1, [@_] if @_ >= 10 && @_ <= 13 } 19; forpart { push @p2, [@_] } 19, {nmin=>10,nmax=>13}; is_deeply( [@p1], [@p2], "forpart 19 restricted n=[10..13]" ); } { my @p1 = (); my @p2 = (); forpart { push @p1, [@_] unless scalar grep { $_ > 4 } @_ } 20; forpart { push @p2, [@_] } 20, {amax=>4}; is_deeply( [@p1], [@p2], "forpart 20 restricted amax 4" ); } { my @p1 = (); my @p2 = (); forpart { push @p1, [@_] unless scalar grep { $_ < 4 } @_ } 15; forpart { push @p2, [@_] } 15, {amin=>4}; is_deeply( [@p1], [@p2], "forpart 15 restricted amin 4" ); } { my @p1 = (); my @p2 = (); forpart { push @p1, [@_] unless scalar grep { $_ < 3 || $_ > 6 } @_ } 21; forpart { push @p2, [@_] } 21, {amin=>3,amax=>6}; is_deeply( [@p1], [@p2], "forpart 21 restricted a=[3..6]" ); } #{ my @p1 = (); my @p2 = (); # forpart { push @p1, [@_] unless @_ != 4 || scalar grep { $_ < 2 || $_ > 8 } @_ } 22; # forpart { push @p2, [@_] } 22, {amin=>2,amax=>8,n=>4}; # is_deeply( [@p1], [@p2], "forpart 22 restricted n=4 and a=[3..6]" ); } { my @p=(); forpart { push @p, [@_] } 22, {amin=>2,amax=>8,n=>4}; is_deeply( [@p], [[2,4,8,8],[2,5,7,8],[2,6,6,8],[2,6,7,7],[3,3,8,8],[3,4,7,8],[3,5,6,8],[3,5,7,7],[3,6,6,7],[4,4,6,8],[4,4,7,7],[4,5,5,8],[4,5,6,7],[4,6,6,6],[5,5,5,7],[5,5,6,6]], "forpart 22 restricted n=4 and a=[3..6]" ); } { my @p = (); forpart { push @p, [@_] unless scalar grep {!is_prime($_)} @_ } 20,{amin=>3}; is_deeply( [@p], [[3,3,3,3,3,5],[3,3,3,11],[3,3,7,7],[3,5,5,7],[3,17],[5,5,5,5],[7,13]], "forpart 20 restricted to odd primes" ); } { my @p=(); forpart { push @p, [@_] } 21, {amax=>0}; is_deeply( [@p], [], "forpart 21 restricted amax 0" ); } { my $c = 0; forpart { $c++ } 2*89+1,{n=>3,amin=>3,prime=>1}; is($c, 86, "A007963(89) = number of odd-prime 3-tuples summing to 2*89+1 = 86"); } { my $c = 0; forpart { $c++ } 23,{n=>4,amin=>2}; is($c, 54, "23 partitioned into 4 with mininum 2 => 54"); } { my $c = 0; forpart { $c++ } 23,{n=>4,amin=>2,prime=>1}; is($c, 5, "23 partitioned into 4 with mininum 2 and prime => 5"); } { my $c = 0; forpart { $c++ } 23,{n=>4,amin=>2,prime=>0}; is($c, 1, "23 partitioned into 4 with mininum 2 and composite => 1"); } ################### forcomp { my @p=(); forcomp { push @p, [@_] } 0; is_deeply( [@p], [[]], "forcomp 0" ); } { my @p=(); forcomp { push @p, [@_] } 1; is_deeply( [@p], [[1]], "forcomp 1" ); } { my @p=(); forcomp { push @p, [@_] } 2; is_deeply( [@p], [[1,1],[2]], "forcomp 2" ); } { my @p=(); forcomp { push @p, [@_] } 3; is_deeply( [@p], [[1,1,1],[1,2],[2,1],[3]], "forcomp 3" ); } { my @p=(); forcomp { push @p, [@_] } 5,{n=>3}; is_deeply( [@p], [[1,1,3],[1,2,2],[1,3,1],[2,1,2],[2,2,1],[3,1,1]], "forcomp 5 restricted n=3" ); } { my @p=(); forcomp { push @p, [@_] } 12,{n=>3,amin=>3,amax=>5}; is_deeply( [@p], [[3,4,5],[3,5,4],[4,3,5],[4,4,4],[4,5,3],[5,3,4],[5,4,3]], "forcomp 12 restricted n=3,a=[3..5]" ); } Math-Prime-Util-0.73/t/34-random.t0000644000076400007640000001627113204400603015054 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/irand irand64 drand urandomb urandomm random_bytes entropy_bytes srand csrand mulmod addmod vecmin vecmax vecall/; my $use64 = (~0 > 4294967295); my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $maxbits = $use64 ? 64 : 32; my $samples = $extra ? 100000 : 10000; plan tests => 1 + 2 + 2 + 2 + 5 # drand range + 4 # identify rng and test srand/csrand + 4 # 0 / undef arguments to urandom* + 1 # urandomb + 3 # urandomm + 4 # entropy_bytes + 0; ######## ok( Math::Prime::Util::_is_csprng_well_seeded(), "CSPRNG is being seeded properly" ); ######## { my @s = map { irand } 1 .. $samples; is( scalar(grep { $_ > 4294967295 } @s), 0, "irand values are 32-bit" ); is( scalar(grep { $_ != int($_) } @s), 0, "irand values are integers" ); } ######## SKIP: { skip "Skipping irand64 on 32-bit Perl", 2 if !$use64; my $bits_on = 0; my $bits_off = 0; my $iter = 0; for (1 .. 6400) { $iter++; my $v = irand64; $bits_on |= $v; $bits_off |= (~$v); last if ~$bits_on == 0 && ~$bits_off == 0; } is( ~$bits_on, 0, "irand64 all bits on in $iter iterations" ); is( ~$bits_off, 0, "irand64 all bits off in $iter iterations" ); } ######## # This is really brute force, but it doesn't take too long. { my $mask = 0; my $v; for (1..1024) { $v = drand; last if $v >= 1; next if $v < .5; for my $b (0..127) { last unless $v; $v *= 2; if ($v >= 1) { $mask |= (1 << $b); $v -= 1; } } } ok($v < 1, "drand values between 0 and 1-eps"); my $k = 0; while ($mask) { $k++; $mask >>= 1; } # Assuming drand is working properly: # k = 24 NV is float # k = 53 NV is double # k = 64 NV is long double # If we used drand48 we'd get 48 with double or long double. ok($k >= 21, "drand supplies at least 21 bits (got $k)"); } sub check_float_range { my($name, $lo, $hi, $v) = @_; if ($lo <= $hi) { ok( vecall(sub{ $_ >= $lo && $_ < $hi },@$v), "$name: all in range [$lo,$hi)" ); } else { ok( vecall(sub{ $_ >= $hi && $_ < $lo },@$v), "$name: all in range ($hi,$lo]" ); } } my $num = $extra ? 1000 : 100; check_float_range('drand(10)',0,10,[map{ drand(10) } 1..$num]); check_float_range('drand()',0,1,[map{ drand() } 1..$num]); check_float_range('drand(-10)',0,-10,[map{ drand(-10) } 1..$num]); check_float_range('drand(0)',0,1,[map{ drand(0) } 1..$num]); { # Skip warnings these give, worry about the behavior no warnings; check_float_range('drand(undef)',0,1,[map{ drand(undef) } 1..$num]); } # We can't easily supress the warning here, but we'd like to check the # result. Math::Random::Secure fails this, for instance. #check_float_range('drand("foo")',0,1,[map{ drand("foo") } 1..$num]); ######## my $core_rand = "not drand48"; if (1) { my @r = map { CORE::rand() } 0..8; if (try_lcg(25214903917,11,2**48,@r)) { $core_rand = "drand48 (yech)"; } elsif (try_16bit(@r)) { $core_rand = "16-bit (ack)"; } } sub try_lcg { my($a,$c,$m,@r) = @_; @r = map { int($m * $_) } @r; my @g = ($r[0]); $g[$_] = addmod(mulmod($a,$g[$_-1],$m),$c,$m) for 1..$#r; for (1..$#r) { return unless $r[$_] == $g[$_]; } 1; } # We could try to predict Windows truncated LCG: # http://crypto.stackexchange.com/questions/10608/how-to-attack-a-fixed-lcg-with-partial-output sub try_16bit { my(@r) = @_; for my $r (@r) { my $rem = $r - int(32768*$r); return if $rem > 1e-6; } for my $r (map { CORE::rand() } 1..120) { my $rem = $r - int(32768*$r); return if $rem > 1e-6; } 1; } ######## # Quick check to identify the RNG being used. Should be ChaCha20. srand(42); my $rb42 = irand(); my $csprng = 'something I do not know'; if ($rb42 == 445265827) { $csprng = 'ChaCha20'; } elsif ($rb42 == 3626765506) { $csprng = 'ChaCha12'; } elsif ($rb42 == 266717191) { $csprng = 'ChaCha8'; } elsif ($rb42 == 4274346485) { $csprng = 'ISAAC'; } elsif ($rb42 == 3197710526) { $csprng = 'drand48'; } elsif ($rb42 == 2209484588) { $csprng = 'Math::Random::Xorshift'; } elsif ($rb42 == 1608637542) { $csprng = 'Math::Random::MT'; } elsif ($rb42 == 2746317213) { $csprng = 'Math::Random::MT::Auto (32)'; } elsif ($rb42 == 6909045637428952499) { $csprng = 'Math::Random::MTwist (64)'; } elsif (sprintf("%.1lf",$rb42) eq '6909045637428952064.0') { $csprng = 'Math::Random::MTwist (32)'; } elsif ($rb42 == 9507361240820437267) { $csprng = 'Math::Random::MT::Auto (64)'; } diag "CORE::rand: $core_rand. Our PRNG: $csprng"; SKIP: { if ($csprng eq 'ChaCha20') { srand(15); is(unpack("H8",random_bytes(4)), "546d6108", "random_bytes after srand"); csrand("BLAKEGrostlJHKeccakSkein--RijndaelSerpentTwofishRC6MARS"); is(unpack("H14",random_bytes(7)), "b302e671601bce", "random_bytes after manual seed"); is(irand(), 88564645, "irand after seed"); my $d = drand(); my $dexp = 0.0459118340827543; ok($d > $dexp-1e-6 && $d < $dexp+1e-6,"drand after seed $d ~ $dexp"); } elsif ($csprng eq 'ISAAC') { srand(15); is(unpack("H8",random_bytes(4)), "36cd2d21", "random_bytes after srand"); csrand("BLAKEGrostlJHKeccakSkein--RijndaelSerpentTwofishRC6MARS"); is(unpack("H14",random_bytes(7)), "a0644ad1e00324", "random_bytes after manual seed"); is(irand(), 2526495644, "irand after seed"); my $d = drand(); my $dexp = 0.490707771279301221; ok($d > $dexp-1e-6 && $d < $dexp+1e-6,"drand after seed $d ~ $dexp"); } else { skip "Unknown random number generator! Skipping deterministic tests.",4; } } srand; ####### is(random_bytes(0),'',"random_bytes(0) returns empty string"); is(urandomb(0),0,"urandomb(0) returns 0"); is(urandomm(0),0,"urandomm(0) returns 0"); is(urandomm(1),0,"urandomm(1) returns 0"); ####### { my @failb; for my $bits (1..$maxbits) { my $lim = (1<<($bits-1)) + ((1<<($bits-1))-1); my $r = urandomb($bits); push @failb, $bits unless !ref($r) && $r <= $lim; } is_deeply(\@failb, [], "urandomb returns native int within range for 1..$maxbits"); } ####### { my @failm; for my $m (1..50) { my $r = urandomm($m); push @failm, $m unless !ref($r) && $r < $m; } is_deeply(\@failm, [], "urandomm returns native int within range for 1..50"); } { my %dv; for my $t (1..10000) { $dv{urandomm(10)}++; last if $t > 100 && scalar(keys(%dv)) >= 10; } my @k = sort { $a<=>$b} keys(%dv); is(scalar(@k), 10, "urandomm(10) generated 10 distinct values"); ok( vecmin(@k) == 0 && vecmax(@k) == 9, "urandomm(10) values between 0 and 9 (@k)" ); } ####### # If the functions work, these tests fail with chance less than 2^-128. my $ebytes = 17; my $eb1 = entropy_bytes($ebytes); my $eb2 = entropy_bytes($ebytes); is(length($eb1), $ebytes, "entropy_bytes gave us the right number of bytes"); $eb1 = unpack("H*",$eb1); $eb2 = unpack("H*",$eb2); isnt($eb1, '00' x $ebytes, "entropy_bytes didn't return all zeros once"); isnt($eb2, '00' x $ebytes, "entropy_bytes didn't return all zeros twice"); isnt($eb1, $eb2, "entropy_bytes returned two different binary strings"); Math-Prime-Util-0.73/t/33-examples.t0000644000076400007640000003441713204400603015413 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/:all/; use Math::Prime::Util::PrimeArray; use List::Util qw/first/; # Make sure things used as examples in the documentation work. BEGIN { unless ($ENV{RELEASE_TESTING}) { plan( skip_all => 'these tests are for release candidate testing' ); } } plan tests => 99; { my @nums; forprimes { push @nums, $_ if is_prime($_+2) } 10000; is(scalar @nums, twin_prime_count(10000), "twin primes via forprimes"); } { my @nums; forcomposites { push @nums,$_ if is_strong_pseudoprime($_,2) } 10000, 10**6; is_deeply(\@nums, [qw/15841 29341 42799 49141 52633 65281 74665 80581 85489 88357 90751 104653 130561 196093 220729 233017 252601 253241 256999 271951 280601 314821 357761 390937 458989 476971 486737 489997 514447 580337 635401 647089 741751 800605 818201 838861 873181 877099 916327 976873 983401/], "spsp-2s in range using forcomposites"); } is( prime_count( 1_000_000 ), 78498, "prime_count(1M)" ); is( prime_count( 10**14, 10**14+1000 ), 30, "prime_count(10^14,10^14+1000)" ); { my $n = "100000000000000000"; # 10^17 my $approx = prime_count_approx($n); cmp_ok($approx, '>=', prime_count_lower($n), "10^17: Pi approx >= Pi lower"); cmp_ok($approx, '<=', prime_count_upper($n), "10^17: Pi approx <= Pi upper"); cmp_closeto($approx, 2623557157654233, 0.000001, "10^17: Pi approx within .0001%"); } is(nth_prime(10000), 104729, "nth_prime(10000)"); { my $n = "1000000000000"; # 10^12 my $approx = nth_prime_approx($n); cmp_ok($approx, '>=', nth_prime_lower($n), "10^17: nth approx >= nth lower"); cmp_ok($approx, '<=', nth_prime_upper($n), "10^17: nth approx <= nth upper"); cmp_closeto($approx, 29996224275833, 1e-5, "10^12: nth approx within .001%"); } is(euler_phi("801294088771394680000412"), "391329671260448564651280", "euler_phi(801294088771394680000412)"); is(jordan_totient(5,1234), "2771963542268536", "jordan_totient(5,1234)"); { my $sum = 0; $sum += moebius($_) for 1..200; is($sum, -8, "Mertens(200) via moebius"); } is(mertens(10_000_000), 1037, "Mertens(10_000_000)"); is(exp_mangoldt(49), 7, "exp_mangoldt(49)"); is(liouville(4292384), -1, "liouville(4292384)"); cmp_closeto(chebyshev_psi(234984), 235070.385453159, 1e-6, "chebyshev_psi(234984)"); cmp_closeto(chebyshev_theta(92384234), 92371752.9943251, 1e-6, "chebyshev_theta(92384234)"); is(partitions(1000), "24061467864032622473692149727991", "partitions(1000)"); { my($nparts,$nels) = (0,0); forpart { do { $nparts++; $nels += scalar @_; } unless scalar grep { !is_prime($_) } @_ } 25; is($nparts, 52, "partions of 25 with all prime elements: 52 found"); is($nels, 333, "partions of 25 with all prime elements: 333 total values"); } is(primorial(47), "614889782588491410", "primorial(47)"); is(pn_primorial(47), "1645783550795210387735581011435590727981167322669649249414629852197255934130751870910", "pn_primorial(47)"); ############################################################################## { my $aref = primes( 1_000_000_000_000, 1_000_000_001_000 ); my $eref = [map { "1000000000".$_ } qw/039 061 063 091 121 163 169 177 189 193 211 271 303 331 333 339 459 471 537 543 547 561 609 661 669 721 751 787 789 799 841 903 921 931 933 949 997/]; is_deeply($aref,$eref,"primes(1000M,1000M+1000)"); } { my @nums; forprimes { push @nums, $_ } 100,200; is_deeply(\@nums, primes(100,200), "forprimes 100,200"); } { my $sum = 0; forprimes { $sum += $_ } 100000; is($sum, 454396537, "forprimes sum primes to 100k"); } { my @ecomp = grep { !is_prime($_) } 4..1000; my @acomp; forcomposites { push @acomp, $_ } 1000; is_deeply(\@acomp, \@ecomp, "forcomposites to 1000"); } { my @ecomp = grep { !is_prime($_) } 2000..2020; my @acomp; forcomposites { push @acomp, $_ } 2000,2020; is_deeply(\@acomp, \@ecomp, "forcomposites 2000,2020"); } { my $prod = 1; fordivisors { $prod *= $_ } 1234; is($prod, 1522756, "fordivisors 1234"); } { my $nparts; is(partitions(25), 1958, "partitions(25)"); $nparts = 0; forpart { $nparts++ } 25; is($nparts, 1958, "forpart {} 25 generates 1958 partitions"); $nparts = 0; forpart { $nparts++ } 25,{n=>5}; is($nparts, 192, "forpart {} 25,{n=>5} generates 192 partitions"); $nparts = 0; forpart { $nparts++ } 25,{nmax=>5}; is($nparts, 377, "forpart {} 25,{nmax=>5} generates 377 partitions"); } { my $it = prime_iterator; my $sum = 0; $sum += $it->() for 1..100000; is($sum, 62260698721, "iterator sums first 100k primes"); } { my $it = prime_iterator(200); is($it->(), 211, "prime_iterator(200)->()"); is($it->(), 223, "prime_iterator(200)->()->()"); } { my $sum = 0; my $it = prime_iterator_object; while ($it->value < 100) { $sum += $it->value; $it->next; } is($sum, 1060, "sum primes below 100 with OO iterator"); is(vecsum(@{primes(100)}), 1060, "...with vecsum(primes(100))"); $sum += $it->iterate for 1..100000; is($sum, 62293195902, "sum first 100k primes larger than 100"); is(vecsum(@{primes(nth_prime(prime_count(100)+100000))}), 62293195902, "...with vecsum"); } is(prime_count(1000), 168, "prime_count(1000)"); is(prime_count(1000,10000), 1061, "prime_count(1000,10000)"); cmp_closeto(prime_count_approx("1000000000000000000"),24739954287740860,1e-6,"prime_count_approx(1e18)"); is(twin_prime_count(123456), 1457, "twin_prime_count(123456)"); cmp_closeto(twin_prime_count_approx("100000000000000000"),90948839353159,1e-6,"twin_prime_count_approx(1e17)"); is(chinese([14,643], [254,419], [87,733]), 87041638, "chinese([14,643], [254,419], [87,733])"); is(vecsum(euler_phi(0,500_000)), 75991039676, "totient sum 500k"); is(invmod(42,2017),1969, "inverse of 42 mod 2017"); { my $sum = 0; $sum += exp_mangoldt($_) for 1..100; is($sum, 1156, "summatory von Mangoldt 1..100 = log(1156)"); } { my $sum = 0; forprimes { $sum += log($_) } 12345; cmp_closeto(chebyshev_theta(12345), $sum, 1e-6, "chebyshev_theta(12345) and forprimes"); } { my $sum = 0; for (1..12345) { $sum += log(exp_mangoldt($_)) } cmp_closeto(chebyshev_psi(12345), $sum, 1e-6, "chebyshev_psi(12345) and forprimes"); } is(primorial(11), 2310, "primorial(11)"); is(pn_primorial(5), 2310, "pn_primorial(5)"); is(primorial(0), 1, "primorial(0)"); is(pn_primorial(0), 1, "pn_primorial(0)"); is(znorder(2, next_prime("10000000000000000")-6), 40177783100, "znorder(2,10000000000000061)"); is(legendre_phi(1000000000, 41), 106614188, "Legendre phi 1e9,41"); ############################################################################## # Not sure how best to test the random primes. ok( is_prime(random_prime(1000)), "random_prime(1000)" ); ok( is_prime(random_prime(100,10000)), "random_prime(100,10000)" ); is( length(random_ndigit_prime(4)), 4, "random_ndigit_prime(4) is 4 digits" ); { my $bigprime; $bigprime = random_nbit_prime(512); is( length($bigprime->as_bin), 2+512, "random_nbit_prime(512) is 512 bits" ); $bigprime = random_strong_prime(512); is( length($bigprime->as_bin), 2+512, "random_strong_prime(512) is 512 bits" ); $bigprime = random_proven_prime(512); is( length($bigprime->as_bin), 2+512, "random_proven_prime(512) is 512 bits" ); } # TODO: More of the random primes and certs ############################################################################## is_deeply([factor("3369738766071892021")], [204518747,16476429743], "factor(3_369_738_766_071_892_021)"); is_deeply([factor_exp(29513484000)], [[2,5], [3,4], [5,3], [7,2], [11,1], [13,2]], "factor_exp(29513484000)"); is_deeply([factor(29513484000)], [2,2,2,2,2,3,3,3,3,5,5,5,7,7,11,13,13], "factor(29513484000)"); is_deeply([divisors(30)], [1, 2, 3, 5, 6, 10, 15, 30], "divisors(30)"); ############################################################################## { my $sum = 0; forcomposites { $sum += $_ if is_strong_pseudoprime($_,17) } 1000000; is($sum, 23206520, "forcomposites looking for base-17 strong probable primes"); } { my($start,$end) = ("100000000000000000000", "100000000000000001000"); my $aref = primes($start, $end); my $eref = [map { "100000000000000000".$_ } qw/039 129 151 193 207 301 349 361 391 393 441 477 547 559 561 721 741 753 757 763 801 853 961 993/]; is_deeply($aref,$eref,"primes(10^20,10^20+1000)"); $aref = []; forprimes { push @$aref,$_ } "100000000000000000039", "100000000000000000993"; } { my @c; foroddcomposites { push @c,$_ if $_ % carmichael_lambda($_) == 1 } 10000; is_deeply(\@c,[qw/561 1105 1729 2465 2821 6601 8911/], "carmichael numbers under 10000"); @c=(); foroddcomposites { push @c,$_ if $_ % carmichael_lambda($_) == 1 } 1020000,1085000; is_deeply(\@c,[qw/1024651 1033669 1050985 1082809/], "carmichael numbers from 1020k to 1085k"); } { my $nu3 = sub { my $n = shift; my($phix,$v) = (chebyshev_psi($n), 0); $v += (moebius($_)/$_)*LogarithmicIntegral($phix**(1/$_)) for 1..3; $v; }; cmp_closeto($nu3->(1e6), 78498, 1e-4, "η3(1e6) ~ Pi(1e6)"); cmp_closeto($nu3->(1e7), 664579, 1e-4, "η3(1e7) ~ Pi(1e7)"); } { my $make_sg_it = sub { my $p = shift || 2; my $it = prime_iterator($p); return sub { do { $p = $it->() } while !is_prime(2*$p+1); $p; }; }; my $sgit = $make_sg_it->(); my $sum = 0; $sum += $sgit->() for 1..10000; is($sum, 6171027819, "sum first 10k Sophie-Germain primes using iterator"); } is( (factor("600851475143"))[-1], 6857, "largest prime factor of 600851475143"); is( nth_prime(10001), 104743, "nth_prime(10001)"); { my $sum = 0; forprimes { $sum += $_ } 2_000_000; is($sum, 142913828922, "sum 2M primes with forprimes"); is(vecsum( @{primes(2_000_000)} ), 142913828922, "sum 2M primes with vecsum(primes())"); } { my $sum = 0; foreach my $x (1..10000) { my $y = divisor_sum($x)-$x; $sum += $x + $y if $y > $x && $x == divisor_sum($y)-$y; } is($sum, 31626, "sum of amicable numbers using loop"); $sum = vecsum( map { divisor_sum($_) } grep { my $y = divisor_sum($_)-$_; $y > $_ && $_==(divisor_sum($y)-$y) } 1 .. 10000 ); is($sum, 31626, "sum of amicable numbers using pipeline"); } { my $pd = first { /1/&&/2/&&/3/&&/4/&&/5/&&/6/&&/7/} reverse @{primes(1000000,9999999)}; is($pd, 7652413, "largest 7-digit pandigital prime"); } { my $n = pn_primorial(4); $n++ while (factor_exp($n) != 4 || factor_exp($n+1) != 4 || factor_exp($n+2) != 4 || factor_exp($n+3) != 4); is($n, 134043, "first number in sequence of four 4-factor numbers"); } { my ($maxn, $maxratio) = (0,0); foreach my $n (1..1000000) { my $ndivphi = $n / euler_phi($n); ($maxn, $maxratio) = ($n, $ndivphi) if $ndivphi > $maxratio; } is($maxn, 510510, "largest ratio of n/phi(n) for n < 1M. Brute force."); } { my $n = 0; $n++ while pn_primorial($n+1) < 1000000; my $maxn = pn_primorial($n); is($maxn, 510510, "largest ratio of n/phi(n) for n < 1M. Smart way."); } { my $n=0; forcomposites { $n++ if scalar factor($_) == 2; } int(1e5)-1; is($n, 23378, "Brute force count semiprimes under 1e5"); } { my $limit = 1e7; $limit--; my ($sum, $pc) = (0, 1); forprimes { $sum += prime_count(int($limit/$_)) + 1 - $pc++; } int(sqrt($limit)); is($sum, 1904324, "Count of semiprimes under 1e7"); } { my $matches = sub { my @d = divisors(shift); return map { [$d[$_],$d[$#d-$_]] } 1..(@d-1)>>1; }; is_deeply([$matches->(139650)], [[2,69825],[3,46550],[5,27930],[6,23275],[7,19950],[10,13965],[14,9975],[15,9310],[19,7350],[21,6650],[25,5586],[30,4655],[35,3990],[38,3675],[42,3325],[49,2850],[50,2793],[57,2450],[70,1995],[75,1862],[95,1470],[98,1425],[105,1330],[114,1225],[133,1050],[147,950],[150,931],[175,798],[190,735],[210,665],[245,570],[266,525],[285,490],[294,475],[350,399]], "matches 139650"); } { my @nums; forcomposites { push @nums,$_ if divisor_sum($_)+6==divisor_sum($_+6) } 9,1e5; is_deeply(\@nums,[qw/104 147 596 1415 4850 5337/], "OEIS A054903"); } { my @s; foreach my $n (1..30) { if (!znprimroot($n)) { push @s, "$n -"; } else { my $phi = euler_phi($n); my @r = grep { gcd($_,$n) == 1 && znorder($_,$n) == $phi } 1..$n-1; push @s, "$n " . join(" ", @r); } } my @expect = split(/\|/, "1 -|2 1|3 2|4 3|5 2 3|6 5|7 3 5|8 -|9 2 5|10 3 7|11 2 6 7 8|12 -|13 2 6 7 11|14 3 5|15 -|16 -|17 3 5 6 7 10 11 12 14|18 5 11|19 2 3 10 13 14 15|20 -|21 -|22 7 13 17 19|23 5 7 10 11 14 15 17 19 20 21|24 -|25 2 3 8 12 13 17 22 23|26 7 11 15 19|27 2 5 11 14 20 23|28 -|29 2 3 8 10 11 14 15 18 19 21 26 27|30 -|"); is_deeply(\@s,\@expect,"znprimroot table 1..30"); } ############################################################################## { my $checksum = vecreduce { $a ^ $b } @{twin_primes(1000000)}; is($checksum, 630871, "xor of twin primes <= 1M"); } ############################################################################## { my @v = (qw/a b c d e/); my $ps = join " ", map { join("",vecextract(\@v,$_)) } 0..2**scalar(@v)-1; is($ps, " a b ab c ac bc abc d ad bd abd cd acd bcd abcd e ae be abe ce ace bce abce de ade bde abde cde acde bcde abcde", "power set of 5 elements"); my $word = join "", vecextract(["a".."z"], [15, 17, 8, 12, 4]); is($word, "prime", "use vecextract with array"); } ############################################################################## tie my @primes, 'Math::Prime::Util::PrimeArray'; { my @plist; for my $n (0..9) { push @plist, $primes[$n]; } is_deeply(\@plist, primes(nth_prime(10)), "PrimeArray for index loop"); } { my @plist; for my $p (@primes) { last if $p > 79; push @plist, $p; } is_deeply(\@plist, primes(79), "PrimeArray for primes loop"); } { my @plist; is_deeply([@primes[0..49]], primes(nth_prime(50)), "PrimeArray array slice"); } SKIP: { skip "hash each requires 5.12 or newer", 1 if $] < 5.012; my @plist; while ( my($index,$value) = each @primes ) { last if $value > 147; push @plist, $value; } is_deeply(\@plist, primes(147), "PrimeArray each primes loop"); } { my @plist; while ((my $p = shift @primes) < 250) { push @plist, $p; } is_deeply(\@plist, primes(250), "PrimeArray shift"); unshift @primes, ~0; # put primes back. is($primes[0], 2, "unshift puts it back"); } ############################################################################## sub cmp_closeto { my $got = shift; my $expect = shift; my $tolerance = shift; my $message = shift; my $error = sprintf("%g", abs($got - $expect) / $expect); my $errorpr = sprintf "%.2g", $error; cmp_ok( $error, '<=', $tolerance, "$message ($errorpr)"); } Math-Prime-Util-0.73/t/19-rootint.t0000644000076400007640000000571213204400603015273 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/ sqrtint rootint logint /; #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'}; #my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; #$use64 = 0 if $use64 && 18446744073709550592 == ~0; my @roots = ( [25, 3, 15625], [13, 4, 28561], [13, 5, 371293], [25, 6, 244140625], [ 7, 7, 823543], [13, 8, 815730721], [ 7, 9, 40353607], [13, 10, "137858491849"], [21, 11, "350277500542221"], [25, 12, "59604644775390625"], [ 7, 13, "96889010407"], [ 7, 14, "678223072849"], [13, 16, "665416609183179841"], [13, 17, "8650415919381337933"], [ 7, 18, "1628413597910449"], [ 6, 19, "609359740010496"], [ 3, 21, "10460353203"], [ 3, 23, "94143178827"], [ 3, 25, "847288609443"], [ 3, 29, "68630377364883"], ); plan tests => 0 + 4 # sqrtint + 6 # rootint + 5; # logint ###### sqrtint is_deeply( [map { sqrtint($_) } 0..100], [map { int(sqrt($_)) } 0..100], "sqrtint 0 .. 100" ); is( sqrtint(1524155677489), 1234567, "sqrtint(1234567^2) = 1234567" ); is( sqrtint(1524158146623), 1234567, "sqrtint(1234568^2-1) = 1234567" ); is( sqrtint(1524155677488), 1234566, "sqrtint(1234567^2-1) = 1234566" ); ###### rootint # TODO: croak if n < 0 or k < 1 is(rootint(928342398,1), 928342398, "rootint(928342398,1) returns 928342398"); is(rootint(88875,3), 44, "rootint(88875,3) returns 44"); is(rootint("266667176579895999",3), 643659, "integer third root of 266667176579895999 is 643659"); { my(@got, @expected); for my $arr (@roots) { my($b, $k, $n) = @$arr; push @expected, [$b,$n]; my $rk; my $r = rootint($n,$k,\$rk); push @got, [$r,$rk]; } is_deeply( \@got, \@expected, "rootint on perfect powers where log fails" ); } is( rootint("43091031920942300256108314560009772304748698124094750326895058640841523270081624169128280918534127523222564290447104831706207227117677890695945149868732770531628297914633063561406978145215542597509491443634033203125",23), 2147483645, "integer 23rd root of a large 23rd power" ); is( rootint("43091031920942300256108314560009772304748698124094750326895058640841523270081624169128280918534127523222564290447104831706207227117677890695945149868732770531628297914633063561406978145215542597509491443634033203124",23), 2147483644, "integer 23rd root of almost a large 23rd power" ); ###### logint is_deeply( [map { logint($_,2) } 1..200], [map { int(log($_)/log(2)+1e-10) } 1..200], "logint base 2: 0 .. 200" ); is_deeply( [map { logint($_,3) } 1..200], [map { int(log($_)/log(3)+1e-10) } 1..200], "logint base 3: 0 .. 200" ); is_deeply( [map { logint($_,5) } 1..200], [map { int(log($_)/log(5)+1e-10) } 1..200], "logint base 5: 0 .. 200" ); { my $be; is( logint(19284098234,16,\$be), 8, "logint(19284098234,16) = 8" ); is( $be, 16**8, "power is 16^8" ); } Math-Prime-Util-0.73/t/81-bignum.t0000644000076400007640000005575313210572416015100 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/ 100000982717289000001 100170437171734071001 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 + 1 # twin primes + 2 # next/prev prime + 1 # prime_iterator + 1 # primecount large base small range + scalar(keys %pseudoprimes) + 6 # PC lower, upper, approx + 6*3*$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 + 1 # gcdext + 1 # chinese + 4 # ispower + 15 # random primes + 8 # miller-rabin random + 2 # Perrin PsP + 1 # valuation + 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 gcdext chinese is_power pn_primorial ExponentialIntegral LogarithmicIntegral RiemannR primes twin_primes prime_count nth_prime is_prime is_provable_prime next_prime prev_prime prime_iterator is_strong_pseudoprime random_prime random_ndigit_prime random_nbit_prime random_strong_prime random_maurer_prime miller_rabin_random is_perrin_pseudoprime is_bpsw_prime verify_prime valuation /; # 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_deeply( twin_primes(18446744073709558000, 18446744073709559000), [18446744073709558601,18446744073709558727], "twin_primes( 18446744073709558000, +1000)" ); ############################################################################### is( next_prime(777777777777777777777777), 777777777777777777777787, "next_prime(777777777777777777777777)"); is( prev_prime(777777777777777777777777), 777777777777777777777767, "prev_prime(777777777777777777777777)"); ############################################################################### {my $it = prime_iterator(10**24+910); is_deeply( [map { $it->() } 1..3], [1000000000000000000000921,1000000000000000000000931,1000000000000000000000949], "iterator 3 primes starting at 10^24+910" ); } ############################################################################### # 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, '2e-8', '2e-8'); if ($extra) { check_pcbounds(314159265358979323846, 6803848951392700268, '5e-9', '5e-9'); check_pcbounds(31415926535897932384626433, 544551456607147153724423, '3e-6', '3e-11'); # pi(10^23) = 1925320391606803968923 check_pcbounds(10**23, 1925320391607837268776, '5e-10', '5e-10'); } ############################################################################### 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)" ); # Work around a Math::BigInt::Lite issue is_deeply( [gcdext(803028077895224634710139483024654235947,101394830246542359478030280778952246347)], [7687627417944666569835322284775478836, -60884570288210047004733169112173096587, "3"], "gcdext(a,b)" ); is( chinese([26,17179869209],[17,34359738421]), 103079215280, "chinese([26,17179869209],[17,34359738421] = 103079215280" ); is( is_power(18475335773296164196), "0", "ispower(18475335773296164196) == 0" ); is( is_power(3089265681159475043336839581081873360674602365963130114355701114591322241990483812812582393906477998611814245513881), 14, "ispower(150607571^14) == 14" ); my @negpowers = (qw/0 0 0 3 0 5 3 7 0 9 5 11 3 13 7 15 0 17 9 19 5 21 11 23 3 25 13 27 7 29 15 31/); push @negpowers, (qw/0 33 17 35 9 37 19 39 5 41 21 43 11 45 23 47 3 49 25 51 13 53 27 55 7 57 29 59 15 61 31 63 0 65 33 67 17 69 35 71 9 73 37 75 19 77 39 79 5 81 41 83 21 85 43 87 11 89 45 91 23 93 47 95 3 97 49 99 25 101 51 103 13 105 53 107 27 109 55 111 7 113 57 115 29 117 59 119 15 121 61 123 31 125 63 127 0 129 65 131 33 133 67 135 17 137 69 139 35 141 71 143 9 145 73 147 37 149 75/) if $extra; # Work around bug in Math::BigInt::Pari and Perl pre-5.18. if ($bigintlib eq 'Pari' && $] < "5.018") { is_deeply( [map { is_power("".-7 ** $_) } 0 .. $#negpowers], \@negpowers, "-7 ^ i for 0 .. $#negpowers" ); is_deeply( [map { my $r; my $p=is_power("".-7 ** $_, "0", \$r); $p ? (0+$r) ** $p : -7 ** $_; } 0 .. $#negpowers], [map { -7 ** $_ } 0 .. $#negpowers], "correct root from is_power for -7^i for 0 .. $#negpowers" ); } else { is_deeply( [map { is_power(-7 ** $_) } 0 .. $#negpowers], \@negpowers, "-7 ^ i for 0 .. $#negpowers" ); SKIP: { skip "Skipping some is_power tests on broken 64-bit Perl", 1 if $broken64; is_deeply( [map { my $r; my $p=is_power(-7 ** $_, "0", \$r); $p ? (1*$r) ** $p : -7 ** $_; } 0 .. $#negpowers], [map { -7 ** $_ } 0 .. $#negpowers], "correct root from is_power for -7^i for 0 .. $#negpowers" ); } } ############################################################################### 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(180); cmp_ok( $randprime, '>', 2**179, "random 180-bit strong prime is not too small"); cmp_ok( $randprime, '<', 2**180, "random 180-bit strong prime is not too big"); ok( is_prime($randprime), "random 180-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" ); # Failure and shortcuts for MRR: ok(!eval { miller_rabin_random(undef,4); }, "MRR(undef,4)"); ok(!eval { miller_rabin_random(10007,-4); }, "MRR(10007,-4)"); # Note use of 1-1 : bigint on perl 5.6 and 5.8 is totally borked is(miller_rabin_random(10007, 1-1), 1, "MRR(n,0) = 1"); is(miller_rabin_random(61, 17), 1, "MRR(61,17) = 1"); is(miller_rabin_random(62, 17), 1-1, "MRR(62,17) = 0"); is(miller_rabin_random(1009), 1, "MRR(1009) = 1"); # runs one random base ############################################################################### my $perrinpsp = "1872702918368901354491086980308187833191468631072304770659547218657051750499825897279325406141660412842572655186363032039901203993254366727915836984799032960354882761038920216623610400227219443050113697104123375722324640843102690830473074828429679607154504449403902608511103291058038852618235905156930862492532896467422733403061010774542590301998535381232230279731082501"; SKIP: { # It's fast with a *new* version of the GMP code (that has the test). skip "Perrin pseudoprime tests without EXTENDED_TESTING.", 2 if !$extra; is( is_perrin_pseudoprime($perrinpsp), 1, "18727...2501 is a Perrin PRP" ); is( is_bpsw_prime($perrinpsp), 1-1, "18727...2501 is not a BPSW prime" ); } ############################################################################### is( valuation(6**10000-1,5), 5, "valuation(6^10000,5) = 5" ); ############################################################################### 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.73/t/19-valuation.t0000644000076400007640000000140213204400603015567 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/valuation/; #my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; #my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; #my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; #my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; #$use64 = 0 if $use64 && 18446744073709550592 == ~0; my @valuations = ( [-4,2, 2], [0,0, 0], [1,0, 0], [96552,6, 3], [1879048192,2, 28], ["65520150907877741108803406077280119039314703968014509493068998974809747144832",2, 7], ); plan tests => scalar(@valuations); ###### valuation foreach my $r (@valuations) { my($n, $k, $exp) = @$r; is( valuation($n, $k), $exp, "valuation($n,$k) = $exp" ); } Math-Prime-Util-0.73/t/94-weaken.t0000644000076400007640000000270712532503145015063 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.73/t/23-primality-proofs.t0000644000076400007640000003656712532503145017134 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.73/t/70-rt-bignum.t0000644000076400007640000000334413204400603015475 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. Perl 5.8.x [x < 8] will get lost # and just exit with no message. 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.73/t/11-primes.t0000644000076400007640000001771013204400603015065 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/primes prime_count sieve_range/; 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)) + 10; 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)"); # AIX 128-bit doubles have 30 digits of precision, quadmath has even more. ok(!eval { primes(50000000000000000000000000000000000); }, "primes(inf)"); ok(!eval { primes(2,50000000000000000000000000000000000); }, "primes(2,inf)"); ok(!eval { primes(50000000000000000000000000000000000,50000000000000000000000000000000001); }, "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)" ); } is_deeply( [sieve_range(0, 1000, 40)], primes(1000), "sieve_range 0 width 1000 depth 40 returns primes" ); is_deeply( [sieve_range(1, 4, 2)], [1,2], "sieve_range 1 width 4 depth 2 returns 1,2" ); is_deeply( [sieve_range(1, 5, 2)], [1,2,4], "sieve_range 1 width 5 depth 2 returns 1,2,4" ); is_deeply( [sieve_range(1, 6, 3)], [1,2,4], "sieve_range 1 width 6 depth 3 returns 1,2,4" ); is_deeply( [sieve_range(109485, 100, 3)], [2,4,8,10,14,16,20,22,26,28,32,34,38,40,44,46,50,52,56,58,62,64,68,70,74,76,80,82,86,88,92,94,98], "sieve_range(109485,100,3)" ); is_deeply( [sieve_range(109485, 100, 5)], [2,4,8,14,16,22,26,28,32,34,38,44,46,52,56,58,62,64,68,74,76,82,86,88,92,94,98], "sieve_range(109485,100,5)" ); is_deeply( [sieve_range(109485, 100, 7)], [4,8,14,22,26,28,32,34,38,46,52,56,62,64,68,74,76,82,88,92,94,98], "sieve_range(109485,100,7)" ); is_deeply( [sieve_range(109485, 100, 11)], [4,8,14,22,26,28,32,34,38,46,52,56,62,68,74,76,82,88,92,94,98], "sieve_range(109485,100,11)" ); is_deeply( [sieve_range(109485, 100, 13)], [4,8,22,26,28,32,34,38,46,52,56,62,68,74,76,82,88,94,98], "sieve_range(109485,100,13)" ); is_deeply( [sieve_range(109485, 100, 17)], [4,8,22,26,28,32,34,38,52,56,62,68,74,76,82,88,94,98], "sieve_range(109485,100,17)" ); Math-Prime-Util-0.73/t/31-threading.t0000644000076400007640000001210413204400603015525 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Config; BEGIN { unless ($ENV{RELEASE_TESTING} || $ENV{EXTENDED_TESTING}) { print("1..0 # Skip only in release or extended testing\n"); exit(0); } 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; } } # Math::Pari + threads = crossing the streams. Instant segfault. use Math::BigInt lib=>"Calc"; use Test::More 'tests' => 8; use Math::Prime::Util qw/:all srand/; 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"); if (0) { 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"); if (0) { 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"); thread_test( sub { my $sum = 0; $sum += int(RiemannR($_)) for (@randn); return $sum;}, $numthreads, "RiemannR"); # Requires per-thread context thread_test( sub { srand(10); my $sum = 0; $sum += irand for 1..1141; return $sum;}, $numthreads, "irand"); 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; SKIP: { # If not doing extended testing, allow these to fail with a note. if (!$extra && $par_sum != $seq_sum) { diag "Threading test $text got $par_sum, expected $seq_sum"; skip "Threading failure", 1; } is($par_sum, $seq_sum, "$nthreads threads $text"); } } Math-Prime-Util-0.73/t/12-nextprime.t0000644000076400007640000001143013204400603015573 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 + 1 + 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, undef; 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( next_prime(10019), 10037, "next prime of 10019 is 10037" ); is( prev_prime(2), undef, "Previous prime of 2 returns undef" ); if ($use64) { # With 5.8.8 and earlier, this can cause problems due to Perl getting lost # when the return value is turned into a Math::BigInt. Fixed in 5.8.9. 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.73/t/29-mersenne.t0000644000076400007640000000111413204400603015402 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_mersenne_prime/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my @A000043 = (2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127); push @A000043, (521, 607, 1279, 2203, 2281) if $extra; #push @A000043, (3217, 4253, 4423, 9689, 9941) if $extra; #push @A000043, (11213, 19937, 21701, 23209, 44497, 86243) if $extra; plan tests => 1; is_deeply( [grep { is_mersenne_prime($_) } 0 .. $A000043[-1]], \@A000043, "Find Mersenne primes from 0 to $A000043[-1]" ); Math-Prime-Util-0.73/t/26-issquarefree.t0000644000076400007640000000132613204400603016266 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_square_free/; my %isf = map { $_ => 0 } 0 .. 16,758096738,434420340,870589313,695486396,602721315,418431087; $isf{$_} = 1 for 1,2,3,5,6,7,10,11,13,14,15,752518565,723570005,506916483,617459403; plan tests => 2*scalar(keys %isf) + 2; while (my($n, $isf) = each (%isf)) { is( is_square_free($n), $isf, "is_square_free($n)" ); is( is_square_free(-$n), $isf, "is_square_free(-$n)" ); } ok(is_square_free("815373060690029363516051578884163974"),"815373060690029363516051578884163974 is square free"); ok(!is_square_free("638277566021123181834824715385258732627350"),"638277566021123181834824715385258732627350 is not square free"); Math-Prime-Util-0.73/t/26-isfundamental.t0000644000076400007640000000145213204400603016422 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_fundamental/; #my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; #my $usegmp = Math::Prime::Util::prime_get_config->{'gmp'}; #my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; plan tests => 0 + 4 ; is_deeply( [grep { is_fundamental($_) } -50 .. 0], [-47,-43,-40,-39,-35,-31,-24,-23,-20,-19,-15,-11,-8,-7,-4,-3], "is_fundamental(-50 .. 0)" ); is_deeply( [grep { is_fundamental($_) } 0 .. 50], [1,5,8,12,13,17,21,24,28,29,33,37,40,41,44], "is_fundamental(0 .. 50)" ); is( is_fundamental("147573952589676412937"), 1, "is_fundamental(2^67+9)" ); is( is_fundamental("-147573952589676412884"), 1, "is_fundamental(-2^67+44)" ); Math-Prime-Util-0.73/t/26-ispower.t0000644000076400007640000001033113204400603015254 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_power is_prime_power is_square vecsum/; #use Math::BigInt try=>"GMP,Pari"; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; $use64 = 0 if $use64 && 18446744073709550592 == ~0; my @pow1 = (0,0,0,0,2,0,0,0,3,2,0,0,0,0,0,0,4,0,0,0,0,0,0,0,0,2,0,3,0,0,0,0,5); my @ppow1 = (0,0,1,1,2,1,0,1,3,2,0,1,0,1,0,0,4,1,0,1,0,0,0,1,0,2,0,3,0,1,0,1,5); my %bpow = ( "16926659444736" => [6,17], "100000000000000000" => [10,17], "609359740010496" => [6,19], "789730223053602816" => [6,23], "4611686018427387904" => [2,62], "4738381338321616896" => [6,24], "9223372036854775808" => [2,63], "12157665459056928801" => [3,40], "10000000000000000000" => [10,19], ); my %bppow = ( "762939453125" => [5,17], "232630513987207" => [7,17], "11398895185373143" => [7,19], "11920928955078125" => [5,23], "68630377364883" => [3,29], "617673396283947" => [3,31], "450283905890997363" => [3,37], "12157665459056928801" => [3,40], "7450580596923828125" => [5,27], "3909821048582988049" => [7,22], "5559917313492231481" => [11,18], "8650415919381337933" => [13,17], "2862423051509815793" => [17,15], "15181127029874798299" => [19,15], ); my %powers = ( 0 => [-2, -1, 0, 1, 2, 3, 5, 6, 7, 10, 11, 12, 13, 14, 15, 17, 18, 19], 2 => [4, 9, 25, 36, 49], 3 => [8, 27, 125, 343, 17576], 4 => [16, 38416], 9 => [19683, 1000000000], ); if ($use64) { push @{$powers{0}}, 9908918038843197151; push @{$powers{2}}, 18446743927680663841; push @{$powers{3}}, 2250923753991375; push @{$powers{4}}, 1150530828529256001; push @{$powers{9}}, 118587876497; } my @negpowers = (0,0,0,3,0,5,3,7,0,9,5); plan tests => 0 + 2 + 2 + 2*$extra + scalar(keys(%bpow)) + scalar(keys(%bppow)) + 4 + 7 + scalar(keys %powers) + scalar(@negpowers) + 3 # is_square + 0; is_deeply( [map { is_power($_) } 0 .. $#pow1], \@pow1, "is_power 0 .. $#pow1" ); is_deeply( [map { is_prime_power($_) } 0 .. $#ppow1], \@ppow1, "is_prime_power 0 .. $#ppow1" ); is( vecsum(map { is_power(2099*$_+$_+1) } 0..200), 8, "is_power 200 small ints" ); is( vecsum(map { is_prime_power(2099*$_+$_+1) } 0..200), 77, "is_prime_power 200 small ints" ); if ($extra) { is( vecsum(map { is_power(23*$_+$_) } 0..10000), 122, "is_power 10k small ints" ); is( vecsum(map { is_prime_power(23*$_+$_+1) } 0..10000), 2829, "is_prime_power 10k small ints" ); } while (my($n, $expect) = each (%bpow)) { my $r; my $k = is_power($n,0,\$r); is_deeply( $expect, [$r,$k], "ispower => $n = $r^$k (@$expect)" ); } while (my($n, $expect) = each (%bppow)) { my $r; my $k = is_prime_power($n,\$r); is_deeply( $expect, [$r,$k], "isprimepower => $n = $r^$k (@$expect)" ); } { my $r; my $ip = is_power(-8,3,\$r); is( $ip, 1, "-8 is a third power" ); is( $r, -2, "-8 is a third power of -2" ); is( is_power(-8, 4), 0, "-8 is not a fourth power" ); is( is_power(-16,4), 0, "-16 is not a fourth power" ); } ###### is_power while (my($e, $vals) = each (%powers)) { my @fail; foreach my $val (@$vals) { push @fail, $val unless is_power($val) == $e; } ok( @fail == 0, "is_power returns $e for " . join(",",@fail) ); } foreach my $e (0 .. $#negpowers) { is( is_power(-7 ** $e), $negpowers[$e], "is_power(-7^$e ) = $negpowers[$e]" ); } is( is_power(-1,5), 1, "-1 is a 5th power" ); { my($ispow, $root); $ispow = is_power(24, 2, \$root); is( $ispow, 0, "24 isn't a perfect square..."); is( $root, undef, "...and the root wasn't set"); $ispow = is_power( "1000093002883029791", 3, \$root); is( $ispow, 1, "1000031^3 is a perfect cube..."); is( $root, 1000031, "...and the root was set"); $ispow = is_power( 36**5 , 0, \$root); is( $ispow, 10, "36^5 is a 10th power..."); is( $root, 6, "...and the root is 6"); } ###### is_square is_deeply( [map { is_square($_) } (-4 .. 16)], [0,0,0,0,1,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,1], "is_square for -4 .. 16" ); is(is_square(603729), 1, "603729 is a square"); is(is_square("765413284212226299051111674934086564882382225721"), 1, "is_square() = 1"); Math-Prime-Util-0.73/t/26-vec.t0000644000076400007640000001436313204400603014352 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/vecreduce vecextract vecmin vecmax vecsum vecprod factorial vecany vecall vecnotall vecnone vecfirst vecfirstidx/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; $use64 = 0 if $use64 && 18446744073709550592 == ~0; my @vecmins = ( [ ], [ 1, 1 ], [ 0, 0 ], [ -1, -1 ], [ 1, 1, 2 ], [ 1, 2, 1 ], [ 1, 2, 1 ], [ -6, 0, 4, -5, 6, -6, 0 ], [ -6, 0, 4, -5, 7, -6, 0 ], [ "27944220269257565027", "81033966278481626507", "27944220269257565027" ], ); if ($use64) { # List::Util::min gets these wrong push @vecmins, [ qw/18446744073702958477 18446744073704516093 18446744073706008451 18446744073706436837 18446744073707776433 18446744073702959347 18446744073702958477/ ]; push @vecmins, [ qw/-9223372036852260731 -9223372036852260673 -9223372036852260731 -9223372036850511139 -9223372036850207017 -9223372036852254557 -9223372036849473359/ ]; push @vecmins, [ qw/-9223372036853497843 9223372036852278343 -9223372036853497487 -9223372036844936897 -9223372036850971897 -9223372036853497843 9223372036848046999/ ]; } my @vecmaxs = ( [ ], [ 1, 1 ], [ 0, 0 ], [ -1, -1 ], [ 2, 1, 2 ], [ 2, 2, 1 ], [ 2, 2, 1 ], [ 6, 0, 4, -5, 6, -6, 0 ], [ 7, 0, 4, -5, 7, -8, 0 ], [ "81033966278481626507" , "27944220269257565027", "81033966278481626507" ], ); if ($use64) { # List::Util::max gets these wrong push @vecmaxs, [ qw/18446744072030630259 18446744070011576186 18446744070972009258 18446744071127815503 18446744072030630259 18446744072030628952 18446744071413452589/ ]; push @vecmaxs, [ qw/18446744073707508539 18446744073702156661 18446744073707508539 18446744073700111529 18446744073707506771 18446744073707086091 18446744073704381821/ ]; push @vecmaxs, [ qw/-9223372036847631197 -9223372036853227739 -9223372036847631197 -9223372036851632173 -9223372036847631511 -9223372036852712261 -9223372036851707899/ ]; push @vecmaxs, [ qw/9223372036846154833 -9223372036846673813 9223372036846154833 -9223372036851103423 9223372036846154461 -9223372036849190963 -9223372036847538803/ ]; } my @vecsums = ( [ 0 ], [ -1, -1 ], [ 0, 1,-1 ], [ 0, -1,1 ], [ 0, -1,1 ], [ 0, -2147483648,2147483648 ], [ 0, "-4294967296","4294967296" ], [ 0, "-9223372036854775808","9223372036854775808" ], [ "18446744073709551615", "18446744073709551615","-18446744073709551615","18446744073709551615" ], [ "55340232221128654848", "18446744073709551616","18446744073709551616","18446744073709551616" ], ); if ($use64) { push @vecsums, [ "18446744073709620400", 18446744073709540400, (1000) x 80 ]; } my @vecprods = ( [ 1 ], [ 1, 1 ], [ -1, -1 ], [ 2, -1, -2 ], [ 2, -1, -2 ], [ "-2147385345", 32767, -65535 ], [ "-2147385345", 32767, -65535 ], [ "-2147450880", 32768, -65535 ], [ "-2147483648", 32768, -65536 ], ); plan tests => 0 + scalar(@vecmins) + scalar(@vecmaxs) + scalar(@vecsums) + 1 + scalar(@vecprods) + 4 # vecreduce + 2 # vecextract + 3*4 # vec{any,all,notall,none} + 5 # vecfirst + 5 # vecfirstidx + 0; ###### vecmin foreach my $r (@vecmins) { if (@$r == 0) { is(vecmin(), undef, "vecmin() = undef"); } else { my($exp, @vals) = @$r; is( vecmin(@vals), $exp, "vecmin(@vals) = $exp" ); } } ###### vecmax foreach my $r (@vecmaxs) { if (@$r == 0) { is(vecmax(), undef, "vecmax() = undef"); } else { my($exp, @vals) = @$r; is( vecmax(@vals), $exp, "vecmax(@vals) = $exp" ); } } ###### vecsum foreach my $r (@vecsums) { my($exp, @vals) = @$r; is( vecsum(@vals), $exp, "vecsum(@vals) = $exp" ); } ###### vecprod foreach my $r (@vecprods) { my($exp, @vals) = @$r; is( vecprod(@vals), $exp, "vecprod(@vals) = $exp" ); } { my(@prod,@fact); for my $f (0 .. 50) { push @fact, factorial($f); push @prod, vecprod(1 .. $f); } is_deeply(\@prod, \@fact, "vecprod matches factorial for 0 .. 50"); } ##### vecreduce { my $fail = 0; is(vecreduce(sub{ $a + $b },()), undef, "vecreduce with empty list is undef"); is(vecreduce(sub{ $fail = 1; 0; },(15)), 15+$fail, "vecreduce with (a) is a and does not call the sub"); is(vecreduce(sub{ $a ^ $b },(4,2)), 6, "vecreduce [xor] (4,2) => 6"); is(vecreduce(sub{ $a * $b**2 },(1, 17, 18, 19)), 17**2 * 18**2 * 19**2, "vecreduce product of squares"); } ###### vecextract { is_deeply([vecextract(['a'..'z'],12345758)], [qw/b c d e h i n o s t u v x/], "vecextract bits"); is(join("", vecextract(['a'..'z'],[22,14,17,10,18])), "works", "vecextract list"); } ###### vec{any,all,notall,none} ok( (vecany { $_ == 1 } 1, 2, 3), 'any true' ); ok( !(vecany { $_ == 1 } 2, 3, 4), 'any false' ); ok( !(vecany { 1 }), 'any empty list' ); ok( (vecall { $_ == 1 } 1, 1, 1), 'all true' ); ok( !(vecall { $_ == 1 } 1, 2, 3), 'all false' ); ok( (vecall { 1 }), 'all empty list' ); ok( (vecnotall { $_ == 1 } 1, 2, 3), 'notall true' ); ok( !(vecnotall { $_ == 1 } 1, 1, 1), 'notall false' ); ok( !(vecnotall { 1 }), 'notall empty list' ); ok( (vecnone { $_ == 1 } 2, 3, 4), 'none true' ); ok( !(vecnone { $_ == 1 } 1, 2, 3), 'none false' ); ok( (vecnone { 1 }), 'none empty list' ); ###### vecfirst { my $v; $v = vecfirst { 8 == ($_ - 1) } 9,4,5,6; is($v, 9, "first success"); $v = vecfirst { 0 } 1,2,3,4; is($v, undef, "first failure"); $v = vecfirst { 0 }; is($v, undef, "first empty list"); $v = vecfirst { $_->[1] le "e" and "e" le $_->[2] } [qw(a b c)], [qw(d e f)], [qw(g h i)]; is_deeply($v, [qw(d e f)], 'first with reference args'); $v = vecfirst {while(1) {return ($_>6)} } 2,4,6,12; is($v,12,"first returns in loop"); } { my $v; $v = vecfirstidx { 8 == ($_ - 1) } 9,4,5,6; is($v, 0, "first idx success"); $v = vecfirstidx { 0 } 1,2,3,4; is($v, -1, "first idx failure"); $v = vecfirstidx { 0 }; is($v, -1, "first idx empty list"); $v = vecfirstidx { $_->[1] le "e" and "e" le $_->[2] } [qw(a b c)], [qw(d e f)], [qw(g h i)]; is($v, 1, "first idx with reference args"); $v = vecfirstidx {while(1) {return ($_>6)} } 2,4,6,12; is($v,3,"first idx returns in loop"); } Math-Prime-Util-0.73/t/26-iscarmichael.t0000644000076400007640000000265713204400603016224 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/ is_carmichael is_quasi_carmichael /; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; #my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; #my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; #$use64 = 0 if $use64 && 18446744073709550592 == ~0; plan tests => 3 + 4; ###### is_carmichael is_deeply( [grep { is_carmichael($_) } 1 .. 20000], [561,1105,1729,2465,2821,6601,8911,10585,15841], "Carmichael numbers to 20000" ); SKIP: { skip "Skipping large Carmichael", 1 unless $usegmp || $extra; ok( is_carmichael("1298392318741906953539071949881"), "Large Carmichael" ); } SKIP: { skip "Skipping larger Carmichael", 1 unless $usegmp && $extra; ok( is_carmichael("341627175004511735787409078802107169251"), "Larger Carmichael" ); } ###### is_quasi_carmichael is_deeply( [grep { is_quasi_carmichael($_) } 1 .. 400], [35,77,143,165,187,209,221,231,247,273,299,323,357,391,399], "Quasi-Carmichael numbers to 400" ); is( scalar(grep { is_quasi_carmichael($_) } 1 .. 5000), 95, "95 Quasi-Carmichael numbers under 5000" ); is(is_quasi_carmichael(5092583), 1, "5092583 is a Quasi-Carmichael number with 1 base"); is(is_quasi_carmichael(777923), 7, "777923 is a Quasi-Carmichael number with 7 bases"); Math-Prime-Util-0.73/t/80-pp.t0000644000076400007640000011217713204400603014216 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) + 6 + # PC, pc approx 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 ($extra ? 3 : 0) + # factor stage 2 10 + # AKS ($use64 ? 3 : 2) + # Lucas and BLS75 primality proofs 6 + # M-R and Lucas on bigint 2 + # PC and NP approx 65 + # Misc util.pm functions ($extra ? 1 : 0) + # twin prime count approx scalar(keys %ipp) + # is_prob_prime 1; use Math::Prime::Util qw/primes prime_count_approx nth_prime_approx prime_get_config prime_set_config consecutive_integer_lcm primorial pn_primorial partitions miller_rabin_random 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; *prime_count_lower = \&Math::Prime::Util::PP::prime_count_lower; *prime_count_upper = \&Math::Prime::Util::PP::prime_count_upper; *nth_prime = \&Math::Prime::Util::PP::nth_prime; undef *prime_count_approx; undef *nth_prime_approx; *prime_count_approx = \&Math::Prime::Util::PP::prime_count_approx; *nth_prime_approx = \&Math::Prime::Util::PP::nth_prime_approx; *twin_prime_count = \&Math::Prime::Util::PP::twin_prime_count; *nth_twin_prime = \&Math::Prime::Util::PP::nth_twin_prime; *twin_prime_count_approx = \&Math::Prime::Util::PP::twin_prime_count_approx; *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_perrin_pseudoprime = \&Math::Prime::Util::PP::is_perrin_pseudoprime; *is_frobenius_pseudoprime = \&Math::Prime::Util::PP::is_frobenius_pseudoprime; *is_aks_prime = \&Math::Prime::Util::PP::is_aks_prime; *factor = \&Math::Prime::Util::PP::factor; *gcd = \&Math::Prime::Util::PP::gcd; *lcm = \&Math::Prime::Util::PP::lcm; *moebius = \&Math::Prime::Util::PP::moebius; *euler_phi = \&Math::Prime::Util::PP::euler_phi; *jordan_totient = \&Math::Prime::Util::PP::jordan_totient; *mertens = \&Math::Prime::Util::PP::mertens; *exp_mangoldt = \&Math::Prime::Util::PP::exp_mangoldt; *chebyshev_theta= \&Math::Prime::Util::PP::chebyshev_theta; *chebyshev_psi = \&Math::Prime::Util::PP::chebyshev_psi; *znprimroot = \&Math::Prime::Util::PP::znprimroot; *znorder = \&Math::Prime::Util::PP::znorder; *znlog = \&Math::Prime::Util::PP::znlog; *binomial = \&Math::Prime::Util::PP::binomial; *stirling = \&Math::Prime::Util::PP::stirling; *bernfrac = \&Math::Prime::Util::PP::bernfrac; *valuation = \&Math::Prime::Util::PP::valuation; *gcdext = \&Math::Prime::Util::PP::gcdext; *invmod = \&Math::Prime::Util::PP::invmod; *vecmin = \&Math::Prime::Util::PP::vecmin; *vecmax = \&Math::Prime::Util::PP::vecmax; *vecsum = \&Math::Prime::Util::PP::vecsum; *vecprod = \&Math::Prime::Util::PP::vecprod; *liouville = \&Math::Prime::Util::PP::liouville; *carmichael_lambda = \&Math::Prime::Util::PP::carmichael_lambda; *forperm = \&Math::Prime::Util::PP::forperm; *forcomb = \&Math::Prime::Util::PP::forcomb; *forpart = \&Math::Prime::Util::PP::forpart; *Pi = \&Math::Prime::Util::PP::Pi; *RiemannR = \&Math::Prime::Util::PP::RiemannR; *RiemannZeta = \&Math::Prime::Util::PP::RiemannZeta; *LogarithmicIntegral = \&Math::Prime::Util::PP::LogarithmicIntegral; *ExponentialIntegral = \&Math::Prime::Util::PP::ExponentialIntegral; *LambertW = \&Math::Prime::Util::PP::LambertW; # 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), undef, "Previous prime of 2 returns undef" ); 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"); } # These are small enough they should be exact. is( prime_count_lower(450), 87, "prime_count_lower(450)" ); is( prime_count_upper(450), 87, "prime_count_upper(450)" ); # Make sure these are about right cmp_closeto( prime_count_lower(1234567), 95360, 60, "prime_count_lower(1234567) in range" ); cmp_closeto( prime_count_upper(1234567), 95360, 60, "prime_count_upper(1234567) in range" ); cmp_closeto( prime_count_lower(412345678), 21958997, 1500, "prime_count_lower(412345678) in range" ); cmp_closeto( prime_count_upper(412345678), 21958997, 1500, "prime_count_upper(412345678) in range" ); ############################################################################### while (my($n, $pin) = each (%pivals_small)) { my $next = $pin+1; cmp_ok( $pin ? nth_prime($pin) : 0, '<=', $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"); } cmp_closeto( LambertW(6588), 6.86636957140619, 0.000000001, "LambertW(6588)"); 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)" ); # Try to force using stage 2. SKIP: { skip "Skipping ecm stage 2 tests", 1 if defined $Math::Prime::Util::GMP::VERSION && $Math::Prime::Util::GMP::VERSION < 0.20; is_deeply( [ sort {$a<=>$b} Math::Prime::Util::PP::ecm_factor(101303039, 5, 100000,100) ], [ 1013, 100003 ], "ecm(101303039)" ); } 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); SKIP: { skip "Skipping ecm test", 3 if defined $Math::Prime::Util::GMP::VERSION && $Math::Prime::Util::GMP::VERSION < 0.20; 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"); } } ##### Some numbers that go to stage 2 of tests if ($extra) { my $nbig = Math::BigInt->new("9087500560545072247139"); my @nfac; @nfac = sort {$a<=>$b} Math::Prime::Util::PP::pminus1_factor($nbig,1000,10000); is_deeply( [@nfac], ["24133","376559091722747783"], "p-1 stage 2 finds factors of $nbig" ); @nfac = sort {$a<=>$b} Math::Prime::Util::PP::trial_factor($nbig, 50000); is_deeply( [@nfac], ["24133","376559091722747783"], "trial factor finds factors of $nbig" ); @nfac = sort {$a<=>$b} Math::Prime::Util::PP::ecm_factor($nbig, 10,1000,100); is_deeply( [@nfac], ["24133","376559091722747783"], "ecm factor finds factors of $nbig" ); } ##### 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(1009), 1, "AKS: 1009 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" ); } #is( is_perrin_pseudoprime($n), 0, "168790877523676911809192454171451 is not a Perrin pseudoprime" ); is(is_perrin_pseudoprime(517697641), 1, "517697641 is a Perrin pseudoprime"); is(is_frobenius_pseudoprime(517697641), 0, "517697641 is not a Frobenius pseudoprime"); } { my $ntha = nth_prime_approx(1287248); ok( $ntha >= 20274907 && $ntha <= 20284058, "nth_prime_approx(1287248) in range" ); my $pca = prime_count_approx(128722248); ok( $pca >= 7309252 && $pca <= 7310044, "prime_count_approx(128722248) in range" ); } { # 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( moebius(42199), 1, "moebius(42199)" ); is( liouville(444456), 1, "liouville(444456)" ); is( liouville(562894), -1, "liouville(562894)" ); 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( jordan_totient(4, 899), "653187225600", "jordan_totient(4, 899)" ); is( carmichael_lambda(324234), 18012, "carmichael_lambda(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" ); is_deeply( [map { scalar znprimroot($_) } (-11, 0, 8, 3, 1729, 10, 5109721)], [2, undef, undef, 2, undef, 3, 94], "znprimroot" ); is(znorder(2,35), 12, "znorder(2,35) = 12"); is(znorder(7,35), undef, "znorder(7,35) = undef"); is(znorder(67,999999749), 30612237, "znorder(67,999999749) = 30612237"); is(znlog(5678, 5, 10007), 8620, "znlog(5678, 5, 10007)"); is(binomial(35,16), 4059928950, "binomial(35,16)"); is(binomial(228,12), "30689926618143230620", "binomial(228,12)"); is(binomial(-23,-26), -2300, "binomial(-23,-26) should be -2300"); is(stirling(12,4,2), '611501', "S(12,4)" ); is(stirling(12,4,1), '105258076', "s(12,4)" ); is_deeply( [bernfrac(0)], [1,1], "bernfrac(0)" ); is_deeply( [bernfrac(1)], [1,2], "bernfrac(1)" ); is_deeply( [bernfrac(2)], [1,6], "bernfrac(2)" ); is_deeply( [bernfrac(3)], [0,1], "bernfrac(3)" ); is_deeply( [bernfrac(12)], [-691,2730], "bernfrac(12)" ); is_deeply( [bernfrac(13)], [0,1], "bernfrac(12)" ); is_deeply( [gcdext(23948236,3498248)], [2263, -15492, 52], "gcdext(23948236,3498248)" ); is( valuation(1879048192,2), 28, "valuation(1879048192,2)"); is( valuation(96552,6), 3, "valuation(96552,6)"); is(invmod(45,59), 21, "invmod(45,59)"); is(invmod(14,28474), undef, "invmod(14,28474)"); is(invmod(42,-2017), 1969, "invmod(42,-2017)"); is(vecsum(15, 30, 45), 90, "vecsum(15,30,45)"); is(vecsum(4294966296,4294965296,4294964296), "12884895888", "vecsum(2^32-1000,2^32-2000,2^32-3000)"); is(vecprod(15, 30, 45), 20250, "vecprod(15,30,45)"); is(vecprod(4294966296,4294965296,4294964296), "79228051833847139970490254336", "vecprod(2^32-1000,2^32-2000,2^32-3000)"); is(vecmin(4294966296,4294965296,4294964296), 4294964296, "vecmin(2^32-1000,2^32-2000,2^32-3000)"); is(vecmax(4294966296,4294965296,4294964296), 4294966296, "vecmax(2^32-1000,2^32-2000,2^32-3000)"); cmp_closeto( chebyshev_theta(7001), 6929.27483821865062, 0.006929, "chebyshev_theta(7001) =~ 6929.2748"); cmp_closeto( chebyshev_psi(6588), 6597.07452996633704, 0.006597, "chebyshev_psi(6588) =~ 6597.07453"); while (my($n, $isp) = each (%ipp)) { is( is_prob_prime($n), $isp, "is_prob_prime($n) should be $isp" ); } is( primorial(24), 223092870, "primorial(24)" ); is( primorial(118), "31610054640417607788145206291543662493274686990", "primorial(118)" ); is( pn_primorial(7), 510510, "pn_primorial(7)" ); is( partitions(74), 7089500, "partitions(74)" ); is( miller_rabin_random(4294967281, 20), "0", "Miller-Rabin random 40 on composite" ); { my @t; Math::Prime::Util::_generic_forprimes(sub {push @t,$_}, 2387234,2387303); is_deeply( [@t], [2387237,2387243,2387249,2387269,2387291,2387299,2387303], "generic forprimes 2387234,2387303" ); } { my @t; Math::Prime::Util::_generic_forcomposites(sub {push @t,$_}, 15202630,15202641); is_deeply( [@t], [15202630,15202632,15202634,15202635,15202636,15202638,15202640,15202641], "generic forcomposites 15202630,15202641" ); } { my @t; Math::Prime::Util::_generic_foroddcomposites(sub {push @t,$_}, 15202630,15202641); is_deeply( [@t], [15202635,15202641], "generic foroddcomposites 15202630,15202641" ); } { my $k = 0; Math::Prime::Util::_generic_fordivisors(sub {$k += $_+int(sqrt($_))},92834); is( $k, 168921, "generic fordivisors: d|92834: k+=d+int(sqrt(d))" ); } { my @p; forcomb(sub { push @p, [@_] }, 3, 2); is_deeply( \@p, [ [0,1], [0,2], [1,2] ], "forcomb(3,2)" ); } { my @p; forperm(sub { push @p, [@_] }, 3); is_deeply( \@p, [ [0,1,2], [0,2,1], [1,0,2], [1,2,0], [2,0,1], [2,1,0] ], "forperm(3)" ); } { my @p; forpart(sub { push @p, [@_] }, 4); is_deeply( \@p, [ [1,1,1,1],[1,1,2],[1,3],[2,2],[4] ], "forpart(4)" ); } is( Pi(82), "3.141592653589793238462643383279502884197169399375105820974944592307816406286208999", "Pi(82)" ); is( gcd(-30,-90,90), 30, "gcd(-30,-90,90) = 30" ); is( lcm(11926,78001,2211), 2790719778, "lcm(11926,78001,2211) = 2790719778" ); is( twin_prime_count(4321), 114, "twin_prime_count(4321)" ); cmp_closeto( twin_prime_count_approx(Math::BigInt->new("4123456784123")), "6950213327", 14937 * 2, "twin_prime_count_approx(4123456784123)" ); if ($extra) { cmp_closeto( twin_prime_count_approx(Math::BigInt->new("412345678412345678412345678")), "149939117920176008847283", 1e11, "twin_prime_count_approx(412345678412345678412345678)" ); } is( nth_twin_prime(249), 13217, "nth_twin_prime(249)" ); 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.73/t/19-mangoldt.t0000644000076400007640000000152513204400603015400 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/exp_mangoldt/; #my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; #my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; #my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; #my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; #$use64 = 0 if $use64 && 18446744073709550592 == ~0; 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, ); plan tests => scalar(keys %mangoldt); ###### Exponential of von Mangoldt while (my($n, $em) = each (%mangoldt)) { is( exp_mangoldt(0+$n), $em, "exp_mangoldt($n) == $em" ); } Math-Prime-Util-0.73/t/21-conseq-lcm.t0000644000076400007640000000664112453427654015655 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.73/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.73/t/27-bernfrac.t0000644000076400007640000002654313204400603015363 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/bernfrac bernreal harmfrac harmreal stirling sumdigits todigits vecsum/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my @A000367 = (qw/1 1 -1 1 -1 5 -691 7 -3617 43867 -174611 854513 -236364091 8553103 -23749461029 8615841276005 -7709321041217 2577687858367 -26315271553053477373 2929993913841559 -261082718496449122051 1520097643918070802691 -27833269579301024235023 596451111593912163277961 -5609403368997817686249127547 495057205241079648212477525 -801165718135489957347924991853 29149963634884862421418123812691 -2479392929313226753685415739663229 84483613348880041862046775994036021 -1215233140483755572040304994079820246041491/); my @A002445 = (qw/1 6 30 42 30 66 2730 6 510 798 330 138 2730 6 870 14322 510 6 1919190 6 13530 1806 690 282 46410 66 1590 798 870 354 56786730 6 510 64722 30 4686 140100870 6 30 3318 230010 498 3404310 6 61410 272118 1410 6 4501770 6 33330 4326 1590 642 209191710 1518 1671270 42/); my @A001008 = (qw/1 3 11 25 137 49 363 761 7129 7381 83711 86021 1145993 1171733 1195757 2436559 42142223 14274301 275295799 55835135 18858053 19093197 444316699 1347822955 34052522467 34395742267 312536252003 315404588903 9227046511387/); my @A002805 = (qw/1 2 6 12 60 20 140 280 2520 2520 27720 27720 360360 360360 360360 720720 12252240 4084080 77597520 15519504 5173168 5173168 118982864 356948592 8923714800 8923714800 80313433200 80313433200 2329089562800/); if (!$extra) { $#A000367 = 20; $#A002445 = 20; $#A001008 = 20; $#A002805 = 20; } my @bern_reals = (1,1/2,1/6,0,-1/30,0,1/42,0,-1/30,0,5/66,0,-691/2730,0,7/6,0,-3617/510,0,43867/798,0,-174611/330,0,854513/138,0,-236364091/2730); my @harm_reals = (0/1,1/1,3/2,11/6,50/24,274/120,1764/720,13068/5040,109584/40320,1026576/362880,10628640/3628800,120543840/39916800,1486442880/479001600,19802759040/6227020800,283465647360/87178291200,4339163001600/1307674368000,70734282393600/20922789888000,1223405590579200/355687428096000,22376988058521600/6402373705728000,431565146817638400/121645100408832000,8752948036761600000/2432902008176640000); # Generated by gp 2.8.0: # lah(n,k)={n==0&&k==0&&return(1);(n==0||m==0||k>n)&&return(0);binomial(n,k)*binomial(n-1,k-1)*(n-k)!} # for(n=0,20,printf("[qw/");for(m=0,n+1,printf("%d ",lah(n,m)));printf("/],\n")) my @stirling3 = ( [qw/1 0 /], [qw/0 1 0 /], [qw/0 2 1 0 /], [qw/0 6 6 1 0 /], [qw/0 24 36 12 1 0 /], [qw/0 120 240 120 20 1 0 /], [qw/0 720 1800 1200 300 30 1 0 /], [qw/0 5040 15120 12600 4200 630 42 1 0 /], [qw/0 40320 141120 141120 58800 11760 1176 56 1 0 /], [qw/0 362880 1451520 1693440 846720 211680 28224 2016 72 1 0 /], [qw/0 3628800 16329600 21772800 12700800 3810240 635040 60480 3240 90 1 0 /], [qw/0 39916800 199584000 299376000 199584000 69854400 13970880 1663200 118800 4950 110 1 0 /], [qw/0 479001600 2634508800 4390848000 3293136000 1317254400 307359360 43908480 3920400 217800 7260 132 1 0 /], [qw/0 6227020800 37362124800 68497228800 57081024000 25686460800 6849722880 1141620480 122316480 8494200 377520 10296 156 1 0 /], [qw/0 87178291200 566658892800 1133317785600 1038874636800 519437318400 155831195520 29682132480 3710266560 309188880 17177160 624624 14196 182 1 0 /], [qw/0 1307674368000 9153720576000 19833061248000 19833061248000 10908183686400 3636061228800 779155977600 111307996800 10821610800 721440720 32792760 993720 19110 210 1 0 /], [qw/0 20922789888000 156920924160000 366148823040000 396661224960000 237996734976000 87265469491200 20777492736000 3339239904000 371026656000 28857628800 1574052480 59623200 1528800 25200 240 1 0 /], [qw/0 355687428096000 2845499424768000 7113748561920000 8299373322240000 5394592659456000 2157837063782400 565147802419200 100919250432000 12614906304000 1121325004800 71357045760 3243502080 103958400 2284800 32640 272 1 0 /], [qw/0 6402373705728000 54420176498688000 145120470663168000 181400588328960000 126980411830272000 55024845126451200 15721384321843200 3088129063219200 428906814336000 42890681433600 3119322286080 165418606080 6362254080 174787200 3329280 41616 306 1 0 /], [qw/0 121645100408832000 1094805903679488000 3101950060425216000 4135933413900288000 3101950060425216000 1447576694865100800 448059453172531200 96012739965542400 14668613050291200 1629845894476800 133351027729920 8081880468480 362648482560 11955444480 284653440 4744224 52326 342 1 0 /], [qw/0 2432902008176640000 23112569077678080000 69337707233034240000 98228418580131840000 78582734864105472000 39291367432052736000 13097122477350912000 3040403432242176000 506733905373696000 61934143990118400 5630376726374400 383889322252800 19686631910400 757178150400 21633661440 450701280 6627960 64980 380 1 0 /], ); # Generated by gp 2.8.0: for(n=0,20,printf("[qw/");for(m=0,n+1,printf("%d ",stirling(n,m,2)));printf("/],\n")) my @stirling2 = ( [qw/1 0/], [qw/0 1 0/], [qw/0 1 1 0/], [qw/0 1 3 1 0/], [qw/0 1 7 6 1 0/], [qw/0 1 15 25 10 1 0/], [qw/0 1 31 90 65 15 1 0/], [qw/0 1 63 301 350 140 21 1 0/], [qw/0 1 127 966 1701 1050 266 28 1 0/], [qw/0 1 255 3025 7770 6951 2646 462 36 1 0/], [qw/0 1 511 9330 34105 42525 22827 5880 750 45 1 0/], [qw/0 1 1023 28501 145750 246730 179487 63987 11880 1155 55 1 0/], [qw/0 1 2047 86526 611501 1379400 1323652 627396 159027 22275 1705 66 1 0/], [qw/0 1 4095 261625 2532530 7508501 9321312 5715424 1899612 359502 39325 2431 78 1 0/], [qw/0 1 8191 788970 10391745 40075035 63436373 49329280 20912320 5135130 752752 66066 3367 91 1 0/], [qw/0 1 16383 2375101 42355950 210766920 420693273 408741333 216627840 67128490 12662650 1479478 106470 4550 105 1 0/], [qw/0 1 32767 7141686 171798901 1096190550 2734926558 3281882604 2141764053 820784250 193754990 28936908 2757118 165620 6020 120 1 0/], [qw/0 1 65535 21457825 694337290 5652751651 17505749898 25708104786 20415995028 9528822303 2758334150 512060978 62022324 4910178 249900 7820 136 1 0/], [qw/0 1 131071 64439010 2798806985 28958095545 110687251039 197462483400 189036065010 106175395755 37112163803 8391004908 1256328866 125854638 8408778 367200 9996 153 1 0/], [qw/0 1 262143 193448101 11259666950 147589284710 693081601779 1492924634839 1709751003480 1144614626805 477297033785 129413217791 23466951300 2892439160 243577530 13916778 527136 12597 171 1 0/], [qw/0 1 524287 580606446 45232115901 749206090500 4306078895384 11143554045652 15170932662679 12011282644725 5917584964655 1900842429486 411016633391 61068660380 6302524580 452329200 22350954 741285 15675 190 1 0/], ); my @stirling1 = ( [qw/1 0/], [qw/0 1 0/], [qw/0 -1 1 0/], [qw/0 2 -3 1 0/], [qw/0 -6 11 -6 1 0/], [qw/0 24 -50 35 -10 1 0/], [qw/0 -120 274 -225 85 -15 1 0/], [qw/0 720 -1764 1624 -735 175 -21 1 0/], [qw/0 -5040 13068 -13132 6769 -1960 322 -28 1 0/], [qw/0 40320 -109584 118124 -67284 22449 -4536 546 -36 1 0/], [qw/0 -362880 1026576 -1172700 723680 -269325 63273 -9450 870 -45 1 0/], [qw/0 3628800 -10628640 12753576 -8409500 3416930 -902055 157773 -18150 1320 -55 1 0/], [qw/0 -39916800 120543840 -150917976 105258076 -45995730 13339535 -2637558 357423 -32670 1925 -66 1 0/], [qw/0 479001600 -1486442880 1931559552 -1414014888 657206836 -206070150 44990231 -6926634 749463 -55770 2717 -78 1 0/], [qw/0 -6227020800 19802759040 -26596717056 20313753096 -9957703756 3336118786 -790943153 135036473 -16669653 1474473 -91091 3731 -91 1 0/], [qw/0 87178291200 -283465647360 392156797824 -310989260400 159721605680 -56663366760 14409322928 -2681453775 368411615 -37312275 2749747 -143325 5005 -105 1 0/], [qw/0 -1307674368000 4339163001600 -6165817614720 5056995703824 -2706813345600 1009672107080 -272803210680 54631129553 -8207628000 928095740 -78558480 4899622 -218400 6580 -120 1 0/], [qw/0 20922789888000 -70734282393600 102992244837120 -87077748875904 48366009233424 -18861567058880 5374523477960 -1146901283528 185953177553 -23057159840 2185031420 -156952432 8394022 -323680 8500 -136 1 0/], [qw/0 -355687428096000 1223405590579200 -1821602444624640 1583313975727488 -909299905844112 369012649234384 -110228466184200 24871845297936 -4308105301929 577924894833 -60202693980 4853222764 -299650806 13896582 -468180 10812 -153 1 0/], [qw/0 6402373705728000 -22376988058521600 34012249593822720 -30321254007719424 17950712280921504 -7551527592063024 2353125040549984 -557921681547048 102417740732658 -14710753408923 1661573386473 -147560703732 10246937272 -549789282 22323822 -662796 13566 -171 1 0/], [qw/0 -121645100408832000 431565146817638400 -668609730341153280 610116075740491776 -371384787345228000 161429736530118960 -52260903362512720 12953636989943896 -2503858755467550 381922055502195 -46280647751910 4465226757381 -342252511900 20692933630 -973941900 34916946 -920550 16815 -190 1 0/], ); if (!$extra) { $#stirling1 = 12; $#stirling2 = 12; $#stirling3 = 12; } plan tests => 2*$extra + 2 + scalar(@bern_reals) + 2 + scalar(@harm_reals) + 2 + scalar(@stirling3) + scalar(@stirling2) + scalar(@stirling1) + 2*$extra + 2*$extra; if ($extra) { like( bernreal(46), qr/2115074863808199160560.145/, "bernreal(46)" ); like( harmreal(46), qr/4.416687245986104750714329/, "harmreal(46)" ); } { my @num = map { (bernfrac(2*$_))[0] } 0 .. $#A000367; my @den = map { (bernfrac(2*$_))[1] } 0 .. $#A002445; is_deeply( \@num, \@A000367, "B_2n numerators 0 .. $#A000367" ); is_deeply( \@den, \@A002445, "B_2n denominators 0 .. $#A002445" ); } for my $n (0 .. $#bern_reals) { cmp_closeto( bernreal($n), $bern_reals[$n], 1e-8, "bernreal($n)" ); } { my @num = map { (harmfrac(1+$_))[0] } 0 .. $#A001008; my @den = map { (harmfrac(1+$_))[1] } 0 .. $#A002805; is_deeply( \@num, \@A001008, "H_n numerators 0 .. $#A001008" ); is_deeply( \@den, \@A002805, "H_n denominators 0 .. $#A002805" ); } for my $n (0 .. $#harm_reals) { cmp_closeto( harmreal($n), $harm_reals[$n], 1e-8, "harmreal($n)" ); } sub cmp_closeto { my $got = shift; my $expect = shift; my $tolerance = shift; my $message = shift; cmp_ok( abs($got - $expect), '<=', $tolerance, $message ); } # These are compiler errors: #ok(!eval { stirling() }, "stirling with no args"); #ok(!eval { stirling(4) }, "stirling with one arg"); #ok(!eval { stirling(1,2,3,4) }, "stirling with four args"); ok(!eval { stirling(-4, -3) }, "Expected fail: stirling with negative args"); ok(!eval { stirling(4,3,4) }, "Expected fail: stirling type 4"); # These just generate warnings due to our prototype #ok(!eval { stirling(undef, undef) }, "stirling given undefs"); #ok(!eval { stirling("x","y") }, "stirling x y"); { my $n = 0; foreach my $narr (@stirling3) { my @s3 = map { stirling($n,$_,3) } 0..$n+1; is_deeply( \@s3, $narr, "Stirling 3: L($n,0..". ($n+1) .")" ); $n++; } } { my $n = 0; foreach my $narr (@stirling2) { my @s2 = map { stirling($n,$_,2) } 0..$n+1; is_deeply( \@s2, $narr, "Stirling 2: S($n,0..". ($n+1) .")" ); $n++; } } { my $n = 0; foreach my $narr (@stirling1) { my @s1 = map { stirling($n,$_,1) } 0..$n+1; is_deeply( \@s1, $narr, "Stirling 1: s($n,0..". ($n+1) .")" ); $n++; } } if ($extra) { # Random large values is( stirling(114,85,2), '722095587897382907118640452680242028195738761915144254970925658656935934040', "S(114,85)" ); is( stirling(132,67,1), '-6132458966070920781607687809239433538883836871765225500351514785120957322534135782514155513931693375104995311496306605620444680401484569675682191339176710', "s(132,67)" ); } if ($extra) { is(vecsum(todigits((bernfrac(502))[0],157)), 27893, "sumdigits(bernfrac(502) numerator) base 157"); is(sumdigits(stirling(234,95)), 1485, "sumdigits(stirling(234,95))"); } Math-Prime-Util-0.73/t/20-primorial.t0000644000076400007640000000425412532503145015573 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.73/t/19-totients.t0000644000076400007640000000663413373330217015464 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/euler_phi jordan_totient carmichael_lambda divisor_sum moebius inverse_totient/; #my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; #my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; #my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; $use64 = 0 if $use64 && 18446744073709550592 == ~0; my %totients = ( -123456 => 0, 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 @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); plan tests => 2 + 10 + scalar(keys %totients) + 1 # Small Carmichael Lambda + 5 # inverse_totient ; ###### euler_phi (totient) { 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" ); } { my $s = 0; $s += $_ for euler_phi(1, 240); is($s, 17544, "sum of totients to 240"); } 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)" ); # negative euler_phi returns zero is_deeply( [euler_phi(-5,5)], [0,0,0,0,0,0,1,1,2,2,4], "euler_phi -5 to 5" ); ###### Carmichael Lambda { my @lambda = map { carmichael_lambda($_) } (0 .. $#A002322); is_deeply( \@lambda, \@A002322, "carmichael_lambda with range: 0, $#A000010" ); } ###### Inverse Totient { my $tot = 0; $tot += 0+inverse_totient($_) for 0..100; is($tot, 198, "Totient count 0-100 = 198"); is(0+inverse_totient(1728), 62, "inverse_totient(1728) = 62"); is(0+inverse_totient(362880), 1138, "inverse_totient(9!) = 1138"); is_deeply( [inverse_totient(10000008)], [10555583,15000039,21111166,30000078], "inverse_totient(10000008)" ); ok( scalar(grep { $_ == 123456789} inverse_totient(82260072)) == 1, "inverse_totient(82260072) includes 123456789" ); } Math-Prime-Util-0.73/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.73/t/022-can-ntheory.t0000644000076400007640000000022212776251142016104 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use ntheory qw/is_prime/; use Test::More tests => 1; ok(is_prime(7), "ntheory can do is_prime"); Math-Prime-Util-0.73/t/11-twinprimes.t0000644000076400007640000000256612776251142016011 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/twin_primes nth_twin_prime/; my $use64 = ~0 > 4294967295 && ~0 != 18446744073709550592; my @small_twins = (3, 5, 11, 17, 29, 41, 59, 71, 101, 107, 137, 149, 179, 191, 197, 227, 239, 269, 281, 311, 347, 419, 431, 461, 521, 569, 599, 617, 641, 659, 809, 821, 827, 857, 881, 1019, 1031, 1049, 1061, 1091, 1151, 1229, 1277, 1289, 1301, 1319, 1427, 1451, 1481, 1487, 1607); my %small_range = ( "6 to 10" => [], "5 to 10" => [5], "5 to 11" => [5,11], "5 to 12" => [5,11], "5 to 13" => [5,11], "5 to 16" => [5,11], "4 to 11" => [5,11], "3 to 11" => [3,5,11], "2 to 11" => [3,5,11], "1 to 11" => [3,5,11], "0 to 11" => [3,5,11], "29 to 31" => [29], "213897 to 213997" => [213947], "4294957296 to 4294957796" => [4294957307,4294957397,4294957697], "134217228 to 134217728" => [134217401,134217437], ); plan tests => 2 + scalar(keys %small_range); is_deeply( twin_primes($small_twins[-1]), \@small_twins, "twin_primes($small_twins[-1])" ); { my @tp = map { nth_twin_prime($_) } 1 .. scalar(@small_twins); is_deeply( \@tp, \@small_twins, "nth_twin_prime for small values" ); } while (my($range, $expect) = each (%small_range)) { my($low,$high) = $range =~ /(\d+) to (\d+)/; is_deeply( twin_primes($low, $high), $expect, "twin_primes($low,$high) should return [@{$expect}]"); } Math-Prime-Util-0.73/t/17-pseudoprime.t0000644000076400007640000004452613341204063016141 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_prime is_pseudoprime is_euler_pseudoprime is_euler_plumb_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_frobenius_khashin_pseudoprime is_perrin_pseudoprime is_catalan_pseudoprime is_frobenius_pseudoprime lucas_sequence kronecker/; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $usegmp =Math::Prime::Util::prime_get_config->{'gmp'}; 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/ ], plumb => [ qw/1729 1905 2047 2465 3277 4033 4681 8321 12801 15841 16705 18705 25761 29341 33153 34945 41041 42799 46657 49141 52633 65281 74665 75361 80581 85489 87249 88357 90751/ ], epsp2 => [ qw/561 1105 1729 1905 2047 2465 3277 4033 4681 6601 8321 8481 10585 12801 15841 16705 18705 25761 29341 30121 33153 34945 41041 42799 46657 49141 52633 62745 65281 74665 75361 80581 85489 87249 88357 90751/ ], epsp3 => [ qw/121 703 1729 1891 2821 3281 7381 8401 8911 10585 12403 15457 15841 16531 18721 19345 23521 24661 28009 29341 31621 41041 44287 46657 47197 49141 50881 52633 55969 63139 63973 74593 75361 79003 82513 87913 88573 93961 97567/ ], epsp29 => [ qw/15 91 341 469 871 2257 4371 4411 5149 5185 6097 8401 8841 11581 12431 15577 15841 16471 19093 22281 25681 27613 28009 29539 31417 33001 41041 46657 48133 49141 54913 57889 79003 98301/ ], 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/ ], perrin => [ qw/271441 904631 16532714 24658561 27422714 27664033 46672291 102690901 130944133 196075949 214038533 517697641 545670533 801123451/ ], catalan => [ qw/5907 1194649 12327121/ ], fibonacci => [ qw/323 377 1891 3827 4181 5777 6601 6721 8149 10877 11663 13201 13981 15251 17119 17711 18407 19043 23407 25877 27323/ ], pell => [ qw/169 385 741 961 1121 2001 3827 4879 5719 6215 6265 6441 6479 6601 7055 7801 8119 9799 10945 11395 13067 13079 13601 15841 18241 19097 20833 20951 24727 27839 27971 29183 29953/ ], frobenius => [ qw/4181 5777 6721 10877 13201 15251 34561 51841 64079 64681 67861 68251 75077 90061 96049 97921 100127/ ], frob35 => [ qw/13333 44801 486157 1615681 3125281 4219129 9006401 12589081 13404751 15576571 16719781/ ], ); if ($use64) { push @{$pseudoprimes{psp3}}, 4398117272641; push @{$pseudoprimes{3}}, 1099558795087; push @{$pseudoprimes{lucas}}, 2199055761527; push @{$pseudoprimes{slucas}}, 4294967311,4294967357,12598021314449; push @{$pseudoprimes{eslucas}}, 4294967311,4294967357,10099386070337; push @{$pseudoprimes{aeslucas1}}, 4294967311,4294967357,10071551814917; push @{$pseudoprimes{aeslucas2}}, 34372519409; } if (!$usexs) { if (!$usegmp || !defined &Math::Prime::Util::GMP::binomial || $Math::Prime::Util::GMP::VERSION < 0.27) { # Don't make Math::BigInt do large binomials $pseudoprimes{catalan} = [5907]; } } 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 + scalar(keys %pseudoprimes) + scalar @phis + 1 # mr base 2 2-4k + 9 # mr with large bases + 3 # multi-base Fermat/strong pseudoprimes + scalar @small_lucas_trials + scalar(keys %lucas_sequences) + 1 # frob-underwood + 2*$use64 # frob-underwood + 1 # frob-khashin + 2*$use64 # frob-khashin + 1*$extra + 6 # Perrin restrictions + 0; 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 for each test, small pseudoprimes pass the given test. for my $base (sort keys %pseudoprimes) { my @c = @{$pseudoprimes{$base}}; my @fails; my $text; if ($base =~ /^psp(\d+)/) { my $pbase = $1; @fails = grep { !is_pseudoprime($_,$pbase) } @c; $text = "pseudoprimes base $pbase (i.e. Fermat)"; } elsif ($base =~ /^epsp(\d+)/) { my $pbase = $1; @fails = grep { !is_euler_pseudoprime($_,$pbase) } @c; $text = "Euler pseudoprimes base $pbase"; } elsif ($base =~ /^aeslucas(\d+)/) { my $inc = $1; @fails = grep { !is_almost_extra_strong_lucas_pseudoprime($_,$inc) } @c; $text = "almost extra strong Lucas pseudoprimes (inc $inc)"; } elsif ($base eq 'eslucas') { @fails = grep { !is_extra_strong_lucas_pseudoprime($_) } @c; $text = "extra strong Lucas pseudoprimes"; } elsif ($base eq 'slucas') { @fails = grep { !is_strong_lucas_pseudoprime($_) } @c; $text = "strong Lucas pseudoprimes"; } elsif ($base eq 'lucas') { @fails = grep { !is_lucas_pseudoprime($_) } @c; $text = "Lucas pseudoprimes"; } elsif ($base eq 'plumb') { @fails = grep { !is_euler_plumb_pseudoprime($_) } @c; $text = "Euler-Plumb pseudoprimes"; } elsif ($base eq 'perrin') { @fails = grep { !is_perrin_pseudoprime($_) } @c; $text = "Unrestricted Perrin pseudoprimes"; } elsif ($base eq 'catalan') { @fails = grep { !is_catalan_pseudoprime($_) } @c; $text = "Catalan pseudoprimes"; } elsif ($base eq 'frobenius') { @fails = grep { !is_frobenius_pseudoprime($_,1,-1) } @c; $text = "Frobenius(1,-1) pseudoprimes"; } elsif ($base eq 'frob35') { @fails = grep { !is_frobenius_pseudoprime($_,3,-5) } @c; $text = "Frobenius(3,-5) pseudoprimes"; } elsif ($base eq 'fibonacci') { @fails = grep { my $t = (($_%5)==2||($_%5)==3) ? $_+1 : $_-1; my $is_fib = !(lucas_sequence($_, 1, -1, $t))[0]; !$is_fib; } @c; $text = "Fibonacci pseudoprimes"; } elsif ($base eq 'pell') { if ($] < 5.008) { # Work around a fault in ancient Perl @fails = grep { "" . (((lucas_sequence($_,2,-1,$_))[0] - kronecker(2,$_)) % $_) } @c; } else { @fails = grep { (((lucas_sequence($_,2,-1,$_))[0] - kronecker(2,$_)) % $_) } @c; } $text = "Pell pseudoprimes"; } else { @fails = grep { !is_strong_pseudoprime($_,$base) } @c; $text = "strong pseudoprimes base $base (i.e. Miller-Rabin)"; } is_deeply(\@fails, [], "Small $text"); } # 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), 0, "spsp( 11, 11)"); is( is_strong_pseudoprime( 89, 5785), 0, "spsp( 89, 5785)"); is( is_strong_pseudoprime(257, 6168), 0, "spsp(257, 6168)"); is( is_strong_pseudoprime(367, 367), 0, "spsp(367, 367)"); is( is_strong_pseudoprime(367, 1101), 0, "spsp(367, 1101)"); is( is_strong_pseudoprime(49001, 921211727), 0, "spsp(49001, 921211727)"); is( is_strong_pseudoprime( 331, 921211727), 0, "spsp( 331, 921211727)"); is( is_strong_pseudoprime(49117, 921211727), 1, "spsp(49117, 921211727)"); # Some examples of Fermat and strong pseudoprimes is(is_pseudoprime(143168581, 2, 3, 5, 7, 11), 1, "143168581 is a Fermat pseudoprime to bases 2,3,5,7,11"); is(is_strong_pseudoprime(3215031751, 2, 3, 5, 7), 1, "3215031751 is a strong pseudoprime to bases 2,3,5,7"); is(is_strong_pseudoprime("2152302898747", 2, 3, 5, 7, 11), 1, "2152302898747 is a strong pseudoprime to bases 2,3,5,7,11"); # 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 Underwood with 52-bit prime" ); is( is_frobenius_underwood_pseudoprime(10099386070337), 0, "Frobenius Underwood with 44-bit Lucas pseudoprime" ); } } { my $fufail = 0; my $ntests = ($usexs) ? 100 : 2; foreach my $i (1 .. $ntests) { my $n = 2*int(rand(1000000000)) + 1; my $ispfu = !!is_frobenius_khashin_pseudoprime($n); my $prime = !!is_prime($n); if ($ispfu != $prime) { $fufail = $n; last; } } is($fufail, 0, "is_frobenius_khashin_pseudoprime matches is_prime"); if ($use64) { is( is_frobenius_khashin_pseudoprime("2727480595375747"), 1, "Frobenius Khashin with 52-bit prime" ); is( is_frobenius_khashin_pseudoprime(10099386070337), 0, "Frobenius Khashin with 44-bit Lucas pseudoprime" ); } } # Perrin restrictions is( is_perrin_pseudoprime("40814059160177",0), 1, "40814059160177 is an unrestricted Perrin pseudoprime"); is( is_perrin_pseudoprime("40814059160177",1), 0, "40814059160177 is not a minimal restricted Perrin pseudoprime"); is( is_perrin_pseudoprime("36407440637569",1), 1, "36407440637569 is minimal restricted Perrin pseudoprime"); is( is_perrin_pseudoprime("36407440637569",2), 0, "36407440637569 is not an Adams/Shanks Perrin pseudoprime"); is( is_perrin_pseudoprime("364573433665",2), 1, "364573433665 is an Adams/Shanks Perrin pseudoprime"); is( is_perrin_pseudoprime("364573433665",3), 0, "364573433665 is not a Grantham restricted Perrin pseudoprime"); Math-Prime-Util-0.73/t/04-inputvalidation.t0000644000076400007640000000521113204400603016773 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 Config; use Carp; my @incorrect = ( -4, '-', '+', '++4', '+-4', '-0004', 'a', '5.6', '4e', '1.1e12', '1e8', 'NaN', Math::BigInt->new("-4"), Math::BigFloat->new("15.6"), ); push @incorrect, Math::BigInt->bnan() if $Config{d_isnan}; 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/ ('' )?must be a positive integer/, "next_prime('')"); foreach my $v (@incorrect) { eval { next_prime($v); }; like($@, qr/ '\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 next two tests really are not critical, but are nice to check. SKIP: { skip "Your machine does not have NaN", 1 unless $Config{d_isinf}; my $infinity = ($^O ne 'MSWin32') ? 0+'inf' : '1.#INF'; $infinity = Math::BigInt->binf()->numify() if 65535 > $infinity; $infinity = +(20**20**20) if 65535 > $infinity; skip "Your machine seems to not have infinity", 1 if 65535 > $infinity; eval { next_prime($infinity); }; like($@, qr/must be a positive integer/, "next_prime( infinity )"); } SKIP: { skip "Your machine does not have NaN" unless $Config{d_isnan}; my $nan = ($^O ne 'MSWin32') ? 0+'nan' : '1.#IND'; $nan = Math::BigInt->bnan()->numify() if $nan >= 0; $nan = -sin('inf') if $nan >= 0; skip "Your machine seems to not have NaN", 1 if $nan >= 0 || $nan =~ /^\d*$/; eval { next_prime($nan); }; like($@, qr/must be a positive integer/, "next_prime( nan ) [nan = '$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.73/t/18-functions.t0000644000076400007640000001146713001030561015605 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/ prime_count ExponentialIntegral LogarithmicIntegral RiemannR RiemannZeta LambertW /; my $infinity = 20**20**20; 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, 79 => 2.61362206325045575e+32, ); my %livals = ( # In pari these are: -eint1(-log($n)) 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, ); # 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, ); my %rzvals = ( 2 => 0.6449340668482264364724151666, 2.5 => 0.3414872572509171797567696934, 4.5 => 0.0547075107614542640229672890, 7 => 0.0083492773819228268397975498, 8.5 => 0.0028592508824156277133439825, 20.6 => 0.0000006293391573578212882457, ); my %lamvals = ( -0.3678794411714423215955237701614608674458 => -0.99999995824889, # Ideally this would be -1 -.1 => -0.11183255915896296483356945682026584227264536229126586332968, 0 => 0, 0.3678794411714423215955237701614608674458 => 0.278464542761073795109358739022980155439470898229676526861772, 1 => 0.567143290409783872999968662210355549753815787186512508135131, 10 => 1.7455280027406993830743012648753899115, 10000 => 7.2318460380933727064756185001412538839, 100000000000 => 22.227122734961075624690200512898589272, 18446744073709551615 => 40.656266572498926634921823566267328254, ); plan tests => 3 + 6 + 1 + scalar(keys(%eivals)) + scalar(keys(%livals)) + scalar(keys(%rvals)) + scalar(keys(%rzvals)) + scalar(keys(%lamvals)) ; 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)"); 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"); } while (my($n, $lin) = each (%lamvals)) { # Machines with long double will be a little different near -1/e cmp_closeto( LambertW($n), $lin, 0.0000001 * abs($lin), "LambertW($n) ~= $lin"); } 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.73/t/35-cipher.t0000644000076400007640000000342713204400603015046 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/csrand random_bytes/; my $use64 = (~0 > 4294967295); my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $maxbits = $use64 ? 64 : 32; plan tests => 6; ######## my $plaintext = 'Now I’m not gonna make a lot of extravagant claims for this little machine. Sure, it’ll change your whole life for the better, but that’s all.'; my $key = "A lovely day for a ride"; my $nonce = "20170412"; csrand( pack("A32A8",$key, $nonce) ); my $ciphertext = $plaintext ^ random_bytes(length($plaintext)); if (unpack("L",$ciphertext) == 351607655) { isnt( $ciphertext, $plaintext, "Ciphertext is probably ChaCha/20 expected result" ); } else { isnt( $ciphertext, $plaintext, "We at least vaguely changed the text" ); } my $key2 = "The city needs a car like a fish needs a bicycle."; csrand( pack("A32A8",$key2, $nonce) ); my $ciphertext2 = $plaintext ^ random_bytes(length($plaintext)); isnt( $ciphertext2, $plaintext, "We at least vaguely changed the text" ); if (unpack("L",$ciphertext2) == 3391833874) { isnt( $ciphertext2, $ciphertext, "Different key makes different ChaCha/20 result" ); } else { isnt( $ciphertext2, $ciphertext, "Different key produces different data" ); } csrand( pack("A32A8",$key, $nonce) ); my $ciphertext3 = $plaintext ^ random_bytes(length($plaintext)); is( $ciphertext3, $ciphertext, "We can reproduce the cipher" ); csrand( pack("A32A8",$key, $nonce) ); my $decodetext = $ciphertext ^ random_bytes(length($ciphertext)); is( $decodetext, $plaintext, "We can decode using the same key." ); csrand( pack("A32A8",$key, "Berlin") ); my $ciphertext4 = $plaintext ^ random_bytes(length($plaintext)); isnt( $ciphertext4, $ciphertext, "Different nonce produces different data" ); Math-Prime-Util-0.73/t/23-random-certs.t0000644000076400007640000000230312776251142016176 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_prime verify_prime random_maurer_prime_with_cert random_shawe_taylor_prime_with_cert random_proven_prime_with_cert /; use Math::BigInt try=>"GMP,Pari"; my $do_st = 1; $do_st = 0 unless eval { require Digest::SHA; my $version = $Digest::SHA::VERSION; $version =~ s/[^\d.]//g; $version >= 4.00; }; plan tests => 3*2; { my($n,$cert) = random_maurer_prime_with_cert(80); ok( is_prime($n), "Random Maurer prime returns a prime" ); ok( verify_prime($cert), " with a valid certificate" ); } SKIP: { skip "random Shawe-Taylor prime generation requires Digest::SHA",2 unless $do_st; my($n,$cert) = random_shawe_taylor_prime_with_cert(80); ok( is_prime($n), "Random Shawe-Taylor prime returns a prime" ); ok( verify_prime($cert), " with a valid certificate" ); } { my($n,$cert) = random_proven_prime_with_cert(80); ok( is_prime($n), "Random proven prime returns a prime" ); ok( verify_prime($cert), " with a valid certificate" ); } Math-Prime-Util-0.73/t/26-issemiprime.t0000644000076400007640000000211413335226506016127 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_semiprime/; my $usegmp = Math::Prime::Util::prime_get_config->{'gmp'}; plan tests => 6; { is_deeply( [map { is_semiprime($_) } 121,341,2047,7009,28153], [qw/1 1 1 1 1/], "Semiprimes that were incorrectly calculated in v0.70" ); is_deeply( [grep { is_semiprime($_) } 10000..10100], [qw/10001 10003 10006 10015 10018 10019 10021 10022 10027 10029 10031 10033 10041 10042 10046 10049 10055 10057 10063 10073 10077 10078 10081 10083 10085 10097/], "Identify semiprimes from 10000 to 10100" ); is(is_semiprime("669386384129397581"), 1, "is_semiprime(669386384129397581)"); is(is_semiprime("10631816576169524657"), 1, "is_semiprime(10631816576169524657)"); is(is_semiprime("1814186289136250293214268090047441303"), 0, "is_semiprime(1814186289136250293214268090047441303)"); SKIP: { skip "Skipping difficult is_semiprime", 1 unless $usegmp; is(is_semiprime("42535430147496493121551759"), 0, "is_semiprime(42535430147496493121551759)"); } } Math-Prime-Util-0.73/t/011-load-ntheory.t0000644000076400007640000000014212776251142016261 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 1; require_ok 'ntheory'; Math-Prime-Util-0.73/t/19-moebius.t0000644000076400007640000000650513204400603015241 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/moebius mertens/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; $use64 = 0 if $use64 && 18446744073709550592 == ~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, ); delete $big_mertens{10000000} unless $extra || $usexs; 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 ); } # These are slow with XS, and *really* slow with PP. if (!$usexs) { %big_mertens = map { $_ => $big_mertens{$_} } grep { $_ < 100000000 } keys %big_mertens; } plan tests => 1 + 5 + 2 + 3 + scalar(keys %big_mertens); ok(!eval { moebius(0); }, "moebius(0)"); is_deeply( [map { moebius($_) } 1 .. 20], [1,-1,-1,0,-1,1,-1,0,0,1,-1,0,-1,1,1,0,-1,0,-1,0], "moebius 1 .. 20 (single)" ); is_deeply( [moebius(1,20)], [1,-1,-1,0,-1,1,-1,0,0,1,-1,0,-1,1,1,0,-1,0,-1,0], "moebius 1 .. 20 (range)" ); # moebius uses |n| so negative inputs reflect about zero. is_deeply( [map { moebius(-$_) } 1 .. 20], [1,-1,-1,0,-1,1,-1,0,0,1,-1,0,-1,1,1,0,-1,0,-1,0], "moebius -1 .. -20 (single)" ); is_deeply( [moebius(-14,-9)], [1,-1,0,-1,1,0], "moebius -14 .. -9 (range)" ); is_deeply( [moebius(-7,5)], [-1,1,-1,0,-1,-1,1,0,1,-1,-1,0,-1], "moebius -7 .. 5 (range)" ); is( moebius(3*5*7*11*13), -1, "moebius(3*5*7*11*13) = -1" ); is( moebius("20364840299624512075310661735"), 1, "moebius(73#/2) = 1" ); { my(@mert_sum1, @mert_sum2, @mertens, @expect, $M); while (my($n, $val) = each (%mertens)) { $M = 0; $M += moebius($_) for 1 .. $n; push @mert_sum1, $M; $M = 0; $M += $_ for moebius(1,$n); push @mert_sum2, $M; push @mertens, mertens($n); push @expect, $val; } is_deeply( \@mert_sum1, \@expect, "sum(moebius(k) for k=1..n) small n" ); is_deeply( \@mert_sum2, \@expect, "sum(moebius(1,n)) small n" ); is_deeply( \@mertens, \@expect, "mertens(n) small n" ); } while (my($n, $mertens) = each (%big_mertens)) { is( mertens($n), $mertens, "mertens($n)" ); } Math-Prime-Util-0.73/t/50-factoring.t0000644000076400007640000001705512776251142015566 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/factor factor_exp divisors 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 392498 /; my @testn64 = qw/37607912018 346065536839 600851475143 3204941750802 29844570422669 279238341033925 2623557157654233 24739954287740860 3369738766071892021 10023859281455311421 9007199254740991 9007199254740992 9007199254740993 6469693230 200560490130 7420738134810 304250263527210 13082761331670030 614889782588491410 440091295252541 5333042142001571 79127989298 /; 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( [divisors($n)], $divisors, "divisors($n)" ); is( scalar divisors($n), scalar @$divisors, "scalar divisors($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)}); # TODO: old versions of MPUGMP didn't pull out factors of 3 or 5. #extra_factor_test("ecm_factor", sub {Math::Prime::Util::ecm_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.73/t/19-ramanujan.t0000644000076400007640000000775113204400603015556 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/ ramanujan_sum hclassno ramanujan_tau /; #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'}; #my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; #$use64 = 0 if $use64 && 18446744073709550592 == ~0; my %hclassno = ( -3 => 0, 0 => -1, 1 => 0, 2 => 0, 3 => 4, 4 => 6, 7 => 12, 8 => 12, 11 => 12, 12 => 16, 20 => 24, 23 => 36, 39 => 48, 47 => 60, 71 => 84, 163 => 12, 427 => 24, 907 => 36, 1555 => 48, 6307 => 96, 20563 => 156, 30067 => 168, 31243 => 192, 34483 => 180, 4031 => 1008, ); my %rtau = ( 0 => 0, 1 => 1, 2 => -24, 3 => 252, 4 => -1472, 5 => 4830, 53 => -1596055698, 106 => 38305336752, 243 => 13400796651732, 16089 => "12655813883111729342208", ); plan tests => 0 + 3 # Ramanujan sum + scalar(keys %hclassno) + scalar(keys %rtau); ###### Ramanujan Sum { is( ramanujan_sum(0, 34), 0, "Ramanujan Sum c_0(34) = 0" ); is( ramanujan_sum(34, 0), 0, "Ramanujan Sum c_34(0)" ); # A 30x30 grid of c_k(n) my @expect = (qw/1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 -1 2 -1 -1 2 -1 -1 2 -1 -1 2 -1 -1 2 -1 -1 2 -1 -1 2 -1 -1 2 -1 -1 2 -1 -1 2 0 -2 0 2 0 -2 0 2 0 -2 0 2 0 -2 0 2 0 -2 0 2 0 -2 0 2 0 -2 0 2 0 -2 -1 -1 -1 -1 4 -1 -1 -1 -1 4 -1 -1 -1 -1 4 -1 -1 -1 -1 4 -1 -1 -1 -1 4 -1 -1 -1 -1 4 1 -1 -2 -1 1 2 1 -1 -2 -1 1 2 1 -1 -2 -1 1 2 1 -1 -2 -1 1 2 1 -1 -2 -1 1 2 -1 -1 -1 -1 -1 -1 6 -1 -1 -1 -1 -1 -1 6 -1 -1 -1 -1 -1 -1 6 -1 -1 -1 -1 -1 -1 6 -1 -1 0 0 0 -4 0 0 0 4 0 0 0 -4 0 0 0 4 0 0 0 -4 0 0 0 4 0 0 0 -4 0 0 0 0 -3 0 0 -3 0 0 6 0 0 -3 0 0 -3 0 0 6 0 0 -3 0 0 -3 0 0 6 0 0 -3 1 -1 1 -1 -4 -1 1 -1 1 4 1 -1 1 -1 -4 -1 1 -1 1 4 1 -1 1 -1 -4 -1 1 -1 1 4 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 10 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 10 -1 -1 -1 -1 -1 -1 -1 -1 0 2 0 -2 0 -4 0 -2 0 2 0 4 0 2 0 -2 0 -4 0 -2 0 2 0 4 0 2 0 -2 0 -4 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 12 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 12 -1 -1 -1 -1 1 -1 1 -1 1 -1 -6 -1 1 -1 1 -1 1 6 1 -1 1 -1 1 -1 -6 -1 1 -1 1 -1 1 6 1 -1 1 1 -2 1 -4 -2 1 1 -2 -4 1 -2 1 1 8 1 1 -2 1 -4 -2 1 1 -2 -4 1 -2 1 1 8 0 0 0 0 0 0 0 -8 0 0 0 0 0 0 0 8 0 0 0 0 0 0 0 -8 0 0 0 0 0 0 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 16 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 0 0 3 0 0 -3 0 0 -6 0 0 -3 0 0 3 0 0 6 0 0 3 0 0 -3 0 0 -6 0 0 -3 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 18 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 0 2 0 -2 0 2 0 -2 0 -8 0 -2 0 2 0 -2 0 2 0 8 0 2 0 -2 0 2 0 -2 0 -8 1 1 -2 1 1 -2 -6 1 -2 1 1 -2 1 -6 -2 1 1 -2 1 1 12 1 1 -2 1 1 -2 -6 1 -2 1 -1 1 -1 1 -1 1 -1 1 -1 -10 -1 1 -1 1 -1 1 -1 1 -1 1 10 1 -1 1 -1 1 -1 1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 22 -1 -1 -1 -1 -1 -1 -1 0 0 0 4 0 0 0 -4 0 0 0 -8 0 0 0 -4 0 0 0 4 0 0 0 8 0 0 0 4 0 0 0 0 0 0 -5 0 0 0 0 -5 0 0 0 0 -5 0 0 0 0 -5 0 0 0 0 20 0 0 0 0 -5 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 -12 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 12 1 -1 1 -1 0 0 0 0 0 0 0 0 -9 0 0 0 0 0 0 0 0 -9 0 0 0 0 0 0 0 0 18 0 0 0 0 2 0 -2 0 2 0 -2 0 2 0 -2 0 -12 0 -2 0 2 0 -2 0 2 0 -2 0 2 0 12 0 2 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 28 -1 -1 1 2 1 4 -2 -1 1 2 -4 -1 -2 -1 1 -8 1 -1 -2 -1 -4 2 1 -1 -2 4 1 2 1 -1 8/); my @got; for my $k (1..30) { for my $n (1..30) { push @got, ramanujan_sum($k, $n); } } is_deeply( \@got, \@expect, "Ramanujan sum c_{1..30}(1..30)" ); } ###### Hurwitz Class Number while (my($n, $h) = each (%hclassno)) { is( hclassno(0 + $n), $h, "H($n) = $h" ); } ###### Ramanujan Tau while (my($n, $tau) = each (%rtau)) { is( ramanujan_tau(0 + $n), $tau, "Ramanujan Tau($n) = $tau" ); } Math-Prime-Util-0.73/t/26-pillai.t0000644000076400007640000000171213352074136015055 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_pillai/; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $usegmp = Math::Prime::Util::prime_get_config->{'gmp'}; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my @pillai = (23,29,59,61,67,71,79,83,109,137,139,149,193,227,233,239,251,257,269,271,277,293,307,311,317,359,379,383,389,397,401,419,431,437,449,461,463,467,479,499,503,521,551,557,563,569,571,577,593,599,601,607,613,619,631,641,647,661,673,683,691,709,719,727,733,739,787,797,809,811,823,829,853,857,881,883,887,907,919,947,953,967,983,991); # This is horribly slow in pure Perl. Run fewer tests. $#pillai = 10 unless $usexs; #if (!$usexs) { $#pillai = ($usegmp) ? 50 : 10; } plan tests => 0 + 2 ; is(is_pillai(1059511), 16, "1059511 is a Pillai prime"); is_deeply( [grep { is_pillai($_) } 0 .. $pillai[-1]], \@pillai, "is_pillai from -10 to 1000" ); Math-Prime-Util-0.73/t/13-primecount.t0000644000076400007640000002264513337662133015777 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/prime_count semiprime_count twin_prime_count prime_count_lower prime_count_upper prime_count_approx twin_prime_count_approx ramanujan_prime_count/; 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, "3 to 15000" => 1753, "7 to 54321" => 5522, "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 }; my %tpcs = ( 5000 => 126, 500000 => 4565, 50000000 => 239101, 5000000000 => 14618166, 500000000000 => 986222314, 50000000000000 => 71018282471, 5000000000000000 => 5357875276068, ); my %spcs = ( 2048 => 589, 8192 => 2186, 5000 => 1365, 50000 => 12110, 500000 => 108326, 5000000 => 979274, 50000000 => 8940570, 500000000 => 82302116, 5000000000 => 763121842, ); my %rpcs = ( 5000 => 302, 50000 => 2371, 500000 => 19492, 5000000 => 165440, 135791 => 5888, 65536 => 3030, ); 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 + 3 + (($isxs && $use64) ? 1+2*scalar(keys %tpcs) : 0) # twin pc + 2 + (($isxs && $use64) ? 2+1*scalar(keys %spcs) : 0) # semi pc + 2 + (($isxs && $use64) ? 2+1*scalar(keys %rpcs) : 0) # ram pc + 0; 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::_lehmer_pi (66123456),3903023,"XS Lehmer count"); #is(Math::Prime::Util::_meissel_pi (66123456),3903023,"XS Meissel count"); #is(Math::Prime::Util::_legendre_pi(66123456),3903023,"XS Legendre count"); #is(Math::Prime::Util::_LMOS_pi (66123456),3903023,"XS LMOS count"); is(Math::Prime::Util::_LMO_pi (66123456), 3903023,"XS LMO count"); is(Math::Prime::Util::_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"); } ####### Twin prime counts is(twin_prime_count(13,31), 2, "twin prime count 13 to 31"); is(twin_prime_count(10**8,10**8+34587), 137, "twin prime count 10^8 to +34587"); is(twin_prime_count(654321), 5744, "twin prime count 654321"); if ($isxs && $use64) { is(twin_prime_count(1000000000123456), 1177209242446, "twin prime count 1000000000123456"); while (my($n, $tpc) = each (%tpcs)) { is(twin_prime_count($n), $tpc, "twin prime count $n"); my $errorp = 100 * abs($tpc - twin_prime_count_approx($n)) / $tpc; my $estr = sprintf "%8.6f%%", $errorp; cmp_ok( $errorp, '<=', 2, "twin_prime_count_approx($n) is $estr"); } } ####### Semiprime prime counts is(semiprime_count(13,31), 6, "semiprime count 13 to 31"); is(semiprime_count(654321), 140067, "semiprime count 654321"); # TODO: Add this when PP semiprime count walks. #is(semiprime_count(10**8,10**8+3587),602, "semiprime count 10^8 to +3587"); if ($isxs && $use64) { is(semiprime_count(10**8,10**8+34587),5802, "semiprime count 10^8 to +34587"); is(semiprime_count(10000123456), 1493794315, "semiprime count 10000123456"); while (my($n, $rpc) = each (%spcs)) { is(semiprime_count($n), $rpc, "semiprime count $n"); } } ####### Ramanujan prime counts is(ramanujan_prime_count(13,31), 2, "Ramanujan prime count 13 to 31"); is(ramanujan_prime_count(1357), 94, "Ramanujan prime count 1357"); if ($isxs && $use64) { is(ramanujan_prime_count(10**8,10**8+34587), 927, "Ramanujan prime count 10^8 to +34587"); is(ramanujan_prime_count(654321), 24973, "Ramanujan prime count 654321"); while (my($n, $rpc) = each (%rpcs)) { is(ramanujan_prime_count($n), $rpc, "Ramanujan prime count $n"); #my $errorp = 100 * abs($tpc - ramanujan_prime_count_approx($n)) / $tpc; #my $estr = sprintf "%8.6f%%", $errorp; #cmp_ok( $errorp, '<=', 2, "ramanujan_prime_count_approx($n) is $estr"); } } Math-Prime-Util-0.73/t/19-liouville.t0000644000076400007640000000236113204400603015576 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/liouville/; #my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; #my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; #my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; $use64 = 0 if $use64 && 18446744073709550592 == ~0; 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 => scalar(@liouville_pos) + scalar(@liouville_neg); ###### 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" ); } Math-Prime-Util-0.73/t/35-rand-tag.t0000644000076400007640000000275013204400603015267 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/:rand/; my $use64 = (~0 > 4294967295); my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $maxbits = $use64 ? 64 : 32; plan tests => 1+4+1; ######## # # Notes: # 32-bit Perls won't have irand64 properly available. We should test that it # exists and returns rands, but it will only get a single word. # # On quadmath platforms drand will use 128-bits instead of 64. Simiarly # for NV=float platforms we'd see different patterns after the first. is( srand(7652245), 7652245, "srand returns result" ); my %alg = ( ChaCha20 => [1951677399, 598936225, 0.716442236122296401], ISAAC => [2993131935, 393080975, 0.00891862162060655416], ); my @got = ( irand, irand, rand ); my @exp; my $which; for my $alg (keys %alg) { next if $alg{$alg}->[0] != $got[0]; @exp = @{ $alg{$alg} }; $which = $alg; last; } SKIP: { skip "Unknown PRNG algorithm",4 if !defined $which; is( $got[0], $exp[0], "$which irand" ); is( $got[1], $exp[1], "$which irand" ); ok( $got[2] > $exp[2]-1e-6 && $got[2] < $exp[2]+1e-6, "$which drand" ); srand(7652245); my($r, $want) = (irand, $got[0]); is( $r, $want, "Replicates after srand" ); } SKIP: { skip "Unknown PRNG algorithm",1 if !defined $which; skip "Skipping irand64 on 32-bit Perl", 1 if !$use64; my $r = irand64; my $want = ($which eq 'ChaCha20') ? 2572411501841793573 : 1688269932343098788; is($r, $want, "$which irand64"); } Math-Prime-Util-0.73/t/19-divisorsum.t0000644000076400007640000000561013204400603015776 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/divisor_sum/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; #my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; #my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; #my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; #$use64 = 0 if $use64 && 18446744073709550592 == ~0; 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); push @tau4, (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) if $extra; plan tests => 1 + 2*scalar(keys %sigmak) + 3; ###### 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" ); } Math-Prime-Util-0.73/t/19-gcd.t0000644000076400007640000000537613204400603014340 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/ gcd lcm gcdext /; 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'}; my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; $use64 = 0 if $use64 && 18446744073709550592 == ~0; 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 @gcdexts = ( [ [0, 0], [0, 0, 0] ], [ [0, 28], [0, 1,28] ], [ [ 28,0], [ 1,0,28] ], [ [0,-28], [0,-1,28] ], [ [-28,0], [-1,0,28] ], [ [ 3706259912, 1223661804], [ 123862139,-375156991, 4] ], [ [ 3706259912,-1223661804], [ 123862139, 375156991, 4] ], [ [-3706259912, 1223661804], [-123862139,-375156991, 4] ], [ [-3706259912,-1223661804], [-123862139, 375156991, 4] ], [ [22,242], [1, 0, 22] ], [ [2731583792,3028241442], [-187089956, 168761937, 2] ], [ [42272720,12439910], [-21984, 74705, 70] ], ); if ($use64) { push @gcdexts, [ [10139483024654235947,8030280778952246347], [-2715309548282941287,3428502169395958570,1] ]; } plan tests => scalar(@gcds) + scalar(@lcms) + scalar(@gcdexts); ###### 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" ); } ###### gcdext foreach my $garg (@gcdexts) { my($aref, $eref) = @$garg; my($x,$y) = @$aref; is_deeply( [gcdext($x,$y)], $eref, "gcdext($x,$y) = [@$eref]" ); } Math-Prime-Util-0.73/t/19-chebyshev.t0000644000076400007640000000340013204400603015545 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/ chebyshev_theta chebyshev_psi /; 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'}; my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; $use64 = 0 if $use64 && 18446744073709550592 == ~0; 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; } plan tests => scalar(keys %chebyshev1) + scalar(keys %chebyshev2); ###### first Chebyshev function while (my($n, $c1) = each (%chebyshev1)) { cmp_closeto( chebyshev_theta(0+$n), $c1, 1e-9*abs($n), "chebyshev_theta($n)" ); } ###### second Chebyshev function while (my($n, $c2) = each (%chebyshev2)) { cmp_closeto( chebyshev_psi(0+$n), $c2, 1e-9*abs($n), "chebyshev_psi($n)" ); } 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.73/t/15-probprime.t0000644000076400007640000001173012532503145015575 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.73/t/92-release-pod-coverage.t0000644000076400007640000001071313373330217017576 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|segment_twin)_primes$/, 'semi_prime_sieve', ], }; $param->{trustme} = [mpu_public_regex(), mpu_factor_regex()] if $m eq 'Math::Prime::Util::PP'; $param->{trustme} = [mpu_public_regex(), mpu_factor_regex(), qw/rand srand/] if $m eq 'ntheory'; 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_euler_pseudoprime is_strong_pseudoprime is_euler_plumb_pseudoprime is_lucas_pseudoprime is_strong_lucas_pseudoprime is_extra_strong_lucas_pseudoprime is_almost_extra_strong_lucas_pseudoprime is_frobenius_pseudoprime is_frobenius_underwood_pseudoprime is_frobenius_khashin_pseudoprime is_perrin_pseudoprime is_catalan_pseudoprime is_aks_prime is_bpsw_prime is_ramanujan_prime is_mersenne_prime is_power is_prime_power is_pillai is_semiprime is_square is_polygonal is_square_free is_primitive_root is_carmichael is_quasi_carmichael is_fundamental is_totient sqrtint rootint logint miller_rabin_random lucas_sequence lucasu lucasv primes twin_primes semi_primes ramanujan_primes sieve_prime_cluster sieve_range forprimes forcomposites foroddcomposites forsemiprimes fordivisors forpart forcomp forcomb forperm forderange formultiperm forsetproduct forfactored forsquarefree lastfor numtoperm permtonum randperm shuffle 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 inverse_li twin_prime_count twin_prime_count_approx nth_twin_prime nth_twin_prime_approx semiprime_count semiprime_count_approx nth_semiprime nth_semiprime_approx ramanujan_prime_count ramanujan_prime_count_approx ramanujan_prime_count_lower ramanujan_prime_count_upper nth_ramanujan_prime nth_ramanujan_prime_approx nth_ramanujan_prime_lower nth_ramanujan_prime_upper sum_primes print_primes 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 random_shawe_taylor_prime random_shawe_taylor_prime_with_cert random_semiprime random_unrestricted_semiprime random_factored_integer primorial pn_primorial consecutive_integer_lcm gcdext chinese gcd lcm factor factor_exp divisors valuation hammingweight todigits fromdigits todigitstring sumdigits invmod sqrtmod addmod mulmod divmod powmod vecsum vecmin vecmax vecprod vecreduce vecextract vecany vecall vecnotall vecnone vecfirst vecfirstidx moebius mertens euler_phi jordan_totient exp_mangoldt liouville partitions bernfrac bernreal harmfrac harmreal chebyshev_theta chebyshev_psi divisor_sum carmichael_lambda kronecker hclassno inverse_totient ramanujan_tau ramanujan_sum binomial stirling znorder znprimroot znlog legendre_phi factorial factorialmod ExponentialIntegral LogarithmicIntegral RiemannZeta RiemannR LambertW Pi irand irand64 drand urandomb urandomm csrand random_bytes entropy_bytes ); my $pattern = '^(' . join('|', @funcs) . ')$'; return qr/$pattern/; } sub mpu_factor_regex { my @funcs = (qw/trial_factor fermat_factor holf_factor lehman_factor squfof_factor prho_factor pbrent_factor pminus1_factor pplus1_factor ecm_factor/); my $pattern = '^(' . join('|', @funcs) . ')$'; return qr/$pattern/; } Math-Prime-Util-0.73/t/19-kronecker.t0000644000076400007640000000332413204400603015555 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/kronecker/; #my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; #my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; #my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; $use64 = 0 if $use64 && 18446744073709550592 == ~0; 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]; } plan tests => scalar(@kroneckers); ###### kronecker foreach my $karg (@kroneckers) { my($a, $n, $exp) = @$karg; my $k = kronecker($a, $n); is( $k, $exp, "kronecker($a, $n) = $exp" ); } Math-Prime-Util-0.73/t/26-digits.t0000644000076400007640000000704513204400603015057 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/todigits fromdigits todigitstring sumdigits vecsum factorial/; 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'}; #my $usegmp= Math::Prime::Util::prime_get_config->{'gmp'}; #$use64 = 0 if $use64 && 18446744073709550592 == ~0; plan tests => 0 + 6 + 3 + 2 + 1 # fromdigits + 6 + 4 + 1 # todigits + 4 + 2*$extra # sumdigits + 12; ###### fromdigits is(fromdigits([0,1,1,0,1],2), 13, "fromdigits binary with leading 0"); is(fromdigits([1,1,0,1],2), 13, "fromdigits binary"); is(fromdigits([0,1,1,0,1]), 1101, "fromdigits decimal"); is(fromdigits([0,1,1,0,1],3), 37, "fromdigits base 3"); is(fromdigits([0,1,1,0,1],16), 4353, "fromdigits base 16"); is(fromdigits([0,1,1,0,2216],16), 6568, "fromdigits base 16 with overflow"); is(fromdigits([7,999,44],5), 7*5**2 + 999*5 + 44*1, "fromdigits base 5 with carry"); is(fromdigits([7,999,44],3), 7*3**2 + 999*3 + 44*1, "fromdigits base 3 with carry"); is(fromdigits([7,999,44],2), 7*2**2 + 999*2 + 44*1, "fromdigits base 2 with carry"); is(fromdigits("1f",16), 31, "fromdigits hex string"); is(fromdigits("24"), 24, "fromdigits decimal"); is(fromdigits("zzzyzzzyzzzyzzzy",36), "7958656371562241451187966", "fromdigits with Large base 36 number"); ###### todigits is_deeply([todigits(0)], [], "todigits 0"); is_deeply([todigits(1)], [1], "todigits 1"); is_deeply([todigits(77)], [7,7], "todigits 77"); is_deeply([todigits(77,2)], [1,0,0,1,1,0,1], "todigits 77 base 2"); is_deeply([todigits(77,3)], [2,2,1,2], "todigits 77 base 3"); is_deeply([todigits(77,21)], [3,14], "todigits 77 base 21"); is_deeply([todigits(900,2)], [1,1,1,0,0,0,0,1,0,0], "todigits 900 base 2"); is_deeply([todigits(900,2,0)], [], "todigits 900 base 2 len 0"); is_deeply([todigits(900,2,3)], [1,0,0], "todigits 900 base 2 len 3"); is_deeply([todigits(900,2,32)], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,1,0,0], "todigits 900 base 2 len 32"); is(vecsum(todigits("293852387239761276234029385230912847923872323")), 201, "vecsum of todigits of bigint"); ###### sumdigits is(sumdigits("-45.36"), 4+5+3+6, "sumdigits(-45.36)"); { my @sumd = map { sumdigits($_) } 0 .. 1000; my @splitd = map { vecsum(split(//,$_)) } 0 .. 1000; is_deeply( \@sumd, \@splitd, "sumdigits 0 to 1000"); } is(sumdigits("0x3290f8E"), 51, "sumdigits hex"); is(sumdigits("293852387239761276234029385230912847923872323"), 201, "sumdigits bigint"); if ($extra) { is(sumdigits(factorial(1000)), 10539, "sumdigits 1000!"); is(sumdigits(factorial(10000)), 149346, "sumdigits 10000!"); } ###### examples from Wolfram docs is_deeply([todigits(1234135634,16)], [4,9,8,15,6,10,5,2], "todigits 1234135634 base 16"); is_deeply([todigits(56,2,8)], [0,0,1,1,1,0,0,0], "todigits 56 base 2 len 8"); is(fromdigits([todigits(56,2,8)],2), 56, "fromdigits of previous"); is(todigitstring(56,2), "111000", "56 as binary string"); is(fromdigits(todigitstring(56,2),2), 56, "fromdigits of previous"); is(todigitstring(37,2), "100101", "todigitstring 37"); is(fromdigits([5,1,2,8]), 5128, "fromdigits 5128 base 10"); is(fromdigits([1,0,1,1,0,1,1],2), 91, "fromdigits 91 base 2"); is(fromdigits("1923"), 1923, "fromdigits 1923 base 10"); is(fromdigits("1011011",2), 91, "fromdigits 91 base 2"); is(fromdigits([7,11,0,0,0,122]), 810122, "fromdigits with carry"); is_deeply([todigits(6345354, 10, 4)], [5,3,5,4], "only last 4 digits"); Math-Prime-Util-0.73/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.73/t/10-isprime.t0000644000076400007640000001173112532503145015242 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.73/t/52-primearray.t0000644000076400007640000001052013204400603015736 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.73/lmo.c0000644000076400007640000007136513357250742013700 0ustar danadana#include #include #include #include /***************************************************************************** * * Prime counts using the extended Lagarias-Miller-Odlyzko combinatorial method. * * Copyright (c) 2013-2014 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. */ /* 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 "constants.h" #include "prime_nth_count.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) ? segment_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) { /* If 'x' is very small, give a quick answer with any 'a' */ if (x <= PHIC) return tablephi(x, (a > PHIC) ? PHIC : a); /* Shortcuts for large values, from R. Andrew Ohana */ if (a > (x >> 1)) return 1; /* If a > prime_count(2^32), then we need not be concerned with composite * x values with all factors > 2^32, as x is limited to 64-bit. */ if (a > 203280221) { /* prime_count(2**32) */ UV pc = LMO_prime_count(x); return (a > pc) ? 1 : pc - a + 1; } /* If a is large enough, check the ratios */ if (a > 1000000 && x < a*21) { /* x always less than 2^32 */ if ( LMO_prime_count(x) < a) return 1; } /* TODO: R. Andrew Ohana's 2011 SAGE code is faster as the a value * increases. It uses a primelist as in the caching code below, as * well as a binary search prime count on it (like in our lehmer). */ if ( a > 254 || (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) LMO_prime_count(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 LMO_prime_count(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 < _MPU_LMO_CROSSOVER || n < 10000) return segment_prime_count(2, n); /* n should now be reasonably sized (not tiny). */ #ifdef USE_PRIMECOUNT_FOR_LARGE_LMO if (n > 110000000000UL) { FILE *f; char cmd[100]; sprintf(cmd, "primecount %lu", n); f = popen(cmd, "r"); fscanf(f, "%lu", &sum1); pclose(f); return sum1; } #endif 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.73/csprng.c0000644000076400007640000002072213370623653014374 0ustar danadana /* Our API for random numbers. * * We can use ISAAC, ChaCha20, or something else. * * 3700 ns/word ChaCha20 in Perl * 3100 ns/word Salsa20 in Perl * 1600 ns/word ChaCha8 in Perl * 760 ns/word ISAAC in Perl * * 11.20 ns/word ChaCha20 (openbsd) * 10.31 ns/word ChaCha20 (dj) * 8.66 ns/word ChaCha20 (sse2 Peters) * 6.85 ns/word ChaCha12 (dj) * 5.99 ns/word Tyche * 5.11 ns/word ChaCha8 (dj) * 4.37 ns/word MT19937 (Cokus) * 4.14 ns/word Tyche-i * 3.26 ns/word ISAAC * 3.18 ns/word PCG64 (64-bit state, 64-bit types) * 1.95 ns/word PCG64 (64-bit state, 128-bit types) * 1.84 ns/word ChaCha20 (AVX2 chacha-opt) * 1.48 ns/word Xoroshiro128+ * 1.16 ns/word SplitMix64 * * These functions do locking, the underlying library does not. */ #include #include #include #include "ptypes.h" #include "csprng.h" #include "chacha.h" #define SEED_BYTES (32+8) #define CSEED(ctx,bytes,data,good) chacha_seed(ctx,bytes,data,good) #define CRBYTES(ctx,bytes,data) chacha_rand_bytes(ctx,bytes,data) #define CIRAND32(ctx) chacha_irand32(ctx) #define CIRAND64(ctx) chacha_irand64(ctx) #define CSELFTEST() chacha_selftest() /* Helper macros, similar to ChaCha, so we're consistent. */ #ifndef U8TO32_LE #define U8TO32_LE(p) \ (((uint32_t)((p)[0]) ) | \ ((uint32_t)((p)[1]) << 8) | \ ((uint32_t)((p)[2]) << 16) | \ ((uint32_t)((p)[3]) << 24)) #endif #define U32TO8_LE(p, v) \ do { \ uint32_t _v = v; \ (p)[0] = (((_v) ) & 0xFFU); \ (p)[1] = (((_v) >> 8) & 0xFFU); \ (p)[2] = (((_v) >> 16) & 0xFFU); \ (p)[3] = (((_v) >> 24) & 0xFFU); \ } while (0) /*****************************************************************************/ /* We put a simple 32-bit non-CS PRNG here to help fill small seeds. */ #if 0 /* XOSHIRO128** 32-bit output, 32-bit types, 128-bit state */ static INLINE uint32_t rotl(const uint32_t x, int k) { return (x << k) | (x >> (32 - k)); } uint32_t prng_next(char* ctx) { uint32_t *s = (uint32_t*) ctx; const uint32_t result_starstar = rotl(s[0] * 5, 7) * 9; const uint32_t t = s[1] << 9; s[2] ^= s[0]; s[3] ^= s[1]; s[1] ^= s[2]; s[0] ^= s[3]; s[2] ^= t; s[3] = rotl(s[3], 11); return result_starstar; } char* prng_new(uint32_t a, uint32_t b, uint32_t c, uint32_t d) { uint32_t *state; New(0, state, 4, uint32_t); state[0] = 1; state[1] = b; state[2] = c; state[3] = d; (void) prng_next((char*)state); state[0] += a; (void) prng_next((char*)state); return (char*) state; } #else /* PCG RXS M XS 32. 32-bit output, 32-bit state and types. */ uint32_t prng_next(char* ctx) { uint32_t *rng = (uint32_t*) ctx; uint32_t word, oldstate = rng[0]; rng[0] = rng[0] * 747796405U + rng[1]; word = ((oldstate >> ((oldstate >> 28u) + 4u)) ^ oldstate) * 277803737u; return (word >> 22u) ^ word; } char* prng_new(uint32_t a, uint32_t b, uint32_t c, uint32_t d) { uint32_t *state; New(0, state, 2, uint32_t); state[0] = 0U; state[1] = (b << 1u) | 1u; (void) prng_next((char*)state); state[0] += a; (void) prng_next((char*)state); state[0] ^= c; (void) prng_next((char*)state); state[0] ^= d; (void) prng_next((char*)state); return (char*) state; } #endif /*****************************************************************************/ uint32_t csprng_context_size(void) { return sizeof(chacha_context_t); } static char _has_selftest_run = 0; void csprng_seed(void *ctx, uint32_t bytes, const unsigned char* data) { unsigned char seed[SEED_BYTES + 4]; /* If given a short seed, minimize zeros in state */ if (bytes >= SEED_BYTES) { memcpy(seed, data, SEED_BYTES); } else { char* rng; uint32_t a, b, c, d, i; memcpy(seed, data, bytes); memset(seed+bytes, 0, sizeof(seed)-bytes); a = U8TO32_LE((seed + 0)); b = U8TO32_LE((seed + 4)); c = U8TO32_LE((seed + 8)); d = U8TO32_LE((seed + 12)); rng = prng_new(a,b,c,d); for (i = 4*((bytes+3)/4); i < SEED_BYTES; i += 4) U32TO8_LE(seed + i, prng_next(rng)); Safefree(rng); #if 0 printf("got %u bytes in expanded to %u\n", bytes, SEED_BYTES); printf("from: ");for(i=0;i= 16)); } extern void csprng_srand(void* ctx, UV insecure_seed) { #if BITS_PER_WORD == 32 unsigned char seed[4] = {0}; U32TO8_LE(seed, insecure_seed); csprng_seed(ctx, 4, seed); #else unsigned char seed[8] = {0}; if (insecure_seed <= UVCONST(4294967295)) { U32TO8_LE(seed, insecure_seed); csprng_seed(ctx, 4, seed); } else { U32TO8_LE(seed, insecure_seed); U32TO8_LE(seed + 4, (insecure_seed >> 32)); csprng_seed(ctx, 8, seed); } #endif } void csprng_rand_bytes(void* ctx, uint32_t bytes, unsigned char* data) { CRBYTES(ctx, bytes, data); } uint32_t irand32(void* ctx) { return CIRAND32(ctx); } UV irand64(void* ctx) { #if BITS_PER_WORD < 64 croak("irand64 too many bits for UV"); #else return CIRAND64(ctx); #endif } /*****************************************************************************/ int is_csprng_well_seeded(void *ctx) { chacha_context_t *cs = ctx; return cs->goodseed; } /* There are many ways to get floats from integers. A few good, many bad. * * Vigna recommends (x64 >> 11) * (1.0 / (1ULL<<53)). * http://xoroshiro.di.unimi.it * Also see alternatives discussed: * http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/VERSIONS/C-LANG/speed-up-real.html * * Melissa O'Neill notes the problem is harder than it looks, doesn't address. * http://www.pcg-random.org/pdf/toms-oneill-pcg-family-v1.02.pdf * * randomstate for numpy uses separate code for each generator. * With the exception of dSFMT, they each one one of: * (x64 >> 11) * (1 / 9007199254740992.0) * ((x32 >> 5) * 67108864.0 + (y32 >> 6)) / 9007199254740992.0 * where the first one is identical to Vigna. * * David Jones recommends the minor 32-bit variant: * ((x32 >> 6) * 134217728.0 + (y32 >> 5)) / 9007199254740992.0 * http://www0.cs.ucl.ac.uk/staff/d.jones/GoodPracticeRNG.pdf * * Taylor Campbell discusses this in: * http://mumble.net/~campbell/tmp/random_real.c * He points out that there are two common non-broken choices, * div by 2^-53 or div by 2^-64, and each are slightly flawed in * different ways. He shows a theoretically better method. */ /* * We prefer the x64 / 2^-64 method. It seems to produce the best results * and is easiest for ensuring we fill up all the bits. * It is similar to what Geoff Kuenning does in MTwist, though he computes * the constants at runtime to ensure a dodgy compiler won't munge them. */ #define TO_NV_32 2.3283064365386962890625000000000000000E-10L #define TO_NV_64 5.4210108624275221700372640043497085571E-20L #define TO_NV_96 1.2621774483536188886587657044524579675E-29L #define TO_NV_128 2.9387358770557187699218413430556141945E-39L #define DRAND_32_32 (CIRAND32(ctx) * TO_NV_32) #define DRAND_64_32 (((CIRAND32(ctx)>>5) * 67108864.0 + (CIRAND32(ctx)>>6)) / 9007199254740992.0) #define DRAND_64_64 (CIRAND64(ctx) * TO_NV_64) #define DRAND_128_32 (CIRAND32(ctx) * TO_NV_32 + CIRAND32(ctx) * TO_NV_64 + CIRAND32(ctx) * TO_NV_96 + CIRAND32(ctx) * TO_NV_128) #define DRAND_128_64 (CIRAND64(ctx) * TO_NV_64 + CIRAND64(ctx) * TO_NV_128) NV drand64(void* ctx) { NV r; #if NVMANTBITS <= 32 r = DRAND_32_32; #elif NVMANTBITS <= 64 r = (BITS_PER_WORD <= 32) ? DRAND_64_32 : DRAND_64_64; #else r = (BITS_PER_WORD <= 32) ? DRAND_128_32 : DRAND_128_64; #endif return r; } /* Return rand 32-bit integer between 0 to n-1 inclusive */ uint32_t urandomm32(void *ctx, uint32_t n) { uint32_t r, rmin; if (n <= 1) return 0; rmin = -n % n; while (1) { r = CIRAND32(ctx); if (r >= rmin) break; } return r % n; } UV urandomm64(void* ctx, UV n) { UV r, rmin; if (n <= 4294967295UL) return urandomm32(ctx,n); if (n-1 == 4294967295UL) return irand32(ctx); rmin = -n % n; while (1) { r = CIRAND64(ctx); if (r >= rmin) break; } return r % n; } UV urandomb(void* ctx, int nbits) { if (nbits == 0) { return 0; } else if (nbits <= 32) { return irand32(ctx) >> (32-nbits); #if BITS_PER_WORD == 64 } else if (nbits <= 64) { return irand64(ctx) >> (64-nbits); #endif } croak("irand64 too many bits for UV"); } Math-Prime-Util-0.73/XS.xs0000644000076400007640000032630713373330217013644 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 */ #include /* For fileno and stdout */ #define NEED_newCONSTSUB #define NEED_newRV_noinc #define NEED_sv_2pv_flags #define NEED_HvNAME_get #include "ppport.h" #define FUNC_gcd_ui 1 #define FUNC_isqrt 1 #define FUNC_ipow 1 #define FUNC_popcnt 1 #include "ptypes.h" #include "cache.h" #include "sieve.h" #include "sieve_cluster.h" #include "util.h" #include "primality.h" #include "factor.h" #include "lehmer.h" #include "lmo.h" #include "aks.h" #include "constants.h" #include "mulmod.h" #include "entropy.h" #include "csprng.h" #include "random_prime.h" #include "ramanujan_primes.h" #include "semi_primes.h" #include "prime_nth_count.h" #ifdef FACTORING_HARNESSES #include static double my_difftime (struct timeval * start, struct timeval * end) { double secs, usecs; if (start->tv_sec == end->tv_sec) { secs = 0; usecs = end->tv_usec - start->tv_usec; } else { usecs = 1000000 - start->tv_usec; secs = end->tv_sec - (start->tv_sec + 1); usecs += end->tv_usec; if (usecs >= 1000000) { usecs -= 1000000; secs += 1; } } return secs + usecs / 1000000.; } #endif #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 defined(_MSC_VER) && !defined(strtold) #define strtold strtod #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) */ /* TODO: Math::BigInt::Pari has the same problem with negs pre-5.18.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 #if PERL_REVISION >=5 && PERL_VERSION >= 9 && PERL_SUBVERSION >= 4 #define SVf_MAGTEST SVf_ROK #else #define SVf_MAGTEST SVf_AMAGIC #endif #define SVNUMTEST(n) \ ((SvFLAGS(n) & (SVf_IOK | SVf_MAGTEST | SVs_GMG )) == SVf_IOK) /* 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 >= 1) || (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" #define CINTS 100 typedef struct { HV* MPUroot; HV* MPUGMP; HV* MPUPP; SV* const_int[CINTS+1]; /* -1, 0, 1, ..., 99 */ void* randcxt; /* per-thread csprng context */ uint16_t forcount; char forexit; } my_cxt_t; START_MY_CXT static int _is_sv_bigint(pTHX_ SV* n) { if (sv_isobject(n)) { const char *hvname = HvNAME_get(SvSTASH(SvRV(n))); if (hvname != 0) { if (strEQ(hvname, "Math::BigInt") || strEQ(hvname, "Math::BigFloat") || strEQ(hvname, "Math::GMPz") || strEQ(hvname, "Math::GMP") || strEQ(hvname, "Math::GMPq") || strEQ(hvname, "Math::AnyNum") || strEQ(hvname, "Math::Pari") || strEQ(hvname, "Math::BigInt::Lite")) return 1; } } return 0; } /* 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 (SVNUMTEST(n)) { /* 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 (sv_isobject(n)) { isbignum = _is_sv_bigint(aTHX_ n); if (!isbignum) 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, int minversion) { 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() && _XS_get_callgmp() >= minversion; assert(!(stashflags & ~(VCALL_PP|VCALL_GMP))); if (use_gmp && hv_exists(MY_CXT.MPUGMP,name,namelen)) { 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,0) #define _vcallsub_with_gmp(ver,func) (void)_vcallsubn(aTHX_ G_SCALAR, VCALL_GMP|VCALL_PP, func, items,(int)(100*(ver))) #define _vcallsub_with_pp(func) (void)_vcallsubn(aTHX_ G_SCALAR, VCALL_PP, func, items,0) #define _vcallsub_with_gmpobj(ver,func) (void)_vcallsubn(aTHX_ G_SCALAR, (PERL_REVISION >= 5 && PERL_VERSION > 8) ? VCALL_GMP|VCALL_PP : VCALL_PP, func, items,(int)(100*(ver))) #if 0 static int _vcallgmpsubn(pTHX_ I32 flags, const char* name, int nargs, int minversion) { Size_t namelen = strlen(name); int gmpver = _XS_get_callgmp(); dMY_CXT; if (gmpver && gmpver >= minversion && hv_exists(MY_CXT.MPUGMP,name,namelen)) { GV ** gvp = (GV**)hv_fetch(MY_CXT.MPUGMP,name,namelen,0); if (gvp) { GV* gv = *gvp; PUSHMARK(PL_stack_sp-nargs); return call_sv((SV*)gv, flags); } } return 0; } #endif /* 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_= -1 && r_= 5 && PERL_VERSION > 8) { \ SV* resptr = output; \ const char *iname = (input && sv_isobject(input)) \ ? HvNAME_get(SvSTASH(SvRV(input))) : 0; \ if (iname == 0 || strEQ(iname, "Math::BigInt")) { \ (void)_vcallsubn(aTHX_ G_SCALAR, VCALL_ROOT, "_to_bigint", 1, 0); \ } else if (iname == 0 || strEQ(iname, "Math::GMPz")) { \ (void)_vcallsubn(aTHX_ G_SCALAR, VCALL_ROOT, "_to_gmpz", 1, 0); \ } else if (iname == 0 || strEQ(iname, "Math::GMP")) { \ (void)_vcallsubn(aTHX_ G_SCALAR, VCALL_ROOT, "_to_gmp", 1, 0); \ } else { /* Return it as: ref(input)->new(result) */ \ dSP; (void)POPs; ENTER; PUSHMARK(SP); \ XPUSHs(sv_2mortal(newSVpv(iname, 0))); XPUSHs(resptr); \ PUTBACK; call_method("new", G_SCALAR); LEAVE; \ } \ } static SV* sv_to_bigint(pTHX_ SV* r) { dSP; ENTER; PUSHMARK(SP); XPUSHs(r); PUTBACK; call_pv("Math::Prime::Util::_to_bigint", G_SCALAR); SPAGAIN; r = POPs; PUTBACK; LEAVE; return r; } #define RETURN_128(hi,lo) \ do { char str[40]; \ int slen = to_string_128(str, hi, lo); \ XPUSHs( sv_to_bigint( aTHX_ sv_2mortal(newSVpv(str,slen)) ) ); \ XSRETURN(1); } while(0) static int arrayref_to_int_array(pTHX_ UV** ret, AV* av, int base) { int len, i; UV *r, carry = 0; if (SvTYPE((SV*)av) != SVt_PVAV) croak("fromdigits first argument must be a string or array reference"); len = 1 + av_len(av); New(0, r, len, UV); for (i = len-1; i >= 0; i--) { SV** psvd = av_fetch(av, i, 0); if (_validate_int(aTHX_ *psvd, 1) != 1) break; r[i] = my_svuv(*psvd) + carry; if (r[i] >= (UV)base && i > 0) { carry = r[i] / base; r[i] -= carry * base; } else { carry = 0; } } if (i >= 0) { Safefree(r); return -1; } /* printf("array is ["); for(i=0;i= 2) { /* Make derangements start deranged */ for (i = 0; i < k; i++) cm[k-i-1] = (i&1) ? i : i+2; if (k & 1) { cm[0] = k-2; cm[1] = k; } } } static int _comb_iterate(UV* cm, UV k, UV n, int ix) { UV i, j, m; if (ix == 0) { if (cm[0]++ < n) return 0; /* Increment last value */ for (i = 1; i < k && cm[i] >= n-i; i++) ; /* Find next index to incr */ if (i >= k) return 1; /* Done! */ cm[i]++; /* Increment this one */ while (i-- > 0) cm[i] = cm[i+1] + 1; /* Set the rest */ } else if (ix == 1) { for (j = 1; j < k && cm[j] > cm[j-1]; j++) ; /* Find last decrease */ if (j >= k) return 1; /* Done! */ for (m = 0; cm[j] > cm[m]; m++) ; /* Find next greater */ { UV t = cm[j]; cm[j] = cm[m]; cm[m] = t; } /* Swap */ for (i = j-1, m = 0; m < i; i--, m++) /* Reverse the end */ { UV t = cm[i]; cm[i] = cm[m]; cm[m] = t; } } else { REDERANGE: for (j = 1; j < k && cm[j] > cm[j-1]; j++) ; /* Find last decrease */ if (j >= k) return 1; /* Done! */ for (m = 0; cm[j] > cm[m]; m++) ; /* Find next greater */ { UV t = cm[j]; cm[j] = cm[m]; cm[m] = t; } /* Swap */ if (cm[j] == k-j) goto REDERANGE; /* Skip? */ for (i = j-1, m = 0; m < i; i--, m++) /* Reverse the end */ { UV t = cm[i]; cm[i] = cm[m]; cm[m] = t; } for (i = 0; i < k; i++) /* Check deranged */ if (cm[k-i-1]-1 == i) break; if (i != k) goto REDERANGE; } return 0; } MODULE = Math::Prime::Util PACKAGE = Math::Prime::Util PROTOTYPES: ENABLE BOOT: { int i; SV * sv = newSViv(BITS_PER_WORD); HV * stash = gv_stashpv("Math::Prime::Util", TRUE); newCONSTSUB(stash, "_XS_prime_maxbits", sv); { MY_CXT_INIT; MY_CXT.MPUroot = stash; MY_CXT.MPUGMP = gv_stashpv("Math::Prime::Util::GMP", TRUE); MY_CXT.MPUPP = gv_stashpv("Math::Prime::Util::PP", TRUE); for (i = 0; i <= CINTS; i++) { MY_CXT.const_int[i] = newSViv(i-1); SvREADONLY_on(MY_CXT.const_int[i]); } New(0, MY_CXT.randcxt, csprng_context_size(), char); csprng_init_seed(MY_CXT.randcxt); MY_CXT.forcount = 0; MY_CXT.forexit = 0; } } #if defined(USE_ITHREADS) && defined(MY_CXT_KEY) void CLONE(...) PREINIT: int i; PPCODE: { MY_CXT_CLONE; /* possible declaration */ 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); /* These should be shared between threads, but that's dodgy. */ for (i = 0; i <= CINTS; i++) { MY_CXT.const_int[i] = newSViv(i-1); SvREADONLY_on(MY_CXT.const_int[i]); } /* Make a new CSPRNG context for this thread */ New(0, MY_CXT.randcxt, csprng_context_size(), char); csprng_init_seed(MY_CXT.randcxt); /* NOTE: There is no thread destroy, so these never get freed... */ MY_CXT.forcount = 0; MY_CXT.forexit = 0; } return; /* skip implicit PUTBACK, returning @_ to caller, more efficient*/ #endif void END(...) PREINIT: dMY_CXT; int i; PPCODE: _prime_memfreeall(); MY_CXT.MPUroot = NULL; MY_CXT.MPUGMP = NULL; MY_CXT.MPUPP = NULL; for (i = 0; i <= CINTS; 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 */ Safefree(MY_CXT.randcxt); MY_CXT.randcxt = 0; return; /* skip implicit PUTBACK, returning @_ to caller, more efficient*/ void csrand(IN SV* seed = 0) PREINIT: unsigned char* data; STRLEN size; dMY_CXT; PPCODE: if (items == 0) { csprng_init_seed(MY_CXT.randcxt); } else if (_XS_get_secure()) { croak("secure option set, manual seeding disabled"); } else { data = (unsigned char*) SvPV(seed, size); csprng_seed(MY_CXT.randcxt, size, data); } if (_XS_get_callgmp() >= 42) _vcallsub("_csrand_p"); return; UV srand(IN UV seedval = 0) PREINIT: dMY_CXT; CODE: if (_XS_get_secure()) croak("secure option set, manual seeding disabled"); if (items == 0) get_entropy_bytes(sizeof(UV), (unsigned char*) &seedval); csprng_srand(MY_CXT.randcxt, seedval); if (_XS_get_callgmp() >= 42) _vcallsub("_srand_p"); RETVAL = seedval; OUTPUT: RETVAL UV irand() ALIAS: irand64 = 1 PREINIT: dMY_CXT; CODE: if (ix == 0) RETVAL = irand32(MY_CXT.randcxt); else #if BITS_PER_WORD >= 64 RETVAL = irand64(MY_CXT.randcxt); #else /* TODO: should irand64 on 32-bit perl (1) croak, (2) return 32-bits */ RETVAL = irand32(MY_CXT.randcxt); #endif OUTPUT: RETVAL NV drand(NV m = 0.0) ALIAS: rand = 1 PREINIT: dMY_CXT; CODE: PERL_UNUSED_VAR(ix); RETVAL = drand64(MY_CXT.randcxt); if (m != 0) RETVAL *= m; OUTPUT: RETVAL SV* random_bytes(IN UV n) PREINIT: char* sptr; dMY_CXT; CODE: RETVAL = newSV(n == 0 ? 1 : n); SvPOK_only(RETVAL); SvCUR_set(RETVAL, n); sptr = SvPVX(RETVAL); csprng_rand_bytes(MY_CXT.randcxt, n, (unsigned char*)sptr); sptr[n] = '\0'; OUTPUT: RETVAL SV* entropy_bytes(IN UV n) PREINIT: char* sptr; CODE: RETVAL = newSV(n == 0 ? 1 : n); SvPOK_only(RETVAL); SvCUR_set(RETVAL, n); sptr = SvPVX(RETVAL); get_entropy_bytes(n, (unsigned char*)sptr); sptr[n] = '\0'; OUTPUT: RETVAL UV _is_csprng_well_seeded() ALIAS: _XS_get_verbose = 1 _XS_get_callgmp = 2 _XS_get_secure = 3 _XS_set_secure = 4 _get_forexit = 5 _start_for_loop = 6 _get_prime_cache_size = 7 CODE: switch (ix) { case 0: { dMY_CXT; RETVAL = is_csprng_well_seeded(MY_CXT.randcxt); } break; case 1: RETVAL = _XS_get_verbose(); break; case 2: RETVAL = _XS_get_callgmp(); break; case 3: RETVAL = _XS_get_secure(); break; case 4: _XS_set_secure(); RETVAL = 1; break; case 5: { dMY_CXT; RETVAL = MY_CXT.forexit; } break; case 6: { dMY_CXT; MY_CXT.forcount++; RETVAL = MY_CXT.forexit; MY_CXT.forexit = 0; } break; case 7: default: RETVAL = get_prime_cache(0,0); break; } OUTPUT: RETVAL void prime_memfree() PREINIT: dMY_CXT; PPCODE: prime_memfree(); /* (void) _vcallgmpsubn(aTHX_ G_VOID|G_DISCARD, "_GMP_memfree", 0, 49); */ if (MY_CXT.MPUPP != NULL) _vcallsub_with_pp("prime_memfree"); return; void prime_precalc(IN UV n) ALIAS: _XS_set_verbose = 1 _XS_set_callgmp = 2 _end_for_loop = 3 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; case 2: _XS_set_callgmp(n); break; case 3: default: { dMY_CXT; MY_CXT.forcount--; MY_CXT.forexit = n; } break; } return; /* skip implicit PUTBACK */ void prime_count(IN SV* svlo, ...) ALIAS: semiprime_count = 1 twin_prime_count = 2 ramanujan_prime_count = 3 ramanujan_prime_count_approx = 4 sum_primes = 5 print_primes = 6 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 == 0) { count = prime_count(lo, hi); } else if (ix == 1) { count = semiprime_count(lo, hi); } else if (ix == 2) { count = twin_prime_count(lo, hi); } else if (ix == 3) { count = ramanujan_prime_count(lo, hi); } else if (ix == 4) { count = ramanujan_prime_count_approx(hi); if (lo > 2) count -= ramanujan_prime_count_approx(lo-1); } else if (ix == 5) { #if BITS_PER_WORD == 64 && HAVE_UINT128 if (hi >= 29505444491UL && hi-lo > hi/50) { UV hicount, lo_hic, lo_loc; lostatus = sum_primes128(hi, &hicount, &count); if (lostatus == 1 && lo > 2) { lostatus = sum_primes128(lo-1, &lo_hic, &lo_loc); hicount -= lo_hic; if (count < lo_loc) hicount--; count -= lo_loc; } if (lostatus == 1 && hicount > 0) RETURN_128(hicount, count); } #endif lostatus = sum_primes(lo, hi, &count); } else if (ix == 6) { int fd = (items < 3) ? fileno(stdout) : my_sviv(ST(2)); print_primes(lo, hi, fd); XSRETURN_EMPTY; } } if (lostatus == 1) XSRETURN_UV(count); } switch (ix) { case 0: _vcallsubn(aTHX_ GIMME_V, VCALL_ROOT, "_generic_prime_count", items, 0); break; case 1: _vcallsub_with_pp("semiprime_count"); break; case 2: _vcallsub_with_pp("twin_prime_count"); break; case 3: _vcallsub_with_pp("ramanujan_prime_count"); break; case 4: _vcallsub_with_pp("ramanujan_prime_count_approx"); break; case 5: _vcallsub_with_pp("sum_primes"); break; case 6: default:_vcallsub_with_pp("print_primes"); break; } return; /* skip implicit PUTBACK */ void random_prime(IN SV* svlo, IN SV* svhi = 0) PREINIT: int lostatus, histatus; UV lo, hi, ret; dMY_CXT; PPCODE: lostatus = _validate_int(aTHX_ svlo, 0); histatus = (items == 1 || _validate_int(aTHX_ svhi, 0)); if (lostatus == 1 && histatus == 1) { if (items == 1) { lo = 2; hi = my_svuv(svlo); } else { lo = my_svuv(svlo); hi = my_svuv(svhi); } ret = random_prime(MY_CXT.randcxt,lo,hi); if (ret) XSRETURN_UV(ret); else XSRETURN_UNDEF; } _vcallsub_with_gmpobj(0.44,"random_prime"); OBJECTIFY_RESULT(ST(0), ST(0)); XSRETURN(1); UV _LMO_pi(IN UV n) ALIAS: _legendre_pi = 1 _meissel_pi = 2 _lehmer_pi = 3 _LMOS_pi = 4 _segment_pi = 5 PREINIT: UV ret; CODE: switch (ix) { case 0: ret = LMO_prime_count(n); break; case 1: ret = legendre_prime_count(n); break; case 2: ret = meissel_prime_count(n); break; case 3: ret = lehmer_prime_count(n); break; case 4: ret = LMOS_prime_count(n); break; default:ret = segment_prime_count(2,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 segment_twin_primes = 4 semi_prime_sieve = 5 _ramanujan_primes = 6 _n_ramanujan_primes = 7 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 (ix == 4) { /* twin primes */ if ((low <= 3) && (high >= 3)) av_push(av, newSVuv( 3 )); if ((low <= 5) && (high >= 5)) av_push(av, newSVuv( 5 )); } else if (ix == 5) { /* semiprimes */ if ((low <= 4) && (high >= 4)) av_push(av, newSVuv( 4 )); if ((low <= 6) && (high >= 6)) av_push(av, newSVuv( 6 )); } else if (ix == 6) { /* ramanujan primes */ if ((low <= 2) && (high >= 2)) av_push(av, newSVuv( 2 )); } else { 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 == 4) high += 2; 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, 0, low, high ) { av_push(av,newSVuv(p)); } END_DO_FOR_EACH_SIEVE_PRIME Safefree(sieve); } else if (ix == 3 || ix == 4) { /* Segment */ unsigned char* segment; UV seg_base, seg_low, seg_high, lastp = 0; 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_base, seg_low, seg_high ) if (ix == 3) av_push(av,newSVuv( p )); else if (lastp+2 == p) av_push(av,newSVuv( lastp )); lastp = p; END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } else if (ix == 5) { /* Semiprimes */ UV i, count, *semi; count = range_semiprime_sieve(&semi, low, high); for (i = 0; i < count; i++) av_push(av, newSVuv(semi[i])); Safefree(semi); } else if (ix == 6) { /* Ramanujan primes */ UV i, beg, end, *L; L = ramanujan_primes(&beg, &end, low, high); if (L && end >= beg) for (i = beg; i <= end; i++) av_push(av,newSVuv(L[i])); Safefree(L); } else if (ix == 7) { /* Ramanujan primes */ UV i, *L; L = n_range_ramanujan_primes(low, high); if (L && high >= low) for (i = 0; i <= (high-low); i++) av_push(av,newSVuv(L[i])); Safefree(L); } } return; /* skip implicit PUTBACK */ void sieve_range(IN SV* svn, IN UV width, IN UV depth) PREINIT: int status; PPCODE: status = _validate_int(aTHX_ svn, 0); if (status == 1) { /* TODO: actually sieve */ UV factors[MPU_MAX_FACTORS+1], i, n = my_svuv(svn); if (depth == 0) depth = 1; /* Trial factor takes 0 to means sqrt(n) */ if ( (n + width) < n) { /* Overflow */ status = 0; } else if (depth <= 100) { /* trial division for each value */ for (i = (n<2)?2-n:0; i < width; i++) if (trial_factor(n+i, factors, 2, depth) < 2) XPUSHs(sv_2mortal(newSVuv( i ))); } else { /* small trial + factor for each value */ for (i = (n<2)?2-n:0; i < width; i++) if (factor_one(n+i, factors, 1, 1) < 2 || factors[0] > depth) XPUSHs(sv_2mortal(newSVuv( i ))); } } if (status != 1) { _vcallsubn(aTHX_ GIMME_V, VCALL_GMP|VCALL_PP, "sieve_range", items, 36); return; } void sieve_prime_cluster(IN SV* svlo, IN SV* svhi, ...) PREINIT: uint32_t nc, cl[100]; UV i, cval, nprimes, *list; int lostatus, histatus, done; PPCODE: nc = items-1; if (items > 100) croak("sieve_prime_cluster: too many entries"); cl[0] = 0; for (i = 1; i < nc; i++) { if (!_validate_int(aTHX_ ST(1+i), 0)) croak("sieve_prime_cluster: cluster values must be standard integers"); cval = my_svuv(ST(1+i)); if (cval & 1) croak("sieve_prime_cluster: values must be even"); if (cval > 2147483647UL) croak("sieve_prime_cluster: values must be 31-bit"); if (cval <= cl[i-1]) croak("sieve_prime_cluster: values must be increasing"); cl[i] = cval; } lostatus = _validate_int(aTHX_ svlo, 1); histatus = _validate_int(aTHX_ svhi, 1); done = 0; if (lostatus == 1 && histatus == 1) { UV low = my_svuv(svlo); UV high = my_svuv(svhi); list = sieve_cluster(low, high, nc, cl, &nprimes); if (list != 0) { done = 1; EXTEND(SP, (IV)nprimes); for (i = 0; i < nprimes; i++) PUSHs(sv_2mortal(newSVuv( list[i] ))); Safefree(list); } } if (!done) { _vcallsubn(aTHX_ GIMME_V, VCALL_GMP|VCALL_PP, "sieve_prime_cluster", items, 34); return; } void trial_factor(IN UV n, ...) ALIAS: fermat_factor = 1 holf_factor = 2 squfof_factor = 3 lehman_factor = 4 prho_factor = 5 pplus1_factor = 6 pbrent_factor = 7 pminus1_factor = 8 ecm_factor = 9 PREINIT: UV arg1, arg2; static const UV default_arg1[] = {0, 64000000, 8000000, 4000000, 0, 4000000, 200, 4000000, 1000000}; /* Trial, Fermat, Holf, SQUFOF, Lmn, PRHO, P+1, Brent, P-1 */ PPCODE: if (n == 0) XSRETURN_UV(0); if (ix == 9) { /* We don't have an ecm_factor, call PP. */ _vcallsubn(aTHX_ GIMME_V, VCALL_PP, "ecm_factor", 1, 0); return; } /* 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 (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, 2, 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 = lehman_factor (n, factors, arg1); break; case 5: nfactors = prho_factor (n, factors, arg1); break; case 6: nfactors = pplus1_factor (n, factors, arg1); break; case 7: if (items < 3) arg2 = 1; nfactors = pbrent_factor (n, factors, arg1, arg2); break; case 8: 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, ...) ALIAS: is_pseudoprime = 1 is_euler_pseudoprime = 2 PREINIT: int c, status = 1; PPCODE: if (items < 2) croak("No bases given to is_strong_pseudoprime"); /* 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) { /* 0,1 composite; 2,3 prime */ ret = (n >= 2); } else if (ix == 1) { /* Fermat test */ for (c = 1; c < items && ret == 1; c++) ret = is_pseudoprime(n, my_svuv(ST(c))); } else if (ix == 2) { /* Euler test */ for (c = 1; c < items && ret == 1; c++) ret = is_euler_pseudoprime(n, my_svuv(ST(c))); } else if ((n % 2) == 0) { /* evens composite */ ret = 0; } 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 = miller_rabin(n, bases, b); } } RETURN_NPARITY(ret); } switch (ix) { case 0: _vcallsub_with_gmp(0.00,"is_strong_pseudoprime"); break; case 1: _vcallsub_with_gmp(0.20,"is_pseudoprime"); break; case 2: default:_vcallsub_with_gmp(0.00,"is_euler_pseudoprime"); break; } return; /* skip implicit PUTBACK */ void gcd(...) PROTOTYPE: @ ALIAS: lcm = 1 vecmin = 2 vecmax = 3 vecsum = 4 vecprod = 5 PREINIT: int i, status = 1; UV ret, nullv, n; PPCODE: if (ix == 2 || ix == 3) { UV retindex = 0; int sign, minmax = (ix == 2); if (items == 0) XSRETURN_UNDEF; if (items == 1) XSRETURN(1); status = _validate_int(aTHX_ ST(0), 2); if (status != 0 && items > 1) { sign = status; ret = my_svuv(ST(0)); for (i = 1; i < items; i++) { status = _validate_int(aTHX_ ST(i), 2); if (status == 0) break; n = my_svuv(ST(i)); if (( (sign == -1 && status == 1) || (n >= ret && sign == status) ) ? !minmax : minmax ) { sign = status; ret = n; retindex = i; } } } if (status != 0) { ST(0) = ST(retindex); XSRETURN(1); } } else if (ix == 4) { UV lo = 0; IV hi = 0; for (ret = i = 0; i < items; i++) { status = _validate_int(aTHX_ ST(i), 2); if (status == 0) break; n = my_svuv(ST(i)); if (status == 1) { hi += (n > (UV_MAX - lo)); } else { if (UV_MAX-n == (UV)IV_MAX) { status = 0; break; } /* IV Overflow */ hi -= ((UV_MAX-n) >= lo); } lo += n; } if (status != 0 && hi != 0) { if (hi == -1 && lo > IV_MAX) XSRETURN_IV((IV)lo); else RETURN_128(hi, lo); } ret = lo; } else if (ix == 5) { int sign = 1; ret = 1; for (i = 0; i < items; i++) { status = _validate_int(aTHX_ ST(i), 2); if (status == 0) break; n = (status == 1) ? my_svuv(ST(i)) : (UV)-my_sviv(ST(i)); if (ret > 0 && n > UV_MAX/ret) { status = 0; break; } sign *= status; ret *= n; } if (sign == -1 && status != 0) { if (ret <= (UV)IV_MAX) XSRETURN_IV(-(IV)ret); else status = 0; } } else { /* 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); /* For min/max, use string compare if not an object */ if ((ix == 2 || ix == 3) && !sv_isobject(ST(0))) { int retindex = 0; int minmax = (ix == 2); STRLEN alen, blen; char *aptr, *bptr; aptr = SvPV(ST(0), alen); (void) strnum_minmax(minmax, 0, 0, aptr, alen); for (i = 1; i < items; i++) { bptr = SvPV(ST(i), blen); if (strnum_minmax(minmax, aptr, alen, bptr, blen)) { aptr = bptr; alen = blen; retindex = i; } } ST(0) = ST(retindex); XSRETURN(1); } switch (ix) { case 0: _vcallsub_with_gmp(0.17,"gcd"); break; case 1: _vcallsub_with_gmp(0.17,"lcm"); break; case 2: _vcallsub_with_gmp(0.00,"vecmin"); break; case 3: _vcallsub_with_gmp(0.00,"vecmax"); break; case 4: _vcallsub_with_pp("vecsum"); break; case 5: default:_vcallsub_with_pp("vecprod"); break; } return; /* skip implicit PUTBACK */ void vecextract(IN SV* x, IN SV* svm) PREINIT: AV* av; UV i = 0; PPCODE: if ((!SvROK(x)) || (SvTYPE(SvRV(x)) != SVt_PVAV)) croak("vecextract first argument must be an array reference"); av = (AV*) SvRV(x); if (SvROK(svm) && SvTYPE(SvRV(svm)) == SVt_PVAV) { AV* avm = (AV*) SvRV(svm); int j, mlen = av_len(avm); for (j = 0; j <= mlen; j++) { SV** iv = av_fetch(avm, j, 0); if (iv && SvTYPE(*iv) == SVt_IV) { SV **v = av_fetch(av, SvIV(*iv), 0); if (v) XPUSHs(*v); } } } else if (_validate_int(aTHX_ svm, 0)) { UV mask = my_svuv(svm); while (mask) { if (mask & 1) { SV** v = av_fetch(av, i, 0); if (v) XPUSHs(*v); } i++; mask >>= 1; } } else { _vcallsubn(aTHX_ GIMME_V, VCALL_PP, "vecextract", items, 0); return; } void chinese(...) PROTOTYPE: @ PREINIT: int i, status; UV ret, *an; SV **psva, **psvn; PPCODE: status = 1; New(0, an, 2*items, UV); ret = 0; for (i = 0; i < items; i++) { AV* av; if (!SvROK(ST(i)) || SvTYPE(SvRV(ST(i))) != SVt_PVAV || av_len((AV*)SvRV(ST(i))) != 1) croak("chinese arguments are two-element array references"); av = (AV*) SvRV(ST(i)); psva = av_fetch(av, 0, 0); psvn = av_fetch(av, 1, 0); if (psva == 0 || psvn == 0 || _validate_int(aTHX_ *psva, 1) != 1 || !_validate_int(aTHX_ *psvn, 0)) { status = 0; break; } an[i+0] = my_svuv(*psva); an[i+items] = my_svuv(*psvn); } if (status) ret = chinese(an, an+items, items, &status); Safefree(an); if (status == -1) XSRETURN_UNDEF; if (status) XSRETURN_UV(ret); psvn = av_fetch((AV*) SvRV(ST(0)), 1, 0); _vcallsub_with_gmpobj(0.32,"chinese"); OBJECTIFY_RESULT( (psvn ? *psvn : 0), ST(0)); return; /* skip implicit PUTBACK */ void lucas_sequence(...) ALIAS: lucasu = 1 lucasv = 2 PREINIT: UV U, V, Qk; PPCODE: if (ix == 1 || ix == 2) { if (items != 3) croak("lucasu: P, Q, k"); if (_validate_int(aTHX_ ST(0), 1) && _validate_int(aTHX_ ST(1), 1) && _validate_int(aTHX_ ST(2), 0)) { IV P = my_sviv(ST(0)); IV Q = my_sviv(ST(1)); UV k = my_svuv(ST(2)); IV ret; int ok = (ix == 1) ? lucasu(&ret, P, Q, k) : lucasv(&ret, P, Q, k); if (ok) XSRETURN_IV(ret); } _vcallsub_with_gmpobj(0.29,(ix==1) ? "lucasu" : "lucasv"); OBJECTIFY_RESULT(ST(2), ST(0)); return; } if (items != 4) croak("lucas_sequence: n, P, Q, k"); if (_validate_int(aTHX_ ST(0), 0) && _validate_int(aTHX_ ST(1), 1) && _validate_int(aTHX_ ST(2), 1) && _validate_int(aTHX_ ST(3), 0)) { lucas_seq(&U, &V, &Qk, my_svuv(ST(0)), my_sviv(ST(1)), my_sviv(ST(2)), my_svuv(ST(3))); PUSHs(sv_2mortal(newSVuv( U ))); /* 4 args in, 3 out, no EXTEND needed */ PUSHs(sv_2mortal(newSVuv( V ))); PUSHs(sv_2mortal(newSVuv( Qk ))); } else { _vcallsubn(aTHX_ GIMME_V, VCALL_PP, "lucas_sequence", items, 0); return; } void is_prime(IN SV* svn) ALIAS: is_prob_prime = 1 is_provable_prime = 2 is_bpsw_prime = 3 is_aks_prime = 4 is_lucas_pseudoprime = 5 is_strong_lucas_pseudoprime = 6 is_extra_strong_lucas_pseudoprime = 7 is_frobenius_underwood_pseudoprime = 8 is_frobenius_khashin_pseudoprime = 9 is_catalan_pseudoprime = 10 is_euler_plumb_pseudoprime = 11 is_ramanujan_prime = 12 is_square_free = 13 is_carmichael = 14 is_quasi_carmichael = 15 is_semiprime = 16 is_square = 17 is_mersenne_prime = 18 is_totient = 19 PREINIT: int status, ret; PPCODE: ret = 0; status = _validate_int(aTHX_ svn, 1); if (status == 1) { UV n = my_svuv(svn); switch (ix) { case 0: case 1: case 2: ret = is_prime(n); break; case 3: ret = BPSW(n); break; case 4: ret = is_aks_prime(n); break; case 5: ret = is_lucas_pseudoprime(n, 0); break; case 6: ret = is_lucas_pseudoprime(n, 1); break; case 7: ret = is_lucas_pseudoprime(n, 3); break; case 8: ret = is_frobenius_underwood_pseudoprime(n); break; case 9: ret = is_frobenius_khashin_pseudoprime(n); break; case 10: ret = is_catalan_pseudoprime(n); break; case 11: ret = is_euler_plumb_pseudoprime(n); break; case 12: ret = is_ramanujan_prime(n); break; case 13: ret = is_square_free(n); break; case 14: ret = is_carmichael(n); break; case 15: ret = is_quasi_carmichael(n); break; case 16: ret = is_semiprime(n); break; case 17: ret = is_power(n,2); break; case 18: ret = is_mersenne_prime(n); if (ret == -1) status = 0; break; case 19: default: ret = is_totient(n); break; } } else if (status == -1) { /* Result for negative inputs will be zero unless changed here */ if (ix == 13) { IV sn = my_sviv(svn); if (sn > -IV_MAX) ret = is_square_free(-sn); else status = 0; } } if (status != 0) RETURN_NPARITY(ret); switch (ix) { case 0: _vcallsub_with_gmp(0.01,"is_prime"); break; case 1: _vcallsub_with_gmp(0.01,"is_prob_prime"); break; case 2: _vcallsub_with_gmp(0.04,"is_provable_prime"); break; case 3: _vcallsub_with_gmp(0.17,"is_bpsw_prime"); break; case 4: _vcallsub_with_gmp(0.16,"is_aks_prime"); break; case 5: _vcallsub_with_gmp(0.01,"is_lucas_pseudoprime"); break; case 6: _vcallsub_with_gmp(0.01,"is_strong_lucas_pseudoprime"); break; case 7: _vcallsub_with_gmp(0.01,"is_extra_strong_lucas_pseudoprime"); break; case 8: _vcallsub_with_gmp(0.13,"is_frobenius_underwood_pseudoprime"); break; case 9: _vcallsub_with_gmp(0.30,"is_frobenius_khashin_pseudoprime"); break; case 10:_vcallsub_with_gmp(0.00,"is_catalan_pseudoprime"); break; case 11:_vcallsub_with_gmp(0.39,"is_euler_plumb_pseudoprime"); break; case 12:_vcallsub_with_gmp(0.00,"is_ramanujan_prime"); break; case 13:_vcallsub_with_gmp(0.00,"is_square_free"); break; case 14:_vcallsub_with_gmp(0.47,"is_carmichael"); break; case 15:_vcallsub_with_gmp(0.00,"is_quasi_carmichael"); break; case 16:_vcallsub_with_gmp(0.42,"is_semiprime"); break; case 17:_vcallsub_with_gmp(0.47,"is_square"); break; case 18:_vcallsub_with_gmp(0.28,"is_mersenne_prime"); break; case 19: default:_vcallsub_with_gmp(0.47,"is_totient"); break; } return; /* skip implicit PUTBACK */ void is_fundamental(IN SV* svn) PREINIT: int status; PPCODE: status = _validate_int(aTHX_ svn, 1); if (status == 1) RETURN_NPARITY(is_fundamental(my_svuv(svn), 0)); if (status == -1) { IV sn = my_sviv(svn); if (sn > -IV_MAX) RETURN_NPARITY(is_fundamental(-sn, 1)); } _vcallsub_with_gmp(0.00,"is_fundamental"); return; void is_power(IN SV* svn, IN UV k = 0, IN SV* svroot = 0) PREINIT: int status; PPCODE: status = _validate_int(aTHX_ svn, 1); if (status != 0) { int ret = 0; UV n = my_svuv(svn); if (status == -1) { IV sn = my_sviv(svn); if (sn <= -IV_MAX) status = 0; else n = -sn; } if (status == 1 || (status == -1 && (k == 0 || k & 1))) { ret = is_power(n, k); if (status == -1 && k == 0) { ret >>= valuation(ret,2); if (ret == 1) ret = 0; } if (ret && svroot != 0) { UV root = rootof(n, k ? k : (UV)ret); if (!SvROK(svroot)) croak("is_power: third argument not a scalar reference"); if (status == 1) sv_setuv(SvRV(svroot), root); else sv_setiv(SvRV(svroot), -root); } } if (status != 0) RETURN_NPARITY(ret); } if (svroot == 0) { _vcallsub_with_gmp(0.28, "is_power"); } else { _vcallsub_with_pp("is_power"); } return; void is_prime_power(IN SV* svn, IN SV* svroot = 0) PREINIT: int status, ret; UV n, root; PPCODE: status = _validate_int(aTHX_ svn, 1); if (status == -1) RETURN_NPARITY(0); if (status != 0) { n = my_svuv(svn); ret = primepower(n, &root); if (ret && svroot != 0) { if (!SvROK(svroot))croak("is_prime_power: second argument not a scalar reference"); sv_setuv(SvRV(svroot), root); } RETURN_NPARITY(ret); } (void)_vcallsubn(aTHX_ G_SCALAR, (svroot == 0) ? (VCALL_GMP|VCALL_PP) : (VCALL_PP), "is_prime_power", items, 40); return; void is_perrin_pseudoprime(IN SV* svn, IN int k = 0) ALIAS: is_almost_extra_strong_lucas_pseudoprime = 1 PREINIT: int status, ret; PPCODE: ret = 0; status = _validate_int(aTHX_ svn, 1); if (status == 1) { UV n = my_svuv(svn); if (ix == 0) ret = is_perrin_pseudoprime(n, k); else ret = is_almost_extra_strong_lucas_pseudoprime(n, (k < 1) ? 1 : k); } if (status != 0) RETURN_NPARITY(ret); if (ix == 0) _vcallsub_with_gmp( (k == 0) ? 0.20 : 0.40, "is_perrin_pseudoprime"); else _vcallsub_with_gmp(0.13,"is_almost_extra_strong_lucas_pseudoprime"); return; void is_frobenius_pseudoprime(IN SV* svn, IN IV P = 0, IN IV Q = 0) PREINIT: int status, ret; PPCODE: ret = 0; status = _validate_int(aTHX_ svn, 1); if (status == 1) { UV n = my_svuv(svn); ret = is_frobenius_pseudoprime(n, P, Q); } if (status != 0) RETURN_NPARITY(ret); _vcallsub_with_gmp(0.24,"is_frobenius_pseudoprime"); return; void is_polygonal(IN SV* svn, IN UV k, IN SV* svroot = 0) PREINIT: int status, result, overflow; UV n, root; PPCODE: if (k < 3) croak("is_polygonal: k must be >= 3"); status = _validate_int(aTHX_ svn, 1); if (status != 0) { overflow = 0; if (status == -1) { result = 0; } else { n = my_svuv(svn); root = polygonal_root(n, k, &overflow); result = (n == 0) || root; } if (!overflow) { if (result && svroot != 0) { if (!SvROK(svroot)) croak("is_polygonal: third argument not a scalar reference"); sv_setuv(SvRV(svroot), root); } RETURN_NPARITY(result); } } if (items != 3) { _vcallsub_with_gmp(0.47, "is_polygonal"); } else { _vcallsub_with_pp("is_polygonal"); } return; void logint(IN SV* svn, IN UV k, IN SV* svret = 0) ALIAS: rootint = 1 PREINIT: int status; UV n, root; PPCODE: status = _validate_int(aTHX_ svn, 1); if (status != 0) { n = my_svuv(svn); if (svret != 0 && !SvROK(svret)) croak("%s: third argument not a scalar reference",(ix==0)?"logint":"rootint"); if (ix == 0) { if (status != 1 || n <= 0) croak("logint: n must be > 0"); if (k <= 1) croak("logint: base must be > 1"); root = logint(n, k); if (svret) sv_setuv(SvRV(svret), ipow(k,root)); } else { if (status == -1) croak("rootint: n must be >= 0"); if (k <= 0) croak("rootint: k must be > 0"); root = rootof(n, k); if (svret) sv_setuv(SvRV(svret), ipow(root,k)); } XSRETURN_UV(root); } switch (ix) { case 0: (void)_vcallsubn(aTHX_ G_SCALAR, (svret == 0) ? (VCALL_GMP|VCALL_PP) : (VCALL_PP), "logint", items, 47); break; case 1: (void)_vcallsubn(aTHX_ G_SCALAR, (svret == 0) ? (VCALL_GMP|VCALL_PP) : (VCALL_PP), "rootint", items, 40); break; default: break; } return; void miller_rabin_random(IN SV* svn, IN IV bases = 1, IN char* seed = 0) PREINIT: int status; dMY_CXT; PPCODE: status = _validate_int(aTHX_ svn, 0); if (bases < 0) croak("miller_rabin_random: number of bases must be positive"); if (status != 0 && seed == 0) { UV n = my_svuv(svn); RETURN_NPARITY( is_mr_random(MY_CXT.randcxt, n, bases) ); } _vcallsub_with_gmp(0.46,"miller_rabin_random"); return; 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 inverse_li = 6 nth_twin_prime = 7 nth_twin_prime_approx = 8 nth_semiprime = 9 nth_semiprime_approx = 10 nth_ramanujan_prime = 11 nth_ramanujan_prime_upper = 12 nth_ramanujan_prime_lower = 13 nth_ramanujan_prime_approx = 14 prime_count_upper = 15 prime_count_lower = 16 prime_count_approx = 17 ramanujan_prime_count_upper = 18 ramanujan_prime_count_lower = 19 twin_prime_count_approx = 20 semiprime_count_approx = 21 urandomm = 22 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 || ix == 6)) || (n >= MPU_MAX_TWIN_PRIME_IDX && (ix==7 || ix==8)) || (n >= MPU_MAX_SEMI_PRIME_IDX && (ix==9 || ix==10)) || (n >= MPU_MAX_RMJN_PRIME_IDX && (ix==11 || ix==12 || ix==13 || ix==14)) ) { /* Out of range. Fall through to Perl. */ } else { UV ret; /* Prev prime of 2 or less should return undef */ if (ix == 1 && n < 3) XSRETURN_UNDEF; /* nth_prime(0) and similar should return undef */ if (n == 0 && (ix >= 2 && ix <= 10 && ix != 6)) XSRETURN_UNDEF; 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 = inverse_li(n); break; case 7: ret = nth_twin_prime(n); break; case 8: ret = nth_twin_prime_approx(n); break; case 9: ret = nth_semiprime(n); break; case 10:ret = nth_semiprime_approx(n); /* Do the following if we need a semiprime returned. */ /* while (!is_semiprime(ret)) ret++; */ break; case 11:ret = nth_ramanujan_prime(n); break; case 12:ret = nth_ramanujan_prime_upper(n); break; case 13:ret = nth_ramanujan_prime_lower(n); break; case 14:ret = nth_ramanujan_prime_approx(n); break; case 15:ret = prime_count_upper(n); break; case 16:ret = prime_count_lower(n); break; case 17:ret = prime_count_approx(n); break; case 18:ret = ramanujan_prime_count_upper(n); break; case 19:ret = ramanujan_prime_count_lower(n); break; case 20:ret = twin_prime_count_approx(n); break; case 21:ret = semiprime_count_approx(n); break; case 22: default:{ dMY_CXT; ret = urandomm64(MY_CXT.randcxt,n); } break; } XSRETURN_UV(ret); } } if ((ix == 0 || ix == 1) && _XS_get_callgmp() && PERL_REVISION >= 5 && PERL_VERSION > 8) { _vcallsub_with_gmpobj(0.01, ix ? "prev_prime" : "next_prime"); OBJECTIFY_RESULT(svn, ST(0)); return; } switch (ix) { case 0: _vcallsub_with_pp("next_prime"); break; case 1: _vcallsub_with_pp("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("inverse_li"); break; case 7: _vcallsub_with_pp("nth_twin_prime"); break; case 8: _vcallsub_with_pp("nth_twin_prime_approx"); break; case 9: _vcallsub_with_pp("nth_semiprime"); break; case 10: _vcallsub_with_pp("nth_semiprime_approx"); break; case 11: _vcallsub_with_pp("nth_ramanujan_prime"); break; case 12: _vcallsub_with_pp("nth_ramanujan_prime_upper"); break; case 13: _vcallsub_with_pp("nth_ramanujan_prime_lower"); break; case 14: _vcallsub_with_pp("nth_ramanujan_prime_approx"); break; case 15: _vcallsub_with_pp("prime_count_upper"); break; case 16: _vcallsub_with_pp("prime_count_lower"); break; case 17: _vcallsub_with_pp("prime_count_approx"); break; case 18: _vcallsub_with_pp("ramanujan_prime_count_upper"); break; case 19: _vcallsub_with_pp("ramanujan_prime_count_lower"); break; case 20: _vcallsub_with_pp("twin_prime_count_approx"); break; case 21: _vcallsub_with_pp("semiprime_count_approx"); break; case 22: default: _vcallsub_with_gmpobj(0.44,"urandomm"); OBJECTIFY_RESULT(svn, ST(0)); break; } return; /* skip implicit PUTBACK */ void urandomb(IN UV bits) ALIAS: random_ndigit_prime = 1 random_semiprime = 2 random_unrestricted_semiprime = 3 random_nbit_prime = 4 random_shawe_taylor_prime = 5 random_maurer_prime = 6 random_proven_prime = 7 random_strong_prime = 8 PREINIT: UV res, minarg; dMY_CXT; void* cs; PPCODE: switch (ix) { case 1: minarg = 1; break; case 2: minarg = 4; break; case 3: minarg = 3; break; case 4: case 5: case 6: case 7: minarg = 2; break; case 8: minarg = 128; break; default: minarg = 0; break; } if (minarg > 0 && bits < minarg) croak("Parameter '%d' must be >= %d", (int)bits, (int)minarg); cs = MY_CXT.randcxt; if (bits <= BITS_PER_WORD) { switch (ix) { case 0: res = urandomb(cs,bits); break; case 1: res = random_ndigit_prime(cs,bits); break; case 2: res = random_semiprime(cs,bits); break; case 3: res = random_unrestricted_semiprime(cs,bits); break; case 4: case 5: case 6: case 7: case 8: default: res = random_nbit_prime(cs,bits); break; } if (res || ix == 0) XSRETURN_UV(res); } switch (ix) { case 0: _vcallsub_with_gmpobj(0.43,"urandomb"); break; case 1: _vcallsub_with_gmpobj(0.42,"random_ndigit_prime"); break; case 2: _vcallsub_with_gmpobj(0.00,"random_semiprime"); break; case 3: _vcallsub_with_gmpobj(0.00,"random_unrestricted_semiprime"); break; case 4: _vcallsub_with_gmpobj(0.42,"random_nbit_prime"); break; case 5: _vcallsub_with_gmpobj(0.43,"random_shawe_taylor_prime"); break; case 6: case 7: _vcallsub_with_gmpobj(0.43,"random_maurer_prime"); break; case 8: default: _vcallsub_with_gmpobj(0.43,"random_strong_prime"); break; } OBJECTIFY_RESULT(ST(0), ST(0)); XSRETURN(1); void random_factored_integer(IN SV* svn) PPCODE: if (_validate_int(aTHX_ svn, 0)) { dMY_CXT; int f, nf, flip; UV r, F[MPU_MAX_FACTORS+1], n = my_svuv(svn); AV* av = newAV(); if (n < 1) croak("random_factored_integer: n must be >= 1"); r = random_factored_integer(MY_CXT.randcxt, n, &nf, F); flip = (F[0] >= F[nf-1]); /* Handle results in either sort order */ for (f = 0; f < nf; f++) av_push(av, newSVuv(F[flip ? nf-1-f : f])); XPUSHs(sv_2mortal(newSVuv( r ))); XPUSHs(sv_2mortal(newRV_noinc( (SV*) av ))); } else { (void)_vcallsubn(aTHX_ G_ARRAY, VCALL_PP, "random_factored_integer",items,0); return; } void Pi(IN UV digits = 0) PREINIT: #ifdef USE_QUADMATH #define STRTONV(t) strtoflt128(t,NULL) const UV mantsize = FLT128_DIG; const NV pival = 3.141592653589793238462643383279502884197169Q; #elif defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) #define STRTONV(t) strtold(t,NULL) const UV mantsize = LDBL_DIG; const NV pival = 3.141592653589793238462643383279502884197169L; #else #define STRTONV(t) strtod(t,NULL) const UV mantsize = DBL_DIG; const NV pival = 3.141592653589793238462643383279502884197169; #endif PPCODE: if (digits == 0) { XSRETURN_NV( pival ); } else if (digits <= mantsize) { char* out = pidigits(digits); NV pi = STRTONV(out); Safefree(out); XSRETURN_NV( pi ); } else { _vcallsub_with_pp("Pi"); return; } void _pidigits(IN int digits) PREINIT: char* out; PPCODE: if (digits <= 0) XSRETURN_EMPTY; out = pidigits(digits); XPUSHs(sv_2mortal(newSVpvn(out, digits+1))); Safefree(out); void factor(IN SV* svn) ALIAS: factor_exp = 1 divisors = 2 inverse_totient = 3 PREINIT: U32 gimme_v; int status, i, nfactors, it_overflow; PPCODE: gimme_v = GIMME_V; status = _validate_int(aTHX_ svn, 0); it_overflow = (status == 1 && ix==3 && gimme_v == G_ARRAY && my_svuv(svn) > UV_MAX/7.5 ); if (status == 1 && !it_overflow) { UV factors[MPU_MAX_FACTORS+1]; UV exponents[MPU_MAX_FACTORS+1]; UV n = my_svuv(svn); if (gimme_v == G_SCALAR) { UV res; switch (ix) { case 0: res = factor(n, factors); break; case 1: res = factor_exp(n, factors, 0); break; case 2: res = divisor_sum(n, 0); break; default: res = inverse_totient_count(n); break; } PUSHs(sv_2mortal(newSVuv( res ))); } 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; case 2: { UV ndivisors; UV* divs = _divisor_list(n, &ndivisors); EXTEND(SP, (IV)ndivisors); for (i = 0; (UV)i < ndivisors; i++) PUSHs(sv_2mortal(newSVuv( divs[i] ))); Safefree(divs); } break; default: { UV ntotients; UV* tots = inverse_totient_list(&ntotients, n); EXTEND(SP, (IV)ntotients); for (i = 0; (UV)i < ntotients; i++) PUSHs(sv_2mortal(newSVuv( tots[i] ))); Safefree(tots); } break; } } } else { switch (ix) { case 0: _vcallsubn(aTHX_ gimme_v, VCALL_ROOT, "_generic_factor", 1, 0); break; case 1: _vcallsubn(aTHX_ gimme_v, VCALL_ROOT, "_generic_factor_exp", 1, 0); break; case 2: _vcallsubn(aTHX_ gimme_v, VCALL_GMP|VCALL_PP, "divisors", 1, 0); break; default: _vcallsubn(aTHX_ gimme_v, VCALL_GMP|VCALL_PP, "inverse_totient", 1, 0); 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) >= 0)) ? 1 : 0; /* The above doesn't understand small bigints */ if (nstatus == 1 && kstatus == 0 && SvROK(svk) && (sv_isa(svk, "Math::BigInt") || sv_isa(svk, "Math::GMP") || sv_isa(svk, "Math::GMPz"))) kstatus = _validate_int(aTHX_ svk, 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(0.00,"divisor_sum"); return; /* skip implicit PUTBACK */ void znorder(IN SV* sva, IN SV* svn) ALIAS: binomial = 1 jordan_totient = 2 ramanujan_sum = 3 factorialmod = 4 legendre_phi = 5 PREINIT: int astatus, nstatus; PPCODE: astatus = _validate_int(aTHX_ sva, (ix==1) ? 2 : 0); nstatus = _validate_int(aTHX_ svn, (ix==1) ? 2 : 0); if (astatus != 0 && nstatus != 0) { UV a = my_svuv(sva); UV n = my_svuv(svn); UV ret; switch (ix) { case 0: ret = znorder(a, n); break; case 1: if ( (astatus == 1 && (nstatus == -1 || n > a)) || (astatus ==-1 && (nstatus == -1 && n > a)) ) { ret = 0; break; } if (nstatus == -1) n = a - n; /* n<0,k<=n: (-1)^(n-k) * binomial(-k-1,n-k) */ if (astatus == -1) { ret = binomial( -my_sviv(sva)+n-1, n ); if (ret > 0 && ret <= (UV)IV_MAX) XSRETURN_IV( (IV)ret * ((n&1) ? -1 : 1) ); goto overflow; } else { ret = binomial(a, n); if (ret == 0) goto overflow; } break; case 2: ret = jordan_totient(a, n); if (ret == 0 && n > 1) goto overflow; break; case 3: if (a < 1 || n < 1) XSRETURN_IV(0); { UV g = a / gcd_ui(a,n); int m = moebius(g); if (m == 0 || a == g) RETURN_NPARITY(m); XSRETURN_IV( m * (totient(a) / totient(g)) ); } break; case 4: ret = factorialmod(a, n); break; case 5: default: ret = legendre_phi(a, n); break; } if (ret == 0 && ix == 0) XSRETURN_UNDEF; /* not defined */ XSRETURN_UV(ret); } overflow: switch (ix) { case 0: _vcallsub_with_pp("znorder"); break; case 1: _vcallsub_with_pp("binomial"); break; case 2: _vcallsub_with_pp("jordan_totient"); break; case 3: _vcallsub_with_pp("ramanujan_sum"); break; case 4: _vcallsub_with_pp("factorialmod"); break; case 5: default: _vcallsub_with_pp("legendre_phi"); break; } return; /* skip implicit PUTBACK */ void znlog(IN SV* sva, IN SV* svg, IN SV* svp) ALIAS: addmod = 1 mulmod = 2 divmod = 3 powmod = 4 PREINIT: int astatus, gstatus, pstatus, retundef; UV ret; PPCODE: astatus = _validate_int(aTHX_ sva, (ix == 0) ? 0 : 1); gstatus = _validate_int(aTHX_ svg, (ix == 0) ? 0 : 1); pstatus = _validate_int(aTHX_ svp, 0); if (astatus != 0 && gstatus != 0 && pstatus == 1) { UV a, g, p = my_svuv(svp); if (p <= 1) XSRETURN_UV(0); ret = 0; retundef = 0; a = (astatus == 1) ? my_svuv(sva) : negmod(my_sviv(sva), p); g = (gstatus == 1) ? my_svuv(svg) : negmod(my_sviv(svg), p); if (a >= p) a %= p; if (g >= p && ix != 4) g %= p; switch (ix) { case 0: ret = znlog(a, g, p); if (ret == 0 && a > 1) retundef = 1; if (ret == 0 && (a == 0 || g == 0)) retundef = 1; break; case 1: ret = addmod(a, g, p); break; case 2: ret = mulmod(a, g, p); break; case 3: g = modinverse(g, p); if (g == 0) retundef = 1; else ret = mulmod(a, g, p); break; case 4: default:if (a == 0) { ret = (g == 0); retundef = (gstatus == -1); } else { if (gstatus == -1) { a = modinverse(a, p); if (a == 0) retundef = 1; else g = -my_sviv(svg); } ret = powmod(a, g, p); } break; } if (retundef) XSRETURN_UNDEF; XSRETURN_UV(ret); } switch (ix) { case 0: _vcallsub_with_gmpobj(0.00,"znlog"); break; case 1: _vcallsub_with_gmpobj(0.36,"addmod"); break; case 2: _vcallsub_with_gmpobj(0.36,"mulmod"); break; case 3: _vcallsub_with_gmpobj(0.36,"divmod"); break; case 4: default:_vcallsub_with_gmpobj(0.36,"powmod"); break; } OBJECTIFY_RESULT(svp, ST(items-1)); return; /* skip implicit PUTBACK */ void kronecker(IN SV* sva, IN SV* svb) ALIAS: valuation = 1 invmod = 2 sqrtmod = 3 is_primitive_root = 4 PREINIT: int astatus, bstatus, abpositive, abnegative; PPCODE: astatus = _validate_int(aTHX_ sva, 2); bstatus = _validate_int(aTHX_ svb, 2); if (astatus != 0 && bstatus != 0) { if (ix == 0) { /* Are both a and b positive? */ abpositive = astatus == 1 && bstatus == 1; /* Will both fit in IVs? We should use a bitmask return. */ abnegative = !abpositive && (SvIOK(sva) && !SvIsUV(sva)) && (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); } } else if (ix == 1) { UV n = (astatus == -1) ? (UV)(-(my_sviv(sva))) : my_svuv(sva); UV k = (bstatus == -1) ? (UV)(-(my_sviv(svb))) : my_svuv(svb); /* valuation of 0-2 is very common, so return a constant if possible */ RETURN_NPARITY( valuation(n, k) ); } else if (ix == 2) { UV a, n, ret = 0; n = (bstatus != -1) ? my_svuv(svb) : (UV)(-(my_sviv(svb))); if (n > 0) { a = (astatus == 1) ? my_svuv(sva) : negmod(my_sviv(sva), n); if (a > 0) { if (n == 1) XSRETURN_UV(0); ret = modinverse(a, n); } } if (ret == 0) XSRETURN_UNDEF; XSRETURN_UV(ret); } else if (ix == 3) { UV a, n, s; n = (bstatus != -1) ? my_svuv(svb) : (UV)(-(my_sviv(svb))); a = (n == 0) ? 0 : (astatus != -1) ? my_svuv(sva) % n : negmod(my_sviv(sva), n); if (is_prob_prime(n)) { if (!sqrtmod(&s, a, n)) XSRETURN_UNDEF; } else { if (!sqrtmod_composite(&s, a, n)) XSRETURN_UNDEF; } XSRETURN_UV(s); } else { UV a, n; n = (bstatus != -1) ? my_svuv(svb) : (UV)(-(my_sviv(svb))); a = (n == 0) ? 0 : (astatus != -1) ? my_svuv(sva) % n : negmod(my_sviv(sva), n); RETURN_NPARITY( is_primitive_root(a,n,0) ); } } switch (ix) { case 0: _vcallsub_with_gmp(0.17,"kronecker"); break; case 1: _vcallsub_with_gmp(0.20,"valuation"); break; case 2: _vcallsub_with_gmp(0.20,"invmod"); break; case 3: _vcallsub_with_gmp(0.36,"sqrtmod"); break; case 4: default: _vcallsub_with_gmp(0.36,"is_primitive_root"); break; } return; /* skip implicit PUTBACK */ void gcdext(IN SV* sva, IN SV* svb) PREINIT: int astatus, bstatus; PPCODE: astatus = _validate_int(aTHX_ sva, 2); bstatus = _validate_int(aTHX_ svb, 2); /* TODO: These should be built into validate_int */ if ( (astatus == 1 && SvIsUV(sva)) || (astatus == -1 && !SvIOK(sva)) ) astatus = 0; /* too large */ if ( (bstatus == 1 && SvIsUV(svb)) || (bstatus == -1 && !SvIOK(svb)) ) bstatus = 0; /* too large */ if (astatus != 0 && bstatus != 0) { IV u, v, d; IV a = my_sviv(sva); IV b = my_sviv(svb); d = gcdext(a, b, &u, &v, 0, 0); XPUSHs(sv_2mortal(newSViv( u ))); XPUSHs(sv_2mortal(newSViv( v ))); XPUSHs(sv_2mortal(newSViv( d ))); } else { _vcallsubn(aTHX_ GIMME_V, VCALL_PP, "gcdext", items, 0); return; /* skip implicit PUTBACK */ } void stirling(IN UV n, IN UV m, IN UV type = 1) PPCODE: if (type != 1 && type != 2 && type != 3) croak("stirling type must be 1, 2, or 3"); if (n == m) XSRETURN_UV(1); else if (n == 0 || m == 0 || m > n) XSRETURN_UV(0); else if (type == 3) { UV s = stirling3(n, m); if (s != 0) XSRETURN_UV(s); } else if (type == 2) { IV s = stirling2(n, m); if (s != 0) XSRETURN_IV(s); } else if (type == 1) { IV s = stirling1(n, m); if (s != 0) XSRETURN_IV(s); } _vcallsub_with_gmpobj(0.26,"stirling"); OBJECTIFY_RESULT(ST(0), ST(0)); return; NV _XS_ExponentialIntegral(IN SV* x) ALIAS: _XS_LogarithmicIntegral = 1 _XS_RiemannZeta = 2 _XS_RiemannR = 3 _XS_LambertW = 4 PREINIT: NV nv, ret; CODE: nv = SvNV(x); switch (ix) { case 0: ret = Ei(nv); break; case 1: ret = Li(nv); break; case 2: ret = (NV) ld_riemann_zeta(nv); break; case 3: ret = (NV) RiemannR(nv); break; case 4: default:ret = lambertw(nv); break; } RETVAL = ret; OUTPUT: RETVAL void euler_phi(IN SV* svlo, IN SV* svhi = 0) ALIAS: moebius = 1 PREINIT: int lostatus, histatus; PPCODE: lostatus = _validate_int(aTHX_ svlo, 2); histatus = (svhi == 0 || _validate_int(aTHX_ svhi, 1)); if (svhi == 0 && lostatus != 0) { /* input is a single value and in UV/IV range */ if (ix == 0) { UV ret = (lostatus == -1) ? 0 : totient(my_svuv(svlo)); XSRETURN_UV(ret); } 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(svhi); if (lo <= hi) { UV i, count = hi - lo + 1; EXTEND(SP, (IV)count); if (ix == 0) { UV arrlo = (lo < 100) ? 0 : lo; UV *totients = range_totient(arrlo, hi); for (i = 0; i < count; i++) PUSHs(sv_2mortal(newSVuv(totients[i+lo-arrlo]))); Safefree(totients); } else { signed char* mu = range_moebius(lo, hi); dMY_CXT; for (i = 0; i < count; i++) PUSH_NPARITY(mu[i]); Safefree(mu); } } } else { /* Whatever we didn't handle above */ U32 gimme_v = GIMME_V; I32 flags = VCALL_PP; if (ix == 1 && lostatus == 1 && histatus == 1) flags |= VCALL_GMP; switch (ix) { case 0: _vcallsubn(aTHX_ gimme_v, flags, "euler_phi", items, 22);break; case 1: default: _vcallsubn(aTHX_ gimme_v, flags, "moebius", items, 22); break; } return; } void carmichael_lambda(IN SV* svn) ALIAS: mertens = 1 liouville = 2 chebyshev_theta = 3 chebyshev_psi = 4 factorial = 5 sqrtint = 6 exp_mangoldt = 7 znprimroot = 8 hammingweight = 9 hclassno = 10 is_pillai = 11 ramanujan_tau = 12 PREINIT: int status; PPCODE: status = _validate_int(aTHX_ svn, (ix >= 7) ? 1 : 0); if (status != 0) { UV r, n = my_svuv(svn); switch (ix) { case 0: XSRETURN_UV(carmichael_lambda(n)); break; case 1: XSRETURN_IV(mertens(n)); break; case 2: { UV factors[MPU_MAX_FACTORS+1]; int nfactors = factor(my_svuv(svn), factors); RETURN_NPARITY( (nfactors & 1) ? -1 : 1 ); } break; case 3: XSRETURN_NV(chebyshev_theta(n)); break; case 4: XSRETURN_NV(chebyshev_psi(n)); break; case 5: r = factorial(n); if (r != 0) XSRETURN_UV(r); status = 0; break; case 6: XSRETURN_UV(isqrt(n)); break; case 7: XSRETURN_UV( (status == -1) ? 1 : exp_mangoldt(n) ); break; case 8: if (status == -1) n = -(IV)n; r = znprimroot(n); if (r == 0 && n != 1) XSRETURN_UNDEF; /* No root */ XSRETURN_UV(r); break; case 9: if (status == -1) n = -(IV)n; XSRETURN_UV(popcnt(n)); break; case 10: XSRETURN_IV( (status == -1) ? 0 : hclassno(n) ); break; case 11: RETURN_NPARITY( (status == -1) ? 0 : pillai_v(n) ); break; case 12: default: { IV tau = (status == 1) ? ramanujan_tau(n) : 0; if (tau != 0 || status == -1 || n == 0) XSRETURN_IV(tau); } /* Fall through if n > 0 and we got 0 back */ break; } } switch (ix) { case 0: _vcallsub_with_gmp(0.22,"carmichael_lambda"); break; case 1: _vcallsub_with_pp("mertens"); break; case 2: _vcallsub_with_gmp(0.22,"liouville"); break; case 3: _vcallsub_with_pp("chebyshev_theta"); break; case 4: _vcallsub_with_pp("chebyshev_psi"); break; case 5: _vcallsub_with_pp("factorial"); break; case 6: _vcallsub_with_pp("sqrtint"); break; case 7: _vcallsub_with_gmp(0.19,"exp_mangoldt"); break; case 8: _vcallsub_with_gmp(0.22,"znprimroot"); break; case 9: if (_XS_get_callgmp() >= 47) { /* Very fast */ _vcallsub_with_gmp(0.47,"hammingweight"); } else { /* Better than PP */ char* ptr; STRLEN len; ptr = SvPV(svn, len); XSRETURN_UV(mpu_popcount_string(ptr, len)); } break; case 10: _vcallsub_with_pp("hclassno"); break; case 11: _vcallsub_with_gmp(0.00,"is_pillai"); break; case 12: default: _vcallsub_with_pp("ramanujan_tau"); break; } return; /* skip implicit PUTBACK */ void numtoperm(IN UV n, IN SV* svk) PREINIT: UV k; int i, S[32]; PPCODE: if (n == 0) XSRETURN_EMPTY; if (n < 32 && _validate_int(aTHX_ svk, 1) == 1) { k = my_svuv(svk); if (num_to_perm(k, n, S)) { dMY_CXT; EXTEND(SP, (IV)n); for (i = 0; i < (int)n; i++) PUSH_NPARITY( S[i] ); XSRETURN(n); } } _vcallsubn(aTHX_ GIMME_V, VCALL_PP|VCALL_GMP, "numtoperm", items, 47); return; void permtonum(IN SV* svp) PREINIT: AV *av; UV val, num; int plen, i; PPCODE: if ((!SvROK(svp)) || (SvTYPE(SvRV(svp)) != SVt_PVAV)) croak("permtonum argument must be an array reference"); av = (AV*) SvRV(svp); plen = av_len(av); if (plen < 32) { int V[32], A[32] = {0}; for (i = 0; i <= plen; i++) { SV **iv = av_fetch(av, i, 0); if (iv == 0 || _validate_int(aTHX_ *iv, 1) != 1) break; val = my_svuv(*iv); if (val > (UV)plen || A[val] != 0) break; A[val] = i+1; V[i] = val; } if (i > plen && perm_to_num(plen+1, V, &num)) XSRETURN_UV(num); } _vcallsub_with_gmpobj(0.47,"permtonum"); OBJECTIFY_RESULT(ST(0), ST(0)); XSRETURN(1); void randperm(IN UV n, IN UV k = 0) PREINIT: UV i, *S; dMY_CXT; PPCODE: if (items == 1) k = n; if (k > n) k = n; if (k == 0) XSRETURN_EMPTY; New(0, S, k, UV); randperm(MY_CXT.randcxt, n, k, S); EXTEND(SP, (IV)k); for (i = 0; i < k; i++) { if (n < 2*CINTS) PUSH_NPARITY(S[i]); else PUSHs(sv_2mortal(newSVuv(S[i]))); } Safefree(S); void shuffle(...) PROTOTYPE: @ PREINIT: int i, j; void* randcxt; dMY_CXT; PPCODE: if (items == 0) XSRETURN_EMPTY; for (i = 0, randcxt = MY_CXT.randcxt; i < items-1; i++) { j = urandomm32(randcxt, items-i); { SV* t = ST(i); ST(i) = ST(i+j); ST(i+j) = t; } } XSRETURN(items); void sumdigits(SV* svn, UV ibase = 255) PREINIT: UV base, sum; STRLEN i, len; const char* s; PPCODE: base = (ibase == 255) ? 10 : ibase; if (base < 2 || base > 36) croak("sumdigits: invalid base %"UVuf, base); sum = 0; /* faster for integer input in base 10 */ if (base == 10 && SVNUMTEST(svn) && (SvIsUV(svn) || SvIVX(svn) >= 0)) { UV n, t = my_svuv(svn); while ((n=t)) { t = n / base; sum += n - base*t; } XSRETURN_UV(sum); } s = SvPV(svn, len); /* If no base given and input is 0x... or 0b..., select base. */ if (ibase == 255 && len > 2 && s[0] == '0' && (s[1] == 'x' || s[1] == 'b')){ base = (s[1] == 'x') ? 16 : 2; s += 2; len -= 2; } for (i = 0; i < len; i++) { UV d = 0; const char c = s[i]; if (c >= '0' && c <= '9') { d = c - '0'; } else if (c >= 'a' && c <= 'z') { d = c - 'a' + 10; } else if (c >= 'A' && c <= 'Z') { d = c - 'A' + 10; } if (d < base) sum += d; } XSRETURN_UV(sum); void todigits(SV* svn, int base=10, int length=-1) ALIAS: todigitstring = 1 fromdigits = 2 PREINIT: int i, status; UV n; char *str; PPCODE: if (base < 2) croak("invalid base: %d", base); status = 0; if (ix == 0 || ix == 1) { status = _validate_int(aTHX_ svn, 1); n = (status == 0) ? 0 : status * my_svuv(svn); } /* todigits with native input */ if (ix == 0 && status != 0 && length < 128) { int digits[128]; IV len = to_digit_array(digits, n, base, length); if (len >= 0) { dMY_CXT; EXTEND(SP, len); for (i = 0; i < len; i++) PUSH_NPARITY( digits[len-i-1] ); XSRETURN(len); } } /* todigitstring with native input */ if (ix == 1 && status != 0 && length < 128) { char s[128+1]; IV len = to_digit_string(s, n, base, length); if (len >= 0) { XPUSHs(sv_2mortal(newSVpv(s, len))); XSRETURN(1); } } /* todigits or todigitstring base 10 (large size) */ if ((ix == 0 || ix == 1) && base == 10 && length < 0) { STRLEN len; str = SvPV(svn, len); if (ix == 1) { XPUSHs(sv_2mortal(newSVpv(str, len))); XSRETURN(1); } if (len == 1 && str[0] == '0') XSRETURN(0); { dMY_CXT; EXTEND(SP, (IV)len); for (i = 0; i < (int)len; i++) PUSH_NPARITY(str[i]-'0'); } XSRETURN(len); } if (ix == 2) { /* fromdigits */ if (!SvROK(svn)) { /* string */ if (from_digit_string(&n, SvPV_nolen(svn), base)) { XSRETURN_UV(n); } } else if (!_is_sv_bigint(aTHX_ svn)) { /* array ref of digits */ UV* r = 0; int len = arrayref_to_int_array(aTHX_ &r, (AV*) SvRV(svn), base); if (from_digit_to_UV(&n, r, len, base)) { Safefree(r); XSRETURN_UV(n); } else if (from_digit_to_str(&str, r, len, base)){ Safefree(r); XPUSHs( sv_to_bigint(aTHX_ sv_2mortal(newSVpv(str,0))) ); Safefree(str); XSRETURN(1); } Safefree(r); } } switch (ix) { case 0: _vcallsubn(aTHX_ GIMME_V, VCALL_GMP|VCALL_PP, "todigits", items, 41); break; case 1: _vcallsub_with_gmp(0.00,"todigitstring"); break; case 2: default: _vcallsub_with_gmp(0.00,"fromdigits"); break; } return; 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 lastfor() PREINIT: dMY_CXT; PPCODE: /* printf("last for with count = %u\n", MY_CXT.forcount); */ if (MY_CXT.forcount == 0) croak("lastfor called outside a loop"); MY_CXT.forexit = 1; /* In some ideal world this would also act like a last */ return; #define START_FORCOUNT \ do { \ oldforloop = ++MY_CXT.forcount; \ oldforexit = MY_CXT.forexit; \ forexit = &MY_CXT.forexit; \ *forexit = 0; \ } while(0) #define CHECK_FORCOUNT \ if (*forexit) break; #define END_FORCOUNT \ do { \ /* Put back outer loop's exit request, if any. */ \ *forexit = oldforexit; \ /* Ensure loops are nested and not woven. */ \ if (MY_CXT.forcount-- != oldforloop) croak("for loop mismatch"); \ } while (0) #define DECL_FORCOUNT \ uint16_t oldforloop; \ char oldforexit; \ char *forexit 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; DECL_FORCOUNT; dMY_CXT; 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, 0); return; } if (items < 3) { beg = 2; end = my_svuv(svbeg); } else { beg = my_svuv(svbeg); end = my_svuv(svend); } START_FORCOUNT; SAVESPTR(GvSV(PL_defgv)); svarg = newSVuv(beg); 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); CHECK_FORCOUNT; } 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)) { CHECK_FORCOUNT; sv_setuv(svarg, beg); { ENTER; MULTICALL; LEAVE; } } } else { /* MULTICALL segment sieve */ void* ctx = start_segment_primes(beg, end, &segment); while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { int crossuv = (seg_high > IV_MAX) && !SvIsUV(svarg); START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_base, seg_low, seg_high ) CHECK_FORCOUNT; /* sv_setuv(svarg, p); */ if (SvTYPE(svarg) != SVt_IV) { sv_setuv(svarg, p); } else if (crossuv && p > IV_MAX) { sv_setuv(svarg, p); crossuv=0; } else { SvUV_set(svarg, p); } { ENTER; MULTICALL; LEAVE; } END_DO_FOR_EACH_SIEVE_PRIME CHECK_FORCOUNT; } 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_base, seg_low, seg_high ) CHECK_FORCOUNT; sv_setuv(svarg, p); PUSHMARK(SP); call_sv((SV*)cv, G_VOID|G_DISCARD); END_DO_FOR_EACH_SIEVE_PRIME CHECK_FORCOUNT; } end_segment_primes(ctx); } SvREFCNT_dec(svarg); END_FORCOUNT; #define FORCOMPTEST(ix,n) \ ( (ix==1) || (ix==0 && n&1) ) void foroddcomposites (SV* block, IN SV* svbeg, IN SV* svend = 0) ALIAS: forcomposites = 1 PROTOTYPE: &$;$ PREINIT: UV beg, end; GV *gv; HV *stash; SV* svarg; /* We use svarg to prevent clobbering $_ outside the block */ CV *cv; DECL_FORCOUNT; dMY_CXT; 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, (ix == 0) ? "_generic_foroddcomposites" : "_generic_forcomposites", items, 0); return; } if (items < 3) { beg = ix ? 4 : 9; end = my_svuv(svbeg); } else { beg = my_svuv(svbeg); end = my_svuv(svend); } START_FORCOUNT; SAVESPTR(GvSV(PL_defgv)); svarg = newSVuv(0); GvSV(PL_defgv) = svarg; #if USE_MULTICALL if (!CvISXSUB(cv) && end >= beg) { unsigned char* segment; UV seg_base, seg_low, seg_high, c, cbeg, cend, cinc, prevprime, nextprime; void* ctx; dMULTICALL; I32 gimme = G_VOID; PUSH_MULTICALL(cv); if (beg >= MPU_MAX_PRIME || #if BITS_PER_WORD == 64 (beg >= UVCONST( 100000000000000) && end-beg < 120000) || (beg >= UVCONST( 10000000000000) && end-beg < 50000) || (beg >= UVCONST( 1000000000000) && end-beg < 20000) || #endif end-beg < 1000 ) { beg = (beg <= 4) ? 3 : beg-1; nextprime = next_prime(beg); while (beg++ < end) { if (beg == nextprime) nextprime = next_prime(beg); else if (FORCOMPTEST(ix,beg)) { sv_setuv(svarg, beg); { ENTER; MULTICALL; LEAVE; } } CHECK_FORCOUNT; } } else { if (!ix) { if (beg < 8) beg = 8; } else if (beg <= 4) { /* sieve starts at 7, so handle this here */ sv_setuv(svarg, 4); { ENTER; MULTICALL; LEAVE; } beg = 6; } /* Find the two primes that bound their interval. */ /* beg must be < max_prime, and end >= max_prime is special. */ prevprime = prev_prime(beg); nextprime = (end >= MPU_MAX_PRIME) ? MPU_MAX_PRIME : next_prime(end); ctx = start_segment_primes(beg, nextprime, &segment); while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { int crossuv = (seg_high > IV_MAX) && !SvIsUV(svarg); START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_base, seg_low, seg_high ) cbeg = prevprime+1; if (cbeg < beg) cbeg = beg - (ix == 0 && (beg % 2)); prevprime = p; cend = prevprime-1; if (cend > end) cend = end; /* If ix=0, skip evens by starting 1 farther and skipping by 2 */ cinc = 1 + (ix==0); for (c = cbeg + (ix==0); c <= cend; c += cinc) { CHECK_FORCOUNT; if (SvTYPE(svarg) != SVt_IV) { sv_setuv(svarg,c); } else if (crossuv && c > IV_MAX) { sv_setuv(svarg,c); crossuv=0;} else { SvUV_set(svarg,c); } { ENTER; MULTICALL; LEAVE; } } END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); if (end > nextprime) /* Complete the case where end > max_prime */ while (nextprime++ < end) if (FORCOMPTEST(ix,nextprime)) { CHECK_FORCOUNT; sv_setuv(svarg, nextprime); { ENTER; MULTICALL; LEAVE; } } } FIX_MULTICALL_REFCOUNT; POP_MULTICALL; } else #endif if (beg <= end) { beg = (beg <= 4) ? 3 : beg-1; while (beg++ < end) { if (FORCOMPTEST(ix,beg) && !is_prob_prime(beg)) { sv_setuv(svarg, beg); PUSHMARK(SP); call_sv((SV*)cv, G_VOID|G_DISCARD); CHECK_FORCOUNT; } } } SvREFCNT_dec(svarg); END_FORCOUNT; void forsemiprimes (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; DECL_FORCOUNT; dMY_CXT; 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_forsemiprimes", items, 0); return; } if (items < 3) { beg = 4; end = my_svuv(svbeg); } else { beg = my_svuv(svbeg); end = my_svuv(svend); } if (beg < 4) beg = 4; if (end > MPU_MAX_SEMI_PRIME) end = MPU_MAX_SEMI_PRIME; START_FORCOUNT; SAVESPTR(GvSV(PL_defgv)); svarg = newSVuv(0); GvSV(PL_defgv) = svarg; #if USE_MULTICALL if (!CvISXSUB(cv) && end >= beg) { UV c, seg_beg, seg_end, *S, count; dMULTICALL; I32 gimme = G_VOID; PUSH_MULTICALL(cv); if (beg >= MPU_MAX_SEMI_PRIME || #if BITS_PER_WORD == 64 (beg >= UVCONST(10000000000000000000) && end-beg < 1400000) || (beg >= UVCONST( 1000000000000000000) && end-beg < 950000) || (beg >= UVCONST( 100000000000000000) && end-beg < 440000) || (beg >= UVCONST( 10000000000000000) && end-beg < 240000) || (beg >= UVCONST( 1000000000000000) && end-beg < 65000) || (beg >= UVCONST( 100000000000000) && end-beg < 29000) || (beg >= UVCONST( 10000000000000) && end-beg < 11000) || (beg >= UVCONST( 1000000000000) && end-beg < 5000) || #endif end-beg < 200 ) { beg = (beg <= 4) ? 3 : beg-1; while (beg++ < end) { if (is_semiprime(beg)) { sv_setuv(svarg, beg); { ENTER; MULTICALL; LEAVE; } } CHECK_FORCOUNT; } } else { while (beg < end) { seg_beg = beg; seg_end = end; if ((seg_end - seg_beg) > 50000000) seg_end = seg_beg + 50000000 - 1; count = range_semiprime_sieve(&S, seg_beg, seg_end); for (c = 0; c < count; c++) { sv_setuv(svarg, S[c]); { ENTER; MULTICALL; LEAVE; } CHECK_FORCOUNT; } Safefree(S); beg = seg_end+1; CHECK_FORCOUNT; } } FIX_MULTICALL_REFCOUNT; POP_MULTICALL; } else #endif if (beg <= end) { beg = (beg <= 4) ? 3 : beg-1; while (beg++ < end) { if (is_semiprime(beg)) { sv_setuv(svarg, beg); PUSHMARK(SP); call_sv((SV*)cv, G_VOID|G_DISCARD); CHECK_FORCOUNT; } } } SvREFCNT_dec(svarg); END_FORCOUNT; 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; DECL_FORCOUNT; dMY_CXT; 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, 0); return; } n = my_svuv(svn); divs = _divisor_list(n, &ndivisors); START_FORCOUNT; 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]); { ENTER; MULTICALL; LEAVE; } CHECK_FORCOUNT; } 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); CHECK_FORCOUNT; } } SvREFCNT_dec(svarg); Safefree(divs); END_FORCOUNT; void forpart (SV* block, IN SV* svn, IN SV* svh = 0) ALIAS: forcomp = 1 PROTOTYPE: &$;$ PREINIT: UV i, n, amin, amax, nmin, nmax; int primeq; GV *gv; HV *stash; CV *cv; SV** svals; DECL_FORCOUNT; dMY_CXT; PPCODE: cv = sv_2cv(block, &stash, &gv, 0); if (cv == Nullcv) croak("Not a subroutine reference"); if (!_validate_int(aTHX_ svn, 0)) { _vcallsub_with_pp("forpart"); return; } n = my_svuv(svn); if (n > (UV_MAX-2)) croak("forpart argument overflow"); New(0, svals, n+1, SV*); for (i = 0; i <= n; i++) { svals[i] = newSVuv(i); SvREADONLY_on(svals[i]); } amin = 1; amax = n; nmin = 1; nmax = n; primeq = -1; if (svh != 0) { HV* rhash; SV** svp; if (!SvROK(svh) || SvTYPE(SvRV(svh)) != SVt_PVHV) croak("forpart second argument must be a hash reference"); rhash = (HV*) SvRV(svh); if ((svp = hv_fetchs(rhash, "n", 0)) != NULL) { nmin = my_svuv(*svp); nmax = nmin; } if ((svp = hv_fetchs(rhash, "amin", 0)) != NULL) amin = my_svuv(*svp); if ((svp = hv_fetchs(rhash, "amax", 0)) != NULL) amax = my_svuv(*svp); if ((svp = hv_fetchs(rhash, "nmin", 0)) != NULL) nmin = my_svuv(*svp); if ((svp = hv_fetchs(rhash, "nmax", 0)) != NULL) nmax = my_svuv(*svp); if ((svp = hv_fetchs(rhash, "prime",0)) != NULL) primeq=my_svuv(*svp); if (amin < 1) amin = 1; if (amax > n) amax = n; if (nmin < 1) nmin = 1; if (nmax > n) nmax = n; if (primeq != 0 && primeq != -1) primeq = 2; /* -1, 0, or 2 */ } if (primeq == 2) { UV prev = prev_prime(amax+1); UV next = amin <= 2 ? 2 : next_prime(amin-1); if (amin < next) amin = next; if (amax > prev) amax = prev; } if (n==0 && nmin <= 1) { { PUSHMARK(SP); /* Nothing */ PUTBACK; call_sv((SV*)cv, G_VOID|G_DISCARD); SPAGAIN; } } if (n >= nmin && nmin <= nmax && amin <= amax && nmax > 0 && amax > 0) { /* RuleAsc algorithm from Kelleher and O'Sullivan 2009/2014) */ UV *a, k, x, y, r; New(0, a, n+1, UV); k = 1; a[0] = amin-1; a[1] = n-amin+1; START_FORCOUNT; while (k != 0) { x = a[k-1]+1; y = a[k]-1; k--; r = (ix == 0) ? x : 1; while (r <= y) { a[k++] = x; x = r; y -= x; } a[k] = x + y; /* ------ length restrictions ------ */ while (k+1 > nmax) { /* Skip range if over max size */ a[k-1] += a[k]; k--; } /* Look into: quick skip over nmin range */ if (k+1 < nmin) { /* Skip if not over min size */ if (a[0] >= n-nmin+1 && a[k] > 1) break; /* early exit check */ continue; } /* ------ value restrictions ------ */ if (amin > 1 || amax < n) { /* Lexical order allows us to start at amin, and exit early */ if (a[0] > amax) break; if (ix == 0) { /* value restrictions for partitions */ if (a[k] > amax) continue; } else { /* restrictions for compositions */ /* TODO: maybe skip forward? */ for (i = 0; i <= k; i++) if (a[i] < amin || a[i] > amax) break; if (i <= k) continue; } } if (primeq != -1) { for (i = 0; i <= k; i++) if (is_prime(a[i]) != primeq) break; if (i <= k) continue; } PUSHMARK(SP); EXTEND(SP, (IV)k); for (i = 0; i <= k; i++) { PUSHs(svals[a[i]]); } PUTBACK; call_sv((SV*)cv, G_VOID|G_DISCARD); SPAGAIN; CHECK_FORCOUNT; } Safefree(a); END_FORCOUNT; } for (i = 0; i <= n; i++) SvREFCNT_dec(svals[i]); Safefree(svals); void forcomb (SV* block, IN SV* svn, IN SV* svk = 0) ALIAS: forperm = 1 forderange = 2 PROTOTYPE: &$;$ PREINIT: UV i, n, k, begk, endk; GV *gv; HV *stash; CV *cv; SV** svals; UV* cm; DECL_FORCOUNT; dMY_CXT; PPCODE: cv = sv_2cv(block, &stash, &gv, 0); if (cv == Nullcv) croak("Not a subroutine reference"); if (ix > 0 && svk != 0) croak("Too many arguments for forperm"); if (!_validate_int(aTHX_ svn, 0) || (svk != 0 && !_validate_int(aTHX_ svk, 0))) { _vcallsub_with_pp( (ix == 0) ? "forcomb" : (ix == 1) ? "forperm" : "forderange" ); return; } n = my_svuv(svn); if (svk == 0) { begk = (ix == 0) ? 0 : n; endk = n; } else { begk = endk = my_svuv(svk); if (begk > n) return; } New(0, svals, n, SV*); for (i = 0; i < n; i++) { svals[i] = newSVuv(i); SvREADONLY_on(svals[i]); } New(0, cm, endk+1, UV); START_FORCOUNT; #if USE_MULTICALL if (!CvISXSUB(cv)) { dMULTICALL; I32 gimme = G_VOID; AV *av = save_ary(PL_defgv); AvREAL_off(av); PUSH_MULTICALL(cv); for (k = begk; k <= endk; k++) { _comb_init(cm, k, ix == 2); while (1) { if (ix < 2 || k != 1) { IV j; av_extend(av, k-1); av_fill(av, k-1); for (j = k-1; j >= 0; j--) AvARRAY(av)[j] = svals[ cm[k-j-1]-1 ]; { ENTER; MULTICALL; LEAVE; } } CHECK_FORCOUNT; if (_comb_iterate(cm, k, n, ix)) break; } CHECK_FORCOUNT; } FIX_MULTICALL_REFCOUNT; POP_MULTICALL; } else #endif { for (k = begk; k <= endk; k++) { _comb_init(cm, k, ix == 2); while (1) { if (ix < 2 || k != 1) { PUSHMARK(SP); EXTEND(SP, ((IV)k)); for (i = 0; i < k; i++) { PUSHs(svals[ cm[k-i-1]-1 ]); } PUTBACK; call_sv((SV*)cv, G_VOID|G_DISCARD); SPAGAIN; } CHECK_FORCOUNT; if (_comb_iterate(cm, k, n, ix)) break; } CHECK_FORCOUNT; } } Safefree(cm); for (i = 0; i < n; i++) SvREFCNT_dec(svals[i]); Safefree(svals); END_FORCOUNT; void forsetproduct (SV* block, ...) PROTOTYPE: &@ PREINIT: IV narrays, i, *arlen, *arcnt; AV **arptr; SV **arout; GV *gv; HV *stash; CV *cv; DECL_FORCOUNT; dMY_CXT; PPCODE: cv = sv_2cv(block, &stash, &gv, 0); if (cv == Nullcv) croak("Not a subroutine reference"); narrays = items-1; if (narrays < 1) return; for (i = 1; i <= narrays; i++) { SvGETMAGIC(ST(i)); if ((!SvROK(ST(i))) || (SvTYPE(SvRV(ST(i))) != SVt_PVAV)) croak("forsetproduct arguments must be array references"); if (av_len((AV *)SvRV(ST(i))) < 0) return; } Newz(0, arcnt, narrays, IV); New(0, arlen, narrays, IV); New(0, arptr, narrays, AV*); New(0, arout, narrays, SV*); for (i = 0; i < narrays; i++) { arptr[i] = (AV*) SvRV(ST(i+1)); arlen[i] = 1 + av_len(arptr[i]); arout[i] = AvARRAY(arptr[i])[0]; } START_FORCOUNT; #if USE_MULTICALL if (!CvISXSUB(cv)) { dMULTICALL; I32 gimme = G_VOID; AV *av = save_ary(PL_defgv); AvREAL_off(av); PUSH_MULTICALL(cv); do { av_extend(av, narrays-1); av_fill(av, narrays-1); for (i = narrays-1; i >= 0; i--) /* Faster to fill backwards */ AvARRAY(av)[i] = arout[i]; { ENTER; MULTICALL; LEAVE; } CHECK_FORCOUNT; for (i = narrays-1; i >= 0; i--) { if (++arcnt[i] >= arlen[i]) arcnt[i] = 0; arout[i] = AvARRAY(arptr[i])[arcnt[i]]; if (arcnt[i] > 0) break; } } while (i >= 0); FIX_MULTICALL_REFCOUNT; POP_MULTICALL; } else #endif do { PUSHMARK(SP); EXTEND(SP, narrays); for (i = 0; i < narrays; i++) { PUSHs(arout[i]); } PUTBACK; call_sv((SV*)cv, G_VOID|G_DISCARD); SPAGAIN; CHECK_FORCOUNT; for (i = narrays-1; i >= 0; i--) { if (++arcnt[i] >= arlen[i]) arcnt[i] = 0; arout[i] = AvARRAY(arptr[i])[arcnt[i]]; if (arcnt[i] > 0) break; } } while (i >= 0); Safefree(arout); Safefree(arptr); Safefree(arlen); Safefree(arcnt); END_FORCOUNT; void forfactored (SV* block, IN SV* svbeg, IN SV* svend = 0) ALIAS: forsquarefree = 1 PROTOTYPE: &$;$ PREINIT: UV beg, end, n, *factors; int i, nfactors, maxfactors; factor_range_context_t fctx; GV *gv; HV *stash; SV* svarg; /* We use svarg to prevent clobbering $_ outside the block */ CV *cv; SV* svals[64]; DECL_FORCOUNT; dMY_CXT; 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, (ix == 0) ? "_generic_forfactored" : "_generic_forsquarefree", items, 0); return; } if (items < 3) { beg = 1; end = my_svuv(svbeg); } else { beg = my_svuv(svbeg); end = my_svuv(svend); } if (beg > end) return; for (maxfactors = 0, n = end >> 1; n; n >>= 1) maxfactors++; for (i = 0; i < maxfactors; i++) { svals[i] = newSVuv(UV_MAX); SvREADONLY_on(svals[i]); } SAVESPTR(GvSV(PL_defgv)); svarg = newSVuv(0); GvSV(PL_defgv) = svarg; START_FORCOUNT; if (beg <= 1) { PUSHMARK(SP); sv_setuv(svarg, 1); PUTBACK; call_sv((SV*)cv, G_VOID|G_DISCARD); SPAGAIN; beg = 2; } fctx = factor_range_init(beg, end, ix); #if USE_MULTICALL if (!CvISXSUB(cv)) { dMULTICALL; I32 gimme = G_VOID; AV *av = save_ary(PL_defgv); AvREAL_off(av); PUSH_MULTICALL(cv); for (n = 0; n < end-beg+1; n++) { CHECK_FORCOUNT; nfactors = factor_range_next(&fctx); if (nfactors > 0) { sv_setuv(svarg, fctx.n); factors = fctx.factors; av_extend(av, nfactors-1); av_fill(av, nfactors-1); for (i = nfactors-1; i >= 0; i--) { SV* sv = svals[i]; SvREADONLY_off(sv); sv_setuv(sv, factors[i]); SvREADONLY_on(sv); AvARRAY(av)[i] = sv; } { ENTER; MULTICALL; LEAVE; } } } FIX_MULTICALL_REFCOUNT; POP_MULTICALL; } else #endif for (n = 0; n < end-beg+1; n++) { CHECK_FORCOUNT; nfactors = factor_range_next(&fctx); if (nfactors > 0) { PUSHMARK(SP); EXTEND(SP, nfactors); sv_setuv(svarg, fctx.n); factors = fctx.factors; for (i = 0; i < nfactors; i++) { SV* sv = svals[i]; SvREADONLY_off(sv); sv_setuv(sv, factors[i]); SvREADONLY_on(sv); PUSHs(sv); } PUTBACK; call_sv((SV*)cv, G_VOID|G_DISCARD); SPAGAIN; } } SvREFCNT_dec(svarg); for (i = 0; i < maxfactors; i++) SvREFCNT_dec(svals[i]); END_FORCOUNT; void vecreduce(SV* block, ...) PROTOTYPE: &@ CODE: { /* This is basically reduce from List::Util. Try to maintain compat. */ SV *ret = sv_newmortal(); int i; GV *agv,*bgv,*gv; HV *stash; SV **args = &PL_stack_base[ax]; CV *cv = sv_2cv(block, &stash, &gv, 0); if (cv == Nullcv) croak("Not a subroutine reference"); if (items <= 1) XSRETURN_UNDEF; agv = gv_fetchpv("a", GV_ADD, SVt_PV); bgv = gv_fetchpv("b", GV_ADD, SVt_PV); SAVESPTR(GvSV(agv)); SAVESPTR(GvSV(bgv)); GvSV(agv) = ret; SvSetMagicSV(ret, args[1]); #ifdef dMULTICALL if (!CvISXSUB(cv)) { dMULTICALL; I32 gimme = G_SCALAR; PUSH_MULTICALL(cv); for (i = 2; i < items; i++) { GvSV(bgv) = args[i]; { ENTER; MULTICALL; LEAVE; } SvSetMagicSV(ret, *PL_stack_sp); } FIX_MULTICALL_REFCOUNT; POP_MULTICALL; } else #endif { for (i = 2; i < items; i++) { dSP; GvSV(bgv) = args[i]; PUSHMARK(SP); call_sv((SV*)cv, G_SCALAR); SvSetMagicSV(ret, *PL_stack_sp); } } ST(0) = ret; XSRETURN(1); } void vecnone(SV* block, ...) ALIAS: vecall = 1 vecany = 2 vecnotall = 3 vecfirst = 4 vecfirstidx = 6 PROTOTYPE: &@ PPCODE: { /* This is very similar to List::Util. Try to maintain compat. */ int ret_true = !(ix & 2); /* return true at end of loop for none/all; false for any/notall */ int invert = (ix & 1); /* invert block test for all/notall */ int index; GV *gv; HV *stash; SV **args = &PL_stack_base[ax]; CV *cv = sv_2cv(block, &stash, &gv, 0); if (cv == Nullcv) croak("Not a subroutine reference"); SAVESPTR(GvSV(PL_defgv)); #ifdef dMULTICALL if (!CvISXSUB(cv)) { dMULTICALL; I32 gimme = G_SCALAR; PUSH_MULTICALL(cv); for (index = 1; index < items; index++) { GvSV(PL_defgv) = args[index]; { ENTER; MULTICALL; LEAVE; } if (SvTRUEx(*PL_stack_sp) ^ invert) break; } FIX_MULTICALL_REFCOUNT; POP_MULTICALL; } else #endif { for (index = 1; index < items; index++) { dSP; GvSV(PL_defgv) = args[index]; PUSHMARK(SP); call_sv((SV*)cv, G_SCALAR); if (SvTRUEx(*PL_stack_sp) ^ invert) break; } } if (ix == 4) { if (index == items) XSRETURN_UNDEF; ST(0) = ST(index); XSRETURN(1); } if (ix == 6) { if (index == items) XSRETURN_IV(-1); XSRETURN_UV(index-1); } if (index != items) /* We exited the loop early */ ret_true = !ret_true; if (ret_true) XSRETURN_YES; else XSRETURN_NO; } #ifdef FACTORING_HARNESSES void factor_test_harness1(...) PROTOTYPE: @ PPCODE: /* Pass in a big array of numbers, we factor them in a timed loop */ { UV res, factors[MPU_MAX_FACTORS+1], *comp; struct timeval gstart, gstop; double t_time; int i, j, k, correct, nf, num = items; //num = (items > 100000) ? 100000 : items; New(0, comp, num, UV); for (i = 0; i < num; i++) comp[i] = my_svuv(ST(i)); gettimeofday(&gstart, NULL); for (j = 0; j < 1; j++) { correct = 0; for (i = 0; i < num; i++) { nf = factor(comp[i], factors); //nf = squfof_factor(comp[i], factors, 140000); //nf = pbrent_factor(comp[i], factors, 500000, 1); //nf = holf_factor(comp[i], factors, 1000000); //nf = lehman_factor(comp[i], factors, 1); //nf = lehman_factor(comp[i], factors, 0); if (nf < 2) nf=pbrent_factor(comp[i], factors, 500000, 3); //nf = factor63(comp[i], factors); //nf = pminus1_factor(comp[i], factors, 1000,10000); //nf = prho_factor(comp[i], factors, 10000); if (nf >= 2) { for (res = factors[0], k = 1; k < nf; k++) res *= factors[k]; if (res == comp[i]) correct++; } //printf("%lu:",comp[i]);for(k=0;k -bit numbers */ { UV factors[MPU_MAX_FACTORS+1], exponents[MPU_MAX_FACTORS+1]; FILE *fid = 0; // fopen("results.txt", "w"); uint64_t n, state = 28953; int i, nfactors, totfactors = 0; /* Use Knuth MMIX -- simple and no worse than Chacha20 for this */ for (i = 0; i < count; i++) { state = 6364136223846793005ULL * state + 1442695040888963407ULL; n = state >> (64-bits); nfactors = factor_exp(n, factors, exponents); if (fid) fprintf(fid, "%llu has %d factors\n", n, nfactors); totfactors += nfactors; } if (fid) fclose(fid); XSRETURN_IV(totfactors); } void factor_test_harness3(IN UV start, IN UV end) PPCODE: /* We'll factor -bit numbers */ { UV totf = 0, i, factors[MPU_MAX_FACTORS]; for (i = start; i < end; i++) { totf += factor(i, factors); } XSRETURN_UV(totf); } #endif Math-Prime-Util-0.73/lib/0000755000076400007640000000000013373340013013464 5ustar danadanaMath-Prime-Util-0.73/lib/ntheory.pm0000644000076400007640000003452513373337725015543 0ustar danadanapackage ntheory; use strict; use warnings; BEGIN { $ntheory::AUTHORITY = 'cpan:DANAJ'; $ntheory::VERSION = '0.73'; } BEGIN { require Math::Prime::Util; *ntheory:: = *Math::Prime::Util::; } 1; __END__ # ABSTRACT: Number theory utilities =pod =encoding utf8 =for stopwords ntheory =head1 NAME ntheory - Number theory utilities =head1 SEE See L for complete documentation. =head1 QUICK REFERENCE Tags: :all to import almost all functions :rand to import rand, srand, irand, irand64 =head2 PRIMALITY is_prob_prime(n) primality test (BPSW) is_prime(n) primality test (BPSW + extra) is_provable_prime(n) primality test with proof is_provable_prime_with_cert(n) primality test: (isprime,cert) prime_certificate(n) as above with just certificate verify_prime(cert) verify a primality certificate is_mersenne_prime(p) is 2^p-1 prime or composite is_aks_prime(n) AKS deterministic test (slow) is_ramanujan_prime(n) is n a Ramanujan prime =head2 PROBABLE PRIME TESTS is_pseudoprime(n,bases) Fermat probable prime test is_euler_pseudoprime(n,bases) Euler test to bases is_euler_plumb_pseudoprime(n) Euler Criterion test is_strong_pseudoprime(n,bases) Miller-Rabin test to bases is_lucas_pseudoprime(n) Lucas test is_strong_lucas_pseudoprime(n) strong Lucas test is_almost_extra_strong_lucas_pseudoprime(n, [incr]) AES Lucas test is_extra_strong_lucas_pseudoprime(n) extra strong Lucas test is_frobenius_pseudoprime(n, [a,b]) Frobenius quadratic test is_frobenius_underwood_pseudoprime(n) combined PSP and Lucas is_frobenius_khashin_pseudoprime(n) Khashin's 2013 Frobenius test is_perrin_pseudoprime(n [,r]) Perrin test is_catalan_pseudoprime(n) Catalan test is_bpsw_prime(n) combined SPSP-2 and ES Lucas miller_rabin_random(n, ntests) perform random-base MR tests =head2 PRIMES primes([start,] end) array ref of primes twin_primes([start,] end) array ref of twin primes semi_primes([start,] end) array ref of semiprimes ramanujan_primes([start,] end) array ref of Ramanujan primes sieve_prime_cluster(start, end, @C) list of prime k-tuples sieve_range(n, width, depth) sieve out small factors to depth next_prime(n) next prime > n prev_prime(n) previous prime < n prime_count(n) count of primes <= n prime_count(start, end) count of primes in range prime_count_lower(n) fast lower bound for prime count prime_count_upper(n) fast upper bound for prime count prime_count_approx(n) fast approximate count of primes nth_prime(n) the nth prime (n=1 returns 2) nth_prime_lower(n) fast lower bound for nth prime nth_prime_upper(n) fast upper bound for nth prime nth_prime_approx(n) fast approximate nth prime twin_prime_count(n) count of twin primes <= n twin_prime_count(start, end) count of twin primes in range twin_prime_count_approx(n) fast approx count of twin primes nth_twin_prime(n) the nth twin prime (n=1 returns 3) nth_twin_prime_approx(n) fast approximate nth twin prime semiprime_count(n) count of semiprimes <= n semiprime_count(start, end) count of semiprimes in range semiprime_count_approx(n) fast approximate count of semiprimes nth_semiprime(n) the nth semiprime nth_semiprime_approx(n) fast approximate nth semiprime ramanujan_prime_count(n) count of Ramanujan primes <= n ramanujan_prime_count(start, end) count of Ramanujan primes in range ramanujan_prime_count_lower(n) fast lower bound for Ramanujan count ramanujan_prime_count_upper(n) fast upper bound for Ramanujan count ramanujan_prime_count_approx(n) fast approximate Ramanujan count nth_ramanujan_prime(n) the nth Ramanujan prime (Rn) nth_ramanujan_prime_lower(n) fast lower bound for Rn nth_ramanujan_prime_upper(n) fast upper bound for Rn nth_ramanujan_prime_approx(n) fast approximate Rn legendre_phi(n,a) # below n not div by first a primes inverse_li(n) integer inverse logarithmic integral prime_precalc(n) precalculate primes to n sum_primes([start,] end) return summation of primes in range print_primes(start,end[,fd]) print primes to stdout or fd =head2 FACTORING factor(n) array of prime factors of n factor_exp(n) array of [p,k] factors p^k divisors(n) array of divisors of n divisor_sum(n) sum of divisors divisor_sum(n,k) sum of k-th power of divisors divisor_sum(n,sub{...}) sum of code run for each divisor znlog(a, g, p) solve k in a = g^k mod p =head2 ITERATORS forprimes { ... } [start,] end loop over primes in range forcomposites { ... } [start,] end loop over composites in range foroddcomposites {...} [start,] end loop over odd composites in range forsemiprimes {...} [start,] end loop over semiprimes in range forfactored {...} [start,] end loop with factors forsquarefree {...} [start,] end loop with factors of square-free n fordivisors { ... } n loop over the divisors of n forpart { ... } n [,{...}] loop over integer partitions forcomp { ... } n [,{...}] loop over integer compositions forcomb { ... } n, k loop over combinations forperm { ... } n loop over permutations formultiperm { ... } \@n loop over multiset permutations forderange { ... } n loop over derangements forsetproduct { ... } \@a[,...] loop over Cartesian product of lists prime_iterator returns a simple prime iterator prime_iterator_object returns a prime iterator object lastfor stop iteration of for.... loop =head2 RANDOM NUMBERS irand random 32-bit integer irand64 random 64-bit integer drand([limit]) random NV in [0,1) or [0,limit) random_bytes(n) string with n random bytes entropy_bytes(n) string with n entropy-source bytes urandomb(n) random integer less than 2^n urandomm(n) random integer less than n csrand(data) seed the CSPRNG with binary data srand([seed]) simple seed (exported with :rand) rand([limit]) alias for drand (exported with :rand) random_factored_integer(n) random [1..n] and array ref of factors =head2 RANDOM PRIMES random_prime([start,] end) random prime in a range random_ndigit_prime(n) random prime with n digits random_nbit_prime(n) random prime with n bits random_strong_prime(n) random strong prime with n bits random_proven_prime(n) random n-bit prime with proof random_proven_prime_with_cert(n) as above and include certificate random_maurer_prime(n) random n-bit prime w/ Maurer's alg. random_maurer_prime_with_cert(n) as above and include certificate random_shawe_taylor_prime(n) random n-bit prime with S-T alg. random_shawe_taylor_prime_with_cert(n) as above including certificate random_unrestricted_semiprime(n) random n-bit semiprime random_semiprime(n) as above with equal size factors =head2 LISTS vecsum(@list) integer sum of list vecprod(@list) integer product of list vecmin(@list) minimum of list of integers vecmax(@list) maximum of list of integers vecextract(\@list, mask) select from list based on mask vecreduce { ... } @list reduce / left fold applied to list vecall { ... } @list return true if all are true vecany { ... } @list return true if any are true vecnone { ... } @list return true if none are true vecnotall { ... } @list return true if not all are true vecfirst { ... } @list return first value that evals true vecfirstidx { ... } @list return first index that evals true =head2 MATH todigits(n[,base[,len]]) convert n to digit array in base todigitstring(n[,base[,len]]) convert n to string in base fromdigits(\@d,[,base]) convert base digit vector to number fromdigits(str,[,base]) convert base digit string to number sumdigits(n) sum of digits, with optional base is_square(n) return 1 if n is a perfect square is_power(n) return k if n = c^k for integer c is_power(n,k) return 1 if n = c^k for integer c, k is_power(n,k,\$root) as above but also set $root to c. is_prime_power(n) return k if n = p^k for prime p is_prime_power(n,\$p) as above but also set $p to p is_square_free(n) return true if no repeated factors is_carmichael(n) is n a Carmichael number is_quasi_carmichael(n) is n a quasi-Carmichael number is_primitive_root(r,n) is r a primitive root mod n is_pillai(n) v where v! % n == n-1 and n % v != 1 is_semiprime(n) does n have exactly 2 prime factors is_polygonal(n,k) is n a k-polygonal number is_polygonal(n,k,\$root) as above but also set $root is_fundamental(d) is d a fundamental discriminant is_totient(n) is n = euler_phi(x) for some x sqrtint(n) integer square root rootint(n,k) integer k-th root rootint(n,k,\$rk) as above but also set $rk to r^k logint(n,b) integer logarithm logint(n,b,\$be) as above but also set $be to b^e. gcd(@list) greatest common divisor lcm(@list) least common multiple gcdext(x,y) return (u,v,d) where u*x+v*y=d chinese([a,mod1],[b,mod2],...) Chinese Remainder Theorem primorial(n) product of primes below n pn_primorial(n) product of first n primes factorial(n) product of first n integers: n! factorialmod(n,m) factorial mod m binomial(n,k) binomial coefficient partitions(n) number of integer partitions valuation(n,k) number of times n is divisible by k hammingweight(n) population count (# of binary 1s) kronecker(a,b) Kronecker (Jacobi) symbol addmod(a,b,n) a + b mod n mulmod(a,b,n) a * b mod n divmod(a,b,n) a / b mod n powmod(a,b,n) a ^ b mod n invmod(a,n) inverse of a modulo n sqrtmod(a,n) modular square root moebius(n) Moebius function of n moebius(beg, end) array of Moebius in range mertens(n) sum of Moebius for 1 to n euler_phi(n) Euler totient of n euler_phi(beg, end) Euler totient for a range inverse_totient(n) image of Euler totient jordan_totient(n,k) Jordan's totient carmichael_lambda(n) Carmichael's Lambda function ramanujan_sum(k,n) Ramanujan's sum exp_mangoldt exponential of Mangoldt function liouville(n) Liouville function znorder(a,n) multiplicative order of a mod n znprimroot(n) smallest primitive root chebyshev_theta(n) first Chebyshev function chebyshev_psi(n) second Chebyshev function hclassno(n) Hurwitz class number H(n) * 12 ramanujan_tau(n) Ramanujan's Tau function consecutive_integer_lcm(n) lcm(1 .. n) lucasu(P, Q, k) U_k for Lucas(P,Q) lucasv(P, Q, k) V_k for Lucas(P,Q) lucas_sequence(n, P, Q, k) (U_k,V_k,Q_k) for Lucas(P,Q) mod n bernfrac(n) Bernoulli number as (num,den) bernreal(n) Bernoulli number as BigFloat harmfrac(n) Harmonic number as (num,den) harmreal(n) Harmonic number as BigFloat stirling(n,m,[type]) Stirling numbers of 1st or 2nd type numtoperm(n,k) kth lexico permutation of n elems permtonum([a,b,...]) permutation number of given perm randperm(n,[k]) random permutation of n elems shuffle(...) random permutation of an array =head2 NON-INTEGER MATH ExponentialIntegral(x) Ei(x) LogarithmicIntegral(x) li(x) RiemannZeta(x) ζ(s)-1, real-valued Riemann Zeta RiemannR(x) Riemann's R function LambertW(k) Lambert W: solve for W in k = W exp(W) Pi([n]) The constant π (NV or n digits) =head2 SUPPORT prime_get_config gets hash ref of current settings prime_set_config(%hash) sets parameters prime_memfree frees any cached memory =head1 COPYRIGHT Copyright 2011-2018 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.73/lib/Math/0000755000076400007640000000000013373340013014355 5ustar danadanaMath-Prime-Util-0.73/lib/Math/Prime/0000755000076400007640000000000013373340013015431 5ustar danadanaMath-Prime-Util-0.73/lib/Math/Prime/Util/0000755000076400007640000000000013373340013016346 5ustar danadanaMath-Prime-Util-0.73/lib/Math/Prime/Util/MemFree.pm0000644000076400007640000000411513373337725020245 0ustar danadanapackage Math::Prime::Util::MemFree; use strict; use warnings; BEGIN { $Math::Prime::Util::MemFree::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::MemFree::VERSION = '0.73'; } 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.73 =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.73/lib/Math/Prime/Util/ChaCha.pm0000644000076400007640000003235313373337725020041 0ustar danadanapackage Math::Prime::Util::ChaCha; use strict; use warnings; use Carp qw/carp croak confess/; BEGIN { $Math::Prime::Util::ChaCha::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::ChaCha::VERSION = '0.73'; } ############################################################################### # Begin ChaCha core, reference RFC 7539 # with change to make blockcount/nonce be 64/64 from 32/96 # Dana Jacobsen, 9 Apr 2017 BEGIN { use constant ROUNDS => 20; use constant BUFSZ => 1024; use constant BITS => (~0 == 4294967295) ? 32 : 64; } # State is: # cccccccc cccccccc cccccccc cccccccc # kkkkkkkk kkkkkkkk kkkkkkkk kkkkkkkk # kkkkkkkk kkkkkkkk kkkkkkkk kkkkkkkk # bbbbbbbb nnnnnnnn nnnnnnnn nnnnnnnn # # c=constant k=key b=blockcount n=nonce # We have to take care with 32-bit Perl so it sticks with integers. # Unfortunately the pragma "use integer" means signed integer so # it ruins right shifts. We also must ensure we save as unsigned. sub _core { my($j, $blocks) = @_; my $ks = ''; $blocks = 1 unless defined $blocks; while ($blocks-- > 0) { my($x0,$x1,$x2,$x3,$x4,$x5,$x6,$x7,$x8,$x9,$x10,$x11,$x12,$x13,$x14,$x15) = @$j; for (1 .. ROUNDS/2) { use integer; if (BITS == 64) { $x0 =($x0 +$x4 )&0xFFFFFFFF; $x12^=$x0 ; $x12=(($x12<<16)|($x12>>16))&0xFFFFFFFF; $x8 =($x8 +$x12)&0xFFFFFFFF; $x4 ^=$x8 ; $x4 =(($x4 <<12)|($x4 >>20))&0xFFFFFFFF; $x0 =($x0 +$x4 )&0xFFFFFFFF; $x12^=$x0 ; $x12=(($x12<< 8)|($x12>>24))&0xFFFFFFFF; $x8 =($x8 +$x12)&0xFFFFFFFF; $x4 ^=$x8 ; $x4 =(($x4 << 7)|($x4 >>25))&0xFFFFFFFF; $x1 =($x1 +$x5 )&0xFFFFFFFF; $x13^=$x1 ; $x13=(($x13<<16)|($x13>>16))&0xFFFFFFFF; $x9 =($x9 +$x13)&0xFFFFFFFF; $x5 ^=$x9 ; $x5 =(($x5 <<12)|($x5 >>20))&0xFFFFFFFF; $x1 =($x1 +$x5 )&0xFFFFFFFF; $x13^=$x1 ; $x13=(($x13<< 8)|($x13>>24))&0xFFFFFFFF; $x9 =($x9 +$x13)&0xFFFFFFFF; $x5 ^=$x9 ; $x5 =(($x5 << 7)|($x5 >>25))&0xFFFFFFFF; $x2 =($x2 +$x6 )&0xFFFFFFFF; $x14^=$x2 ; $x14=(($x14<<16)|($x14>>16))&0xFFFFFFFF; $x10=($x10+$x14)&0xFFFFFFFF; $x6 ^=$x10; $x6 =(($x6 <<12)|($x6 >>20))&0xFFFFFFFF; $x2 =($x2 +$x6 )&0xFFFFFFFF; $x14^=$x2 ; $x14=(($x14<< 8)|($x14>>24))&0xFFFFFFFF; $x10=($x10+$x14)&0xFFFFFFFF; $x6 ^=$x10; $x6 =(($x6 << 7)|($x6 >>25))&0xFFFFFFFF; $x3 =($x3 +$x7 )&0xFFFFFFFF; $x15^=$x3 ; $x15=(($x15<<16)|($x15>>16))&0xFFFFFFFF; $x11=($x11+$x15)&0xFFFFFFFF; $x7 ^=$x11; $x7 =(($x7 <<12)|($x7 >>20))&0xFFFFFFFF; $x3 =($x3 +$x7 )&0xFFFFFFFF; $x15^=$x3 ; $x15=(($x15<< 8)|($x15>>24))&0xFFFFFFFF; $x11=($x11+$x15)&0xFFFFFFFF; $x7 ^=$x11; $x7 =(($x7 << 7)|($x7 >>25))&0xFFFFFFFF; $x0 =($x0 +$x5 )&0xFFFFFFFF; $x15^=$x0 ; $x15=(($x15<<16)|($x15>>16))&0xFFFFFFFF; $x10=($x10+$x15)&0xFFFFFFFF; $x5 ^=$x10; $x5 =(($x5 <<12)|($x5 >>20))&0xFFFFFFFF; $x0 =($x0 +$x5 )&0xFFFFFFFF; $x15^=$x0 ; $x15=(($x15<< 8)|($x15>>24))&0xFFFFFFFF; $x10=($x10+$x15)&0xFFFFFFFF; $x5 ^=$x10; $x5 =(($x5 << 7)|($x5 >>25))&0xFFFFFFFF; $x1 =($x1 +$x6 )&0xFFFFFFFF; $x12^=$x1 ; $x12=(($x12<<16)|($x12>>16))&0xFFFFFFFF; $x11=($x11+$x12)&0xFFFFFFFF; $x6 ^=$x11; $x6 =(($x6 <<12)|($x6 >>20))&0xFFFFFFFF; $x1 =($x1 +$x6 )&0xFFFFFFFF; $x12^=$x1 ; $x12=(($x12<< 8)|($x12>>24))&0xFFFFFFFF; $x11=($x11+$x12)&0xFFFFFFFF; $x6 ^=$x11; $x6 =(($x6 << 7)|($x6 >>25))&0xFFFFFFFF; $x2 =($x2 +$x7 )&0xFFFFFFFF; $x13^=$x2 ; $x13=(($x13<<16)|($x13>>16))&0xFFFFFFFF; $x8 =($x8 +$x13)&0xFFFFFFFF; $x7 ^=$x8 ; $x7 =(($x7 <<12)|($x7 >>20))&0xFFFFFFFF; $x2 =($x2 +$x7 )&0xFFFFFFFF; $x13^=$x2 ; $x13=(($x13<< 8)|($x13>>24))&0xFFFFFFFF; $x8 =($x8 +$x13)&0xFFFFFFFF; $x7 ^=$x8 ; $x7 =(($x7 << 7)|($x7 >>25))&0xFFFFFFFF; $x3 =($x3 +$x4 )&0xFFFFFFFF; $x14^=$x3 ; $x14=(($x14<<16)|($x14>>16))&0xFFFFFFFF; $x9 =($x9 +$x14)&0xFFFFFFFF; $x4 ^=$x9 ; $x4 =(($x4 <<12)|($x4 >>20))&0xFFFFFFFF; $x3 =($x3 +$x4 )&0xFFFFFFFF; $x14^=$x3 ; $x14=(($x14<< 8)|($x14>>24))&0xFFFFFFFF; $x9 =($x9 +$x14)&0xFFFFFFFF; $x4 ^=$x9 ; $x4 =(($x4 << 7)|($x4 >>25))&0xFFFFFFFF; } else { # 32-bit $x0 +=$x4 ; $x12^=$x0 ; $x12=($x12<<16)|(($x12>>16)& 0xFFFF); $x8 +=$x12; $x4 ^=$x8 ; $x4 =($x4 <<12)|(($x4 >>20)& 0xFFF); $x0 +=$x4 ; $x12^=$x0 ; $x12=($x12<< 8)|(($x12>>24)& 0xFF); $x8 +=$x12; $x4 ^=$x8 ; $x4 =($x4 << 7)|(($x4 >>25)& 0x7F); $x1 +=$x5 ; $x13^=$x1 ; $x13=($x13<<16)|(($x13>>16)& 0xFFFF); $x9 +=$x13; $x5 ^=$x9 ; $x5 =($x5 <<12)|(($x5 >>20)& 0xFFF); $x1 +=$x5 ; $x13^=$x1 ; $x13=($x13<< 8)|(($x13>>24)& 0xFF); $x9 +=$x13; $x5 ^=$x9 ; $x5 =($x5 << 7)|(($x5 >>25)& 0x7F); $x2 +=$x6 ; $x14^=$x2 ; $x14=($x14<<16)|(($x14>>16)& 0xFFFF); $x10+=$x14; $x6 ^=$x10; $x6 =($x6 <<12)|(($x6 >>20)& 0xFFF); $x2 +=$x6 ; $x14^=$x2 ; $x14=($x14<< 8)|(($x14>>24)& 0xFF); $x10+=$x14; $x6 ^=$x10; $x6 =($x6 << 7)|(($x6 >>25)& 0x7F); $x3 +=$x7 ; $x15^=$x3 ; $x15=($x15<<16)|(($x15>>16)& 0xFFFF); $x11+=$x15; $x7 ^=$x11; $x7 =($x7 <<12)|(($x7 >>20)& 0xFFF); $x3 +=$x7 ; $x15^=$x3 ; $x15=($x15<< 8)|(($x15>>24)& 0xFF); $x11+=$x15; $x7 ^=$x11; $x7 =($x7 << 7)|(($x7 >>25)& 0x7F); $x0 +=$x5 ; $x15^=$x0 ; $x15=($x15<<16)|(($x15>>16)& 0xFFFF); $x10+=$x15; $x5 ^=$x10; $x5 =($x5 <<12)|(($x5 >>20)& 0xFFF); $x0 +=$x5 ; $x15^=$x0 ; $x15=($x15<< 8)|(($x15>>24)& 0xFF); $x10+=$x15; $x5 ^=$x10; $x5 =($x5 << 7)|(($x5 >>25)& 0x7F); $x1 +=$x6 ; $x12^=$x1 ; $x12=($x12<<16)|(($x12>>16)& 0xFFFF); $x11+=$x12; $x6 ^=$x11; $x6 =($x6 <<12)|(($x6 >>20)& 0xFFF); $x1 +=$x6 ; $x12^=$x1 ; $x12=($x12<< 8)|(($x12>>24)& 0xFF); $x11+=$x12; $x6 ^=$x11; $x6 =($x6 << 7)|(($x6 >>25)& 0x7F); $x2 +=$x7 ; $x13^=$x2 ; $x13=($x13<<16)|(($x13>>16)& 0xFFFF); $x8 +=$x13; $x7 ^=$x8 ; $x7 =($x7 <<12)|(($x7 >>20)& 0xFFF); $x2 +=$x7 ; $x13^=$x2 ; $x13=($x13<< 8)|(($x13>>24)& 0xFF); $x8 +=$x13; $x7 ^=$x8 ; $x7 =($x7 << 7)|(($x7 >>25)& 0x7F); $x3 +=$x4 ; $x14^=$x3 ; $x14=($x14<<16)|(($x14>>16)& 0xFFFF); $x9 +=$x14; $x4 ^=$x9 ; $x4 =($x4 <<12)|(($x4 >>20)& 0xFFF); $x3 +=$x4 ; $x14^=$x3 ; $x14=($x14<< 8)|(($x14>>24)& 0xFF); $x9 +=$x14; $x4 ^=$x9 ; $x4 =($x4 << 7)|(($x4 >>25)& 0x7F); } } $ks .= pack("V16",$x0 +$j->[ 0],$x1 +$j->[ 1],$x2 +$j->[ 2],$x3 +$j->[ 3], $x4 +$j->[ 4],$x5 +$j->[ 5],$x6 +$j->[ 6],$x7 +$j->[ 7], $x8 +$j->[ 8],$x9 +$j->[ 9],$x10+$j->[10],$x11+$j->[11], $x12+$j->[12],$x13+$j->[13],$x14+$j->[14],$x15+$j->[15]); if (++$j->[12] > 4294967295) { $j->[12] = 0; $j->[13]++; } } $ks; } sub _test_core { return unless ROUNDS == 20; my $init_state = '617078653320646e79622d326b20657403020100070605040b0a09080f0e0d0c13121110171615141b1a19181f1e1d1c00000001090000004a00000000000000'; my @state = map { hex("0x$_") } unpack "a8a8a8a8a8a8a8a8a8a8a8a8a8a8a8a8", $init_state; my $instr = join("",map { sprintf("%08x",$_) } @state); die "Block function fail test 2.3.2 input" unless $instr eq '617078653320646e79622d326b20657403020100070605040b0a09080f0e0d0c13121110171615141b1a19181f1e1d1c00000001090000004a00000000000000'; my @out = unpack("V16", _core(\@state)); my $outstr = join("",map { sprintf("%08x",$_) } @out); #printf " %08x %08x %08x %08x\n %08x %08x %08x %08x\n %08x %08x %08x %08x\n %08x %08x %08x %08x\n", @state; die "Block function fail test 2.3.2 output" unless $outstr eq 'e4e7f11015593bd11fdd0f50c47120a3c7f4d1c70368c0339aaa22044e6cd4c3466482d209aa9f0705d7c214a2028bd9d19c12b5b94e16dee883d0cb4e3c50a2'; } _test_core(); # Returns integral number of 64-byte blocks. sub _keystream { my($nbytes, $rstate) = @_; croak "Keystream invalid state" unless scalar(@$rstate) == 16; _core($rstate, ($nbytes+63) >> 6); } sub _test_keystream { return unless ROUNDS == 20; my $init_state = '617078653320646e79622d326b20657403020100070605040b0a09080f0e0d0c13121110171615141b1a19181f1e1d1c00000001000000004a00000000000000'; my @state = map { hex("0x$_") } unpack "a8a8a8a8a8a8a8a8a8a8a8a8a8a8a8a8", $init_state; my $instr = join("",map { sprintf("%08x",$_) } @state); die "Block function fail test 2.4.2 input" unless $instr eq '617078653320646e79622d326b20657403020100070605040b0a09080f0e0d0c13121110171615141b1a19181f1e1d1c00000001000000004a00000000000000'; my $keystream = _keystream(114, \@state); # Verify new state my $outstr = join("",map { sprintf("%08x",$_) } @state); die "Block function fail test 2.4.2 output" unless $outstr eq '617078653320646e79622d326b20657403020100070605040b0a09080f0e0d0c13121110171615141b1a19181f1e1d1c00000003000000004a00000000000000'; my $ksstr = unpack("H*",$keystream); die "Block function fail test 2.4.2 keystream" unless substr($ksstr,0,2*114) eq '224f51f3401bd9e12fde276fb8631ded8c131f823d2c06e27e4fcaec9ef3cf788a3b0aa372600a92b57974cded2b9334794cba40c63e34cdea212c4cf07d41b769a6749f3f630f4122cafe28ec4dc47e26d4346d70b98c73f3e9c53ac40c5945398b6eda1a832c89c167eacd901d7e2bf363'; } _test_keystream(); # End ChaCha core ############################################################################### # Simple PRNG used to fill small seeds sub _prng_next { my($s) = @_; my $word; my $oldstate = $s->[0]; if (BITS == 64) { $s->[0] = ($s->[0] * 747796405 + $s->[1]) & 0xFFFFFFFF; $word = ((($oldstate >> (($oldstate >> 28) + 4)) ^ $oldstate) * 277803737) & 0xFFFFFFFF; } else { { use integer; $s->[0] = unpack("L",pack("L", $s->[0] * 747796405 + $s->[1] )); } $word = (($oldstate >> (($oldstate >> 28) + 4)) ^ $oldstate) & 0xFFFFFFFF; { use integer; $word = unpack("L",pack("L", $word * 277803737)); } } ($word >> 22) ^ $word; } sub _prng_new { my($a,$b,$c,$d) = @_; my @s = (0, (($b << 1) | 1) & 0xFFFFFFFF); _prng_next(\@s); $s[0] = ($s[0] + $a) & 0xFFFFFFFF; _prng_next(\@s); $s[0] = ($s[0] ^ $c) & 0xFFFFFFFF; _prng_next(\@s); $s[0] = ($s[0] ^ $d) & 0xFFFFFFFF; _prng_next(\@s); \@s; } ############################################################################### # These variables are not accessible outside this file by standard means. { my $_goodseed; # Did we get a long seed my $_state; # the cipher state. 40 bytes user data, 64 total. my $_str; # buffered to-be-sent output. sub _is_csprng_well_seeded { $_goodseed } sub csrand { my($seed) = @_; $_goodseed = length($seed) >= 16; while (length($seed) % 4) { $seed .= pack("C",0); } # zero pad end word my @seed = unpack("V*",substr($seed,0,40)); # If not enough data, fill rest using simple RNG if ($#seed < 9) { my $rng = _prng_new(map { $_ <= $#seed ? $seed[$_] : 0 } 0..3); push @seed, _prng_next($rng) while $#seed < 9; } croak "Seed count failure" unless $#seed == 9; $_state = [0x61707865, 0x3320646e, 0x79622d32, 0x6b206574, @seed[0..7], 0, 0, @seed[8..9]]; $_str = ''; } sub srand { my $seed = shift; $seed = CORE::rand unless defined $seed; if ($seed <= 4294967295) { csrand(pack("V",$seed)); } else { csrand(pack("V2",$seed,$seed>>32)); } $seed; } sub irand { $_str .= _keystream(BUFSZ,$_state) if length($_str) < 4; return unpack("V",substr($_str, 0, 4, '')); } sub irand64 { return irand() if ~0 == 4294967295; $_str .= _keystream(BUFSZ,$_state) if length($_str) < 8; ($a,$b) = unpack("V2",substr($_str, 0, 8, '')); return ($a << 32) | $b; } sub random_bytes { my($bytes) = @_; $bytes = (defined $bytes) ? int abs $bytes : 0; $_str .= _keystream($bytes-length($_str),$_state) if length($_str) < $bytes; return substr($_str, 0, $bytes, ''); } } 1; __END__ # ABSTRACT: Pure Perl ChaCha20 CSPRNG =pod =encoding utf8 =head1 NAME Math::Prime::Util::ChaCha - Pure Perl ChaCha20 CSPRNG =head1 VERSION Version 0.73 =head1 SYNOPSIS =head1 DESCRIPTION A pure Perl implementation of ChaCha20 with a CSPRNG interface. =head1 FUNCTIONS =head2 csrand Takes a binary string as input and seeds the internal CSPRNG. =head2 srand A method for sieving the CSPRNG with a small value. This will not be secure but can be useful for simulations and emulating the system C. With no argument, chooses a random number, seeds and returns the number. With a single integer argument, seeds and returns the number. =head2 irand Returns a random 32-bit integer. =head2 irand64 Returns a random 64-bit integer. =head2 random_bytes Takes an unsigned number C as input and returns that many random bytes as a single binary string. =head2 =head1 AUTHORS Dana Jacobsen Edana@acm.orgE =head1 ACKNOWLEDGEMENTS Daniel J. Bernstein wrote the ChaCha family of stream ciphers in 2008 as an update to the popular Salsa20 cipher from 2005. RFC7539: "ChaCha20 and Poly1305 for IETF Protocols" was used to create both the C and Perl implementations. Test vectors from that document are used here as well. For final optimizations I got ideas from Christopher Madsen's L for how to best work around some of Perl's aggressive dynamic typing. Our core is still about 20% slower than Salsa20. =head1 COPYRIGHT Copyright 2017 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.73/lib/Math/Prime/Util/PP.pm0000644000076400007640000064100713373337725017253 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.73'; } 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 BZERO => Math::BigInt->bzero; use constant BONE => Math::BigInt->bone; use constant BTWO => Math::BigInt->new(2); use constant INTMAX => (!OLD_PERL_VERSION || MPU_32BIT) ? ~0 : 562949953421312; use constant BMAX => Math::BigInt->new('' . INTMAX); use constant B_PRIM767 => Math::BigInt->new("261944051702675568529303"); use constant B_PRIM235 => Math::BigInt->new("30"); use constant PI_TIMES_8 => 25.13274122871834590770114707; } my $_precalc_size = 0; sub prime_precalc { my($n) = @_; croak "Parameter '$n' must be a positive integer" unless _is_positive_int($n); $_precalc_size = $n if $n > $_precalc_size; } sub prime_memfree { $_precalc_size = 0; eval { Math::Prime::Util::GMP::_GMP_memfree(); } if defined $Math::Prime::Util::GMP::VERSION && $Math::Prime::Util::GMP::VERSION >= 0.49; } 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 { #if (OLD_PERL_VERSION) { # my $pack = ($_[0] < 0) ? lc(UVPACKLET) : UVPACKLET; # return unpack($pack,pack($pack,"$_[0]")); #} int("$_[0]"); } sub _upgrade_to_float { do { require Math::BigFloat; Math::BigFloat->import(); } if !defined $Math::BigFloat::VERSION; Math::BigFloat->new(@_); } # 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) = @_; my $b; $b = $x->accuracy() if ref($x) =~ /^Math::Big/; 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 _bfdigits { my($wantbf, $xdigits) = (0, 17); if (defined $bignum::VERSION || ref($_[0]) =~ /^Math::Big/) { do { require Math::BigFloat; Math::BigFloat->import(); } if !defined $Math::BigFloat::VERSION; if (ref($_[0]) eq 'Math::BigInt') { my $xacc = ($_[0])->accuracy(); $_[0] = Math::BigFloat->new($_[0]); ($_[0])->accuracy($xacc) if $xacc; } $_[0] = Math::BigFloat->new("$_[0]") if ref($_[0]) ne 'Math::BigFloat'; $wantbf = _find_big_acc($_[0]); $xdigits = $wantbf; } ($wantbf, $xdigits); } sub _validate_num { my($n, $min, $max) = @_; croak "Parameter must be defined" if !defined $n; return 0 if ref($n); croak "Parameter '$n' must be a positive integer" if $n eq '' || ($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 <= BMAX; } elsif (ref($n) eq 'Math::GMPz') { croak "Parameter '$n' must be a positive integer" if Math::GMPz::Rmpz_sgn($n) < 0; $_[0] = _bigint_to_int($_[0]) if $n <= INTMAX; } else { my $strn = "$n"; if ($strn eq '-0') { $_[0] = 0; $strn = '0'; } croak "Parameter '$strn' must be a positive integer" if $strn eq '' || ($strn =~ tr/0123456789//c && $strn !~ /^\+?\d+$/); if ($n <= INTMAX) { $_[0] = $strn if ref($n); } else { $_[0] = Math::BigInt->new($strn) } } $_[0]->upgrade(undef) if ref($_[0]) eq 'Math::BigInt' && $_[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 _validate_integer { my($n) = @_; croak "Parameter must be defined" if !defined $n; if (ref($n) eq 'CODE') { $_[0] = $_[0]->(); $n = $_[0]; } my $poscmp = OLD_PERL_VERSION ? 562949953421312 : ''.~0; my $negcmp = OLD_PERL_VERSION ? -562949953421312 : -(~0 >> 1); if (ref($n) eq 'Math::BigInt') { croak "Parameter '$n' must be an integer" if !$n->is_int(); $_[0] = _bigint_to_int($_[0]) if $n <= $poscmp && $n >= $negcmp; } else { my $strn = "$n"; if ($strn eq '-0') { $_[0] = 0; $strn = '0'; } croak "Parameter '$strn' must be an integer" if $strn eq '' || ($strn =~ tr/-0123456789//c && $strn !~ /^[-+]?\d+$/); if ($n <= $poscmp && $n >= $negcmp) { $_[0] = $strn if ref($n); } else { $_[0] = Math::BigInt->new($strn) } } $_[0]->upgrade(undef) if ref($_[0]) && $_[0]->upgrade(); 1; } sub _binary_search { my($n, $lo, $hi, $sub, $exitsub) = @_; while ($lo < $hi) { my $mid = $lo + int(($hi-$lo) >> 1); return $mid if defined $exitsub && $exitsub->($n,$lo,$hi); if ($sub->($mid) < $n) { $lo = $mid+1; } else { $hi = $mid; } } return $lo-1; } my @_primes_small = (0,2); { my($n, $s, $sieveref) = (7-2, 3, _sieve_erat_string(5003)); push @_primes_small, 2*pos($$sieveref)-1 while $$sieveref =~ m/0/g; } 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); my @_wheeladvance30 = (1,6,5,4,3,2,1,4,3,2,1,2,1,4,3,2,1,2,1,4,3,2,1,6,5,4,3,2,1,2); my @_wheelretreat30 = (1,2,1,2,3,4,5,6,1,2,3,4,1,2,1,2,3,4,1,2,1,2,3,4,1,2,3,4,5,6); 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) = @_; $n = _bigint_to_int($n) if ref($n) eq 'Math::BigInt' && $n <= BMAX; if (ref($n) eq 'Math::BigInt') { return 0 unless Math::BigInt::bgcd($n, B_PRIM767)->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); # We could do: # return is_strong_pseudoprime($n, (2,299417)) if $n < 19471033; # or: # foreach my $p (@_primes_small[18..168]) { # last if $p > $limit; # return 0 unless $n % $p; # } # return 2; if ($n <= 1_500_000) { my $limit = int(sqrt($n)); my $i = 61; while (($i+30) <= $limit) { return 0 unless ($n% $i ) && ($n%($i+ 6)) && ($n%($i+10)) && ($n%($i+12)) && ($n%($i+16)) && ($n%($i+18)) && ($n%($i+22)) && ($n%($i+28)); $i += 30; } for my $inc (6,4,2,4,2,4,6,2) { last if $i > $limit; return 0 if !($n % $i); $i += $inc; } 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 defined($n) && 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) = @_; return 0 if defined($n) && int($n) < 0; _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; } sub is_provable_prime { my($n) = @_; return 0 if defined $n && $n < 2; _validate_positive_integer($n); if ($n <= 18446744073709551615) { return 0 unless _miller_rabin_2($n); return 0 unless is_almost_extra_strong_lucas_pseudoprime($n); return 2; } my($is_prime, $cert) = Math::Prime::Util::is_provable_prime_with_cert($n); $is_prime; } # 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. 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,$limit) = @_; ($beg, $end) = map { _bigint_to_int($_) } ($beg, $end) if ref($end) && $end <= BMAX; 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 $sqlimit = ref($end) ? $end->copy->bsqrt() : int(sqrt($end)+0.0000001); $limit = $sqlimit if !defined $limit || $sqlimit < $limit; # For large value of end, it's a huge win to just walk primes. my($p, $s, $primesieveref) = (7-2, 3, _sieve_erat($limit)); while ( (my $nexts = 1 + index($$primesieveref, '0', $s)) > 0 ) { $p += 2 * ($nexts - $s); $s = $nexts; my $p2 = $p*$p; if ($p2 < $beg) { my $f = 1+int(($beg-1)/$p); $f++ unless $f % 2; $p2 = $p * $f; } # 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; # For a tiny range, just use next_prime calls if (($high-$low) < 1000) { $low-- if $low >= 2; my $curprime = next_prime($low); while ($curprime <= $high) { push @primes, $curprime; $curprime = next_prime($curprime); } return \@primes; } # Sieve to 10k then BPSW test push @primes, 2 if ($low <= 2) && ($high >= 2); push @primes, 3 if ($low <= 3) && ($high >= 3); push @primes, 5 if ($low <= 5) && ($high >= 5); $low = 7 if $low < 7; $low++ if ($low % 2) == 0; $high-- if ($high % 2) == 0; my $sieveref = _sieve_segment($low, $high, 10000); my $n = $low-2; while ($$sieveref =~ m/0/g) { my $p = $n+2*pos($$sieveref); push @primes, $p if _miller_rabin_2($p) && is_extra_strong_lucas_pseudoprime($p); } return \@primes; } sub primes { my($low,$high) = @_; if (scalar @_ > 1) { _validate_positive_integer($low); _validate_positive_integer($high); $low = 2 if $low < 2; } else { ($low,$high) = (2, $low); _validate_positive_integer($high); } my $sref = []; return $sref if ($low > $high) || ($high < 2); return [grep { $_ >= $low && $_ <= $high } @_primes_small] if $high <= $_primes_small[-1]; return [ Math::Prime::Util::GMP::sieve_primes($low, $high, 0) ] if $Math::Prime::Util::_GMPfunc{"sieve_primes"} && $Math::Prime::Util::GMP::VERSION >= 0.34; # 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; my($n,$sieveref); if ($low == 7) { $n = 0; $sieveref = _sieve_erat($high); substr($$sieveref,0,3,'111'); } else { $n = $low-1; $sieveref = _sieve_segment($low,$high); } push @$sref, $n+2*pos($$sieveref)-1 while $$sieveref =~ m/0/g; $sref; } sub sieve_range { my($n, $width, $depth) = @_; _validate_positive_integer($n); _validate_positive_integer($width); _validate_positive_integer($depth); my @candidates; my $start = $n; if ($n < 5) { push @candidates, (2-$n) if $n <= 2 && $n+$width-1 >= 2; push @candidates, (3-$n) if $n <= 3 && $n+$width-1 >= 3; push @candidates, (4-$n) if $n <= 4 && $n+$width-1 >= 4 && $depth < 2; $start = 5; $width -= ($start - $n); } return @candidates, map {$start+$_-$n } 0 .. $width-1 if $depth < 2; return @candidates, map { $_ - $n } grep { ($_ & 1) && ($depth < 3 || ($_ % 3)) } map { $start+$_ } 0 .. $width-1 if $depth < 5; if (!($start & 1)) { $start++; $width--; } $width-- if !($width&1); return @candidates if $width < 1; my $sieveref = _sieve_segment($start, $start+$width-1, $depth); my $offset = $start - $n - 2; while ($$sieveref =~ m/0/g) { push @candidates, $offset + (pos($$sieveref) << 1); } return @candidates; } sub sieve_prime_cluster { my($lo,$hi,@cl) = @_; my $_verbose = Math::Prime::Util::prime_get_config()->{'verbose'}; _validate_positive_integer($lo); _validate_positive_integer($hi); if ($Math::Prime::Util::_GMPfunc{"sieve_prime_cluster"}) { return map { ($_ > ''.~0) ? Math::BigInt->new(''.$_) : $_ } Math::Prime::Util::GMP::sieve_prime_cluster($lo,$hi,@cl); } return @{primes($lo,$hi)} if scalar(@cl) == 0; unshift @cl, 0; for my $i (1 .. $#cl) { _validate_positive_integer($cl[$i]); croak "sieve_prime_cluster: values must be even" if $cl[$i] & 1; croak "sieve_prime_cluster: values must be increasing" if $cl[$i] <= $cl[$i-1]; } my($p,$sievelim,@p) = (17, 2000); $p = 13 if ($hi-$lo) < 50_000_000; $p = 11 if ($hi-$lo) < 1_000_000; $p = 7 if ($hi-$lo) < 20_000 && $lo < INTMAX; # Add any cases under our sieving point. if ($lo <= $sievelim) { $sievelim = $hi if $sievelim > $hi; for my $n (@{primes($lo,$sievelim)}) { my $ac = 1; for my $ci (1 .. $#cl) { if (!is_prime($n+$cl[$ci])) { $ac = 0; last; } } push @p, $n if $ac; } $lo = next_prime($sievelim); } return @p if $lo > $hi; # Compute acceptable residues. my $pr = primorial($p); my $startpr = _bigint_to_int($lo % $pr); my @acc = grep { ($_ & 1) && $_%3 } ($startpr .. $startpr + $pr - 1); for my $c (@cl) { if ($p >= 7) { @acc = grep { (($_+$c)%3) && (($_+$c)%5) && (($_+$c)%7) } @acc; } else { @acc = grep { (($_+$c)%3) && (($_+$c)%5) } @acc; } } for my $c (@cl) { @acc = grep { Math::Prime::Util::gcd($_+$c,$pr) == 1 } @acc; } @acc = map { $_-$startpr } @acc; print "cluster sieve using ",scalar(@acc)," residues mod $pr\n" if $_verbose; return @p if scalar(@acc) == 0; # Prepare table for more sieving. my @mprimes = @{primes( $p+1, $sievelim)}; my @vprem; for my $p (@mprimes) { for my $c (@cl) { $vprem[$p]->[ ($p-($c%$p)) % $p ] = 1; } } # Walk the range in primorial chunks, doing primality tests. my($nummr, $numlucas) = (0,0); while ($lo <= $hi) { my @racc = @acc; # Make sure we don't do anything past the limit if (($lo+$acc[-1]) > $hi) { my $max = _bigint_to_int($hi-$lo); @racc = grep { $_ <= $max } @racc; } # Sieve more values using native math foreach my $p (@mprimes) { my $rem = _bigint_to_int( $lo % $p ); @racc = grep { !$vprem[$p]->[ ($rem+$_) % $p ] } @racc; last unless scalar(@racc); } # Do final primality tests. if ($lo < 1e13) { for my $r (@racc) { my($good, $p) = (1, $lo + $r); for my $c (@cl) { $nummr++; if (!Math::Prime::Util::is_prime($p+$c)) { $good = 0; last; } } push @p, $p if $good; } } else { for my $r (@racc) { my($good, $p) = (1, $lo + $r); for my $c (@cl) { $nummr++; if (!Math::Prime::Util::is_strong_pseudoprime($p+$c,2)) { $good = 0; last; } } next unless $good; for my $c (@cl) { $numlucas++; if (!Math::Prime::Util::is_extra_strong_lucas_pseudoprime($p+$c)) { $good = 0; last; } } push @p, $p if $good; } } $lo += $pr; } print "cluster sieve ran $nummr MR and $numlucas Lucas tests\n" if $_verbose; @p; } sub _n_ramanujan_primes { my($n) = @_; return [] if $n <= 0; my $max = nth_prime_upper(int(48/19*$n)+1); my @L = (2, (0) x $n-1); my $s = 1; for (my $k = 7; $k <= $max; $k += 2) { $s++ if is_prime($k); $L[$s] = $k+1 if $s < $n; $s-- if ($k&3) == 1 && is_prime(($k+1)>>1); $L[$s] = $k+2 if $s < $n; } \@L; } sub _ramanujan_primes { my($low,$high) = @_; ($low,$high) = (2, $low) unless defined $high; return [] if ($low > $high) || ($high < 2); my $nn = prime_count_upper($high) >> 1; my $L = _n_ramanujan_primes($nn); shift @$L while @$L && $L->[0] < $low; pop @$L while @$L && $L->[-1] > $high; $L; } sub is_ramanujan_prime { my($n) = @_; return 1 if $n == 2; return 0 if $n < 11; my $L = _ramanujan_primes($n,$n); return (scalar(@$L) > 0) ? 1 : 0; } sub nth_ramanujan_prime { my($n) = @_; return undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) my $L = _n_ramanujan_primes($n); return $L->[$n-1]; } sub next_prime { my($n) = @_; _validate_positive_integer($n); return $_prime_next_small[$n] if $n <= $#_prime_next_small; # This turns out not to be faster. # return $_primes_small[1+_tiny_prime_count($n)] if $n < $_primes_small[-1]; return Math::BigInt->new(MPU_32BIT ? "4294967311" : "18446744073709551629") if ref($n) ne 'Math::BigInt' && $n >= MPU_MAXPRIME; # n is now either 1) not bigint and < maxprime, or (2) bigint and >= uvmax if ($n > 4294967295 && Math::Prime::Util::prime_get_config()->{'gmp'}) { return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::next_prime($n)); } if (ref($n) eq 'Math::BigInt') { do { $n += $_wheeladvance30[$n%30]; } while !Math::BigInt::bgcd($n, B_PRIM767)->is_one || !_miller_rabin_2($n) || !is_extra_strong_lucas_pseudoprime($n); } else { do { $n += $_wheeladvance30[$n%30]; } while !($n%7) || !_is_prime7($n); } $n; } sub prev_prime { my($n) = @_; _validate_positive_integer($n); return (undef,undef,undef,2,3,3,5,5,7,7,7,7)[$n] if $n <= 11; if ($n > 4294967295 && Math::Prime::Util::prime_get_config()->{'gmp'}) { return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::prev_prime($n)); } if (ref($n) eq 'Math::BigInt') { do { $n -= $_wheelretreat30[$n%30]; } while !Math::BigInt::bgcd($n, B_PRIM767)->is_one || !_miller_rabin_2($n) || !is_extra_strong_lucas_pseudoprime($n); } else { do { $n -= $_wheelretreat30[$n%30]; } while !($n%7) || !_is_prime7($n); } $n; } 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 $ZERO = ($n >= ((~0 > 4294967295) ? 400 : 270)) ? BZERO : 0; my @part = ($ZERO+1); foreach my $j (scalar @part .. $n) { my ($psum1, $psum2, $k) = ($ZERO, $ZERO, 1); foreach my $p (@pent) { last if $p > $j; if ((++$k) & 2) { $psum1 += $part[ $j - $p ] } else { $psum2 += $part[ $j - $p ] } } $part[$j] = $psum1 - $psum2; } return $part[$n]; } sub primorial { my $n = shift; my @plist = @{primes($n)}; my $max = (MPU_32BIT) ? 29 : (OLD_PERL_VERSION) ? 43 : 53; # If small enough, multiply the small primes. if ($n < $max) { my $pn = 1; $pn *= $_ for @plist; return $pn; } # Otherwise, combine them as UVs, then combine using product tree. my $i = 0; while ($i < $#plist) { my $m = $plist[$i] * $plist[$i+1]; if ($m <= INTMAX) { splice(@plist, $i, 2, $m); } else { $i++; } } vecprod(@plist); } 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 <= BMAX; return $pn; } sub jordan_totient { my($k, $n) = @_; return ($n == 1) ? 1 : 0 if $k == 0; return euler_phi($n) if $k == 1; return ($n == 1) ? 1 : 0 if $n <= 1; return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::jordan_totient($k, $n)) if $Math::Prime::Util::_GMPfunc{"jordan_totient"}; 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")->bpow($k); $totient->bmul($p->copy->bdec()); $totient->bmul($p) for 2 .. $e; } $totient = _bigint_to_int($totient) if $totient->bacmp(BMAX) <= 0; return $totient; } sub euler_phi { return euler_phi_range(@_) if scalar @_ > 1; my($n) = @_; return 0 if defined $n && $n < 0; return Math::Prime::Util::_reftyped($_[0],Math::Prime::Util::GMP::totient($n)) if $Math::Prime::Util::_GMPfunc{"totient"}; _validate_positive_integer($n); return $n if $n <= 1; my $totient = $n - $n + 1; # Fast reduction of multiples of 2, may also reduce n for factoring if (ref($n) eq 'Math::BigInt') { my $s = 0; if ($n->is_even) { do { $n->brsft(BONE); $s++; } while $n->is_even; $totient->blsft($s-1) if $s > 1; } } else { while (($n % 4) == 0) { $n >>= 1; $totient <<= 1; } if (($n % 2) == 0) { $n >>= 1; } } my @pe = Math::Prime::Util::factor_exp($n); if ($#pe == 0 && $pe[0]->[1] == 1) { if (ref($n) ne 'Math::BigInt') { $totient *= $n-1; } else { $totient->bmul($n->bdec()); } } elsif (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; } } $totient = _bigint_to_int($totient) if ref($totient) eq 'Math::BigInt' && $totient->bacmp(BMAX) <= 0; return $totient; } sub inverse_totient { my($n) = @_; _validate_positive_integer($n); return wantarray ? (1,2) : 2 if $n == 1; return wantarray ? () : 0 if $n < 1 || ($n & 1); $n = Math::Prime::Util::_to_bigint("$n") if !ref($n) && $n > 2**49; my $do_bigint = ref($n); if (is_prime($n >> 1)) { # Coleman Remark 3.3 (Thm 3.1) and Prop 6.2 return wantarray ? () : 0 if !is_prime($n+1); return wantarray ? ($n+1, 2*$n+2) : 2 if $n >= 10; } if (!wantarray) { my %r = ( 1 => 1 ); Math::Prime::Util::fordivisors(sub { my $d = $_; $d = $do_bigint->new("$d") if $do_bigint; my $p = $d+1; if (Math::Prime::Util::is_prime($p)) { my($dp,@sumi,@sumv) = ($d); for my $v (1 .. 1 + Math::Prime::Util::valuation($n, $p)) { Math::Prime::Util::fordivisors(sub { my $d2 = $_; if (defined $r{$d2}) { push @sumi, $d2*$dp; push @sumv, $r{$d2}; } }, $n / $dp); $dp *= $p; } $r{ $sumi[$_] } += $sumv[$_] for 0 .. $#sumi; } }, $n); return (defined $r{$n}) ? $r{$n} : 0; } else { my %r = ( 1 => [1] ); Math::Prime::Util::fordivisors(sub { my $d = $_; $d = $do_bigint->new("$d") if $do_bigint; my $p = $d+1; if (Math::Prime::Util::is_prime($p)) { my($dp,$pp,@T) = ($d,$p); for my $v (1 .. 1 + Math::Prime::Util::valuation($n, $p)) { Math::Prime::Util::fordivisors(sub { my $d2 = $_; push @T, [ $d2*$dp, [map { $_ * $pp } @{ $r{$d2} }] ] if defined $r{$d2}; }, $n / $dp); $dp *= $p; $pp *= $p; } push @{$r{$_->[0]}}, @{$_->[1]} for @T; } }, $n); return () unless defined $r{$n}; delete @r{ grep { $_ != $n } keys %r }; # Delete all intermediate results my @result = sort { $a <=> $b } @{$r{$n}}; return @result; } } sub euler_phi_range { my($lo, $hi) = @_; _validate_integer($lo); _validate_integer($hi); my @totients; while ($lo < 0 && $lo <= $hi) { push @totients, 0; $lo++; } return @totients if $hi < $lo; if ($hi > 2**30 || $hi-$lo < 100) { while ($lo <= $hi) { push @totients, euler_phi($lo++); } } else { my @tot = (0 .. $hi); foreach my $i (2 .. $hi) { next unless $tot[$i] == $i; $tot[$i] = $i-1; foreach my $j (2 .. int($hi / $i)) { $tot[$i*$j] -= $tot[$i*$j]/$i; } } splice(@tot, 0, $lo) if $lo > 0; push @totients, @tot; } @totients; } sub moebius { return moebius_range(@_) if scalar @_ > 1; my($n) = @_; $n = -$n if defined $n && $n < 0; _validate_num($n) || _validate_positive_integer($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 is_square_free { return (Math::Prime::Util::moebius($_[0]) != 0) ? 1 : 0; } sub is_semiprime { my($n) = @_; _validate_positive_integer($n); return ($n == 4) if $n < 6; return (Math::Prime::Util::is_prob_prime($n>>1) ? 1 : 0) if ($n % 2) == 0; return (Math::Prime::Util::is_prob_prime($n/3) ? 1 : 0) if ($n % 3) == 0; return (Math::Prime::Util::is_prob_prime($n/5) ? 1 : 0) if ($n % 5) == 0; { my @f = trial_factor($n, 4999); return 0 if @f > 2; return (_is_prime7($f[1]) ? 1 : 0) if @f == 2; } return 0 if _is_prime7($n); { my @f = pminus1_factor ($n, 250_000); return 0 if @f > 2; return (_is_prime7($f[1]) ? 1 : 0) if @f == 2; } { my @f = pbrent_factor ($n, 128*1024, 3, 1); return 0 if @f > 2; return (_is_prime7($f[1]) ? 1 : 0) if @f == 2; } return (scalar(Math::Prime::Util::factor($n)) == 2) ? 1 : 0; } sub _totpred { my($n, $maxd) = @_; return 0 if $maxd <= 1 || (ref($n) ? $n->is_odd() : ($n & 1)); $n = Math::BigInt->new("$n") unless ref($n) || $n < INTMAX; $n >>= 1; return 1 if $n == 1 || ($n < $maxd && Math::Prime::Util::is_prime(2*$n+1)); for my $d (Math::Prime::Util::divisors($n)) { last if $d >= $maxd; my $p = ($d < (INTMAX >> 1)) ? ($d<<1)+1 : Math::Prime::Util::vecprod(2,$d)+1; next unless Math::Prime::Util::is_prime($p); my $r = int($n / $d); while (1) { return 1 if $r == $p || _totpred($r, $d); last if $r % $p; $r = int($r / $p); } } 0; } sub is_totient { my($n) = @_; _validate_positive_integer($n); return 1 if $n == 1; return 0 if $n <= 0; return _totpred($n,$n); } sub moebius_range { my($lo, $hi) = @_; _validate_integer($lo); _validate_integer($hi); return () if $hi < $lo; return moebius($lo) if $lo == $hi; if ($lo < 0) { if ($hi < 0) { return reverse(moebius_range(-$hi,-$lo)); } else { return (reverse(moebius_range(1,-$lo)), moebius_range(0,$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 ramanujan_sum { my($k,$n) = @_; return 0 if $k < 1 || $n < 1; my $g = $k / Math::Prime::Util::gcd($k,$n); my $m = Math::Prime::Util::moebius($g); return $m if $m == 0 || $k == $g; $m * (Math::Prime::Util::euler_phi($k) / Math::Prime::Util::euler_phi($g)); } sub liouville { my($n) = @_; my $l = (-1) ** scalar Math::Prime::Util::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) = @_; my $p; return 1 unless Math::Prime::Util::is_prime_power($n,\$p); $p; } sub carmichael_lambda { my($n) = @_; return euler_phi($n) if $n < 8; # = phi(n) for n < 8 return $n >> 2 if ($n & ($n-1)) == 0; # = phi(n)/2 = n/4 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; if (!ref($n)) { $lcm = Math::Prime::Util::lcm( map { ($_->[0] ** ($_->[1]-1)) * ($_->[0]-1) } @pe ); } else { $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(BMAX) <= 0; } $lcm; } sub is_carmichael { my($n) = @_; _validate_positive_integer($n); # This works fine, but very slow # return !is_prime($n) && ($n % carmichael_lambda($n)) == 1; return 0 if $n < 561 || ($n % 2) == 0; return 0 if (!($n % 9) || !($n % 25) || !($n%49) || !($n%121)); # Check Korselt's criterion for small divisors my $fn = $n; for my $a (5,7,11,13,17,19,23,29,31,37,41,43) { if (($fn % $a) == 0) { return 0 if (($n-1) % ($a-1)) != 0; # Korselt $fn /= $a; return 0 unless $fn % $a; # not square free } } return 0 if Math::Prime::Util::powmod(2, $n-1, $n) != 1; # After pre-tests, it's reasonably likely $n is a Carmichael number or prime # Use probabilistic test if too large to reasonably factor. if (length($fn) > 50) { return 0 if Math::Prime::Util::is_prime($n); for my $t (13 .. 150) { my $a = $_primes_small[$t]; my $gcd = Math::Prime::Util::gcd($a, $fn); if ($gcd == 1) { return 0 if Math::Prime::Util::powmod($a, $n-1, $n) != 1; } else { return 0 if $gcd != $a; # Not square free return 0 if (($n-1) % ($a-1)) != 0; # factor doesn't divide $fn /= $a; } } return 1; } # Verify with factoring. my @pe = Math::Prime::Util::factor_exp($n); return 0 if scalar(@pe) < 3; for my $pe (@pe) { return 0 if $pe->[1] > 1 || (($n-1) % ($pe->[0]-1)) != 0; } 1; } sub is_quasi_carmichael { my($n) = @_; _validate_positive_integer($n); return 0 if $n < 35; return 0 if (!($n % 4) || !($n % 9) || !($n % 25) || !($n%49) || !($n%121)); my @pe = Math::Prime::Util::factor_exp($n); # Not quasi-Carmichael if prime return 0 if scalar(@pe) < 2; # Not quasi-Carmichael if not square free for my $pe (@pe) { return 0 if $pe->[1] > 1; } my @f = map { $_->[0] } @pe; my $nbases = 0; if ($n < 2000) { # In theory for performance, but mainly keeping to show direct method. my $lim = $f[-1]; $lim = (($n-$lim*$lim) + $lim - 1) / $lim; for my $b (1 .. $f[0]-1) { my $nb = $n - $b; $nbases++ if Math::Prime::Util::vecall(sub { $nb % ($_-$b) == 0 }, @f); } if (scalar(@f) > 2) { for my $b (1 .. $lim-1) { my $nb = $n + $b; $nbases++ if Math::Prime::Util::vecall(sub { $nb % ($_+$b) == 0 }, @f); } } } else { my($spf,$lpf) = ($f[0], $f[-1]); if (scalar(@f) == 2) { foreach my $d (Math::Prime::Util::divisors($n/$spf - 1)) { my $k = $spf - $d; my $p = $n - $k; last if $d >= $spf; $nbases++ if Math::Prime::Util::vecall(sub { my $j = $_-$k; $j && ($p % $j) == 0 }, @f); } } else { foreach my $d (Math::Prime::Util::divisors($lpf * ($n/$lpf - 1))) { my $k = $lpf - $d; my $p = $n - $k; next if $k == 0 || $k >= $spf; $nbases++ if Math::Prime::Util::vecall(sub { my $j = $_-$k; $j && ($p % $j) == 0 }, @f); } } } $nbases; } sub is_pillai { my($p) = @_; return 0 if defined($p) && int($p) < 0; _validate_positive_integer($p); return 0 if $p <= 2; my $pm1 = $p-1; my $nfac = 5040 % $p; for (my $n = 8; $n < $p; $n++) { $nfac = Math::Prime::Util::mulmod($nfac, $n, $p); return $n if $nfac == $pm1 && ($p % $n) != 1; } 0; } sub is_fundamental { my($n) = @_; _validate_integer($n); my $neg = ($n < 0); $n = -$n if $neg; my $r = $n & 15; if ($r) { my $r4 = $r & 3; if (!$neg) { return (($r == 4) ? 0 : is_square_free($n >> 2)) if $r4 == 0; return is_square_free($n) if $r4 == 1; } else { return (($r == 12) ? 0 : is_square_free($n >> 2)) if $r4 == 0; return is_square_free($n) if $r4 == 3; } } 0; } 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 ((defined $k && $k==0) ? 2 : 1) if $n == 0; 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; return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::sigma($n, $k)) if $Math::Prime::Util::_GMPfunc{"sigma"}; 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 @factors = Math::Prime::Util::factor_exp($n); my $product = 1; my @fm; if ($k == 0) { $product = Math::Prime::Util::vecprod(map { $_->[1]+1 } @factors); } elsif (!$will_overflow) { foreach my $f (@factors) { my ($p, $e) = @$f; my $pk = $p ** $k; my $fmult = $pk + 1; foreach my $E (2 .. $e) { $fmult += $pk**$E } $product *= $fmult; } } elsif (ref($n) && ref($n) ne 'Math::BigInt') { # This can help a lot for Math::GMP, etc. $product = ref($n)->new(1); foreach my $f (@factors) { my ($p, $e) = @$f; my $pk = ref($n)->new($p) ** $k; my $fmult = $pk; $fmult++; if ($e >= 2) { my $pke = $pk; for (2 .. $e) { $pke *= $pk; $fmult += $pke; } } $product *= $fmult; } } elsif ($k == 1) { foreach my $f (@factors) { my ($p, $e) = @$f; my $pk = Math::BigInt->new("$p"); if ($e == 1) { push @fm, $pk->binc; next; } my $fmult = $pk->copy->binc; my $pke = $pk->copy; for my $E (2 .. $e) { $pke->bmul($pk); $fmult->badd($pke); } push @fm, $fmult; } $product = Math::Prime::Util::vecprod(@fm); } else { my $bik = Math::BigInt->new("$k"); foreach my $f (@factors) { my ($p, $e) = @$f; my $pk = Math::BigInt->new("$p")->bpow($bik); if ($e == 1) { push @fm, $pk->binc; next; } my $fmult = $pk->copy->binc; my $pke = $pk->copy; for my $E (2 .. $e) { $pke->bmul($pk); $fmult->badd($pke); } push @fm, $fmult; } $product = Math::Prime::Util::vecprod(@fm); } $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; do { require Math::BigFloat; Math::BigFloat->import(); } if ref($x) eq 'Math::BigInt'; 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 undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) 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 undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) 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 >= 46254381) { # Axler 2017 Corollary 1.2 $upper = $n * ( $flogn + $flog2n-1.0 + (($flog2n-2.00)/$flogn) - (($flog2n*$flog2n - 6*$flog2n + 10.667)/(2*$flogn*$flogn)) ); } elsif ($n >= 8009824) { # Axler 2013 page viii Korollar G $upper = $n * ( $flogn + $flog2n-1.0 + (($flog2n-2.00)/$flogn) - (($flog2n*$flog2n - 6*$flog2n + 10.273)/(2*$flogn*$flogn)) ); } elsif ($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 undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) 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)); # Axler 2013 page viii Korollar I, for all n >= 2 #my $lower = $n * ($flogn + $flog2n-1.0 + (($flog2n-2.00)/$flogn) - (($flog2n*$flog2n - 6*$flog2n + 11.847)/(2*$flogn*$flogn)) ); # Axler 2017 Corollary 1.4 my $lower = $n * ($flogn + $flog2n-1.0 + (($flog2n-2.00)/$flogn) - (($flog2n*$flog2n - 6*$flog2n + 11.508)/(2*$flogn*$flogn)) ); return int($lower + 0.999999999); } sub inverse_li { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); return (0,2,3,5,6,8)[$n] if $n <= 5; $n = _upgrade_to_float($n) if $n > MPU_MAXPRIMEIDX || $n > 2**45; my $t = $n * log($n); # Iterator Halley's method until error term grows my $old_term = MPU_INFINITY; for my $iter (1 .. 10000) { my $dn = Math::Prime::Util::LogarithmicIntegral($t) - $n; my $term = $dn * log($t) / (1.0 + $dn/(2*$t)); last if abs($term) >= abs($old_term); $old_term = $term; $t -= $term; last if abs($term) < 1e-6; } if (ref($t)) { $t = Math::BigInt->new($t->bceil->bstr); $t = _bigint_to_int($t) if $t->bacmp(BMAX) <= 0; } else { $t = int($t+0.999999); } $t; } sub _inverse_R { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); return (0,2,3,5,6,8)[$n] if $n <= 5; $n = _upgrade_to_float($n) if $n > MPU_MAXPRIMEIDX || $n > 2**45; my $t = $n * log($n); # Iterator Halley's method until error term grows my $old_term = MPU_INFINITY; for my $iter (1 .. 10000) { my $dn = Math::Prime::Util::RiemannR($t) - $n; my $term = $dn * log($t) / (1.0 + $dn/(2*$t)); last if abs($term) >= abs($old_term); $old_term = $term; $t -= $term; last if abs($term) < 1e-6; } if (ref($t)) { $t = Math::BigInt->new($t->bceil->bstr); $t = _bigint_to_int($t) if $t->bacmp(BMAX) <= 0; } else { $t = int($t+0.999999); } $t; } sub nth_prime_approx { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); return undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) return $_primes_small[$n] if $n <= $#_primes_small; # Once past 10^12 or so, inverse_li gives better results. return Math::Prime::Util::inverse_li($n) if $n > 1e12; $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 += 6.3 * $order; } elsif ($n < 1271) { $approx += 5.3 * $order; } elsif ($n < 2000) { $approx += 4.7 * $order; } elsif ($n < 4000) { $approx += 3.9 * $order; } elsif ($n < 12000) { $approx += 2.8 * $order; } elsif ($n < 150000) { $approx += 1.2 * $order; } elsif ($n < 20000000) { $approx += 0.11 * $order; } elsif ($n < 100000000) { $approx += 0.008 * $order; } elsif ($n < 500000000) { $approx += -0.038 * $order; } elsif ($n < 2000000000) { $approx += -0.054 * $order; } else { $approx += -0.058 * $order; } # If we want the asymptotic approximation to be >= actual, use -0.010. 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' && $x > 1e16; # Method 10^10 %error 10^19 %error # ----------------- ------------ ------------ # n/(log(n)-1) .22% .058% # n/(ln(n)-1-1/ln(n)) .032% .0041% # average bounds .0005% .0000002% # asymp .0006% .00000004% # 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 # Asymp: # my $l1 = log($x); my $l2 = $l1*$l1; my $l4 = $l2*$l2; # my $result = int( $x/$l1 + $x/$l2 + 2*$x/($l2*$l1) + 6*$x/($l4) + 24*$x/($l4*$l1) + 120*$x/($l4*$l2) + 720*$x/($l4*$l2*$l1) + 5040*$x/($l4*$l4) + 40320*$x/($l4*$l4*$l1) + 0.5 ); # 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; # Make sure we get enough accuracy, and also not too much more than needed $x->accuracy(length($x->copy->as_int->bstr())+2) if ref($x) =~ /^Math::Big/; my $result; if ($Math::Prime::Util::_GMPfunc{"riemannr"} || !ref($x)) { # Fast if we have our GMP backend, and ok for native. $result = Math::Prime::Util::PP::RiemannR($x); } else { $x = _upgrade_to_float($x) unless ref($x) eq 'Math::BigFloat'; $result = Math::BigFloat->new(0); $result->accuracy($x->accuracy) if ref($x) && $x->accuracy; $result += Math::BigFloat->new(LogarithmicIntegral($x)); $result -= Math::BigFloat->new(LogarithmicIntegral(sqrt($x))/2); my $intx = ref($x) ? Math::BigInt->new($x->bfround(0)) : $x; for my $k (3 .. 1000) { my $m = moebius($k); next unless $m != 0; # With Math::BigFloat and the Calc backend, FP root is ungodly slow. # Use integer root instead. For more accuracy (not useful here): # my $v = Math::BigFloat->new( "" . rootint($x->as_int,$k) ); # $v->accuracy(length($v)+5); # $v = $v - Math::BigFloat->new(($v**$k - $x))->bdiv($k * $v**($k-1)); # my $term = LogarithmicIntegral($v)/$k; my $term = LogarithmicIntegral(rootint($intx,$k)) / $k; last if $term < .25; if ($m == 1) { $result->badd(Math::BigFloat->new($term)) } else { $result->bsub(Math::BigFloat->new($term)) } } } if (ref($result)) { return $result unless ref($result) eq 'Math::BigFloat'; # Math::BigInt::FastCalc 0.19 implements as_int incorrectly. return Math::BigInt->new($result->bfround(0)->bstr); } int($result+0.5); } sub prime_count_lower { my($x) = @_; _validate_num($x) || _validate_positive_integer($x); return _tiny_prime_count($x) if $x < $_primes_small[-1]; return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::prime_count_lower($x)) if $Math::Prime::Util::_GMPfunc{"prime_count_lower"}; $x = _upgrade_to_float($x) if ref($x) eq 'Math::BigInt' || ref($_[0]) eq 'Math::BigInt'; my($result,$a); my $fl1 = log($x); my $fl2 = $fl1*$fl1; my $one = (ref($x) eq 'Math::BigFloat') ? $x->copy->bone : $x-$x+1.0; # 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 # Axler 2014 (1.2) ""+... x >= 1332450001 # Axler 2014 (1.2) x/(logx-1-1/logx-...) x >= 1332479531 # Büthe 2015 (1.9) li(x)-(sqrtx/logx)*(...) x <= 10^19 # Büthe 2014 Th 2 li(x)-logx*sqrtx/8Pi x > 2657, x <= 1.4*10^25 if ($x < 599) { # Decent for small numbers $result = $x / ($fl1 - 0.7); } elsif ($x < 52600000) { # Dusart 2010 tweaked 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 < 88783) { $a = 1.83; } elsif ($x < 176000) { $a = 1.99; } elsif ($x < 315000) { $a = 2.11; } elsif ($x < 1100000) { $a = 2.19; } elsif ($x < 4500000) { $a = 2.31; } else { $a = 2.35; } $result = ($x/$fl1) * ($one + $one/$fl1 + $a/$fl2); } elsif ($x < 1.4e25 || Math::Prime::Util::prime_get_config()->{'assume_rh'}){ # Büthe 2014/2015 my $lix = LogarithmicIntegral($x); my $sqx = sqrt($x); if ($x < 1e19) { $result = $lix - ($sqx/$fl1) * (1.94 + 3.88/$fl1 + 27.57/$fl2); } else { if (ref($x) eq 'Math::BigFloat') { my $xdigits = _find_big_acc($x); $result = $lix - ($fl1*$sqx / (Math::BigFloat->bpi($xdigits)*8)); } else { $result = $lix - ($fl1*$sqx / PI_TIMES_8); } } } else { # Axler 2014 1.4 my($fl3,$fl4) = ($fl2*$fl1,$fl2*$fl2); my($fl5,$fl6) = ($fl4*$fl1,$fl4*$fl2); $result = $x / ($fl1 - $one - $one/$fl1 - 2.65/$fl2 - 13.35/$fl3 - 70.3/$fl4 - 455.6275/$fl5 - 3404.4225/$fl6); } 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]; return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::prime_count_upper($x)) if $Math::Prime::Util::_GMPfunc{"prime_count_upper"}; $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 # Panaitopol 1999: x/(logx-1.112) x >= 4 # 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 # Axler 2014: x/(logx-1-1/logx-3.35/logxlogx...) x >= e^3.804 # Büthe 2014 7.4 Schoenfeld bounds hold to x <= 1.4e25 # Axler 2017 Prop 2.2 Schoenfeld bounds hold to x <= 5.5e25 # Skewes li(x) x < 1e14 my($result,$a); my $fl1 = log($x); my $fl2 = $fl1 * $fl1; my $one = (ref($x) eq 'Math::BigFloat') ? $x->copy->bone : $x-$x+1.0; if ($x < 15900) { # Tweaked Rosser-type $a = ($x < 1621) ? 1.048 : ($x < 5000) ? 1.071 : 1.098; $result = ($x / ($fl1 - $a)) + 1.0; } elsif ($x < 821800000) { # Tweaked Dusart 2010 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 $result = ($x/$fl1) * ($one + $one/$fl1 + $a/$fl2) + $one; } elsif ($x < 1e19) { # Skewes number lower limit $a = ($x < 110e7) ? 0.032 : ($x < 1001e7) ? 0.027 : ($x < 10126e7) ? 0.021 : 0.0; $result = LogarithmicIntegral($x) - $a * $fl1*sqrt($x)/PI_TIMES_8; } elsif ($x < 5.5e25 || Math::Prime::Util::prime_get_config()->{'assume_rh'}) { # Schoenfeld / Büthe 2014 Th 7.4 my $lix = LogarithmicIntegral($x); my $sqx = sqrt($x); if (ref($x) eq 'Math::BigFloat') { my $xdigits = _find_big_acc($x); $result = $lix + ($fl1*$sqx / (Math::BigFloat->bpi($xdigits)*8)); } else { $result = $lix + ($fl1*$sqx / PI_TIMES_8); } } else { # Axler 2014 1.3 my($fl3,$fl4) = ($fl2*$fl1,$fl2*$fl2); my($fl5,$fl6) = ($fl4*$fl1,$fl4*$fl2); $result = $x / ($fl1 - $one - $one/$fl1 - 3.35/$fl2 - 12.65/$fl3 - 71.7/$fl4 - 466.1275/$fl5 - 3489.8225/$fl6); } return Math::BigInt->new($result->bfloor->bstr()) if ref($result) eq 'Math::BigFloat'; return int($result); } sub twin_prime_count { my($low,$high) = @_; if (defined $high) { _validate_positive_integer($low); } else { ($low,$high) = (2, $low); } _validate_positive_integer($high); my $sum = 0; while ($low <= $high) { my $seghigh = ($high-$high) + $low + 1e7 - 1; $seghigh = $high if $seghigh > $high; $sum += scalar(@{Math::Prime::Util::twin_primes($low,$seghigh)}); $low = $seghigh + 1; } $sum; } sub _semiprime_count { my $n = shift; my($sum,$pc) = (0,0); Math::Prime::Util::forprimes( sub { $sum += Math::Prime::Util::prime_count(int($n/$_))-$pc++; }, sqrtint($n)); $sum; } sub semiprime_count { my($low,$high) = @_; if (defined $high) { _validate_positive_integer($low); } else { ($low,$high) = (2, $low); } _validate_positive_integer($high); # todo: threshold of fast count vs. walk my $sum = _semiprime_count($high) - (($low < 4) ? 0 : semiprime_count($low-1)); $sum; } sub ramanujan_prime_count { my($low,$high) = @_; if (defined $high) { _validate_positive_integer($low); } else { ($low,$high) = (2, $low); } _validate_positive_integer($high); my $sum = 0; while ($low <= $high) { my $seghigh = ($high-$high) + $low + 1e9 - 1; $seghigh = $high if $seghigh > $high; $sum += scalar(@{Math::Prime::Util::ramanujan_primes($low,$seghigh)}); $low = $seghigh + 1; } $sum; } sub twin_prime_count_approx { my($n) = @_; return twin_prime_count(3,$n) if $n < 2000; $n = _upgrade_to_float($n) if ref($n); my $logn = log($n); # The loss of full Ei precision is a few orders of magnitude less than the # accuracy of the estimate, so save huge time and don't bother. my $li2 = Math::Prime::Util::ExponentialIntegral("$logn") + 2.8853900817779268147198494 - ($n/$logn); # Empirical correction factor my $fm; if ($n < 4000) { $fm = 0.2952; } elsif ($n < 8000) { $fm = 0.3151; } elsif ($n < 16000) { $fm = 0.3090; } elsif ($n < 32000) { $fm = 0.3096; } elsif ($n < 64000) { $fm = 0.3100; } elsif ($n < 128000) { $fm = 0.3089; } elsif ($n < 256000) { $fm = 0.3099; } elsif ($n < 600000) { my($x0, $x1, $y0, $y1) = (1e6, 6e5, .3091, .3059); $fm = $y0 + ($n - $x0) * ($y1-$y0) / ($x1 - $x0); } elsif ($n < 1000000) { my($x0, $x1, $y0, $y1) = (6e5, 1e6, .3062, .3042); $fm = $y0 + ($n - $x0) * ($y1-$y0) / ($x1 - $x0); } elsif ($n < 4000000) { my($x0, $x1, $y0, $y1) = (1e6, 4e6, .3067, .3041); $fm = $y0 + ($n - $x0) * ($y1-$y0) / ($x1 - $x0); } elsif ($n < 16000000) { my($x0, $x1, $y0, $y1) = (4e6, 16e6, .3033, .2983); $fm = $y0 + ($n - $x0) * ($y1-$y0) / ($x1 - $x0); } elsif ($n < 32000000) { my($x0, $x1, $y0, $y1) = (16e6, 32e6, .2980, .2965); $fm = $y0 + ($n - $x0) * ($y1-$y0) / ($x1 - $x0); } $li2 *= $fm * log(12+$logn) if defined $fm; return int(1.32032363169373914785562422 * $li2 + 0.5); } sub semiprime_count_approx { my($n) = @_; return 0 if $n < 4; _validate_positive_integer($n); $n = "$n" + 0.00000001; my $l1 = log($n); my $l2 = log($l1); #my $est = $n * $l2 / $l1; my $est = $n * ($l2 + 0.302) / $l1; int(0.5+$est); } sub nth_twin_prime { my($n) = @_; return undef if $n < 0; ## no critic qw(ProhibitExplicitReturnUndef) return (undef,3,5,11,17,29,41)[$n] if $n <= 6; my $p = Math::Prime::Util::nth_twin_prime_approx($n+200); my $tp = Math::Prime::Util::twin_primes($p); while ($n > scalar(@$tp)) { $n -= scalar(@$tp); $tp = Math::Prime::Util::twin_primes($p+1,$p+1e5); $p += 1e5; } return $tp->[$n-1]; } sub nth_twin_prime_approx { my($n) = @_; _validate_positive_integer($n); return nth_twin_prime($n) if $n < 6; $n = _upgrade_to_float($n) if ref($n) || $n > 127e14; # TODO lower for 32-bit my $logn = log($n); my $nlogn2 = $n * $logn * $logn; return int(5.158 * $nlogn2/log(9+log($n*$n))) if $n > 59 && $n <= 1092; my $lo = int(0.7 * $nlogn2); my $hi = int( ($n > 1e16) ? 1.1 * $nlogn2 : ($n > 480) ? 1.7 * $nlogn2 : 2.3 * $nlogn2 + 3 ); _binary_search($n, $lo, $hi, sub{Math::Prime::Util::twin_prime_count_approx(shift)}, sub{ ($_[2]-$_[1])/$_[1] < 1e-15 } ); } sub nth_semiprime { my $n = shift; return undef if $n < 0; ## no critic qw(ProhibitExplicitReturnUndef) return (undef,4,6,9,10,14,15,21,22)[$n] if $n <= 8; my $logn = log($n); my $est = 0.966 * $n * $logn / log($logn); 1+_binary_search($n, int(0.9*$est)-1, int(1.15*$est)+1, sub{Math::Prime::Util::semiprime_count(shift)}); } sub nth_semiprime_approx { my $n = shift; return undef if $n < 0; ## no critic qw(ProhibitExplicitReturnUndef) _validate_positive_integer($n); return (undef,4,6,9,10,14,15,21,22)[$n] if $n <= 8; $n = "$n" + 0.00000001; my $l1 = log($n); my $l2 = log($l1); my $est = 0.966 * $n * $l1 / $l2; int(0.5+$est); } sub nth_ramanujan_prime_upper { my $n = shift; return (0,2,11)[$n] if $n <= 2; $n = Math::BigInt->new("$n") if $n > (~0/3); my $nth = nth_prime_upper(3*$n); return $nth if $n < 10000; $nth = Math::BigInt->new("$nth") if $nth > (~0/177); if ($n < 1000000) { $nth = (177 * $nth) >> 8; } elsif ($n < 1e10) { $nth = (175 * $nth) >> 8; } else { $nth = (133 * $nth) >> 8; } $nth = _bigint_to_int($nth) if ref($nth) && $nth->bacmp(BMAX) <= 0; $nth; } sub nth_ramanujan_prime_lower { my $n = shift; return (0,2,11)[$n] if $n <= 2; $n = Math::BigInt->new("$n") if $n > (~0/2); my $nth = nth_prime_lower(2*$n); $nth = Math::BigInt->new("$nth") if $nth > (~0/275); if ($n < 10000) { $nth = (275 * $nth) >> 8; } elsif ($n < 1e10) { $nth = (262 * $nth) >> 8; } $nth = _bigint_to_int($nth) if ref($nth) && $nth->bacmp(BMAX) <= 0; $nth; } sub nth_ramanujan_prime_approx { my $n = shift; return (0,2,11)[$n] if $n <= 2; my($lo,$hi) = (nth_ramanujan_prime_lower($n),nth_ramanujan_prime_upper($n)); $lo + (($hi-$lo)>>1); } sub ramanujan_prime_count_upper { my $n = shift; return (($n < 2) ? 0 : 1) if $n < 11; my $lo = int(prime_count_lower($n) / 3); my $hi = prime_count_upper($n) >> 1; 1+_binary_search($n, $lo, $hi, sub{Math::Prime::Util::nth_ramanujan_prime_lower(shift)}); } sub ramanujan_prime_count_lower { my $n = shift; return (($n < 2) ? 0 : 1) if $n < 11; my $lo = int(prime_count_lower($n) / 3); my $hi = prime_count_upper($n) >> 1; _binary_search($n, $lo, $hi, sub{Math::Prime::Util::nth_ramanujan_prime_upper(shift)}); } sub ramanujan_prime_count_approx { my $n = shift; return (($n < 2) ? 0 : 1) if $n < 11; #$n = _upgrade_to_float($n) if ref($n) || $n > 2e16; my $lo = ramanujan_prime_count_lower($n); my $hi = ramanujan_prime_count_upper($n); _binary_search($n, $lo, $hi, sub{Math::Prime::Util::nth_ramanujan_prime_approx(shift)}, sub{ ($_[2]-$_[1])/$_[1] < 1e-15 } ); } sub _sum_primes_n { my $n = shift; return (0,0,2,5,5)[$n] if $n < 5; my $r = Math::Prime::Util::sqrtint($n); my $r2 = $r + int($n/($r+1)); my(@V,@S); for my $k (0 .. $r2) { my $v = ($k <= $r) ? $k : int($n/($r2-$k+1)); $V[$k] = $v; $S[$k] = (($v*($v+1)) >> 1) - 1; } Math::Prime::Util::forprimes( sub { my $p = $_; my $sp = $S[$p-1]; my $p2 = $p*$p; for my $v (reverse @V) { last if $v < $p2; my($a,$b) = ($v,int($v/$p)); $a = $r2 - int($n/$a) + 1 if $a > $r; $b = $r2 - int($n/$b) + 1 if $b > $r; $S[$a] -= $p * ($S[$b] - $sp); } }, 2, $r); $S[$r2]; } sub sum_primes { my($low,$high) = @_; if (defined $high) { _validate_positive_integer($low); } else { ($low,$high) = (2, $low); } _validate_positive_integer($high); my $sum = 0; $sum = BZERO->copy if ( (MPU_32BIT && $high > 323_380) || (MPU_64BIT && $high > 29_505_444_490) ); # It's very possible we're here because they've counted too high. Skip fwd. if ($low <= 2 && $high >= 29505444491) { $low = 29505444503; $sum = Math::BigInt->new("18446744087046669523"); } return $sum if $low > $high; # We have to make some decision about whether to use our PP prime sum or loop # doing the XS sieve. TODO: Be smarter here? if (!Math::Prime::Util::prime_get_config()->{'xs'} && !ref($sum) && !MPU_32BIT && ($high-$low) > 1000000) { # Unfortunately with bigints this is horrifically slow, but we have to do it. $high = BZERO->copy + $high if $high >= (1 << (MPU_MAXBITS/2))-1; $sum = _sum_primes_n($high); $sum -= _sum_primes_n($low-1) if $low > 2; return $sum; } my $xssum = (MPU_64BIT && $high < 6e14 && Math::Prime::Util::prime_get_config()->{'xs'}); my $step = ($xssum && $high > 5e13) ? 1_000_000 : 11_000_000; Math::Prime::Util::prime_precalc(sqrtint($high)); while ($low <= $high) { my $next = $low + $step - 1; $next = $high if $next > $high; $sum += ($xssum) ? Math::Prime::Util::sum_primes($low,$next) : Math::Prime::Util::vecsum( @{Math::Prime::Util::primes($low,$next)} ); last if $next == $high; $low = $next+1; } $sum; } sub print_primes { my($low,$high,$fd) = @_; if (defined $high) { _validate_positive_integer($low); } else { ($low,$high) = (2, $low); } _validate_positive_integer($high); $fd = fileno(STDOUT) unless defined $fd; open(my $fh, ">>&=", $fd); # TODO .... or die if ($high >= $low) { my $p1 = $low; while ($p1 <= $high) { my $p2 = $p1 + 15_000_000 - 1; $p2 = $high if $p2 > $high; if ($Math::Prime::Util::_GMPfunc{"sieve_primes"}) { print $fh "$_\n" for Math::Prime::Util::GMP::sieve_primes($p1,$p2,0); } else { print $fh "$_\n" for @{primes($p1,$p2)}; } $p1 = $p2+1; } } close($fh); } ############################################################################# 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; } sub _addmod { my($x, $y, $n) = @_; $x %= $n if $x >= $n; $y %= $n if $y >= $n; if (($n-$x) <= $y) { ($x,$y) = ($y,$x) if $y > $x; $x -= $n; } $x + $y; } # 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, Math::BigInt::Lite, # and use correct lcm semantics. sub gcd { # First see if all inputs are non-bigints 5-10x faster if so. if (0 == scalar(grep { ref($_) } @_)) { my($x,$y) = (shift || 0, 0); while (@_) { $y = shift; while ($y) { ($x,$y) = ($y, $x % $y); } $x = -$x if $x < 0; } return $x; } my $gcd = Math::BigInt::bgcd( map { my $v = (($_ < 2147483647 && !ref($_)) || ref($_) eq 'Math::BigInt') ? $_ : "$_"; $v; } @_ ); $gcd = _bigint_to_int($gcd) if $gcd->bacmp(BMAX) <= 0; return $gcd; } sub lcm { return 0 unless @_; my $lcm = Math::BigInt::blcm( map { my $v = (($_ < 2147483647 && !ref($_)) || ref($_) eq 'Math::BigInt') ? $_ : "$_"; return 0 if $v == 0; $v = -$v if $v < 0; $v; } @_ ); $lcm = _bigint_to_int($lcm) if $lcm->bacmp(BMAX) <= 0; return $lcm; } sub gcdext { my($x,$y) = @_; if ($x == 0) { return (0, (-1,0,1)[($y>=0)+($y>0)], abs($y)); } if ($y == 0) { return ((-1,0,1)[($x>=0)+($x>0)], 0, abs($x)); } if ($Math::Prime::Util::_GMPfunc{"gcdext"}) { my($a,$b,$g) = Math::Prime::Util::GMP::gcdext($x,$y); $a = Math::Prime::Util::_reftyped($_[0], $a); $b = Math::Prime::Util::_reftyped($_[0], $b); $g = Math::Prime::Util::_reftyped($_[0], $g); return ($a,$b,$g); } my($a,$b,$g,$u,$v,$w); if (abs($x) < (~0>>1) && abs($y) < (~0>>1)) { $x = _bigint_to_int($x) if ref($x) eq 'Math::BigInt'; $y = _bigint_to_int($y) if ref($y) eq 'Math::BigInt'; ($a,$b,$g,$u,$v,$w) = (1,0,$x,0,1,$y); while ($w != 0) { my $r = $g % $w; my $q = int(($g-$r)/$w); ($a,$b,$g,$u,$v,$w) = ($u,$v,$w,$a-$q*$u,$b-$q*$v,$r); } } else { ($a,$b,$g,$u,$v,$w) = (BONE->copy,BZERO->copy,Math::BigInt->new("$x"), BZERO->copy,BONE->copy,Math::BigInt->new("$y")); while ($w != 0) { # Using the array bdiv is logical, but is the wrong sign. my $r = $g->copy->bmod($w); my $q = $g->copy->bsub($r)->bdiv($w); ($a,$b,$g,$u,$v,$w) = ($u,$v,$w,$a-$q*$u,$b-$q*$v,$r); } $a = _bigint_to_int($a) if $a->bacmp(BMAX) <= 0; $b = _bigint_to_int($b) if $b->bacmp(BMAX) <= 0; $g = _bigint_to_int($g) if $g->bacmp(BMAX) <= 0; } if ($g < 0) { ($a,$b,$g) = (-$a,-$b,-$g); } return ($a,$b,$g); } sub chinese { return 0 unless scalar @_; return $_[0]->[0] % $_[0]->[1] if scalar @_ == 1; my($lcm, $sum); if ($Math::Prime::Util::_GMPfunc{"chinese"} && $Math::Prime::Util::GMP::VERSION >= 0.42) { $sum = Math::Prime::Util::GMP::chinese(@_); if (defined $sum) { $sum = Math::BigInt->new("$sum"); $sum = _bigint_to_int($sum) if ref($sum) && $sum->bacmp(BMAX) <= 0; } return $sum; } foreach my $aref (sort { $b->[1] <=> $a->[1] } @_) { my($ai, $ni) = @$aref; $ai = Math::BigInt->new("$ai") if !ref($ai) && (abs($ai) > (~0>>1) || OLD_PERL_VERSION); $ni = Math::BigInt->new("$ni") if !ref($ni) && (abs($ni) > (~0>>1) || OLD_PERL_VERSION); if (!defined $lcm) { ($sum,$lcm) = ($ai % $ni, $ni); next; } # gcdext my($u,$v,$g,$s,$t,$w) = (1,0,$lcm,0,1,$ni); while ($w != 0) { my $r = $g % $w; my $q = ref($g) ? $g->copy->bsub($r)->bdiv($w) : int(($g-$r)/$w); ($u,$v,$g,$s,$t,$w) = ($s,$t,$w,$u-$q*$s,$v-$q*$t,$r); } ($u,$v,$g) = (-$u,-$v,-$g) if $g < 0; return if $g != 1 && ($sum % $g) != ($ai % $g); # Not co-prime $s = -$s if $s < 0; $t = -$t if $t < 0; # Convert to bigint if necessary. Performance goes to hell. if (!ref($lcm) && ($lcm*$s) > ~0) { $lcm = Math::BigInt->new("$lcm"); } if (ref($lcm)) { $lcm->bmul("$s"); my $m1 = Math::BigInt->new("$v")->bmul("$s")->bmod($lcm); my $m2 = Math::BigInt->new("$u")->bmul("$t")->bmod($lcm); $m1->bmul("$sum")->bmod($lcm); $m2->bmul("$ai")->bmod($lcm); $sum = $m1->badd($m2)->bmod($lcm); } else { $lcm *= $s; $u += $lcm if $u < 0; $v += $lcm if $v < 0; my $vs = _mulmod($v,$s,$lcm); my $ut = _mulmod($u,$t,$lcm); my $m1 = _mulmod($sum,$vs,$lcm); my $m2 = _mulmod($ut,$ai % $lcm,$lcm); $sum = _addmod($m1, $m2, $lcm); } } $sum = _bigint_to_int($sum) if ref($sum) && $sum->bacmp(BMAX) <= 0; $sum; } sub _from_128 { my($hi, $lo) = @_; return 0 unless defined $hi && defined $lo; #print "hi $hi lo $lo\n"; (Math::BigInt->new("$hi") << MPU_MAXBITS) + $lo; } sub vecsum { return Math::Prime::Util::_reftyped($_[0], @_ ? $_[0] : 0) if @_ <= 1; return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::vecsum(@_)) if $Math::Prime::Util::_GMPfunc{"vecsum"}; my $sum = 0; my $neglim = -(INTMAX >> 1) - 1; foreach my $v (@_) { $sum += $v; if ($sum > (INTMAX-250) || $sum < $neglim) { $sum = BZERO->copy; $sum->badd("$_") for @_; return $sum; } } $sum; } sub vecprod { return 1 unless @_; return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::vecprod(@_)) if $Math::Prime::Util::_GMPfunc{"vecprod"}; # Product tree: my $prod = _product(0, $#_, [map { Math::BigInt->new("$_") } @_]); # Linear: # my $prod = BONE->copy; $prod *= "$_" for @_; $prod = _bigint_to_int($prod) if $prod->bacmp(BMAX) <= 0 && $prod->bcmp(-(BMAX>>1)) > 0; $prod; } sub vecmin { return unless @_; my $min = shift; for (@_) { $min = $_ if $_ < $min; } $min; } sub vecmax { return unless @_; my $max = shift; for (@_) { $max = $_ if $_ > $max; } $max; } sub vecextract { my($aref, $mask) = @_; return @$aref[@$mask] if ref($mask) eq 'ARRAY'; # This is concise but very slow. # map { $aref->[$_] } grep { $mask & (1 << $_) } 0 .. $#$aref; my($i, @v) = (0); while ($mask) { push @v, $i if $mask & 1; $mask >>= 1; $i++; } @$aref[@v]; } sub sumdigits { my($n,$base) = @_; my $sum = 0; $base = 2 if !defined $base && $n =~ s/^0b//; $base = 16 if !defined $base && $n =~ s/^0x//; if (!defined $base || $base == 10) { $n =~ tr/0123456789//cd; $sum += $_ for (split(//,$n)); } else { croak "sumdigits: invalid base $base" if $base < 2; my $cmap = substr("0123456789abcdefghijklmnopqrstuvwxyz",0,$base); for my $c (split(//,lc($n))) { my $p = index($cmap,$c); $sum += $p if $p > 0; } } $sum; } sub invmod { my($a,$n) = @_; return if $n == 0 || $a == 0; return 0 if $n == 1; $n = -$n if $n < 0; # Pari semantics if ($n > ~0) { my $invmod = Math::BigInt->new("$a")->bmodinv("$n"); return if !defined $invmod || $invmod->is_nan; $invmod = _bigint_to_int($invmod) if $invmod->bacmp(BMAX) <= 0; return $invmod; } my($t,$nt,$r,$nr) = (0, 1, $n, $a % $n); while ($nr != 0) { # Use mod before divide to force correct behavior with high bit set my $quot = int( ($r-($r % $nr))/$nr ); ($nt,$t) = ($t-$quot*$nt,$nt); ($nr,$r) = ($r-$quot*$nr,$nr); } return if $r > 1; $t += $n if $t < 0; $t; } sub _verify_sqrtmod { my($r,$a,$n) = @_; if (ref($r)) { return if $r->copy->bmul($r)->bmod($n)->bcmp($a); $r = _bigint_to_int($r) if $r->bacmp(BMAX) <= 0; } else { return unless (($r*$r) % $n) == $a; } $r = $n-$r if $n-$r < $r; $r; } sub sqrtmod { my($a,$n) = @_; return if $n == 0; if ($n <= 2 || $a <= 1) { $a %= $n; return ((($a*$a) % $n) == $a) ? $a : undef; } if ($n < 10000000) { # Horrible trial search $a = _bigint_to_int($a); $n = _bigint_to_int($n); $a %= $n; return 1 if $a == 1; my $lim = ($n+1) >> 1; for my $r (2 .. $lim) { return $r if (($r*$r) % $n) == $a; } undef; } $a = Math::BigInt->new("$a") unless ref($a) eq 'Math::BigInt'; $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; $a->bmod($n); my $r; if (($n % 4) == 3) { $r = $a->copy->bmodpow(($n+1)>>2, $n); return _verify_sqrtmod($r, $a, $n); } if (($n % 8) == 5) { my $q = $a->copy->bmodpow(($n-1)>>2, $n); if ($q->is_one) { $r = $a->copy->bmodpow(($n+3)>>3, $n); } else { my $v = $a->copy->bmul(4)->bmodpow(($n-5)>>3, $n); $r = $a->copy->bmul(2)->bmul($v)->bmod($n); } return _verify_sqrtmod($r, $a, $n); } return if $n->is_odd && !$a->copy->bmodpow(($n-1)>>1,$n)->is_one(); # Horrible trial search. Need to use Tonelli-Shanks here. $r = Math::BigInt->new(2); my $lim = int( ($n+1) / 2 ); while ($r < $lim) { return $r if $r->copy->bmul($r)->bmod($n) == $a; $r++; } undef; } sub addmod { my($a, $b, $n) = @_; return 0 if $n <= 1; return _addmod($a,$b,$n) if $n < INTMAX && $a>=0 && $a=0 && $bnew("$a")->badd("$b")->bmod("$n"); $ret = _bigint_to_int($ret) if $ret->bacmp(BMAX) <= 0; $ret; } sub mulmod { my($a, $b, $n) = @_; return 0 if $n <= 1; return _mulmod($a,$b,$n) if $n < INTMAX && $a>0 && $a0 && $bnew("$a")->bmod("$n")->bmul("$b")->bmod("$n"); $ret = _bigint_to_int($ret) if $ret->bacmp(BMAX) <= 0; $ret; } sub divmod { my($a, $b, $n) = @_; return 0 if $n <= 1; my $ret = Math::BigInt->new("$b")->bmodinv("$n")->bmul("$a")->bmod("$n"); if ($ret->is_nan) { $ret = undef; } else { $ret = _bigint_to_int($ret) if $ret->bacmp(BMAX) <= 0; } $ret; } sub powmod { my($a, $b, $n) = @_; return 0 if $n <= 1; if ($Math::Prime::Util::_GMPfunc{"powmod"}) { my $r = Math::Prime::Util::GMP::powmod($a,$b,$n); return (defined $r) ? Math::Prime::Util::_reftyped($_[0], $r) : undef; } my $ret = Math::BigInt->new("$a")->bmod("$n")->bmodpow("$b","$n"); if ($ret->is_nan) { $ret = undef; } else { $ret = _bigint_to_int($ret) if $ret->bacmp(BMAX) <= 0; } $ret; } # 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) { ($x, $y) = ($y, $x % $y); } $x; } sub is_power { my ($n, $a, $refp) = @_; croak("is_power third argument not a scalar reference") if defined($refp) && !ref($refp); _validate_integer($n); return 0 if abs($n) <= 3 && !$a; if ($Math::Prime::Util::_GMPfunc{"is_power"} && ($Math::Prime::Util::GMP::VERSION >= 0.42 || ($Math::Prime::Util::GMP::VERSION >= 0.28 && $n > 0))) { $a = 0 unless defined $a; my $k = Math::Prime::Util::GMP::is_power($n,$a); return 0 unless $k > 0; if (defined $refp) { $a = $k unless $a; my $isneg = ($n < 0); $n =~ s/^-// if $isneg; $$refp = Math::Prime::Util::rootint($n, $a); $$refp = Math::Prime::Util::_reftyped($_[0], $$refp) if $$refp > INTMAX; $$refp = -$$refp if $isneg; } return $k; } if (defined $a && $a != 0) { return 1 if $a == 1; # Everything is a 1st power return 0 if $n < 0 && $a % 2 == 0; # Negative n never an even power if ($a == 2) { if (_is_perfect_square($n)) { $$refp = int(sqrt($n)) if defined $refp; return 1; } } else { $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my $root = $n->copy->babs->broot($a)->bfloor; $root->bneg if $n->is_neg; if ($root->copy->bpow($a) == $n) { $$refp = $root if defined $refp; return 1; } } } else { $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; if ($n < 0) { my $absn = $n->copy->babs; my $root = is_power($absn, 0, $refp); return 0 unless $root; if ($root % 2 == 0) { my $power = valuation($root, 2); $root >>= $power; return 0 if $root == 1; $power = BTWO->copy->bpow($power); $$refp = $$refp ** $power if defined $refp; } $$refp = -$$refp if defined $refp; return $root; } my $e = 2; while (1) { my $root = $n->copy()->broot($e)->bfloor; last if $root->is_one(); if ($root->copy->bpow($e) == $n) { my $next = is_power($root, 0, $refp); $$refp = $root if !$next && defined $refp; $e *= $next if $next != 0; return $e; } $e = next_prime($e); } } 0; } sub is_square { my($n) = @_; return 0 if $n < 0; #is_power($n,2); _validate_integer($n); _is_perfect_square($n); } sub is_prime_power { my ($n, $refp) = @_; croak("is_prime_power second argument not a scalar reference") if defined($refp) && !ref($refp); return 0 if $n <= 1; if (Math::Prime::Util::is_prime($n)) { $$refp = $n if defined $refp; return 1; } my $r; my $k = Math::Prime::Util::is_power($n,0,\$r); if ($k) { $r = _bigint_to_int($r) if ref($r) && $r->bacmp(BMAX) <= 0; return 0 unless Math::Prime::Util::is_prime($r); $$refp = $r if defined $refp; } $k; } sub is_polygonal { my ($n, $k, $refp) = @_; croak("is_polygonal third argument not a scalar reference") if defined($refp) && !ref($refp); croak("is_polygonal: k must be >= 3") if $k < 3; return 0 if $n <= 0; if ($n == 1) { $$refp = 1 if defined $refp; return 1; } if ($Math::Prime::Util::_GMPfunc{"polygonal_nth"}) { my $nth = Math::Prime::Util::GMP::polygonal_nth($n, $k); return 0 unless $nth; $nth = Math::Prime::Util::_reftyped($_[0], $nth); $$refp = $nth if defined $refp; return 1; } my($D,$R); if ($k == 4) { return 0 unless _is_perfect_square($n); $$refp = sqrtint($n) if defined $refp; return 1; } if ($n <= MPU_HALFWORD && $k <= MPU_HALFWORD) { $D = ($k==3) ? 1+($n<<3) : (8*$k-16)*$n + ($k-4)*($k-4); return 0 unless _is_perfect_square($D); $D = $k-4 + Math::Prime::Util::sqrtint($D); $R = 2*$k-4; } else { if ($k == 3) { $D = vecsum(1, vecprod($n, 8)); } else { $D = vecsum(vecprod($n, vecprod(8, $k) - 16), vecprod($k-4,$k-4));; } return 0 unless _is_perfect_square($D); $D = vecsum( sqrtint($D), $k-4 ); $R = vecprod(2, $k) - 4; } return 0 if ($D % $R) != 0; $$refp = $D / $R if defined $refp; 1; } sub valuation { my($n, $k) = @_; $n = -$n if defined $n && $n < 0; _validate_num($n) || _validate_positive_integer($n); return 0 if $n < 2 || $k < 2; my $v = 0; if ($k == 2) { # Accelerate power of 2 if (ref($n) eq 'Math::BigInt') { # This can pay off for big inputs return 0 unless $n->is_even; my $s = $n->as_bin; # We could do same for k=10 return length($s) - rindex($s,'1') - 1; } while (!($n & 0xFFFF) ) { $n >>=16; $v +=16; } while (!($n & 0x000F) ) { $n >>= 4; $v += 4; } } while ( !($n % $k) ) { $n /= $k; $v++; } $v; } sub hammingweight { my $n = shift; return 0 + (Math::BigInt->new("$n")->as_bin() =~ tr/1//); } my @_digitmap = (0..9, 'a'..'z'); my %_mapdigit = map { $_digitmap[$_] => $_ } 0 .. $#_digitmap; sub _splitdigits { my($n, $base, $len) = @_; # n is num or bigint, base is in range my @d; if ($base == 10) { @d = split(//,"$n"); } elsif ($base == 2) { @d = split(//,substr(Math::BigInt->new("$n")->as_bin,2)); } elsif ($base == 16) { @d = map { $_mapdigit{$_} } split(//,substr(Math::BigInt->new("$n")->as_hex,2)); } else { while ($n >= 1) { my $rem = $n % $base; unshift @d, $rem; $n = ($n-$rem)/$base; # Always an exact division } } if ($len >= 0 && $len != scalar(@d)) { while (@d < $len) { unshift @d, 0; } while (@d > $len) { shift @d; } } @d; } sub todigits { my($n,$base,$len) = @_; $base = 10 unless defined $base; $len = -1 unless defined $len; die "Invalid base: $base" if $base < 2; return if $n == 0; $n = -$n if $n < 0; _validate_num($n) || _validate_positive_integer($n); _splitdigits($n, $base, $len); } sub todigitstring { my($n,$base,$len) = @_; $base = 10 unless defined $base; $len = -1 unless defined $len; $n =~ s/^-//; return substr(Math::BigInt->new("$n")->as_bin,2) if $base == 2 && $len < 0; return substr(Math::BigInt->new("$n")->as_oct,1) if $base == 8 && $len < 0; return substr(Math::BigInt->new("$n")->as_hex,2) if $base == 16 && $len < 0; my @d = ($n == 0) ? () : _splitdigits($n, $base, $len); return join("", @d) if $base <= 10; die "Invalid base for string: $base" if $base > 36; join("", map { $_digitmap[$_] } @d); } sub fromdigits { my($r, $base) = @_; $base = 10 unless defined $base; return $r if $base == 10 && ref($r) =~ /^Math::/; my $n; if (ref($r) && ref($r) !~ /^Math::/) { croak "fromdigits first argument must be a string or array reference" unless ref($r) eq 'ARRAY'; ($n,$base) = (BZERO->copy, BZERO + $base); for my $d (@$r) { $n = $n * $base + $d; } } elsif ($base == 2) { $n = Math::BigInt->from_bin("0b$r"); } elsif ($base == 8) { $n = Math::BigInt->from_oct("0$r"); } elsif ($base == 16) { $n = Math::BigInt->from_hex("0x$r"); } else { $r =~ s/^0*//; ($n,$base) = (BZERO->copy, BZERO + $base); #for my $d (map { $_mapdigit{$_} } split(//,$r)) { # croak "Invalid digit for base $base" unless defined $d && $d < $base; # $n = $n * $base + $d; #} for my $c (split(//, lc($r))) { $n->bmul($base); if ($c ne '0') { my $d = index("0123456789abcdefghijklmnopqrstuvwxyz", $c); croak "Invalid digit for base $base" unless $d >= 0; $n->badd($d); } } } $n = _bigint_to_int($n) if $n->bacmp(BMAX) <= 0; $n; } sub sqrtint { my($n) = @_; my $sqrt = Math::BigInt->new("$n")->bsqrt; return Math::Prime::Util::_reftyped($_[0], "$sqrt"); } sub rootint { my ($n, $k, $refp) = @_; croak "rootint: k must be > 0" unless $k > 0; # Math::BigInt returns NaN for any root of a negative n. my $root = Math::BigInt->new("$n")->babs->broot("$k"); if (defined $refp) { croak("logint third argument not a scalar reference") unless ref($refp); $$refp = $root->copy->bpow($k); } return Math::Prime::Util::_reftyped($_[0], "$root"); } sub logint { my ($n, $b, $refp) = @_; croak("logint third argument not a scalar reference") if defined($refp) && !ref($refp); if ($Math::Prime::Util::_GMPfunc{"logint"}) { my $e = Math::Prime::Util::GMP::logint($n, $b); if (defined $refp) { my $r = Math::Prime::Util::GMP::powmod($b, $e, $n); $r = $n if $r == 0; $$refp = Math::Prime::Util::_reftyped($_[0], $r); } return Math::Prime::Util::_reftyped($_[0], $e); } croak "logint: n must be > 0" unless $n > 0; croak "logint: missing base" unless defined $b; if ($b == 10) { my $e = length($n)-1; $$refp = Math::BigInt->new("1" . "0"x$e) if defined $refp; return $e; } if ($b == 2) { my $e = length(Math::BigInt->new("$n")->as_bin)-2-1; $$refp = Math::BigInt->from_bin("1" . "0"x$e) if defined $refp; return $e; } croak "logint: base must be > 1" unless $b > 1; my $e = Math::BigInt->new("$n")->blog("$b"); $$refp = Math::BigInt->new("$b")->bpow($e) if defined $refp; return Math::Prime::Util::_reftyped($_[0], "$e"); } # Seidel (Luschny), core using Trizen's simplications from Math::BigNum. # http://oeis.org/wiki/User:Peter_Luschny/ComputationAndAsymptoticsOfBernoulliNumbers#Bernoulli_numbers__after_Seidel sub _bernoulli_seidel { my($n) = @_; return (1,1) if $n == 0; return (0,1) if $n > 1 && $n % 2; my $oacc = Math::BigInt->accuracy(); Math::BigInt->accuracy(undef); my @D = (BZERO->copy, BONE->copy, map { BZERO->copy } 1 .. ($n>>1)-1); my ($h, $w) = (1, 1); foreach my $i (0 .. $n-1) { if ($w ^= 1) { $D[$_]->badd($D[$_-1]) for 1 .. $h-1; } else { $w = $h++; $D[$w]->badd($D[$w+1]) while --$w; } } my $num = $D[$h-1]; my $den = BONE->copy->blsft($n+1)->bsub(BTWO); my $gcd = Math::BigInt::bgcd($num, $den); $num /= $gcd; $den /= $gcd; $num->bneg() if ($n % 4) == 0; Math::BigInt->accuracy($oacc); ($num,$den); } sub bernfrac { my $n = shift; return (BONE,BONE) if $n == 0; return (BONE,BTWO) if $n == 1; # We're choosing 1/2 instead of -1/2 return (BZERO,BONE) if $n < 0 || $n & 1; # We should have used one of the GMP functions before coming here. _bernoulli_seidel($n); } sub stirling { my($n, $m, $type) = @_; return 1 if $m == $n; return 0 if $n == 0 || $m == 0 || $m > $n; $type = 1 unless defined $type; croak "stirling type must be 1, 2, or 3" unless $type == 1 || $type == 2 || $type == 3; if ($m == 1) { return 1 if $type == 2; return factorial($n) if $type == 3; return factorial($n-1) if $n&1; return vecprod(-1, factorial($n-1)); } return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::stirling($n,$m,$type)) if $Math::Prime::Util::_GMPfunc{"stirling"}; # Go through vecsum with quoted negatives to make sure we don't overflow. my $s; if ($type == 3) { $s = Math::Prime::Util::vecprod( Math::Prime::Util::binomial($n,$m), Math::Prime::Util::binomial($n-1,$m-1), Math::Prime::Util::factorial($n-$m) ); } elsif ($type == 2) { my @terms; for my $j (1 .. $m) { my $t = Math::Prime::Util::vecprod( Math::BigInt->new($j) ** $n, Math::Prime::Util::binomial($m,$j) ); push @terms, (($m-$j) & 1) ? "-$t" : $t; } $s = Math::Prime::Util::vecsum(@terms) / factorial($m); } else { my @terms; for my $k (1 .. $n-$m) { my $t = Math::Prime::Util::vecprod( Math::Prime::Util::binomial($k + $n - 1, $k + $n - $m), Math::Prime::Util::binomial(2 * $n - $m, $n - $k - $m), Math::Prime::Util::stirling($k - $m + $n, $k, 2), ); push @terms, ($k & 1) ? "-$t" : $t; } $s = Math::Prime::Util::vecsum(@terms); } $s; } sub _harmonic_split { # From Fredrik Johansson my($a,$b) = @_; return (BONE, $a) if $b - $a == BONE; return ($a+$a+BONE, $a*$a+$a) if $b - $a == BTWO; # Cut down recursion my $m = $a->copy->badd($b)->brsft(BONE); my ($p,$q) = _harmonic_split($a, $m); my ($r,$s) = _harmonic_split($m, $b); ($p*$s+$q*$r, $q*$s); } sub harmfrac { my($n) = @_; return (BZERO,BONE) if $n <= 0; $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my($p,$q) = _harmonic_split($n-$n+1, $n+1); my $gcd = Math::BigInt::bgcd($p,$q); ( scalar $p->bdiv($gcd), scalar $q->bdiv($gcd) ); } sub harmreal { my($n, $precision) = @_; do { require Math::BigFloat; Math::BigFloat->import(); } unless defined $Math::BigFloat::VERSION; return Math::BigFloat->bzero if $n <= 0; # Use asymptotic formula for larger $n if possible. Saves lots of time if # the default Calc backend is being used. { my $sprec = $precision; $sprec = Math::BigFloat->precision unless defined $sprec; $sprec = 40 unless defined $sprec; if ( ($sprec <= 23 && $n > 54) || ($sprec <= 30 && $n > 348) || ($sprec <= 40 && $n > 2002) || ($sprec <= 50 && $n > 12644) ) { $n = Math::BigFloat->new($n, $sprec+5); my($n2, $one, $h) = ($n*$n, Math::BigFloat->bone, Math::BigFloat->bzero); my $nt = $n2; my $eps = Math::BigFloat->new(10)->bpow(-$sprec-4); foreach my $d (-12, 120, -252, 240, -132, 32760, -12, 8160, -14364, 6600, -276, 65520, -12) { # OEIS A006593 my $term = $one/($d * $nt); last if $term->bacmp($eps) < 0; $h += $term; $nt *= $n2; } $h->badd(scalar $one->copy->bdiv(2*$n)); $h->badd(_Euler($sprec)); $h->badd($n->copy->blog); $h->round($sprec); return $h; } } my($num,$den) = Math::Prime::Util::harmfrac($n); # Note, with Calc backend this can be very, very slow scalar Math::BigFloat->new($num)->bdiv($den, $precision); } sub is_pseudoprime { my($n, @bases) = @_; return 0 if int($n) < 0; _validate_positive_integer($n); croak("No bases given to is_pseudoprime") unless scalar(@bases) > 0; return 0+($n >= 2) if $n < 4; foreach my $base (@bases) { croak "Base $base is invalid" if $base < 2; $base = $base % $n if $base >= $n; if ($base > 1 && $base != $n-1) { my $x = (ref($n) eq 'Math::BigInt') ? $n->copy->bzero->badd($base)->bmodpow($n-1,$n)->is_one : _powmod($base, $n-1, $n); return 0 unless $x == 1; } } 1; } sub is_euler_pseudoprime { my($n, @bases) = @_; return 0 if int($n) < 0; _validate_positive_integer($n); croak("No bases given to is_euler_pseudoprime") unless scalar(@bases) > 0; return 0+($n >= 2) if $n < 4; foreach my $base (@bases) { croak "Base $base is invalid" if $base < 2; $base = $base % $n if $base >= $n; if ($base > 1 && $base != $n-1) { my $j = kronecker($base, $n); return 0 if $j == 0; $j = ($j > 0) ? 1 : $n-1; my $x = (ref($n) eq 'Math::BigInt') ? $n->copy->bzero->badd($base)->bmodpow(($n-1)/2,$n) : _powmod($base, ($n-1)>>1, $n); return 0 unless $x == $j; } } 1; } sub is_euler_plumb_pseudoprime { my($n) = @_; return 0 if int($n) < 0; _validate_positive_integer($n); return 0+($n >= 2) if $n < 4; return 0 if ($n % 2) == 0; my $nmod8 = $n % 8; my $exp = 1 + ($nmod8 == 1); my $ap = Math::Prime::Util::powmod(2, ($n-1) >> $exp, $n); if ($ap == 1) { return ($nmod8 == 1 || $nmod8 == 7); } if ($ap == $n-1) { return ($nmod8 == 1 || $nmod8 == 3 || $nmod8 == 5); } 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); croak("No bases given to is_strong_pseudoprime") unless scalar(@bases) > 0; 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; } my @newbases; for my $base (@bases) { croak "Base $base is invalid" if $base < 2; $base %= $n if $base >= $n; return 0 if $base == 0 || ($base == $n-1 && ($base % 2) == 1); push @newbases, $base; } @bases = @newbases; 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; } $b = _bigint_to_int($b) if ref($b) eq 'Math::BigInt' && $b <= BMAX; $a = _bigint_to_int($a) if ref($a) eq 'Math::BigInt' && $a <= BMAX; # 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 <= BMAX && ref($b) eq 'Math::BigInt' && $b <= BMAX) { return $k * kronecker(_bigint_to_int($a),_bigint_to_int($b)); } } return ($b == 1) ? $k : 0; } sub _binomialu { my($r, $n, $k) = (1, @_); return ($k == $n) ? 1 : 0 if $k >= $n; $k = $n - $k if $k > ($n >> 1); foreach my $d (1 .. $k) { if ($r >= int(~0/$n)) { my($g, $nr, $dr); $g = _gcd_ui($n, $d); $nr = int($n/$g); $dr = int($d/$g); $g = _gcd_ui($r, $dr); $r = int($r/$g); $dr = int($dr/$g); return 0 if $r >= int(~0/$nr); $r *= $nr; $r = int($r/$dr); } else { $r *= $n; $r = int($r/$d); } $n--; } $r; } sub binomial { my($n, $k) = @_; # 1. Try GMP return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::binomial($n,$k)) if $Math::Prime::Util::_GMPfunc{"binomial"}; # 2. Exit early for known 0 cases, and adjust k to be positive. if ($n >= 0) { return 0 if $k < 0 || $k > $n; } else { return 0 if $k < 0 && $k > $n; } $k = $n - $k if $k < 0; # 3. Try to do in integer Perl my $r; if ($n >= 0) { $r = _binomialu($n, $k); return $r if $r > 0; } else { $r = _binomialu(-$n+$k-1, $k); return $r if $r > 0 && !($k & 1); return -$r if $r > 0 && $r <= (~0>>1); } # 4. Overflow. Solve using Math::BigInt return 1 if $k == 0; # Work around bug in old return $n if $k == $n-1; # Math::BigInt (fixed in 1.90) if ($n >= 0) { $r = Math::BigInt->new(''.$n)->bnok($k); $r = _bigint_to_int($r) if $r->bacmp(BMAX) <= 0; } else { # Math::BigInt is incorrect for negative n $r = Math::BigInt->new(''.(-$n+$k-1))->bnok($k); if ($k & 1) { $r->bneg; $r = _bigint_to_int($r) if $r->bacmp(''.(~0>>1)) <= 0; } else { $r = _bigint_to_int($r) if $r->bacmp(BMAX) <= 0; } } $r; } sub _product { my($a, $b, $r) = @_; if ($b <= $a) { $r->[$a]; } elsif ($b == $a+1) { $r->[$a] -> bmul( $r->[$b] ); } elsif ($b == $a+2) { $r->[$a] -> bmul( $r->[$a+1] ) -> bmul( $r->[$a+2] ); } else { my $c = $a + (($b-$a+1)>>1); _product($a, $c-1, $r); _product($c, $b, $r); $r->[$a] -> bmul( $r->[$c] ); } } sub factorial { my($n) = @_; return (1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800,479001600)[$n] if $n <= 12; return Math::GMP::bfac($n) if ref($n) eq 'Math::GMP'; do { my $r = Math::GMPz->new(); Math::GMPz::Rmpz_fac_ui($r,$n); return $r; } if ref($n) eq 'Math::GMPz'; if (Math::BigInt->config()->{lib} !~ /GMP|Pari/) { # It's not a GMP or GMPz object, and we have a slow bigint library. my $r; if (defined $Math::GMPz::VERSION) { $r = Math::GMPz->new(); Math::GMPz::Rmpz_fac_ui($r,$n); } elsif (defined $Math::GMP::VERSION) { $r = Math::GMP::bfac($n); } elsif (defined &Math::Prime::Util::GMP::factorial && Math::Prime::Util::prime_get_config()->{'gmp'}) { $r = Math::Prime::Util::GMP::factorial($n); } return Math::Prime::Util::_reftyped($_[0], $r) if defined $r; } my $r = Math::BigInt->new($n)->bfac(); $r = _bigint_to_int($r) if $r->bacmp(BMAX) <= 0; $r; } sub factorialmod { my($n,$m) = @_; return Math::Prime::Util::GMP::factorialmod($n,$m) if $Math::Prime::Util::_GMPfunc{"factorialmod"}; return 0 if $n >= $m || $m == 1; if ($n > 10) { my($s,$t,$e) = (1); Math::Prime::Util::forprimes( sub { ($t,$e) = ($n,0); while ($t > 0) { $t = int($t/$_); $e += $t; } $s = Math::Prime::Util::mulmod($s, Math::Prime::Util::powmod($_,$e,$m), $m); }, 2, $n >> 1); Math::Prime::Util::forprimes( sub { $s = Math::Prime::Util::mulmod($s, $_, $m); }, ($n >> 1)+1, $n); return $s; } return factorial($n) % $m; } sub _is_perfect_square { my($n) = @_; return (1,1,0,0,1)[$n] if $n <= 4; 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 is_primitive_root { my($a, $n) = @_; $n = -$n if $n < 0; # Ignore sign of n return ($n==1) ? 1 : 0 if $n <= 1; $a %= $n if $a < 0 || $a >= $n; return Math::Prime::Util::GMP::is_primitive_root($a,$n) if $Math::Prime::Util::_GMPfunc{"is_primitive_root"}; if ($Math::Prime::Util::_GMPfunc{"znorder"} && $Math::Prime::Util::_GMPfunc{"totient"}) { my $order = Math::Prime::Util::GMP::znorder($a,$n); return 0 unless defined $order; my $totient = Math::Prime::Util::GMP::totient($n); return ($order eq $totient) ? 1 : 0; } return 0 if Math::Prime::Util::gcd($a, $n) != 1; my $s = Math::Prime::Util::euler_phi($n); return 0 if ($s % 2) == 0 && Math::Prime::Util::powmod($a, $s/2, $n) == 1; return 0 if ($s % 3) == 0 && Math::Prime::Util::powmod($a, $s/3, $n) == 1; return 0 if ($s % 5) == 0 && Math::Prime::Util::powmod($a, $s/5, $n) == 1; foreach my $f (Math::Prime::Util::factor_exp($s)) { my $fp = $f->[0]; return 0 if $fp > 5 && Math::Prime::Util::powmod($a, $s/$fp, $n) == 1; } 1; } sub znorder { my($a, $n) = @_; return if $n <= 0; return 1 if $n == 1; return if $a <= 0; return 1 if $a == 1; return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::znorder($a,$n)) if $Math::Prime::Util::_GMPfunc{"znorder"}; # Sadly, Calc/FastCalc are horrendously slow for this function. return if Math::Prime::Util::gcd($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 Math::Prime::Util::powmod($a,$k,$n) == 1; } 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 = Math::Prime::Util::powmod($a,$phidiv,$n); while ($b != 1) { return if $enum++ >= $ei; $b = Math::Prime::Util::powmod($b,$pi,$n); $k *= $pi; } } $k = _bigint_to_int($k) if $k->bacmp(BMAX) <= 0; return $k; } sub _dlp_trial { my ($a,$g,$p,$limit) = @_; $limit = $p if !defined $limit || $limit > $p; my $t = $g->copy; if ($limit < 1_000_000_000) { for my $k (1 .. $limit) { return $k if $t == $a; $t = Math::Prime::Util::mulmod($t, $g, $p); } return 0; } for (my $k = BONE->copy; $k < $limit; $k->binc) { if ($t == $a) { $k = _bigint_to_int($k) if $k->bacmp(BMAX) <= 0; return $k; } $t->bmul($g)->bmod($p); } 0; } sub _dlp_bsgs { my ($a,$g,$p,$n,$_verbose) = @_; my $invg = invmod($g, $p); return unless defined $invg; my $maxm = Math::Prime::Util::sqrtint($n)+1; my $b = ($p + $maxm - 1) / $maxm; # Limit for time and space. $b = ($b > 4_000_000) ? 4_000_000 : int("$b"); $maxm = ($maxm > $b) ? $b : int("$maxm"); my %hash; my $am = BONE->copy; my $gm = Math::Prime::Util::powmod($invg, $maxm, $p); my $key = $a->copy; my $r; foreach my $m (0 .. $b) { # Baby Step if ($m <= $maxm) { $r = $hash{"$am"}; if (defined $r) { print " bsgs found in stage 1 after $m tries\n" if $_verbose; $r = Math::Prime::Util::addmod($m, Math::Prime::Util::mulmod($r,$maxm,$p), $p); return $r; } $hash{"$am"} = $m; $am = Math::Prime::Util::mulmod($am,$g,$p); if ($am == $a) { print " bsgs found during bs\n" if $_verbose; return $m+1; } } # Giant Step $r = $hash{"$key"}; if (defined $r) { print " bsgs found in stage 2 after $m tries\n" if $_verbose; $r = Math::Prime::Util::addmod($r, Math::Prime::Util::mulmod($m,$maxm,$p), $p); return $r; } $hash{"$key"} = $m if $m <= $maxm; $key = Math::Prime::Util::mulmod($key,$gm,$p); } 0; } sub znlog { my ($a,$g,$p) = map { ref($_) eq 'Math::BigInt' ? $_ : Math::BigInt->new("$_") } @_; $a->bmod($p); $g->bmod($p); return 0 if $a == 1 || $g == 0 || $p < 2; my $_verbose = Math::Prime::Util::prime_get_config()->{'verbose'}; # For large p, znorder can be very slow. Do trial test first. my $x = _dlp_trial($a, $g, $p, 200); if ($x == 0) { my $n = znorder($g, $p); if (defined $n && $n > 1000) { $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; $x = _dlp_bsgs($a, $g, $p, $n, $_verbose); $x = _bigint_to_int($x) if ref($x) && $x->bacmp(BMAX) <= 0; return $x if $x > 0 && $g->copy->bmodpow($x, $p) == $a; print " BSGS giving up\n" if $x == 0 && $_verbose; print " BSGS incorrect answer $x\n" if $x > 0 && $_verbose > 1; } $x = _dlp_trial($a,$g,$p); } $x = _bigint_to_int($x) if ref($x) && $x->bacmp(BMAX) <= 0; return ($x == 0) ? undef : $x; } 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 = $n-1; if (!is_prob_prime($n)) { $phi = euler_phi($n); # Check that a primitive root exists. return if $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"; while (1) { my $fail = 0; do { $a++ } while Math::Prime::Util::kronecker($a,$n) == 0; return if $a >= $n; foreach my $f (@exp) { if (Math::Prime::Util::powmod($a,$f,$n) == 1) { $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 abs($P) >= $n; croak "lucas_sequence: Q out of range" if abs($Q) >= $n; if ($Math::Prime::Util::_GMPfunc{"lucas_sequence"} && $Math::Prime::Util::GMP::VERSION >= 0.30) { return map { ($_ > ''.~0) ? Math::BigInt->new(''.$_) : $_ } Math::Prime::Util::GMP::lucas_sequence($n, $P, $Q, $k); } $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; if ($D->is_zero) { my $S = ($ZERO+$P) >> 1; my $U = $S->copy->bmodpow($k-1,$n)->bmul($k)->bmod($n); my $V = $S->copy->bmodpow($k,$n)->bmul(BTWO)->bmod($n); my $Qk = ($ZERO+$Q)->bmodpow($k, $n); return ($U, $V, $Qk); } my $U = BONE->copy; my $V = $P->copy; my $Qk = $Q->copy; return (BZERO->copy, BTWO->copy, $Qk) 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 (($n % 2)==0) { $P->bmod($n); $Q->bmod($n); my($Uh,$Vl, $Vh, $Ql, $Qh) = (BONE->copy, BTWO->copy, $P->copy, BONE->copy, BONE->copy); my ($b,$s) = (length($kstr)-1, 0); if ($kstr =~ /(0+)$/) { $s = length($1); } for my $bpos (0 .. $b-$s-1) { $Ql->bmul($Qh)->bmod($n); if (substr($kstr,$bpos,1)) { $Qh = $Ql * $Q; $Uh->bmul($Vh)->bmod($n); $Vl->bmul($Vh)->bsub($P * $Ql)->bmod($n); $Vh->bmul($Vh)->bsub(BTWO * $Qh)->bmod($n); } else { $Qh = $Ql->copy; $Uh->bmul($Vl)->bsub($Ql)->bmod($n); $Vh->bmul($Vl)->bsub($P * $Ql)->bmod($n); $Vl->bmul($Vl)->bsub(BTWO * $Ql)->bmod($n); } } $Ql->bmul($Qh); $Qh = $Ql * $Q; $Uh->bmul($Vl)->bsub($Ql)->bmod($n); $Vl->bmul($Vh)->bsub($P * $Ql)->bmod($n); $Ql->bmul($Qh)->bmod($n); for (1 .. $s) { $Uh->bmul($Vl)->bmod($n); $Vl->bmul($Vl)->bsub(BTWO * $Ql)->bmod($n); $Ql->bmul($Ql)->bmod($n); } ($U, $V, $Qk) = ($Uh, $Vl, $Ql); } elsif ($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 _lucasuv { my($P, $Q, $k) = @_; croak "lucas_sequence: k must be >= 0" if $k < 0; return (0,2) if $k == 0; $P = Math::BigInt->new("$P") unless ref($P) eq 'Math::BigInt'; $Q = Math::BigInt->new("$Q") unless ref($Q) eq 'Math::BigInt'; # Simple way, very slow as k increases: #my($U0, $U1) = (BZERO->copy, BONE->copy); #my($V0, $V1) = (BTWO->copy, Math::BigInt->new("$P")); #for (2 .. $k) { # ($U0,$U1) = ($U1, $P*$U1 - $Q*$U0); # ($V0,$V1) = ($V1, $P*$V1 - $Q*$V0); #} #return ($U1, $V1); my($Uh,$Vl, $Vh, $Ql, $Qh) = (BONE->copy, BTWO->copy, $P->copy, BONE->copy, BONE->copy); $k = Math::BigInt->new("$k") unless ref($k) eq 'Math::BigInt'; my $kstr = substr($k->as_bin, 2); my ($n,$s) = (length($kstr)-1, 0); if ($kstr =~ /(0+)$/) { $s = length($1); } if ($Q == -1) { # This could be simplified, and it's running 10x slower than it should. my ($ql,$qh) = (1,1); for my $bpos (0 .. $n-$s-1) { $ql *= $qh; if (substr($kstr,$bpos,1)) { $qh = -$ql; $Uh->bmul($Vh); if ($ql == 1) { $Vl->bmul($Vh)->bsub( $P ); $Vh->bmul($Vh)->badd( BTWO ); } else { $Vl->bmul($Vh)->badd( $P ); $Vh->bmul($Vh)->bsub( BTWO ); } } else { $qh = $ql; if ($ql == 1) { $Uh->bmul($Vl)->bdec; $Vh->bmul($Vl)->bsub($P); $Vl->bmul($Vl)->bsub(BTWO); } else { $Uh->bmul($Vl)->binc; $Vh->bmul($Vl)->badd($P); $Vl->bmul($Vl)->badd(BTWO); } } } $ql *= $qh; $qh = -$ql; if ($ql == 1) { $Uh->bmul($Vl)->bdec; $Vl->bmul($Vh)->bsub($P); } else { $Uh->bmul($Vl)->binc; $Vl->bmul($Vh)->badd($P); } $ql *= $qh; for (1 .. $s) { $Uh->bmul($Vl); if ($ql == 1) { $Vl->bmul($Vl)->bsub(BTWO); $ql *= $ql; } else { $Vl->bmul($Vl)->badd(BTWO); $ql *= $ql; } } return map { ($_ > ''.~0) ? Math::BigInt->new(''.$_) : $_ } ($Uh, $Vl); } for my $bpos (0 .. $n-$s-1) { $Ql->bmul($Qh); if (substr($kstr,$bpos,1)) { $Qh = $Ql * $Q; #$Uh = $Uh * $Vh; #$Vl = $Vh * $Vl - $P * $Ql; #$Vh = $Vh * $Vh - BTWO * $Qh; $Uh->bmul($Vh); $Vl->bmul($Vh)->bsub($P * $Ql); $Vh->bmul($Vh)->bsub(BTWO * $Qh); } else { $Qh = $Ql->copy; #$Uh = $Uh * $Vl - $Ql; #$Vh = $Vh * $Vl - $P * $Ql; #$Vl = $Vl * $Vl - BTWO * $Ql; $Uh->bmul($Vl)->bsub($Ql); $Vh->bmul($Vl)->bsub($P * $Ql); $Vl->bmul($Vl)->bsub(BTWO * $Ql); } } $Ql->bmul($Qh); $Qh = $Ql * $Q; $Uh->bmul($Vl)->bsub($Ql); $Vl->bmul($Vh)->bsub($P * $Ql); $Ql->bmul($Qh); for (1 .. $s) { $Uh->bmul($Vl); $Vl->bmul($Vl)->bsub(BTWO * $Ql); $Ql->bmul($Ql); } return map { ($_ > ''.~0) ? Math::BigInt->new(''.$_) : $_ } ($Uh, $Vl, $Ql); } sub lucasu { (_lucasuv(@_))[0] } sub lucasv { (_lucasuv(@_))[1] } 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 == 0) ? 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 == 0; $V = Math::BigInt->new("$V") unless ref($V) eq 'Math::BigInt'; $Qk = Math::BigInt->new("$Qk") unless ref($Qk) eq 'Math::BigInt'; 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); $V = Math::BigInt->new("$V") unless ref($V) eq 'Math::BigInt'; return 1 if $U == 0 && ($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_khashin_pseudoprime { my($n) = @_; return 0+($n >= 2) if $n < 4; return 0 unless $n % 2; return 0 if _is_perfect_square($n); $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my($k,$c) = (2,1); if ($n % 4 == 3) { $c = $n-1; } elsif ($n % 8 == 5) { $c = 2; } else { do { $c += 2; $k = kronecker($c, $n); } while $k == 1; } return 0 if $k == 0 || ($k == 2 && !($n % 3));; my $ea = ($k == 2) ? 2 : 1; my($ra,$rb,$a,$b,$d) = ($ea,1,$ea,1,$n-1); while (!$d->is_zero) { if ($d->is_odd()) { ($ra, $rb) = ( (($ra*$a)%$n + ((($rb*$b)%$n)*$c)%$n) % $n, (($rb*$a)%$n + ($ra*$b)%$n) % $n ); } $d >>= 1; if (!$d->is_zero) { ($a, $b) = ( (($a*$a)%$n + ((($b*$b)%$n)*$c)%$n) % $n, (($b*$a)%$n + ($a*$b)%$n) % $n ); } } return ($ra == $ea && $rb == $n-1) ? 1 : 0; } sub is_frobenius_underwood_pseudoprime { my($n) = @_; return 0+($n >= 2) if $n < 4; return 0 unless $n % 2; my($a, $temp1, $temp2); if ($n % 4 == 3) { $a = 0; } else { for ($a = 1; $a < 1000000; $a++) { next if $a==2 || $a==4 || $a==7 || $a==8 || $a==10 || $a==14 || $a==16 || $a==18; my $j = kronecker($a*$a - 4, $n); last if $j == -1; return 0 if $j == 0 || ($a == 20 && _is_perfect_square($n)); } } $temp1 = Math::Prime::Util::gcd(($a+4)*(2*$a+5), $n); return 0 if $temp1 != 1 && $temp1 != $n; $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my $ZERO = $n->copy->bzero; my $ONE = $ZERO->copy->binc; my $TWO = $ONE->copy->binc; my($s, $t) = ($ONE->copy, $TWO->copy); my $ap2 = $TWO + $a; my $np1string = substr( $n->copy->binc->as_bin, 2); my $np1len = length($np1string); foreach my $bit (1 .. $np1len-1) { $temp2 = $t+$t; $temp2 += ($s * $a) if $a != 0; $temp1 = $temp2 * $s; $temp2 = $t - $s; $s += $t; $t = ($s * $temp2) % $n; $s = $temp1 % $n; if ( substr( $np1string, $bit, 1 ) ) { if ($a == 0) { $temp1 = $s + $s; } else { $temp1 = $s * $ap2; } $temp1 += $t; $t->badd($t)->bsub($s); # $t = ($t+$t) - $s; $s = $temp1; } } $temp1 = (2*$a+5) % $n; return ($s == 0 && $t == $temp1) ? 1 : 0; } sub _perrin_signature { my($n) = @_; my @S = (1,$n-1,3, 3,0,2); return @S if $n <= 1; my @nbin = todigits($n,2); shift @nbin; while (@nbin) { my @T = map { addmod(addmod(Math::Prime::Util::mulmod($S[$_],$S[$_],$n), $n-$S[5-$_],$n), $n-$S[5-$_],$n); } 0..5; my $T01 = addmod($T[2], $n-$T[1], $n); my $T34 = addmod($T[5], $n-$T[4], $n); my $T45 = addmod($T34, $T[3], $n); if (shift @nbin) { @S = ($T[0], $T01, $T[1], $T[4], $T45, $T[5]); } else { @S = ($T01, $T[1], addmod($T01,$T[0],$n), $T34, $T[4], $T45); } } @S; } sub is_perrin_pseudoprime { my($n, $restrict) = @_; $restrict = 0 unless defined $restrict; return 0+($n >= 2) if $n < 4; return 0 if $restrict > 2 && ($n % 2) == 0; $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; my @S = _perrin_signature($n); return 0 unless $S[4] == 0; return 1 if $restrict == 0; return 0 unless $S[1] == $n-1; return 1 if $restrict == 1; my $j = kronecker(-23,$n); if ($j == -1) { my $B = $S[2]; my $B2 = mulmod($B,$B,$n); my $A = addmod(addmod(1,mulmod(3,$B,$n),$n),$n-$B2,$n); my $C = addmod(mulmod(3,$B2,$n),$n-2,$n); return 1 if $S[0] == $A && $S[2] == $B && $S[3] == $B && $S[5] == $C && $B != 3 && addmod(mulmod($B2,$B,$n),$n-$B,$n) == 1; } else { return 0 if $j == 0 && $n != 23 && $restrict > 2; return 1 if $S[0] == 1 && $S[2] == 3 && $S[3] == 3 && $S[5] == 2; return 1 if $S[0] == 0 && $S[5] == $n-1 && $S[2] != $S[3] && addmod($S[2],$S[3],$n) == $n-3 && mulmod(addmod($S[2],$n-$S[3],$n),addmod($S[2],$n-$S[3],$n),$n) == $n-(23%$n); } 0; } sub is_catalan_pseudoprime { my($n) = @_; return 0+($n >= 2) if $n < 4; my $m = ($n-1)>>1; return (binomial($m<<1,$m) % $n) == (($m&1) ? $n-1 : 1) ? 1 : 0; } sub is_frobenius_pseudoprime { my($n, $P, $Q) = @_; ($P,$Q) = (0,0) unless defined $P && defined $Q; return 0+($n >= 2) if $n < 4; $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; return 0 if $n->is_even; my($k, $Vcomp, $D, $Du) = (0, 4); if ($P == 0 && $Q == 0) { ($P,$Q) = (-1,2); while ($k != -1) { $P += 2; $P = 5 if $P == 3; # Skip 3 $D = $P*$P-4*$Q; $Du = ($D >= 0) ? $D : -$D; last if $P >= $n || $Du >= $n; # TODO: remove? $k = kronecker($D, $n); return 0 if $k == 0; return 0 if $P == 10001 && _is_perfect_square($n); } } else { $D = $P*$P-4*$Q; $Du = ($D >= 0) ? $D : -$D; croak "Frobenius invalid P,Q: ($P,$Q)" if _is_perfect_square($Du); } return (is_prime($n) ? 1 : 0) if $n <= $Du || $n <= abs($Q) || $n <= abs($P); return 0 if Math::Prime::Util::gcd(abs($P*$Q*$D), $n) > 1; if ($k == 0) { $k = kronecker($D, $n); return 0 if $k == 0; my $Q2 = (2*abs($Q)) % $n; $Vcomp = ($k == 1) ? 2 : ($Q >= 0) ? $Q2 : $n-$Q2; } my($U, $V, $Qk) = lucas_sequence($n, $P, $Q, $n-$k); return 1 if $U == 0 && $V == $Vcomp; 0; } # Since people have graciously donated millions of CPU years to doing these # tests, it would be rude of us not to use the results. This means we don't # actually use the pretest and Lucas-Lehmer test coded below for any reasonable # size number. # See: http://www.mersenne.org/report_milestones/ my %_mersenne_primes; undef @_mersenne_primes{2,3,5,7,13,17,19,31,61,89,107,127,521,607,1279,2203,2281,3217,4253,4423,9689,9941,11213,19937,21701,23209,44497,86243,110503,132049,216091,756839,859433,1257787,1398269,2976221,3021377,6972593,13466917,20996011,24036583,25964951,30402457,32582657,37156667,42643801,43112609,57885161,74207281}; sub is_mersenne_prime { my $p = shift; # Use the known Mersenne primes return 1 if exists $_mersenne_primes{$p}; return 0 if $p < 34007399; # GIMPS has checked all below # Past this we do a generic Mersenne prime test return 1 if $p == 2; return 0 unless is_prob_prime($p); return 0 if $p > 3 && $p % 4 == 3 && $p < ((~0)>>1) && is_prob_prime($p*2+1); my $mp = BONE->copy->blsft($p)->bdec; # Definitely faster than using Math::BigInt that doesn't have GMP. return (0 == (Math::Prime::Util::GMP::lucas_sequence($mp, 4, 1, $mp+1))[0]) if $Math::Prime::Util::_GMPfunc{"lucas_sequence"}; my $V = Math::BigInt->new(4); for my $k (3 .. $p) { $V->bmul($V)->bsub(BTWO)->bmod($mp); } return $V->is_zero; } 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_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($n, $r) > $limit; # Note the arguments! $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'; } my $_verbose = Math::Prime::Util::prime_get_config()->{'verbose'}; print "# aks r = $r s = $rlimit\n" if $_verbose; local $| = 1 if $_verbose > 1; for (my $a = 1; $a <= $rlimit; $a++) { return 0 unless _test_anr($a, $n, $r); print "." if $_verbose > 1; } print "\n" if $_verbose > 1; 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 $] >= 5.008 && $_[0] <= BMAX; } if ( ($_[0] > 1) && _is_prime7($_[0]) ) { push @factors, $_[0]; $_[0] = 1; } @factors; } sub trial_factor { my($n, $limit) = @_; # Don't use _basic_factor here -- they want a trial forced. my @factors; if ($n < 4) { @factors = ($n == 1) ? () : ($n); return @factors; } my $start_idx = 1; # Expand small primes if it would help. push @_primes_small, @{primes($_primes_small[-1]+1, 100_003)} if $n > 400_000_000 && $_primes_small[-1] < 99_000 && (!defined $limit || $limit > $_primes_small[-1]); # Do initial bigint reduction. Hopefully reducing it to native int. if (ref($n) eq 'Math::BigInt') { $n = $n->copy; # Don't modify their original input! my $newlim = $n->copy->bsqrt; $limit = $newlim if !defined $limit || $limit > $newlim; while ($start_idx <= $#_primes_small) { my $f = $_primes_small[$start_idx++]; last if $f > $limit; if ($n->copy->bmod($f)->is_zero) { do { push @factors, $f; $n->bdiv($f)->bfloor(); } while $n->copy->bmod($f)->is_zero; last if $n < BMAX; my $newlim = $n->copy->bsqrt; $limit = $newlim if $limit > $newlim; } } return @factors if $n->is_one; $n = _bigint_to_int($n) if $n <= BMAX; return (@factors,$n) if $start_idx <= $#_primes_small && $_primes_small[$start_idx] > $limit; } { my $newlim = (ref($n) eq 'Math::BigInt') ? $n->copy->bsqrt : int(sqrt($n) + 0.001); $limit = $newlim if !defined $limit || $limit > $newlim; } if (ref($n) ne 'Math::BigInt') { for my $i ($start_idx .. $#_primes_small) { my $p = $_primes_small[$i]; last if $p > $limit; if (($n % $p) == 0) { do { push @factors, $p; $n = int($n/$p); } while ($n % $p) == 0; last if $n == 1; my $newlim = int( sqrt($n) + 0.001); $limit = $newlim if $newlim < $limit; } } if ($_primes_small[-1] < $limit) { my $inc = (($_primes_small[-1] % 6) == 1) ? 4 : 2; my $p = $_primes_small[-1] + $inc; while ($p <= $limit) { if (($n % $p) == 0) { do { push @factors, $p; $n = int($n/$p); } while ($n % $p) == 0; last if $n == 1; my $newlim = int( sqrt($n) + 0.001); $limit = $newlim if $newlim < $limit; } $p += ($inc ^= 6); } } } else { # n is a bigint. Use mod-210 wheel trial division. # Generating a wheel mod $w starting at $s: # mpu 'my($s,$w,$t)=(11,2*3*5); say join ",",map { ($t,$s)=($_-$s,$_); $t; } grep { gcd($_,$w)==1 } $s+1..$s+$w;' # Should start at $_primes_small[$start_idx], do 11 + next multiple of 210. my @incs = map { Math::BigInt->new($_) } (2,4,2,4,6,2,6,4,2,4,6,6,2,6,4,2,6,4,6,8,4,2,4,2,4,8,6,4,6,2,4,6,2,6,6,4,2,4,6,2,6,4,2,4,2,10,2,10); my $f = 11; while ($f <= $_primes_small[$start_idx-1]-210) { $f += 210; } ($f, $limit) = map { Math::BigInt->new("$_") } ($f, $limit); SEARCH: while ($f <= $limit) { foreach my $finc (@incs) { if ($n->copy->bmod($f)->is_zero && $f->bacmp($limit) <= 0) { my $sf = ($f <= BMAX) ? _bigint_to_int($f) : $f->copy; do { push @factors, $sf; $n->bdiv($f)->bfloor(); } while $n->copy->bmod($f)->is_zero; last SEARCH if $n->is_one; my $newlim = $n->copy->bsqrt; $limit = $newlim if $limit > $newlim; } $f->badd($finc); } } } push @factors, $n if $n > 1; @factors; } my $_holf_r; my @_fsublist = ( [ "pbrent 32k", sub { pbrent_factor (shift, 32*1024, 1, 1) } ], [ "p-1 1M", sub { pminus1_factor(shift, 1_000_000, undef, 1); } ], [ "ECM 1k", sub { ecm_factor (shift, 1_000, 5_000, 15) } ], [ "pbrent 512k",sub { pbrent_factor (shift, 512*1024, 7, 1) } ], [ "p-1 4M", sub { pminus1_factor(shift, 4_000_000, undef, 1); } ], [ "ECM 10k", sub { ecm_factor (shift, 10_000, 50_000, 10) } ], [ "pbrent 512k",sub { pbrent_factor (shift, 512*1024, 11, 1) } ], [ "HOLF 256k", sub { holf_factor (shift, 256*1024, $_holf_r); $_holf_r += 256*1024; } ], [ "p-1 20M", sub { pminus1_factor(shift,20_000_000); } ], [ "ECM 100k", sub { ecm_factor (shift, 100_000, 800_000, 10) } ], [ "HOLF 512k", sub { holf_factor (shift, 512*1024, $_holf_r); $_holf_r += 512*1024; } ], [ "pbrent 2M", sub { pbrent_factor (shift, 2048*1024, 13, 1) } ], [ "HOLF 2M", sub { holf_factor (shift, 2048*1024, $_holf_r); $_holf_r += 2048*1024; } ], [ "ECM 1M", sub { ecm_factor (shift, 1_000_000, 1_000_000, 10) } ], [ "p-1 100M", sub { pminus1_factor(shift, 100_000_000, 500_000_000); } ], ); sub factor { my($n) = @_; _validate_positive_integer($n); my @factors; if ($n < 4) { @factors = ($n == 1) ? () : ($n); return @factors; } $n = $n->copy if ref($n) eq 'Math::BigInt'; my $lim = 4999; # How much trial factoring to do # For native integers, we could save a little time by doing hardcoded trials # by 2-29 here. Skipping it. push @factors, trial_factor($n, $lim); return @factors if $factors[-1] < $lim*$lim; $n = pop(@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 <= BMAX; #print "Looking at $n with stack ", join(",",@nstack), "\n"; while ( ($n >= ($lim*$lim)) && !_is_prime7($n) ) { my @ftry; $_holf_r = 1; foreach my $sub (@_fsublist) { last if scalar @ftry >= 2; print " starting $sub->[0]\n" if Math::Prime::Util::prime_get_config()->{'verbose'} > 1; @ftry = $sub->[1]->($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 <= BMAX; 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, $skipbasic) = @_; $rounds = 4*1024*1024 unless defined $rounds; $pa = 3 unless defined $pa; my @factors; if (!$skipbasic) { @factors = _basic_factor($n); return @factors if $n < 4; } my $inloop = 0; my $U = 7; my $V = 7; if ( ref($n) eq 'Math::BigInt' ) { my $zero = $n->copy->bzero; $pa = $zero->badd("$pa"); $U = $zero->copy->badd($U); $V = $zero->copy->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) { my $inner = 32; $rounds = int( ($rounds + $inner-1) / $inner ); while ($rounds-- > 0) { my($m, $oldU, $oldV, $f) = (1, $U, $V); for my $i (1 .. $inner) { $U = ($U * $U + $pa) % $n; $V = ($V * $V + $pa) % $n; $V = ($V * $V + $pa) % $n; $f = ($U > $V) ? $U-$V : $V-$U; $m = ($m * $f) % $n; } $f = _gcd_ui( $m, $n ); next if $f == 1; if ($f == $n) { ($U, $V) = ($oldU, $oldV); for my $i (1 .. $inner) { $U = ($U * $U + $pa) % $n; $V = ($V * $V + $pa) % $n; $V = ($V * $V + $pa) % $n; $f = ($U > $V) ? $U-$V : $V-$U; $f = _gcd_ui( $f, $n); last if $f != 1; } last if $f == 1 || $f == $n; } 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; $U = _mulmod($U, $U, $n); $U = _addmod($U, $pa, $n); $V = _mulmod($V, $V, $n); $V = _addmod($V, $pa, $n); $V = _mulmod($V, $V, $n); $V = _addmod($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); } } } push @factors, $n; @factors; } sub pbrent_factor { my($n, $rounds, $pa, $skipbasic) = @_; $rounds = 4*1024*1024 unless defined $rounds; $pa = 3 unless defined $pa; my @factors; if (!$skipbasic) { @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 = 32; my $zero = $n->copy->bzero; my $saveXi; my $f; $Xi = $zero->copy->badd($Xi); $Xm = $zero->copy->badd($Xm); $pa = $zero->copy->badd($pa); 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->copy->bsub($Xm)); } $rleft -= $dorounds; $rounds -= $dorounds; $m->bmod($n); $f = Math::BigInt::bgcd($m, $n); last unless $f->is_one; } if ($f->is_one) { $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) { # Doing the gcd batching as above works pretty well here, but it's a lot # of code for not much gain for general users. for my $i (1 .. $rounds) { $Xi = ($Xi * $Xi + $pa) % $n; my $f = _gcd_ui( ($Xi>$Xm) ? $Xi-$Xm : $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 = _addmod( _mulmod($Xi, $Xi, $n), $pa, $n); my $f = _gcd_ui( ($Xi>$Xm) ? $Xi-$Xm : $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, $skipbasic) = @_; my @factors; if (!$skipbasic) { @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->copy->bdec, $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) = @_; _validate_positive_integer($n); my @factors = _basic_factor($n); return @factors if $n < 4; if ($Math::Prime::Util::_GMPfunc{"ecm_factor"}) { $B1 = 0 if !defined $B1; $ncurves = 0 if !defined $ncurves; my @ef = Math::Prime::Util::GMP::ecm_factor($n, $B1, $ncurves); if (@ef > 1) { my $ecmfac = Math::Prime::Util::_reftyped($n, $ef[-1]); return _found_factor($ecmfac, $n, "ECM (GMP) B1=$B1 curves $ncurves", @factors); } push @factors, $n; return @factors; } $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)} : (); foreach my $curve (1 .. $ncurves) { my $sigma = Math::Prime::Util::urandomm($n-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); my(@factors, @d, @t); # 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; if ($Math::Prime::Util::_GMPfunc{"divisors"}) { # This trips an erroneous compile time error without the eval. eval ' @d = Math::Prime::Util::GMP::divisors($n); '; ## no critic qw(ProhibitStringyEval) @d = map { $_ <= ~0 ? $_ : ref($n)->new($_) } @d if ref($n); return @d; } @factors = Math::Prime::Util::factor($n); return (1,$n) if scalar @factors == 1; my $bigint = ref($n); @factors = map { $bigint->new("$_") } @factors if $bigint; @d = $bigint ? ($bigint->new(1)) : (1); while (my $p = shift @factors) { my $e = 1; while (@factors && $p == $factors[0]) { $e++; shift(@factors); } push @d, @t = map { $_ * $p } @d; # multiply through once push @d, @t = map { $_ * $p } @t for 2 .. $e; # repeat } @d = map { $_ <= INTMAX ? _bigint_to_int($_) : $_ } @d if $bigint; @d = sort { $a <=> $b } @d; @d; } sub chebyshev_theta { my($n,$low) = @_; $low = 2 unless defined $low; my($sum,$high) = (0.0, 0); while ($low <= $n) { $high = $low + 1e6; $high = $n if $high > $n; $sum += log($_) for @{primes($low,$high)}; $low = $high+1; } $sum; } sub chebyshev_psi { my($n) = @_; return 0 if $n <= 1; my ($sum, $logn, $sqrtn) = (0.0, log($n), int(sqrt($n))); # Sum the log of prime powers first for my $p (@{primes($sqrtn)}) { my $logp = log($p); $sum += $logp * int($logn/$logp+1e-15); } # The rest all have exponent 1: add them in using the segmenting theta code $sum += chebyshev_theta($n, $sqrtn+1); $sum; } sub hclassno { my $n = shift; return -1 if $n == 0; return 0 if $n < 0 || ($n % 4) == 1 || ($n % 4) == 2; return 2 * (2,3,6,6,6,8,12,9,6,12,18,12,8,12,18,18,12,15,24,12,6,24,30,20,12,12,24,24,18,24)[($n>>1)-1] if $n <= 60; my ($h, $square, $b, $b2) = (0, 0, $n & 1, ($n+1) >> 2); if ($b == 0) { my $lim = int(sqrt($b2)); if (_is_perfect_square($b2)) { $square = 1; $lim--; } #$h += scalar(grep { $_ <= $lim } divisors($b2)); for my $i (1 .. $lim) { $h++ unless $b2 % $i; } ($b,$b2) = (2, ($n+4) >> 2); } while ($b2 * 3 < $n) { $h++ unless $b2 % $b; my $lim = int(sqrt($b2)); if (_is_perfect_square($b2)) { $h++; $lim--; } #$h += 2 * scalar(grep { $_ > $b && $_ <= $lim } divisors($b2)); for my $i ($b+1 .. $lim) { $h += 2 unless $b2 % $i; } $b += 2; $b2 = ($n+$b*$b) >> 2; } return (($b2*3 == $n) ? 2*(3*$h+1) : $square ? 3*(2*$h+1) : 6*$h) << 1; } # Sigma method for prime powers sub _taup { my($p, $e, $n) = @_; my($bp) = Math::BigInt->new("".$p); if ($e == 1) { return (0,1,-24,252,-1472,4830,-6048,-16744,84480)[$p] if $p <= 8; my $ds5 = $bp->copy->bpow( 5)->binc(); # divisor_sum(p,5) my $ds11 = $bp->copy->bpow(11)->binc(); # divisor_sum(p,11) my $s = Math::BigInt->new("".vecsum(map { vecprod(BTWO,Math::Prime::Util::divisor_sum($_,5), Math::Prime::Util::divisor_sum($p-$_,5)) } 1..($p-1)>>1)); $n = ( 65*$ds11 + 691*$ds5 - (691*252)*$s ) / 756; } else { my $t = Math::BigInt->new(""._taup($p,1)); $n = $t->copy->bpow($e); if ($e == 2) { $n -= $bp->copy->bpow(11); } elsif ($e == 3) { $n -= BTWO * $t * $bp->copy->bpow(11); } else { $n += vecsum( map { vecprod( ($_&1) ? - BONE : BONE, $bp->copy->bpow(11*$_), binomial($e-$_, $e-2*$_), $t ** ($e-2*$_) ) } 1 .. ($e>>1) ); } } $n = _bigint_to_int($n) if ref($n) && $n->bacmp(BMAX) <= 0; $n; } # Cohen's method using Hurwitz class numbers # The two hclassno calls could be collapsed with some work sub _tauprime { my $p = shift; return -24 if $p == 2; my $sum = Math::BigInt->new(0); if ($p < (MPU_32BIT ? 300 : 1600)) { my($p9,$pp7) = (9*$p, 7*$p*$p); for my $t (1 .. Math::Prime::Util::sqrtint($p)) { my $t2 = $t * $t; my $v = $p - $t2; $sum += $t2**3 * (4*$t2*$t2 - $p9*$t2 + $pp7) * (Math::Prime::Util::hclassno(4*$v) + 2 * Math::Prime::Util::hclassno($v)); } $p = Math::BigInt->new("$p"); } else { $p = Math::BigInt->new("$p"); my($p9,$pp7) = (9*$p, 7*$p*$p); for my $t (1 .. Math::Prime::Util::sqrtint($p)) { my $t2 = Math::BigInt->new("$t") ** 2; my $v = $p - $t2; $sum += $t2**3 * (4*$t2*$t2 - $p9*$t2 + $pp7) * (Math::Prime::Util::hclassno(4*$v) + 2 * Math::Prime::Util::hclassno($v)); } } 28*$p**6 - 28*$p**5 - 90*$p**4 - 35*$p**3 - 1 - 32 * ($sum/3); } # Recursive method for handling prime powers sub _taupower { my($p, $e) = @_; return 1 if $e <= 0; return _tauprime($p) if $e == 1; $p = Math::BigInt->new("$p"); my($tp, $p11) = ( _tauprime($p), $p**11 ); return $tp ** 2 - $p11 if $e == 2; return $tp ** 3 - 2 * $tp * $p11 if $e == 3; return $tp ** 4 - 3 * $tp**2 * $p11 + $p11**2 if $e == 4; # Recurse -3 ($tp**3 - 2*$tp*$p11) * _taupower($p,$e-3) + ($p11*$p11 - $tp*$tp*$p11) * _taupower($p,$e-4); } sub ramanujan_tau { my $n = shift; return 0 if $n <= 0; # Use GMP if we have no XS or if size is small if ($n < 100000 || !Math::Prime::Util::prime_get_config()->{'xs'}) { if ($Math::Prime::Util::_GMPfunc{"ramanujan_tau"}) { return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::ramanujan_tau($n)); } } # _taup is faster for small numbers, but gets very slow. It's not a huge # deal, and the GMP code will probably get run for small inputs anyway. vecprod(map { _taupower($_->[0],$_->[1]) } Math::Prime::Util::factor_exp($n)); } sub _Euler { my($dig) = @_; return Math::Prime::Util::GMP::Euler($dig) if $dig > 70 && $Math::Prime::Util::_GMPfunc{"Euler"}; '0.57721566490153286060651209008240243104215933593992359880576723488486772677766467'; } sub _Li2 { my($dig) = @_; return Math::Prime::Util::GMP::li(2,$dig) if $dig > 70 && $Math::Prime::Util::_GMPfunc{"li"}; '1.04516378011749278484458888919461313652261557815120157583290914407501320521'; } sub ExponentialIntegral { my($x) = @_; return - MPU_INFINITY if $x == 0; return 0 if $x == - MPU_INFINITY; return MPU_INFINITY if $x == MPU_INFINITY; if ($Math::Prime::Util::_GMPfunc{"ei"}) { $x = Math::BigFloat->new("$x") if defined $bignum::VERSION && ref($x) ne 'Math::BigFloat'; return 0.0 + Math::Prime::Util::GMP::ei($x,40) if !ref($x); my $str = Math::Prime::Util::GMP::ei($x, _find_big_acc($x)); return $x->copy->bzero->badd($str); } $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 = _Euler(18)-$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,$opt) = @_; 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; $opt = 0 unless defined $opt; if ($Math::Prime::Util::_GMPfunc{"li"}) { $x = Math::BigFloat->new("$x") if defined $bignum::VERSION && ref($x) ne 'Math::BigFloat'; return 0.0 + Math::Prime::Util::GMP::li($x,40) if !ref($x); my $str = Math::Prime::Util::GMP::li($x, _find_big_acc($x)); return $x->copy->bzero->badd($str); } if ($x == 2) { my $li2const = (ref($x) eq 'Math::BigFloat') ? Math::BigFloat->new(_Li2(_find_big_acc($x))) : 0.0+_Li2(30); return $li2const; } if (defined $bignum::VERSION) { # If bignum is on, always use Math::BigFloat. $x = Math::BigFloat->new("$x") if ref($x) ne 'Math::BigFloat'; } elsif (ref($x)) { # bignum is off, use native if small, BigFloat otherwise. if ($x <= 1e16) { $x = _bigint_to_int($x); } else { $x = _upgrade_to_float($x) if ref($x) ne 'Math::BigFloat'; } } # Make sure we preserve whatever accuracy setting the input was using. $x->accuracy($_[0]->accuracy) if ref($x) && ref($_[0]) =~ /^Math::Big/ && $_[0]->accuracy; # 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->copy->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); # TODO: See if we can tune this if (0 && $x >= 1) { _upgrade_to_float(); my $sum = Math::BigFloat->new(0); my $inner_sum = Math::BigFloat->new(0); my $p = Math::BigFloat->new(-1); my $factorial = 1; my $power2 = 1; my $q; my $k = 0; my $neglogx = -$logx; for my $n (1 .. 1000) { $factorial = vecprod($factorial, $n); $q = vecprod($factorial, $power2); $power2 = vecprod(2, $power2); while ($k <= ($n-1)>>1) { $inner_sum += Math::BigFloat->new(1) / (2*$k+1); $k++; } $p *= $neglogx; my $term = ($p / $q) * $inner_sum; $sum += $term; last if abs($term) < $tol; } $sum *= sqrt($x); return 0.0+_Euler(18) + log($logx) + $sum unless ref($x)=~/^Math::Big/; my $val = Math::BigFloat->new(_Euler(40))->badd("".log($logx))->badd("$sum"); $val->accuracy($finalacc) if $xdigits; return $val; } if ($x > 1e16) { my $invx = ref($logx) ? Math::BigFloat->bone / $logx : 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 .. 1000) { 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; } $invx *= $sum; $invx *= $x; $invx->accuracy($finalacc) if ref($invx) && $xdigits; return $invx; } # 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; } return 0.0+_Euler(18) + log($logx) + $sum unless ref($x) =~ /^Math::Big/; my $val = Math::BigFloat->new(_Euler(40))->badd("".log($logx))->badd("$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) = @_; my $ix = ($x == int($x)) ? "" . Math::BigInt->new($x) : 0; # Try our GMP code if possible. if ($Math::Prime::Util::_GMPfunc{"zeta"}) { my($wantbf,$xdigits) = _bfdigits($x); # If we knew the *exact* number of zero digits, we could let GMP zeta # handle the correct rounding. But we don't, so we have to go over. my $zero_dig = "".int($x / 3) - 1; my $strval = Math::Prime::Util::GMP::zeta($x, $xdigits + 8 + $zero_dig); if ($strval =~ s/^(1\.0*)/./) { $strval .= "e-".(length($1)-2) if length($1) > 2; } else { $strval =~ s/^(\d+)/$1-1/e; } return ($wantbf) ? Math::BigFloat->new($strval,$wantbf) : 0.0 + $strval; } # If we need a bigfloat result, then call our PP routine. if (defined $bignum::VERSION || ref($x) =~ /^Math::Big/) { require Math::Prime::Util::ZetaBigFloat; return Math::Prime::Util::ZetaBigFloat::RiemannZeta($x); } # Native float results 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; # With MPU::GMP v0.49 this is fast. if ($Math::Prime::Util::_GMPfunc{"riemannr"}) { my($wantbf,$xdigits) = _bfdigits($x); my $strval = Math::Prime::Util::GMP::riemannr($x, $xdigits); return ($wantbf) ? Math::BigFloat->new($strval,$wantbf) : 0.0 + $strval; } # TODO: look into this as a generic solution if (0 && $Math::Prime::Util::_GMPfunc{"zeta"}) { my($wantbf,$xdigits) = _bfdigits($x); $x = _upgrade_to_float($x); my $extra_acc = 4; $xdigits += $extra_acc; $x->accuracy($xdigits); my $logx = log($x); my $part_term = $x->copy->bone; my $sum = $x->copy->bone; my $tol = $x->copy->bone->brsft($xdigits-1, 10); my $bigk = $x->copy->bone; my $term; for my $k (1 .. 10000) { $part_term *= $logx / $bigk; my $zarg = $bigk->copy->binc; my $zeta = (RiemannZeta($zarg) * $bigk) + $bigk; #my $strval = Math::Prime::Util::GMP::zeta($k+1, $xdigits + int(($k+1) / 3)); #my $zeta = Math::BigFloat->new($strval)->bdec->bmul($bigk)->badd($bigk); $term = $part_term / $zeta; $sum += $term; last if $term < ($tol * $sum); $bigk->binc; } $sum->bround($xdigits-$extra_acc); my $strval = "$sum"; 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 $sum = 0.0; my $tol = 1e-18; my($c, $y, $t) = (0.0); if ($x > 10**17) { my @mob = Math::Prime::Util::moebius(0,300); for my $k (1 .. 300) { next if $mob[$k] == 0; my $term = $mob[$k] / $k * Math::Prime::Util::LogarithmicIntegral($x**(1.0/$k)); $y = $term-$c; $t = $sum+$y; $c = ($t-$sum)-$y; $sum = $t; last if abs($term) < ($tol * abs($sum)); } } else { $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) { my $zeta = ($k <= $#_Riemann_Zeta_Table) ? $_Riemann_Zeta_Table[$k+1-2] # Small k from table : RiemannZeta($k+1); # Large k from function $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; } sub LambertW { my $x = shift; croak "Invalid input to LambertW: x must be >= -1/e" if $x < -0.36787944118; $x = _upgrade_to_float($x) if ref($x) eq 'Math::BigInt'; my $xacc = ref($x) ? _find_big_acc($x) : 0; my $w; if ($Math::Prime::Util::_GMPfunc{"lambertw"}) { my $w = (!$xacc) ? 0.0 + Math::Prime::Util::GMP::lambertw($x) : $x->copy->bzero->badd(Math::Prime::Util::GMP::lambertw($x, $xacc)); return $w; } # Approximation if ($x < -0.06) { my $ti = $x * 2 * exp($x-$x+1) + 2; return -1 if $ti <= 0; my $t = sqrt($ti); $w = (-1 + 1/6*$t + (257/720)*$t*$t + (13/720)*$t*$t*$t) / (1 + (5/6)*$t + (103/720)*$t*$t); } elsif ($x < 1.363) { my $l1 = log($x + 1); $w = $l1 * (1 - log(1+$l1) / (2+$l1)); } elsif ($x < 3.7) { my $l1 = log($x); my $l2 = log($l1); $w = $l1 - $l2 - log(1 - $l2/$l1)/2.0; } else { my $l1 = log($x); my $l2 = log($l1); my $d1 = 2 * $l1 * $l1; my $d2 = 3 * $l1 * $d1; my $d3 = 2 * $l1 * $d2; my $d4 = 5 * $l1 * $d3; $w = $l1 - $l2 + $l2/$l1 + $l2*($l2-2)/$d1 + $l2*(6+$l2*(-9+2*$l2))/$d2 + $l2*(-12+$l2*(36+$l2*(-22+3*$l2)))/$d3 + $l2*(60+$l2*(-300+$l2*(350+$l2*(-125+12*$l2))))/$d4; } # Now iterate to get the answer # # Newton: # $w = $w*(log($x) - log($w) + 1) / ($w+1); # Halley: # my $e = exp($w); # my $f = $w * $e - $x; # $w -= $f / ($w*$e+$e - ($w+2)*$f/(2*$w+2)); # Fritsch converges quadratically, so tolerance could be 4x smaller. Use 2x. my $tol = ($xacc) ? 10**(-int(1+$xacc/2)) : 1e-16; $w->accuracy($xacc+10) if $xacc; for (1 .. 200) { last if $w == 0; my $w1 = $w + 1; my $zn = log($x/$w) - $w; my $qn = $w1 * 2 * ($w1+(2*$zn/3)); my $en = ($zn/$w1) * ($qn-$zn)/($qn-$zn*2); my $wen = $w * $en; $w += $wen; last if abs($wen) < $tol; } $w->accuracy($xacc) if $xacc; $w; } my $_Pi = "3.141592653589793238462643383279503"; sub Pi { my $digits = shift; return 0.0+$_Pi unless $digits; return 0.0+sprintf("%.*lf", $digits-1, $_Pi) if $digits < 15; return _upgrade_to_float($_Pi, $digits) if $digits < 30; # Performance ranking: # MPU::GMP Uses AGM or Ramanujan/Chudnosky with binary splitting # MPFR Uses AGM, from 1x to 1/4x the above # Perl AGM w/GMP also AGM, nice growth rate, but slower than above # C pidigits much worse than above, but faster than the others # Perl AGM without Math::BigInt::GMP, it's sluggish # Math::BigFloat new versions use AGM, old ones are *very* slow # # With a few thousand digits, any of the top 4 are fine. # At 10k digits, the first two are pulling away. # At 50k digits, the first three are 5-20x faster than C pidigits, and # pray you're not having to the Perl BigFloat methods without GMP. # At 100k digits, the first two are 15x faster than the third, C pidigits # is 200x slower, and the rest thousands of times slower. # At 1M digits, the first is under 1 second, MPFR under 2 seconds, # Perl AGM (Math::BigInt::GMP) is over a minute, and C piigits at 1.5 hours. # # Interestingly, Math::BigInt::Pari, while greatly faster than Calc, is # *much* slower than GMP for these operations (both AGM and Machin). While # Perl AGM with the Math::BigInt::GMP backend will pull away from C pidigits, # using it with the other backends doesn't do so. # # The GMP program at https://gmplib.org/download/misc/gmp-chudnovsky.c # will run ~4x faster than MPFR and ~1.5x faster than MPU::GMP. my $have_bigint_gmp = Math::BigInt->config()->{lib} =~ /GMP/; my $have_xdigits = Math::Prime::Util::prime_get_config()->{'xs'}; my $_verbose = Math::Prime::Util::prime_get_config()->{'verbose'}; if ($Math::Prime::Util::_GMPfunc{"Pi"}) { print " using MPUGMP for Pi($digits)\n" if $_verbose; return _upgrade_to_float( Math::Prime::Util::GMP::Pi($digits) ); } # We could consider looking for Math::MPFR or Math::Pari # This has a *much* better growth rate than the later solutions. if ( !$have_xdigits || ($have_bigint_gmp && $digits > 100) ) { print " using Perl AGM for Pi($digits)\n" if $_verbose; # Brent-Salamin (aka AGM or Gauss-Legendre) $digits += 8; my $HALF = _upgrade_to_float(0.5); my ($an, $bn, $tn, $pn) = ($HALF->copy->bone, $HALF->copy->bsqrt($digits), $HALF->copy->bmul($HALF), $HALF->copy->bone); while ($pn < $digits) { my $prev_an = $an->copy; $an->badd($bn)->bmul($HALF, $digits); $bn->bmul($prev_an)->bsqrt($digits); $prev_an->bsub($an); $tn->bsub($pn * $prev_an * $prev_an); $pn->badd($pn); } $an->badd($bn); $an->bmul($an,$digits)->bdiv(4*$tn, $digits-8); return $an; } # Spigot method in C. Low overhead but not good growth rate. if ($have_xdigits) { print " using XS spigot for Pi($digits)\n" if $_verbose; return _upgrade_to_float(Math::Prime::Util::_pidigits($digits)); } # We're going to have to use the Math::BigFloat code. # 1) it rounds incorrectly (e.g. 761, 1372, 1509,...). # Fix by adding some digits and rounding. # 2) AGM is *much* faster once past ~2000 digits # 3) It is very slow without the GMP backend. The Pari backend helps # but it still pretty bad. With Calc it's glacial for large inputs. # Math::BigFloat AGM spigot AGM # Size GMP Pari Calc GMP Pari Calc C C+GMP # 500 0.04 0.60 0.30 0.08 0.10 0.47 0.09 0.06 # 1000 0.04 0.11 1.82 0.09 0.14 1.82 0.09 0.06 # 2000 0.07 0.37 13.5 0.09 0.34 9.16 0.10 0.06 # 4000 0.14 2.17 107.8 0.12 1.14 39.7 0.20 0.06 # 8000 0.52 15.7 0.22 4.63 186.2 0.56 0.08 # 16000 2.73 121.8 0.52 19.2 2.00 0.08 # 32000 15.4 1.42 7.78 0.12 # ^ ^ ^ # | use this THIRD ---+ | # use this SECOND ---+ | # use this FIRST ---+ # approx # growth 5.6x 7.6x 8.0x 2.7x 4.1x 4.7x 3.9x 2.0x print " using BigFloat for Pi($digits)\n" if $_verbose; _upgrade_to_float(0); return Math::BigFloat::bpi($digits+10)->round($digits); } sub forpart { my($sub, $n, $rhash) = @_; _forcompositions(1, $sub, $n, $rhash); } sub forcomp { my($sub, $n, $rhash) = @_; _forcompositions(0, $sub, $n, $rhash); } sub _forcompositions { my($ispart, $sub, $n, $rhash) = @_; _validate_positive_integer($n); my($mina, $maxa, $minn, $maxn, $primeq) = (1,$n,1,$n,-1); if (defined $rhash) { croak "forpart second argument must be a hash reference" unless ref($rhash) eq 'HASH'; if (defined $rhash->{amin}) { $mina = $rhash->{amin}; _validate_positive_integer($mina); } if (defined $rhash->{amax}) { $maxa = $rhash->{amax}; _validate_positive_integer($maxa); } $minn = $maxn = $rhash->{n} if defined $rhash->{n}; $minn = $rhash->{nmin} if defined $rhash->{nmin}; $maxn = $rhash->{nmax} if defined $rhash->{nmax}; _validate_positive_integer($minn); _validate_positive_integer($maxn); if (defined $rhash->{prime}) { $primeq = $rhash->{prime}; _validate_positive_integer($primeq); } $mina = 1 if $mina < 1; $maxa = $n if $maxa > $n; $minn = 1 if $minn < 1; $maxn = $n if $maxn > $n; $primeq = 2 if $primeq != -1 && $primeq != 0; } $sub->() if $n == 0 && $minn <= 1; return if $n < $minn || $minn > $maxn || $mina > $maxa || $maxn <= 0 || $maxa <= 0; my $oldforexit = Math::Prime::Util::_start_for_loop(); my ($x, $y, $r, $k); my @a = (0) x ($n); $k = 1; $a[0] = $mina - 1; $a[1] = $n - $mina + 1; while ($k != 0) { $x = $a[$k-1]+1; $y = $a[$k]-1; $k--; $r = $ispart ? $x : 1; while ($r <= $y) { $a[$k] = $x; $x = $r; $y -= $x; $k++; } $a[$k] = $x + $y; # Restrict size while ($k+1 > $maxn) { $a[$k-1] += $a[$k]; $k--; } next if $k+1 < $minn; # Restrict values if ($mina > 1 || $maxa < $n) { last if $a[0] > $maxa; if ($ispart) { next if $a[$k] > $maxa; } else { next if Math::Prime::Util::vecany(sub{ $_ < $mina || $_ > $maxa }, @a[0..$k]); } } next if $primeq == 0 && Math::Prime::Util::vecany(sub{ is_prime($_) }, @a[0..$k]); next if $primeq == 2 && Math::Prime::Util::vecany(sub{ !is_prime($_) }, @a[0..$k]); last if Math::Prime::Util::_get_forexit(); $sub->(@a[0 .. $k]); } Math::Prime::Util::_end_for_loop($oldforexit); } sub forcomb { my($sub, $n, $k) = @_; _validate_positive_integer($n); my($begk, $endk); if (defined $k) { _validate_positive_integer($k); return if $k > $n; $begk = $endk = $k; } else { $begk = 0; $endk = $n; } my $oldforexit = Math::Prime::Util::_start_for_loop(); for my $k ($begk .. $endk) { if ($k == 0) { $sub->(); } else { my @c = 0 .. $k-1; while (1) { $sub->(@c); last if Math::Prime::Util::_get_forexit(); next if $c[-1]++ < $n-1; my $i = $k-2; $i-- while $i >= 0 && $c[$i] >= $n-($k-$i); last if $i < 0; $c[$i]++; while (++$i < $k) { $c[$i] = $c[$i-1] + 1; } } } last if Math::Prime::Util::_get_forexit(); } Math::Prime::Util::_end_for_loop($oldforexit); } sub _forperm { my($sub, $n, $all_perm) = @_; my $k = $n; my @c = reverse 0 .. $k-1; my $inc = 0; my $send = 1; my $oldforexit = Math::Prime::Util::_start_for_loop(); while (1) { if (!$all_perm) { # Derangements via simple filtering. $send = 1; for my $p (0 .. $#c) { if ($c[$p] == $k-$p-1) { $send = 0; last; } } } if ($send) { $sub->(reverse @c); last if Math::Prime::Util::_get_forexit(); } if (++$inc & 1) { @c[0,1] = @c[1,0]; next; } my $j = 2; $j++ while $j < $k && $c[$j] > $c[$j-1]; last if $j >= $k; my $m = 0; $m++ while $c[$j] > $c[$m]; @c[$j,$m] = @c[$m,$j]; @c[0..$j-1] = reverse @c[0..$j-1]; } Math::Prime::Util::_end_for_loop($oldforexit); } sub forperm { my($sub, $n, $k) = @_; _validate_positive_integer($n); croak "Too many arguments for forperm" if defined $k; return $sub->() if $n == 0; return $sub->(0) if $n == 1; _forperm($sub, $n, 1); } sub forderange { my($sub, $n, $k) = @_; _validate_positive_integer($n); croak "Too many arguments for forderange" if defined $k; return $sub->() if $n == 0; return if $n == 1; _forperm($sub, $n, 0); } sub _multiset_permutations { my($sub, $prefix, $ar, $sum) = @_; return if $sum == 0; # Remove any values with 0 occurances my @n = grep { $_->[1] > 0 } @$ar; if ($sum == 1) { # A single value $sub->(@$prefix, $n[0]->[0]); } elsif ($sum == 2) { # Optimize the leaf case my($n0,$n1) = map { $_->[0] } @n; if (@n == 1) { $sub->(@$prefix, $n0, $n0); } else { $sub->(@$prefix, $n0, $n1); $sub->(@$prefix, $n1, $n0) unless Math::Prime::Util::_get_forexit(); } } elsif (0 && $sum == scalar(@n)) { # All entries have 1 occurance # TODO: Figure out a way to use this safely. We need to capture any # lastfor that was seen in the forperm. my @i = map { $_->[0] } @n; Math::Prime::Util::forperm(sub { $sub->(@$prefix, @i[@_]) }, 1+$#i); } else { # Recurse over each leading value for my $v (@n) { $v->[1]--; push @$prefix, $v->[0]; no warnings 'recursion'; _multiset_permutations($sub, $prefix, \@n, $sum-1); pop @$prefix; $v->[1]++; last if Math::Prime::Util::_get_forexit(); } } } sub numtoperm { my($n,$k) = @_; _validate_positive_integer($n); _validate_integer($k); return () if $n == 0; return (0) if $n == 1; my $f = factorial($n-1); $k %= vecprod($f,$n) if $k < 0 || int($k/$f) >= $n; my @S = map { $_ } 0 .. $n-1; my @V; while ($n-- > 0) { my $i = int($k/$f); push @V, splice(@S,$i,1); last if $n == 0; $k -= $i*$f; $f /= $n; } @V; } sub permtonum { my $A = shift; croak "permtonum argument must be an array reference" unless ref($A) eq 'ARRAY'; my $n = scalar(@$A); return 0 if $n == 0; { my %S; for my $v (@$A) { croak "permtonum invalid permutation array" if !defined $v || $v < 0 || $v >= $n || $S{$v}++; } } my $f = factorial($n-1); my $rank = 0; for my $i (0 .. $n-2) { my $k = 0; for my $j ($i+1 .. $n-1) { $k++ if $A->[$j] < $A->[$i]; } $rank = Math::Prime::Util::vecsum($rank, Math::Prime::Util::vecprod($k,$f)); $f /= $n-$i-1; } $rank; } sub randperm { my($n,$k) = @_; _validate_positive_integer($n); if (defined $k) { _validate_positive_integer($k); } $k = $n if !defined($k) || $k > $n; return () if $k == 0; my @S; if ("$k"/"$n" <= 0.30) { my %seen; my $v; for my $i (1 .. $k) { do { $v = Math::Prime::Util::urandomm($n); } while $seen{$v}++; push @S,$v; } } else { @S = map { $_ } 0..$n-1; for my $i (0 .. $n-2) { last if $i >= $k; my $j = Math::Prime::Util::urandomm($n-$i); @S[$i,$i+$j] = @S[$i+$j,$i]; } $#S = $k-1; } return @S; } sub shuffle { my @S=@_; # Note: almost all the time is spent in urandomm. for (my $i = $#S; $i >= 1; $i--) { my $j = Math::Prime::Util::urandomm($i+1); @S[$i,$j] = @S[$j,$i]; } @S; } ############################################################################### # Random numbers ############################################################################### # PPFE: irand irand64 drand random_bytes csrand srand _is_csprng_well_seeded sub urandomb { my($n) = @_; return 0 if $n <= 0; return ( Math::Prime::Util::irand() >> (32-$n) ) if $n <= 32; return ( Math::Prime::Util::irand64() >> (64-$n) ) if MPU_MAXBITS >= 64 && $n <= 64; my $bytes = Math::Prime::Util::random_bytes(($n+7)>>3); my $binary = substr(unpack("B*",$bytes),0,$n); return Math::BigInt->new("0b$binary"); } sub urandomm { my($n) = @_; # _validate_positive_integer($n); return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::urandomm($n)) if $Math::Prime::Util::_GMPfunc{"urandomm"}; return 0 if $n <= 1; my $r; if ($n <= 4294967295) { my $rmax = int(4294967295 / $n) * $n; do { $r = Math::Prime::Util::irand() } while $r >= $rmax; } elsif (!ref($n)) { my $rmax = int(~0 / $n) * $n; do { $r = Math::Prime::Util::irand64() } while $r >= $rmax; } else { # TODO: verify and try to optimize this my $bits = length($n->as_bin) - 2; my $bytes = 1 + (($bits+7)>>3); my $rmax = Math::BigInt->bone->blsft($bytes*8)->bdec; my $overflow = $rmax - ($rmax % $n); do { $r = Math::Prime::Util::urandomb($bytes*8); } while $r >= $overflow; } return $r % $n; } sub random_prime { my($low, $high) = @_; if (scalar(@_) == 1) { ($low,$high) = (2,$low); } else { _validate_positive_integer($low); } _validate_positive_integer($high); return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_prime($low, $high)) if $Math::Prime::Util::_GMPfunc{"random_prime"}; require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_prime($low,$high); } sub random_ndigit_prime { my($digits) = @_; _validate_positive_integer($digits, 1); return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_ndigit_prime($digits)) if $Math::Prime::Util::_GMPfunc{"random_ndigit_prime"}; require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_ndigit_prime($digits); } sub random_nbit_prime { my($bits) = @_; _validate_positive_integer($bits, 2); return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_nbit_prime($bits)) if $Math::Prime::Util::_GMPfunc{"random_nbit_prime"}; require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_nbit_prime($bits); } sub random_strong_prime { my($bits) = @_; _validate_positive_integer($bits, 128); return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_strong_prime($bits)) if $Math::Prime::Util::_GMPfunc{"random_strong_prime"}; require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_strong_prime($bits); } sub random_maurer_prime { my($bits) = @_; _validate_positive_integer($bits, 2); return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_maurer_prime($bits)) if $Math::Prime::Util::_GMPfunc{"random_maurer_prime"}; require Math::Prime::Util::RandomPrimes; my ($n, $cert) = Math::Prime::Util::RandomPrimes::random_maurer_prime_with_cert($bits); croak "maurer prime $n failed certificate verification!" unless Math::Prime::Util::verify_prime($cert); return $n; } sub random_shawe_taylor_prime { my($bits) = @_; _validate_positive_integer($bits, 2); return Math::Prime::Util::_reftyped($_[0], Math::Prime::Util::GMP::random_shawe_taylor_prime($bits)) if $Math::Prime::Util::_GMPfunc{"random_shawe_taylor_prime"}; require Math::Prime::Util::RandomPrimes; my ($n, $cert) = Math::Prime::Util::RandomPrimes::random_shawe_taylor_prime_with_cert($bits); croak "shawe-taylor prime $n failed certificate verification!" unless Math::Prime::Util::verify_prime($cert); return $n; } sub miller_rabin_random { my($n, $k, $seed) = @_; _validate_positive_integer($n); if (scalar(@_) == 1 ) { $k = 1; } else { _validate_positive_integer($k); } return 1 if $k <= 0; if ($Math::Prime::Util::_GMPfunc{"miller_rabin_random"}) { return Math::Prime::Util::GMP::miller_rabin_random($n, $k, $seed) if defined $seed; return Math::Prime::Util::GMP::miller_rabin_random($n, $k); } # Math::Prime::Util::prime_get_config()->{'assume_rh'}) ==> 2*log(n)^2 if ($k >= int(3*$n/4) ) { for (2 .. int(3*$n/4)+2) { return 0 unless Math::Prime::Util::is_strong_pseudoprime($n, $_); } return 1; } my $brange = $n-2; return 0 unless Math::Prime::Util::is_strong_pseudoprime($n, Math::Prime::Util::urandomm($brange)+2 ); $k--; while ($k > 0) { my $nbases = ($k >= 20) ? 20 : $k; return 0 unless is_strong_pseudoprime($n, map { urandomm($brange)+2 } 1 .. $nbases); $k -= $nbases; } 1; } sub random_semiprime { my($b) = @_; return 0 if defined $b && int($b) < 0; _validate_positive_integer($b,4); my $n; my $min = ($b <= MPU_MAXBITS) ? (1 << ($b-1)) : BTWO->copy->bpow($b-1); my $max = $min + ($min - 1); my $L = $b >> 1; my $N = $b - $L; my $one = ($b <= MPU_MAXBITS) ? 1 : BONE; do { $n = $one * random_nbit_prime($L) * random_nbit_prime($N); } while $n < $min || $n > $max; $n = _bigint_to_int($n) if ref($n) && $n->bacmp(BMAX) <= 0; $n; } sub random_unrestricted_semiprime { my($b) = @_; return 0 if defined $b && int($b) < 0; _validate_positive_integer($b,3); my $n; my $min = ($b <= MPU_MAXBITS) ? (1 << ($b-1)) : BTWO->copy->bpow($b-1); my $max = $min + ($min - 1); if ($b <= 64) { do { $n = $min + urandomb($b-1); } while !Math::Prime::Util::is_semiprime($n); } else { # Try to get probabilities right for small divisors my %M = ( 2 => 1.91218397452243, 3 => 1.33954826555021, 5 => 0.854756717114822, 7 => 0.635492301836862, 11 => 0.426616792046787, 13 => 0.368193843118344, 17 => 0.290512701603111, 19 => 0.263359264658156, 23 => 0.222406328935102, 29 => 0.181229250520242, 31 => 0.170874199059434, 37 => 0.146112155735473, 41 => 0.133427839963585, 43 => 0.127929010905662, 47 => 0.118254609086782, 53 => 0.106316418106489, 59 => 0.0966989675438643, 61 => 0.0938833658008547, 67 => 0.0864151823151671, 71 => 0.0820822953188297, 73 => 0.0800964416340746, 79 => 0.0747060914833344, 83 => 0.0714973706654851, 89 => 0.0672115468436284, 97 => 0.0622818892486191, 101 => 0.0600855891549939, 103 => 0.0590613570015407, 107 => 0.0570921135626976, 109 => 0.0561691667641485, 113 => 0.0544330141081874, 127 => 0.0490620204315701, ); my ($p,$r); $r = Math::Prime::Util::drand(); for my $prime (2..127) { next unless defined $M{$prime}; my $PR = $M{$prime} / $b + 0.19556 / $prime; if ($r <= $PR) { $p = $prime; last; } $r -= $PR; } if (!defined $p) { # Idea from Charles Greathouse IV, 2010. The distribution is right # at the high level (small primes weighted more and not far off what # we get with the uniform selection), but there is a noticeable skew # toward primes with a large gap after them. For instance 3 ends up # being weighted as much as 2, and 7 more than 5. # # Since we handled small divisors earlier, this is less bothersome. my $M = 0.26149721284764278375542683860869585905; my $weight = $M + log($b * log(2)/2); my $minr = log(log(131)); do { $r = Math::Prime::Util::drand($weight) - $M; } while $r < $minr; # Using Math::BigFloat::bexp is ungodly slow, so avoid at all costs. my $re = exp($r); my $a = ($re < log(~0)) ? int(exp($re)+0.5) : _upgrade_to_float($re)->bexp->bround->as_int; $p = $a < 2 ? 2 : Math::Prime::Util::prev_prime($a+1); } my $ranmin = ref($min) ? $min->badd($p-1)->bdiv($p)->as_int : int(($min+$p-1)/$p); my $ranmax = ref($max) ? $max->bdiv($p)->as_int : int($max/$p); my $q = random_prime($ranmin, $ranmax); $n = Math::Prime::Util::vecprod($p,$q); } $n = _bigint_to_int($n) if ref($n) && $n->bacmp(BMAX) <= 0; $n; } sub random_factored_integer { my($n) = @_; return (0,[]) if defined $n && int($n) < 0; _validate_positive_integer($n,1); while (1) { my @S = ($n); # make s_i chain push @S, 1 + Math::Prime::Util::urandomm($S[-1]) while $S[-1] > 1; # first is n, last is 1 @S = grep { is_prime($_) } @S[1 .. $#S-1]; my $r = Math::Prime::Util::vecprod(@S); return ($r, [@S]) if $r <= $n && (1+urandomm($n)) <= $r; } } 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.73 =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-2016 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.73/lib/Math/Prime/Util/PPFE.pm0000644000076400007640000006700613373330217017454 0ustar danadanapackage Math::Prime::Util::PPFE; use strict; use warnings; use Math::Prime::Util::PP; use Math::Prime::Util::Entropy; # 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; use Carp qw/carp croak confess/; *_validate_num = \&Math::Prime::Util::PP::_validate_num; *_validate_integer = \&Math::Prime::Util::PP::_validate_integer; *_prime_memfreeall = \&Math::Prime::Util::PP::_prime_memfreeall; *prime_memfree = \&Math::Prime::Util::PP::prime_memfree; *prime_precalc = \&Math::Prime::Util::PP::prime_precalc; use Math::Prime::Util::ChaCha; *_is_csprng_well_seeded = \&Math::Prime::Util::ChaCha::_is_csprng_well_seeded; *_csrand = \&Math::Prime::Util::ChaCha::csrand; *_srand = \&Math::Prime::Util::ChaCha::srand; *random_bytes = \&Math::Prime::Util::ChaCha::random_bytes; *irand = \&Math::Prime::Util::ChaCha::irand; *irand64 = \&Math::Prime::Util::ChaCha::irand64; sub srand { my($seed) = @_; croak "secure option set, manual seeding disabled" if prime_get_config()->{'secure'}; if (!defined $seed) { my $nbytes = (~0 == 4294967295) ? 4 : 8; $seed = entropy_bytes( $nbytes ); $seed = unpack(($nbytes==4) ? "L" : "Q", $seed); } Math::Prime::Util::GMP::seed_csprng(8,pack("LL",$seed)) if $Math::Prime::Util::_GMPfunc{"seed_csprng"}; Math::Prime::Util::_srand($seed); } sub csrand { my($seed) = @_; croak "secure option set, manual seeding disabled" if defined $seed && prime_get_config()->{'secure'}; $seed = entropy_bytes( 64 ) unless defined $seed; Math::Prime::Util::GMP::seed_csprng(length($seed),$seed) if $Math::Prime::Util::_GMPfunc{"seed_csprng"}; Math::Prime::Util::_csrand($seed); 1; # Don't return the seed } sub entropy_bytes { my($bytes) = @_; croak "entropy_bytes: input must be integer bytes between 1 and 4294967295" if !defined($bytes) || $bytes < 1 || $bytes > 4294967295 || $bytes != int($bytes); my $data = Math::Prime::Util::Entropy::entropy_bytes($bytes); if (!defined $data) { # We can't find any entropy source! Highly unusual. Math::Prime::Util::_srand(); $data = random_bytes($bytes); } croak "entropy_bytes internal got wrong amount!" unless length($data) == $bytes; $data; } # Fill all the mantissa bits for our NV, regardless of 32-bit or 64-bit Perl. { use Config; my $nvbits = (defined $Config{nvmantbits}) ? $Config{nvmantbits} : (defined $Config{usequadmath}) ? 112 : 53; my $uvbits = (~0 > 4294967295) ? 64 : 32; my $rsub; my $_tonv_32 = 1.0; $_tonv_32 /= 2.0 for 1..32; my $_tonv_64 = $_tonv_32; $_tonv_64 /= 2.0 for 1..32; my $_tonv_96 = $_tonv_64; $_tonv_96 /= 2.0 for 1..32; my $_tonv_128 = $_tonv_96; $_tonv_128/= 2.0 for 1..32; if ($uvbits == 64) { if ($nvbits <= 32) { *drand = sub { my $d = irand() * $_tonv_32; $d *= $_[0] if $_[0]; $d; }; } elsif ($nvbits <= 64) { *drand = sub { my $d = irand64() * $_tonv_64; $d *= $_[0] if $_[0]; $d; }; } else { *drand = sub { my $d = irand64() * $_tonv_64 + irand64() * $_tonv_128; $d *= $_[0] if $_[0]; $d; }; } } else { if ($nvbits <= 32) { *drand = sub { my $d = irand() * $_tonv_32; $d *= $_[0] if $_[0]; $d; }; } elsif ($nvbits <= 64) { *drand = sub { my $d = ((irand() >> 5) * 67108864.0 + (irand() >> 6)) / 9007199254740992.0; $d *= $_[0] if $_[0]; $d; }; } else { *drand = sub { my $d = irand() * $_tonv_32 + irand() * $_tonv_64 + irand() * $_tonv_96 + irand() * $_tonv_128; $d *= $_[0] if $_[0]; $d; }; } } *rand = \&drand; } *urandomb = \&Math::Prime::Util::PP::urandomb; *urandomm = \&Math::Prime::Util::PP::urandomm; # TODO: Go through these and decide if they should be doing anything extra here, # such as input validation. # TODO: If not, why not the other functions? *sumdigits = \&Math::Prime::Util::PP::sumdigits; *todigits = \&Math::Prime::Util::PP::todigits; *todigitstring = \&Math::Prime::Util::PP::todigitstring; *fromdigits = \&Math::Prime::Util::PP::fromdigits; *inverse_li = \&Math::Prime::Util::PP::inverse_li; *sieve_prime_cluster = \&Math::Prime::Util::PP::sieve_prime_cluster; *twin_prime_count = \&Math::Prime::Util::PP::twin_prime_count; *semiprime_count = \&Math::Prime::Util::PP::semiprime_count; *ramanujan_prime_count = \&Math::Prime::Util::PP::ramanujan_prime_count; *sum_primes = \&Math::Prime::Util::PP::sum_primes; *print_primes = \&Math::Prime::Util::PP::print_primes; *sieve_range = \&Math::Prime::Util::PP::sieve_range; *is_carmichael = \&Math::Prime::Util::PP::is_carmichael; *is_quasi_carmichael = \&Math::Prime::Util::PP::is_quasi_carmichael; *is_pillai = \&Math::Prime::Util::PP::is_pillai; *is_fundamental = \&Math::Prime::Util::PP::is_fundamental; *is_semiprime = \&Math::Prime::Util::PP::is_semiprime; *is_totient = \&Math::Prime::Util::PP::is_totient; *is_square = \&Math::Prime::Util::PP::is_square; *random_prime = \&Math::Prime::Util::PP::random_prime; *random_ndigit_prime = \&Math::Prime::Util::PP::random_ndigit_prime; *random_nbit_prime = \&Math::Prime::Util::PP::random_nbit_prime; *random_proven_prime = \&Math::Prime::Util::PP::random_maurer_prime; # redir *random_strong_prime = \&Math::Prime::Util::PP::random_strong_prime; *random_maurer_prime = \&Math::Prime::Util::PP::random_maurer_prime; *random_shawe_taylor_prime =\&Math::Prime::Util::PP::random_shawe_taylor_prime; *miller_rabin_random = \&Math::Prime::Util::PP::miller_rabin_random; *random_semiprime = \&Math::Prime::Util::PP::random_semiprime; *random_unrestricted_semiprime = \&Math::Prime::Util::PP::random_unrestricted_semiprime; *random_factored_integer = \&Math::Prime::Util::PP::random_factored_integer; *numtoperm = \&Math::Prime::Util::PP::numtoperm; *permtonum = \&Math::Prime::Util::PP::permtonum; *randperm = \&Math::Prime::Util::PP::randperm; *shuffle = \&Math::Prime::Util::PP::shuffle; *moebius = \&Math::Prime::Util::PP::moebius; *euler_phi = \&Math::Prime::Util::PP::euler_phi; *inverse_totient = \&Math::Prime::Util::PP::inverse_totient; 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 ramanujan_sum { my($k,$n) = @_; _validate_positive_integer($k); _validate_positive_integer($n); return Math::Prime::Util::PP::ramanujan_sum($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 hclassno { my($n) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); return Math::Prime::Util::PP::hclassno($n); } sub next_prime { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::next_prime($n); } sub prev_prime { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::prev_prime($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 twin_prime_count_approx { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::twin_prime_count_approx($n); } sub semiprime_count_approx { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::semiprime_count_approx($n); } sub ramanujan_prime_count_lower { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::ramanujan_prime_count_lower($n); } sub ramanujan_prime_count_upper { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::ramanujan_prime_count_upper($n); } sub ramanujan_prime_count_approx { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::ramanujan_prime_count_approx($n); } sub nth_twin_prime { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::nth_twin_prime($n); } sub nth_twin_prime_approx { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::nth_twin_prime_approx($n); } sub nth_semiprime { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::nth_semiprime($n); } sub nth_semiprime_approx { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::nth_semiprime_approx($n); } sub nth_ramanujan_prime { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::nth_ramanujan_prime($n); } sub nth_ramanujan_prime_lower { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::nth_ramanujan_prime_lower($n); } sub nth_ramanujan_prime_upper { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::nth_ramanujan_prime_upper($n); } sub nth_ramanujan_prime_approx { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::nth_ramanujan_prime_approx($n); } *is_prime = \&Math::Prime::Util::PP::is_prime; *is_prob_prime = \&Math::Prime::Util::PP::is_prob_prime; *is_provable_prime = \&Math::Prime::Util::PP::is_provable_prime; *is_bpsw_prime = \&Math::Prime::Util::PP::is_bpsw_prime; sub is_pseudoprime { my($n, @bases) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); croak "No bases given to is_strong_pseudoprime" unless @bases; return Math::Prime::Util::PP::is_pseudoprime($n, @bases); } sub is_euler_pseudoprime { my($n, @bases) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); croak "No bases given to is_euler_pseudoprime" unless @bases; return Math::Prime::Util::PP::is_euler_pseudoprime($n, @bases); } sub is_strong_pseudoprime { my($n, @bases) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); croak "No bases given to is_strong_pseudoprime" unless @bases; return Math::Prime::Util::PP::is_strong_pseudoprime($n, @bases); } sub is_euler_plumb_pseudoprime { my($n) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); return Math::Prime::Util::PP::is_euler_plumb_pseudoprime($n); } 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_perrin_pseudoprime { my($n,$restrict) = @_; return 0 if defined $n && int($n) < 0; $restrict = 0 unless defined $restrict; _validate_positive_integer($n); _validate_positive_integer($restrict); return Math::Prime::Util::PP::is_perrin_pseudoprime($n, $restrict); } sub is_catalan_pseudoprime { my($n) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); return Math::Prime::Util::PP::is_catalan_pseudoprime($n); } sub is_frobenius_pseudoprime { my($n, $P, $Q) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); # TODO: validate P & Q return Math::Prime::Util::PP::is_frobenius_pseudoprime($n, $P, $Q); } 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_frobenius_khashin_pseudoprime { my($n) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); return Math::Prime::Util::PP::is_frobenius_khashin_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 is_ramanujan_prime { my($n) = @_; return 0 if defined $n && int($n) < 0; _validate_positive_integer($n); return Math::Prime::Util::PP::is_ramanujan_prime($n); } sub is_mersenne_prime { my($p) = @_; _validate_positive_integer($p); return Math::Prime::Util::PP::is_mersenne_prime($p); } sub is_square_free { my($n) = @_; _validate_integer($n); return Math::Prime::Util::PP::is_square_free($n); } sub is_primitive_root { my($a,$n) = @_; return 0 if $n == 0; $n = -$n if defined $n && $n < 0; $a %= $n if defined $a && $a < 0; _validate_positive_integer($a); _validate_positive_integer($n); return Math::Prime::Util::PP::is_primitive_root($a,$n); } sub lucas_sequence { my($n, $P, $Q, $k) = @_; my ($vp, $vq) = ($P, $Q); $vp = -$vp if defined $vp && $vp < 0; $vq = -$vq if defined $vq && $vq < 0; _validate_positive_integer($n); _validate_positive_integer($vp); _validate_positive_integer($vq); _validate_positive_integer($k); return Math::Prime::Util::PP::lucas_sequence(@_); } sub lucasu { my($P, $Q, $k) = @_; my ($vp, $vq) = ($P, $Q); $vp = -$vp if defined $vp && $vp < 0; $vq = -$vq if defined $vq && $vq < 0; _validate_positive_integer($vp); _validate_positive_integer($vq); _validate_positive_integer($k); return Math::Prime::Util::PP::lucasu(@_); } sub lucasv { my($P, $Q, $k) = @_; my ($vp, $vq) = ($P, $Q); $vp = -$vp if defined $vp && $vp < 0; $vq = -$vq if defined $vq && $vq < 0; _validate_positive_integer($vp); _validate_positive_integer($vq); _validate_positive_integer($k); return Math::Prime::Util::PP::lucasv(@_); } 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 factorial { my($n) = @_; _validate_integer($n); return Math::Prime::Util::PP::factorial($n); } sub factorialmod { my($n, $m) = @_; _validate_integer($n); _validate_integer($m); return Math::Prime::Util::PP::factorialmod($n, $m); } sub binomial { my($n, $k) = @_; _validate_integer($n); _validate_integer($k); return Math::Prime::Util::PP::binomial($n, $k); } sub stirling { my($n, $k, $type) = @_; _validate_positive_integer($n); _validate_positive_integer($k); _validate_positive_integer($type) if defined $type; return Math::Prime::Util::PP::stirling($n, $k, $type); } 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 =~ s/^-(\d+)/$1/ if defined $n; _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 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 { my(@v) = @_; _validate_integer($_) for @v; return Math::Prime::Util::PP::gcd(@v); } sub lcm { my(@v) = @_; _validate_integer($_) for @v; return Math::Prime::Util::PP::lcm(@v); } sub gcdext { my($a,$b) = @_; _validate_integer($a); _validate_integer($b); return Math::Prime::Util::PP::gcdext($a,$b); } sub chinese { # TODO: make sure we're not modding their data foreach my $aref (@_) { die "chinese arguments are two-element array references" unless ref($aref) eq 'ARRAY' && scalar @$aref == 2; _validate_integer($aref->[0]); _validate_integer($aref->[1]); } return Math::Prime::Util::PP::chinese(@_); } sub vecsum { my(@v) = @_; _validate_integer($_) for @v; return Math::Prime::Util::PP::vecsum(@v); } sub vecprod { my(@v) = @_; _validate_integer($_) for @v; return Math::Prime::Util::PP::vecprod(@v); } sub vecmin { my(@v) = @_; _validate_integer($_) for @v; return Math::Prime::Util::PP::vecmin(@v); } sub vecmax { my(@v) = @_; _validate_integer($_) for @v; return Math::Prime::Util::PP::vecmax(@v); } sub invmod { my ($a, $n) = @_; _validate_integer($a); _validate_integer($n); return Math::Prime::Util::PP::invmod($a,$n); } sub sqrtmod { my ($a, $n) = @_; _validate_integer($a); _validate_integer($n); return Math::Prime::Util::PP::sqrtmod($a,$n); } sub addmod { my ($a, $b, $n) = @_; _validate_integer($a); _validate_integer($b>=0?$b:-$b); _validate_integer($n); return Math::Prime::Util::PP::addmod($a,$b, $n); } sub mulmod { my ($a, $b, $n) = @_; _validate_integer($a); _validate_integer($b>=0?$b:-$b); _validate_integer($n); return Math::Prime::Util::PP::mulmod($a,$b, $n); } sub divmod { my ($a, $b, $n) = @_; _validate_integer($a); _validate_integer($b>=0?$b:-$b); _validate_integer($n); return Math::Prime::Util::PP::divmod($a,$b, $n); } sub powmod { my ($a, $b, $n) = @_; _validate_integer($a); _validate_integer($b>=0?$b:-$b); _validate_integer($n); return Math::Prime::Util::PP::powmod($a,$b, $n); } sub sqrtint { my($n) = @_; _validate_integer($n); return Math::Prime::Util::PP::sqrtint($n); } sub rootint { my($n, $k, $refp) = @_; _validate_positive_integer($n); _validate_positive_integer($k); return Math::Prime::Util::PP::rootint($n, $k, $refp); } sub logint { my($n, $b, $refp) = @_; _validate_positive_integer($n); _validate_positive_integer($b); return Math::Prime::Util::PP::logint($n, $b, $refp); } 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 ramanujan_tau { my($n) = @_; _validate_positive_integer($n); return Math::Prime::Util::PP::ramanujan_tau($n); } sub is_power { my($n, $a, $refp) = @_; my $vn = "$n"; $vn =~ s/^-//; _validate_positive_integer($vn); _validate_positive_integer($a) if defined $a; $vn = '-'.$vn if $n < 0; return Math::Prime::Util::PP::is_power($vn, $a, $refp); } sub is_prime_power { my($n, $refp) = @_; my $vn = "$n"; $vn =~ s/^-//; _validate_positive_integer($vn); $vn = '-'.$vn if $n < 0; return Math::Prime::Util::PP::is_prime_power($vn, $refp); } sub is_polygonal { my($x, $s, $refp) = @_; my $vx = "$x"; $vx =~ s/^-//; _validate_positive_integer($vx); _validate_positive_integer($s); $vx = '-'.$vx if $x < 0; return Math::Prime::Util::PP::is_polygonal($vx, $s, $refp); } sub valuation { my($n, $k) = @_; $n = -$n if defined $n && $n < 0; $k = -$k if defined $k && $k < 0; _validate_positive_integer($n); _validate_positive_integer($k); return Math::Prime::Util::PP::valuation($n, $k); } sub hammingweight { my($n) = @_; $n = -$n if defined $n && $n < 0; _validate_positive_integer($n); return Math::Prime::Util::PP::hammingweight($n); } sub Pi { my($digits) = @_; _validate_positive_integer($digits) if defined $digits; return Math::Prime::Util::PP::Pi($digits); } ############################################################################# my $_exitloop = 0; sub lastfor { $_exitloop = 1; } sub _get_forexit { $_exitloop; } sub _start_for_loop { my $old = $_exitloop; $_exitloop = 0; $old; } sub _end_for_loop { $_exitloop = shift; } 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 $oldforexit = _start_for_loop(); { my $pp; local *_ = \$pp; for (my $p = next_prime($beg-1); $p <= $end; $p = next_prime($p)) { $pp = $p; $sub->(); last if $_exitloop; } } _end_for_loop($oldforexit); } sub forcomposites(&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::_generic_forcomp_sub('composites', @_); } sub foroddcomposites(&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::_generic_forcomp_sub('oddcomposites', @_); } sub forsemiprimes(&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::_generic_forcomp_sub('semiprimes', @_); } sub forfactored(&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::_generic_forfac(0, @_); } sub forsquarefree(&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::_generic_forfac(1, @_); } sub fordivisors (&$) { ## no critic qw(ProhibitSubroutinePrototypes) my($sub, $n) = @_; _validate_num($n) || _validate_positive_integer($n); my @divisors = divisors($n); my $oldforexit = _start_for_loop(); { my $pp; local *_ = \$pp; foreach my $d (@divisors) { $pp = $d; $sub->(); last if $_exitloop; } } _end_for_loop($oldforexit); } sub forpart (&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::PP::forpart(@_); } sub forcomp (&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::PP::forcomp(@_); } sub forcomb (&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::PP::forcomb(@_); } sub forperm (&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::PP::forperm(@_); } sub forderange (&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::PP::forderange(@_); } sub forsetproduct (&@) { ## no critic qw(ProhibitSubroutinePrototypes) my($sub, @v) = @_; croak 'Not a subroutine reference' unless (ref($sub) || '') eq 'CODE'; croak 'Not an array reference' if grep {(ref($_) || '') ne 'ARRAY'} @v; # Exit if no arrays or any are empty. return if scalar(@v) == 0 || grep { !@$_ } @v; my @outv = map { $v[$_]->[0] } 0 .. $#v; my @cnt = (0) x @v; my $oldforexit = _start_for_loop(); my $i = 0; while ($i >= 0) { $sub->(@outv); last if $_exitloop; for ($i = $#v; $i >= 0; $i--) { if ($cnt[$i] >= $#{$v[$i]}) { $cnt[$i] = 0; $outv[$i] = $v[$i]->[0]; } else { $outv[$i] = $v[$i]->[++$cnt[$i]]; last; } } } _end_for_loop($oldforexit); } sub vecreduce (&@) { ## no critic qw(ProhibitSubroutinePrototypes) my($sub, @v) = @_; # Mastering Perl page 162, works with old Perl my $caller = caller(); no strict 'refs'; ## no critic(strict) local(*{$caller.'::a'}) = \my $a; local(*{$caller.'::b'}) = \my $b; $a = shift @v; for my $v (@v) { $b = $v; $a = $sub->(); } $a; } sub vecany (&@) { ## no critic qw(ProhibitSubroutinePrototypes) my $sub = shift; $sub->() and return 1 foreach @_; 0; } sub vecall (&@) { ## no critic qw(ProhibitSubroutinePrototypes) my $sub = shift; $sub->() or return 0 foreach @_; 1; } sub vecnone (&@) { ## no critic qw(ProhibitSubroutinePrototypes) my $sub = shift; $sub->() and return 0 foreach @_; 1; } sub vecnotall (&@) { ## no critic qw(ProhibitSubroutinePrototypes) my $sub = shift; $sub->() or return 1 foreach @_; undef; } sub vecfirst (&@) { ## no critic qw(ProhibitSubroutinePrototypes) my $sub = shift; $sub->() and return $_ foreach @_; undef; } sub vecfirstidx (&@) { ## no critic qw(ProhibitSubroutinePrototypes) my $sub = shift; my $i = 0; ++$i and $sub->() and return $i-1 foreach @_; -1; } sub vecextract { my($aref, $mask) = @_; croak "vecextract first argument must be an array reference" unless ref($aref) eq 'ARRAY'; return Math::Prime::Util::PP::vecextract(@_); } 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-2016 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.73/lib/Math/Prime/Util/PrimeIterator.pm0000644000076400007640000001537313373337725021523 0ustar danadanapackage Math::Prime::Util::PrimeIterator; use strict; use warnings; BEGIN { $Math::Prime::Util::PrimeIterator::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::PrimeIterator::VERSION = '0.73'; } 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 =for test_synopsis use v5.14; my ($i,$n) = (2,2); =head1 NAME Math::Prime::Util::PrimeIterator - An object iterator for primes =head1 VERSION Version 0.73 =head1 SYNOPSIS use Math::Prime::Util::PrimeIterator; my $it = Math::Prime::Util::PrimeIterator->new(); # Simple use: return current value and move forward. my $sum = 0; $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) $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 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.73/lib/Math/Prime/Util/ZetaBigFloat.pm0000644000076400007640000006557213373337725021256 0ustar danadanapackage Math::Prime::Util::ZetaBigFloat; use strict; use warnings; BEGIN { $Math::Prime::Util::ZetaBigFloat::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::ZetaBigFloat::VERSION = '0.73'; } BEGIN { do { require Math::BigInt; Math::BigInt->import(try=>"GMP,Pari"); } unless defined $Math::BigInt::VERSION; use Math::BigFloat; } #my $_oldacc = Math::BigFloat->accuracy(); #Math::BigFloat->accuracy(undef); # 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 = 0; # 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 = (); my $orig_acc = Math::BigFloat->accuracy(); Math::BigFloat->accuracy($nterms); foreach my $k (0 .. $nterms) { my $sum = Math::BigInt->bzero; my $num = Math::BigInt->new($nterms-1)->bfac(); foreach my $i (0 .. $k) { my $den = Math::BigInt->new($nterms - $i)->bfac * Math::BigInt->new(2*$i)->bfac; $sum += $num->copy->bdiv($den); $num->bmul(4 * ($nterms+$i)); } $sum->bmul($nterms); $_Borwein_dk[$k] = $sum; } Math::BigFloat->accuracy($orig_acc); } sub RiemannZeta { my($ix) = @_; my $x = (ref($ix) eq 'Math::BigFloat') ? $ix->copy : Math::BigFloat->new("$ix"); $x->accuracy($ix->accuracy) if $ix->accuracy; my $xdigits = $ix->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; } # Note, this code likely will not work correctly without fixes for RTs: # # 43692 : blog and others broken # 43460 : exp and powers broken # # E.g: # 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 # # There is a hack that tries to work around some of the problem, but it # can't cover everything and it slows things down a lot. There just isn't # any way to do this if the basic math operations don't work right. my $orig_acc = Math::BigFloat->accuracy(); my $extra_acc = 5; if ($x > 15 && $x <= 50) { $extra_acc = 15; } $xdigits += $extra_acc; Math::BigFloat->accuracy($xdigits); $x->accuracy($xdigits); my $zero= $x->copy->bzero; my $one = $zero->copy->binc; my $two = $one->copy->binc; my $tol = ref($x)->new('0.' . '0' x ($xdigits-1) . '1'); # Note: with bignum on, $d1->bpow($one-$x) doesn't change d1 ! # This is a hack to turn 6^-40.5 into (6^-(40.5/4))^4. It helps work around # the two RTs listed earlier, though does not completely fix their bugs. # It has the downside of making integer arguments very slow. my $superx = Math::BigInt->bone; my $subx = $x->copy; my $intx = int("$x"); if ($Math::BigFloat::VERSION < 1.9996 || $x != $intx) { while ($subx > 1) { $superx->blsft(1); $subx /= $two; } } if (1 && $x == $intx && $x >= 2 && !($intx & 1) && $intx < 100) { # Mathworld equation 63. How fast this is relative to the others is # dependent on the backend library and if we have MPUGMP. $x = int("$x"); my $den = Math::Prime::Util::factorial($x); $xdigits -= $extra_acc; $extra_acc += length($den); $xdigits += $extra_acc; $one->accuracy($xdigits); $two->accuracy($xdigits); Math::BigFloat->accuracy($xdigits); $subx->accuracy($xdigits); $superx->accuracy($xdigits); my $Pix = Math::Prime::Util::Pi($xdigits)->bpow($subx)->bpow($superx); my $Bn = Math::Prime::Util::bernreal($x,$xdigits); $Bn = -$Bn if $Bn < 0; my $twox1 = $two->copy->bpow($x-1); #my $num = $Pix * $Bn * $twox1; #my $res = $num->bdiv($den)->bdec->bround($xdigits - $extra_acc); my $res = $Bn->bdiv($den)->bmul($Pix)->bmul($twox1)->bdec ->bround($xdigits-$extra_acc); Math::BigFloat->accuracy($orig_acc); return $res; } # Go with the basic formula for large x. if (1 && $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 += $term; last if $term < ($sum*$tol); } $k = $two+$two; $k->bdec(); $sum += $k->copy->bpow($negsubx)->bpow($superx); $k->bdec(); $sum += $k->copy->bpow($negsubx)->bpow($superx); $sum->bround($xdigits-$extra_acc); Math::BigFloat->accuracy($orig_acc); 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 - $d1) * $_Borwein_dk[$n]; $divisor->bneg; $tol = ($divisor * $tol)->babs(); my ($sum, $bigk) = ($zero->copy, $one->copy); my $negsubx = $subx->copy->bneg; foreach my $k (1 .. $n-1) { my $den = $bigk->binc()->copy->bpow($negsubx)->bpow($superx); my $term = ($k % 2) ? ($_Borwein_dk[$n] - $_Borwein_dk[$k]) : ($_Borwein_dk[$k] - $_Borwein_dk[$n]); $term = Math::BigFloat->new($term) unless ref($term) eq 'Math::BigFloat'; $sum += $term * $den; last if $term->copy->babs() < $tol; } $sum += $_Borwein_dk[0] - $_Borwein_dk[$n]; $sum = $sum->bdiv($divisor); $sum->bdec->bround($xdigits-$extra_acc); Math::BigFloat->accuracy($orig_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 $extra_acc = 2; $xdigits += $extra_acc; my $orig_acc = Math::BigFloat->accuracy(); Math::BigFloat->accuracy($xdigits); $x->accuracy($xdigits); my $tol = $x->copy->bone->brsft($xdigits-1, 10); my $sum = $x->copy->bone; if ($xdigits <= length($x->copy->as_int->bstr())) { for my $k (1 .. 1000) { my $mob = Math::Prime::Util::moebius($k); next if $mob == 0; $mob = Math::BigFloat->new($mob); my $term = $mob->bdiv($k) * Math::Prime::Util::LogarithmicIntegral($x->copy->broot($k)); $sum += $term; #warn "k = $k term = $term sum = $sum\n"; last if abs($term) < ($tol * abs($sum)); } } else { my ($flogx, $part_term, $fone, $bigk) = (log($x), Math::BigFloat->bone, Math::BigFloat->bone, Math::BigInt->bone); if ($_Riemann_Zeta_premult_accuracy < $xdigits) { @_Riemann_Zeta_Premult = (); $_Riemann_Zeta_premult_accuracy = $xdigits; } for my $k (1 .. 10000) { my $zeta_term = $_Riemann_Zeta_Premult[$k-1]; if (!defined $zeta_term) { my $zeta = ($xdigits > 44) ? undef : $_Riemann_Zeta_Table[$k-1]; if (!defined $zeta) { my $kz = $fone->copy->badd($bigk); # kz is k+1 if (($k+1) >= 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 = $fone / ($zeta * $bigk + $bigk); $_Riemann_Zeta_Premult[$k-1] = $zeta_term if defined $_Riemann_Zeta_Table[$k-1]; } $part_term *= $flogx / $bigk; my $term = $part_term * $zeta_term; $sum += $term; #warn "k = $k term = $term sum = $sum\n"; last if $term < ($tol*$sum); $bigk->binc; } } $sum->bround($xdigits-$extra_acc); Math::BigFloat->accuracy($orig_acc); return $sum; } #Math::BigFloat->accuracy($_oldacc); #undef $_oldacc; 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.73 =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 L module is not available or old. =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 and 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 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.73/lib/Math/Prime/Util/PrimalityProving.pm0000644000076400007640000007621713373337725022260 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.73'; } BEGIN { do { require Math::BigInt; Math::BigInt->import(try=>"GMP,Pari"); } unless defined $Math::BigInt::VERSION; } my $_smallval = Math::BigInt->new("18446744073709551615"); my $_maxint = Math::BigInt->new( (~0 > 4294967296 && $] < 5.008) ? "562949953421312" : ''.~0 ); ############################################################################### # Pure Perl proofs ############################################################################### my @_fsublist = ( 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::ecm_factor (shift, 1_000, 5_000, 15) }, sub { Math::Prime::Util::PP::pbrent_factor (shift, 512*1024, 7) }, sub { Math::Prime::Util::PP::pminus1_factor(shift, 4_000_000) }, sub { Math::Prime::Util::PP::ecm_factor (shift, 10_000, 50_000, 10) }, sub { Math::Prime::Util::PP::pbrent_factor (shift, 512*1024, 11) }, 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 <= $_maxint && 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, 5000); pop @tf if $tf[-1] > 5000; } 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 <= $_maxint; # 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 <= $_maxint; $m = int($m->bstr) if ref($m) eq 'Math::BigInt' && $m <= $_maxint; } 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 = (@_ == 1) ? $_[0] : convert_array_cert_to_string(@_); $cert = convert_array_cert_to_string($cert) if ref($cert) eq 'ARRAY'; return 0 if $cert eq ''; 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.73 =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.73/lib/Math/Prime/Util/Entropy.pm0000644000076400007640000001225313373337725020367 0ustar danadanapackage Math::Prime::Util::Entropy; use strict; use warnings; use Carp qw/carp croak confess/; BEGIN { $Math::Prime::Util::Entropy::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::Entropy::VERSION = '0.73'; } sub _read_file { my($file, $nbytes) = @_; use Fcntl; my($s, $buffer, $nread) = ('', '', 0); return unless -r $file; sysopen(my $fh, $file, O_RDONLY); binmode $fh; while ($nread < $nbytes) { my $thisread = sysread $fh, $buffer, $nbytes-$nread; last unless defined $thisread && $thisread > 0; $s .= $buffer; $nread += length($buffer); } return unless $nbytes == length($s); return $s; } sub _try_urandom { if (-r "/dev/urandom") { return ('urandom', sub { _read_file("/dev/urandom",shift); }, 0, 1); } if (-r "/dev/random") { return ('random', sub { _read_file("/dev/random",shift); }, 1, 1); } return; } sub _try_win32 { return unless $^O eq 'MSWin32'; eval { require Win32; require Win32::API; require Win32::API::Type; 1; } or return; use constant CRYPT_SILENT => 0x40; # Never display a UI. use constant PROV_RSA_FULL => 1; # Which service provider. use constant VERIFY_CONTEXT => 0xF0000000; # Don't need existing keepairs use constant W2K_MAJOR_VERSION => 5; # Windows 2000 use constant W2K_MINOR_VERSION => 0; my ($major, $minor) = (Win32::GetOSVersion())[1, 2]; return if $major < W2K_MAJOR_VERSION; if ($major == W2K_MAJOR_VERSION && $minor == W2K_MINOR_VERSION) { # We are Windows 2000. Use the older CryptGenRandom interface. my $crypt_acquire_context_a = Win32::API->new('advapi32','CryptAcquireContextA','PPPNN','I'); return unless defined $crypt_acquire_context_a; my $context = chr(0) x Win32::API::Type->sizeof('PULONG'); my $result = $crypt_acquire_context_a->Call( $context, 0, 0, PROV_RSA_FULL, CRYPT_SILENT | VERIFY_CONTEXT ); return unless $result; my $pack_type = Win32::API::Type::packing('PULONG'); $context = unpack $pack_type, $context; my $crypt_gen_random = Win32::API->new( 'advapi32', 'CryptGenRandom', 'NNP', 'I' ); return unless defined $crypt_gen_random; return ('CryptGenRandom', sub { my $nbytes = shift; my $buffer = chr(0) x $nbytes; my $result = $crypt_gen_random->Call($context, $nbytes, $buffer); croak "CryptGenRandom failed: $^E" unless $result; return $buffer; }, 0, 1); # Assume non-blocking and strong } else { my $rtlgenrand = Win32::API->new( 'advapi32', <<'_RTLGENRANDOM_PROTO_'); INT SystemFunction036( PVOID RandomBuffer, ULONG RandomBufferLength ) _RTLGENRANDOM_PROTO_ return unless defined $rtlgenrand; return ('RtlGenRand', sub { my $nbytes = shift; my $buffer = chr(0) x $nbytes; my $result = $rtlgenrand->Call($buffer, $nbytes); croak "RtlGenRand failed: $^E" unless $result; return $buffer; }, 0, 1); # Assume non-blocking and strong } return; } sub _try_crypt_prng { return unless eval { require Crypt::PRNG; 1; }; return ('Crypt::PRNG', sub { Crypt::PRNG::random_bytes(shift) }, 0, 1); } sub _try_crypt_random_seed { return unless eval { require Crypt::Random::Seed; 1; }; return ('Crypt::Random::Seed', sub { my $source = Crypt::Random::Seed->new(NonBlocking=>1); return unless $source; $source->random_bytes(shift) }, 0, 1); } my $_method; sub entropy_bytes { my $nbytes = shift; my @methodlist = ( \&_try_win32, # All we have for Windows \&_try_urandom, # Best if available \&_try_crypt_random_seed, # More sources, fallbacks \&_try_crypt_prng, # Good CSPRNG, worse seeding ); if (!defined $_method) { foreach my $m (@methodlist) { my ($name, $rsub, $isblocking, $isstrong) = $m->(); if (defined $name) { $_method = $rsub; last; } } } return unless defined $_method; $_method->($nbytes); } 1; __END__ # ABSTRACT: Get a good random seed =pod =encoding utf8 =head1 NAME Math::Prime::Util::Entropy - Get a good random seed =head1 VERSION Version 0.73 =head1 SYNOPSIS =head1 DESCRIPTION Provides a single method to get a good seed if possible. This is a streamlined version of L, with ideas from L. =head2 entropy_bytes Takes a number of bytes C and returns either undef (no good seed available) or a binary string with good entropy. We try in order: - the Win32 Crypto API - /dev/urandom - /dev/random - L - L =head1 SEE ALSO L L L L L =head1 AUTHORS Dana Jacobsen Edana@acm.orgE =head1 COPYRIGHT Copyright 2017 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.73/lib/Math/Prime/Util/RandomPrimes.pm0000644000076400007640000011372113373337725021331 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 urandomb urandomm random_bytes /; BEGIN { $Math::Prime::Util::RandomPrimes::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::RandomPrimes::VERSION = '0.73'; } 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; } ################################################################################ ################################################################################ # 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, meaning some numbers in the range will be thousands of times # more likely than others). On the contrary however, nobody has a way # to exploit this, and it's not-uncommon to see used. # # 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 Macbook. # The "with GMP" numbers use Math::Prime::Util::GMP 0.44. # The "no GMP" numbers are with no Math::BigInt backend, so very slow in comparison. # If another backend was used (GMP, Pari, LTM) it would be more comparable. # # random_nbit_prime random_maurer_prime # n-bits no GMP w/ MPU::GMP no GMP w/ MPU::GMP # ---------- -------- ----------- -------- ----------- # 24-bit 1uS same same same # 64-bit 5uS same same same # 128-bit 0.12s 70uS 0.29s 166uS # 256-bit 0.66s 379uS 1.82s 800uS # 512-bit 7.8s 0.0022s 16.2s 0.0044s # 1024-bit ---- 0.019s ---- 0.037s # 2048-bit ---- 0.23s ---- 0.35s # 4096-bit ---- 2.4s ---- 5.2s # # Random timings for 10M calls on i4770K: # 0.39 Math::Random::MTwist 0.13 # 0.41 ntheory <==== us # 0.89 system rand # 1.76 Math::Random::MT::Auto # 5.35 Bytes::Random::Secure OO w/ISAAC::XS # 7.43 Math::Random::Secure w/ISAAC::XS # 12.40 Math::Random::Secure # 12.78 Bytes::Random::Secure OO # 13.86 Bytes::Random::Secure function w/ISAAC::XS # 21.95 Bytes::Random::Secure function # 822.1 Crypt::Random # # time perl -E 'use Math::Random::MTwist "irand32"; irand32() for 1..10000000;' # time perl -E 'sub irand {int(rand(4294967296));} irand() for 1..10000000;' # time perl -E 'use Math::Random::MT::Auto; sub irand { Math::Random::MT::Auto::irand() & 0xFFFFFFFF } 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; #{ 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 = urandomm($irange); 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 * urandomm($oddrange); 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 * urandomm($oddrange); 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 = urandomm($nparts+1); 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 = urandomm($partsize); $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 = urandomm($partsize); # 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]; } my $rand = urandomm($irange); return nth_prime($istart + $rand); } sub random_prime { my($low,$high) = @_; return if $high < 2 || $low > $high; if ($high-$low > 1000000000) { # Range is large, just make them odd if needed. $low = 2 if $low < 2; $low++ if $low > 2 && ($low % 2) == 0; $high-- if ($high % 2) == 0; } else { # Tighten the range to the nearest prime. $low = ($low <= 2) ? 2 : next_prime($low-1); $high = ($high == ~0) ? prev_prime($high) : prev_prime($high + 1); 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. } # 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"); # Very small size, use the nth-prime method if ($bits <= 20 && MPU_USE_XS) { if ($bits <= 4) { return (2,3)[urandomb(1)] if $bits == 2; return (5,7)[urandomb(1)] if $bits == 3; return (11,13)[urandomb(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 = urandomb($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) + urandomb($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(''.urandomb($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 + (urandomb($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 # 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::Prime::Util::drand(); $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 + urandomm( $I ); my $R = $I->copy->binc->badd( urandomm($I) ); #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 sub random_shawe_taylor_prime_with_cert { my $k = shift; my $seed = random_bytes(512/8); my($status,$prime,$prime_seed,$prime_gen_counter,$cert) = _ST_Random_prime($k, $seed); croak "Shawe-Taylor random prime failure" unless $status; croak "Shawe-Taylor random prime failure: prime $prime failed certificate verification!" unless verify_prime($cert); return ($prime,$cert); } sub _seed_plus_one { my($s) = @_; for (my $i = length($s)-1; $i >= 0; $i--) { vec($s, $i, 8)++; last unless vec($s, $i, 8) == 0; } return $s; } sub _ST_Random_prime { # From FIPS 186-4 my($k, $input_seed) = @_; croak "Shawe-Taylor random prime must have length >= 2" if $k < 2; $k = int("$k"); croak "Shawe-Taylor random prime, invalid input seed" unless defined $input_seed && length($input_seed) >= 32; if (!defined $Digest::SHA::VERSION) { eval { require Digest::SHA; my $version = $Digest::SHA::VERSION; $version =~ s/[^\d.]//g; $version >= 4.00; } or do { croak "Must have Digest::SHA 4.00 or later"; }; } my $k2 = Math::BigInt->new(2)->bpow($k-1); if ($k < 33) { my $seed = $input_seed; my $prime_gen_counter = 0; my $kmask = 0xFFFFFFFF >> (32-$k); # Does the mod operation my $kstencil = (1 << ($k-1)) | 1; # Sets high and low bits while (1) { my $seedp1 = _seed_plus_one($seed); my $cvec = Digest::SHA::sha256($seed) ^ Digest::SHA::sha256($seedp1); # my $c = Math::BigInt->from_hex('0x' . unpack("H*", $cvec)); # $c = $k2 + ($c % $k2); # $c = (2 * ($c >> 1)) + 1; my($c) = unpack("N*", substr($cvec,-4,4)); $c = ($c & $kmask) | $kstencil; $prime_gen_counter++; $seed = _seed_plus_one($seedp1); my ($isp, $cert) = is_provable_prime_with_cert($c); return (1,$c,$seed,$prime_gen_counter,$cert) if $isp; return (0,0,0,0) if $prime_gen_counter > 10000 + 16*$k; } } my($status,$c0,$seed,$prime_gen_counter,$cert) = _ST_Random_prime( (($k+1)>>1)+1, $input_seed); return (0,0,0,0) unless $status; $cert = ($c0 < Math::BigInt->new("18446744073709551615")) ? "" : _strip_proof_header($cert); my $iterations = int(($k + 255) / 256) - 1; # SHA256 generates 256 bits my $old_counter = $prime_gen_counter; my $xstr = ''; for my $i (0 .. $iterations) { $xstr = Digest::SHA::sha256_hex($seed) . $xstr; $seed = _seed_plus_one($seed); } my $x = Math::BigInt->from_hex('0x'.$xstr); $x = $k2 + ($x % $k2); my $t = ($x + 2*$c0 - 1) / (2*$c0); _make_big_gcds() if $_big_gcd_use < 0; while (1) { if (2*$t*$c0 + 1 > 2*$k2) { $t = ($k2 + 2*$c0 - 1) / (2*$c0); } my $c = 2*$t*$c0 + 1; $prime_gen_counter++; # Don't do the Pocklington check unless the candidate looks prime my $looks_prime = 0; if (MPU_USE_GMP) { # MPU::GMP::is_prob_prime has fast tests built in. $looks_prime = Math::Prime::Util::GMP::is_prob_prime($c); } else { # No GMP, so first do trial divisions, then a SPSP test. $looks_prime = Math::BigInt::bgcd($c, 111546435)->is_one; if ($looks_prime && $_big_gcd_use && $c > $_big_gcd_top) { $looks_prime = Math::BigInt::bgcd($c, $_big_gcd[0])->is_one && Math::BigInt::bgcd($c, $_big_gcd[1])->is_one && Math::BigInt::bgcd($c, $_big_gcd[2])->is_one && Math::BigInt::bgcd($c, $_big_gcd[3])->is_one; } $looks_prime = 0 if $looks_prime && !is_strong_pseudoprime($c, 3); } if ($looks_prime) { # We could use a in (2,3,5,7,11,13), but pedantically use FIPS 186-4. my $astr = ''; for my $i (0 .. $iterations) { $astr = Digest::SHA::sha256_hex($seed) . $astr; $seed = _seed_plus_one($seed); } my $a = Math::BigInt->from_hex('0x'.$astr); $a = ($a % ($c-3)) + 2; my $z = $a->copy->bmodpow(2*$t,$c); if (Math::BigInt::bgcd($z-1,$c)->is_one && $z->copy->bmodpow($c0,$c)->is_one) { croak "Shawe-Taylor random prime failure at ($k): $c not prime" unless is_prob_prime($c); $cert = "[MPU - Primality Certificate]\nVersion 1.0\n\n" . "Proof for:\nN $c\n\n" . "Type Pocklington\nN $c\nQ $c0\nA $a\n" . $cert; return (1, $c, $seed, $prime_gen_counter, $cert); } } else { # Update seed "as if" we performed the Pocklington check from FIPS 186-4 for my $i (0 .. $iterations) { $seed = _seed_plus_one($seed); } } return (0,0,0,0) if $prime_gen_counter > 10000 + 16*$k + $old_counter; $t++; } } # 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; 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 + urandomm($iu - $il + 1); 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 + urandomm($ju - $jl + 1); 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); } 1; __END__ # ABSTRACT: Generate random primes =pod =encoding utf8 =head1 NAME Math::Prime::Util::RandomPrimes - Generate random primes =head1 VERSION Version 0.73 =head1 SYNOPSIS =head1 DESCRIPTION Routines to generate random primes, including constructing proven primes. =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_shawe_taylor_prime Construct a random provable prime of C bits using Shawe-Taylor's algorithm. C must be at least 2. The implementation is from FIPS 186-4 and uses SHA-256 with 512 bits of randomness. =head2 random_shawe_taylor_prime_with_cert Construct a random provable prime of C bits using Shawe-Taylor's 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 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.73/lib/Math/Prime/Util/PrimeArray.pm0000644000076400007640000002741513373337725021010 0ustar danadanapackage Math::Prime::Util::PrimeArray; use strict; use warnings; BEGIN { $Math::Prime::Util::PrimeArray::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::PrimeArray::VERSION = '0.73'; } # 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(@primes @prime @pr @p $probj); our %EXPORT_TAGS = (all => [ @EXPORT_OK ]); # It would be nice to do this dynamically. our(@primes, @prime, @pr, @p, $probj); sub import { tie @primes, __PACKAGE__ if grep { $_ eq '@primes' } @_; tie @prime , __PACKAGE__ if grep { $_ eq '@prime' } @_; tie @pr , __PACKAGE__ if grep { $_ eq '@pr' } @_; tie @p , __PACKAGE__ if grep { $_ eq '@p' } @_; $probj = __PACKAGE__->TIEARRAY if grep { $_ eq '$probj' } @_; goto &Exporter::import; } 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/; use constant SEGMENT_SIZE => 50_000; use constant ALLOW_SKIP => 3_000; # Sieve if skipping up to this 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, $index) = @_; $index = 0xFFFFFFFF + $index + 1 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 && $index < $endidx + ALLOW_SKIP) { # Forward iteration $self->{ACCESS_TYPE}++; if ($self->{ACCESS_TYPE} > 2 || $index > $endidx+1) { my $end_prime = nth_prime_upper($index + SEGMENT_SIZE); $self->{PRIMES} = primes( $self->{PRIMES}->[-1]+1, $end_prime ); $begidx = $endidx+1; } else { push @{$self->{PRIMES}}, next_prime($self->{PRIMES}->[-1]); } } elsif ($index < $begidx && $index > $begidx - ALLOW_SKIP) { # Bk iteration $self->{ACCESS_TYPE}--; if ($self->{ACCESS_TYPE} < -2 || $index < $begidx-1) { my $beg_prime = $index <= SEGMENT_SIZE ? 2 : nth_prime_lower($index - SEGMENT_SIZE); $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, but that will be quite # a bit slower if true random access. $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, $shiftamount) = @_; $shiftamount = 1 unless defined $shiftamount; $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.73 =head1 SYNOPSIS # Use package and create a tied variable use Math::Prime::Util::PrimeArray; tie my @primes, 'Math::Prime::Util::PrimeArray'; # or all in one (allowed: @primes, @prime, @pr, @p): use Math::Prime::Util::PrimeArray '@primes'; # Use in a loop by index: for my $n (0..9) { print "prime $n = $primes[$n]\n"; } # Use in a loop over array: for my $p (@primes) { last if $p > 1000; # stop sometime print "$p\n"; } # Use via array slice: print join(",", @primes[0..49]), "\n"; # Use via each: use 5.012; while( my($index,$value) = each @primes ) { last if $value > 1000; # stop sometime print "The ${index}th prime is $value\n"; } # Use with shift: while ((my $p = shift @primes) < 1000) { 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 will not shift past the beginning, so C is a useful way to reset from any shifts. 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. Perl will mask all array arguments to 32-bit, making C<2^32-1> the maximum prime through the standard array interface. It will silently wrap after that. The only way around this is using the object interface: use Math::Prime::Util::PrimeArray; my $o = tie my @primes, 'Math::Prime::Util::PrimeArray'; say $o->FETCH(2**36); Here we store the object returned by tie, allowing us to call its FETCH method directly. This is actually faster than using the array. Some people 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 sumprimes: sum_primes(nth_prime(100_000)) MPU forprimes: forprimes { $sum += $_ } nth_prime(100_000); MPU iterator: my $it = prime_iterator; $sum += $it->() for 1..100000; MPU array: $sum = vecsum( @{primes(nth_prime(100_000))} ); MPUPA: tie my @prime, ...; $sum += $prime[$_] for 0..99999; MPUPA-FETCH: my $o=tie my @pr, ...; $sum += $o->FETCH($_) for 0..99999; MNSP: my $seq = Math::NumSeq::Primes->new; $sum += ($seq->next)[1] for 1..100000; MPTA: tie my @prime, ...; $sum += $prime[$_] for 0..99999; List::Gen $sum = primes->take(100000)->sum Memory use is comparing the delta between just loading the module and running the test. Perl 5.20.0, Math::NumSeq v70, Math::Prime::TiedArray v0.04, List::Gen 0.974. Summing the first 0.1M primes via walking the array: .3ms 56k Math::Prime::Util sumprimes 4ms 56k Math::Prime::Util forprimes 4ms 4 MB Math::Prime::Util sum big array 31ms 0 Math::Prime::Util prime_iterator 68ms 644k MPU::PrimeArray using FETCH 101ms 644k MPU::PrimeArray array 95ms 1476k Math::NumSeq::Primes sequence iterator 4451ms 32 MB List::Gen sequence 6954ms 61 MB Math::Prime::TiedArray (extend 1k) Summing the first 1M primes via walking the array: 0.005s 268k Math::Prime::Util sumprimes 0.05s 268k Math::Prime::Util forprimes 0.05s 41 MB Math::Prime::Util sum big array 0.3s 0 Math::Prime::Util prime_iterator 0.7s 644k MPU::PrimeArray using FETCH 1.0s 644k MPU::PrimeArray array 6.1s 2428k Math::NumSeq::Primes sequence iterator 106.0s 93 MB List::Gen sequence 98.1s 760 MB Math::Prime::TiedArray (extend 1k) Summing the first 10M primes via walking the array: 0.07s 432k Math::Prime::Util sumprimes 0.5s 432k Math::Prime::Util forprimes 0.6s 394 MB Math::Prime::Util sum big array 3.2s 0 Math::Prime::Util prime_iterator 6.8s 772k MPU::PrimeArray using FETCH 10.2s 772k MPU::PrimeArray array 1046 s 11.1MB Math::NumSeq::Primes sequence iterator 6763 s 874 MB List::Gen sequence >5000 MB Math::Primes::TiedArray (extend 1k) L offers four obvious solutions: the C function, 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 both fast and low memory, but it isn't quite as flexible as the iterator (e.g. it doesn't lend itself to wrapping inside a filter). L offers an iterator alternative, and works quite well as long as you don't need lots of primes. It does not support random access. It has reasonable performance for the first few hundred thousand, but each successive value takes much longer to generate, and once past 1 million it isn't very practical. Internally it is sieving all primes up to C every time it makes a new segment which is why it slows down so much. L includes a built-in prime sequence. It uses an inefficient Perl sieve for numbers below 10M, trial division past that. It uses too much time and memory to be practical for anything but very small inputs. It also gives incorrect results for large inputs (RT 105758). L is remarkably impractical for anything other than tiny 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-2016 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.73/lib/Math/Prime/Util/ECProjectivePoint.pm0000644000076400007640000001463213373337725022266 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.73'; } 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 =for test_synopsis use v5.14; my($c,$n,$k,$ECP2); =head1 NAME Math::Prime::Util::ECProjectivePoint - Elliptic curve operations for projective points =head1 VERSION Version 0.73 =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.73/lib/Math/Prime/Util/ECAffinePoint.pm0000644000076400007640000001422513373337725021342 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.73'; } 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 =for test_synopsis use v5.14; my($a,$b,$n,$k,$ECP2); =head1 NAME Math::Prime::Util::ECAffinePoint - Elliptic curve operations for affine points =head1 VERSION Version 0.73 =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.73/lib/Math/Prime/Util.pm0000644000076400007640000065205213373337725016736 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.73'; } # 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_euler_pseudoprime is_strong_pseudoprime is_euler_plumb_pseudoprime is_lucas_pseudoprime is_strong_lucas_pseudoprime is_extra_strong_lucas_pseudoprime is_almost_extra_strong_lucas_pseudoprime is_frobenius_pseudoprime is_frobenius_underwood_pseudoprime is_frobenius_khashin_pseudoprime is_perrin_pseudoprime is_catalan_pseudoprime is_aks_prime is_bpsw_prime is_ramanujan_prime is_mersenne_prime is_power is_prime_power is_pillai is_semiprime is_square is_polygonal is_square_free is_primitive_root is_carmichael is_quasi_carmichael is_fundamental is_totient sqrtint rootint logint miller_rabin_random lucas_sequence lucasu lucasv primes twin_primes semi_primes ramanujan_primes sieve_prime_cluster sieve_range forprimes forcomposites foroddcomposites forsemiprimes fordivisors forpart forcomp forcomb forperm forderange formultiperm forsetproduct forfactored forsquarefree lastfor numtoperm permtonum randperm shuffle 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 inverse_li twin_prime_count twin_prime_count_approx nth_twin_prime nth_twin_prime_approx semiprime_count semiprime_count_approx nth_semiprime nth_semiprime_approx ramanujan_prime_count ramanujan_prime_count_approx ramanujan_prime_count_lower ramanujan_prime_count_upper nth_ramanujan_prime nth_ramanujan_prime_approx nth_ramanujan_prime_lower nth_ramanujan_prime_upper sum_primes print_primes 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 random_shawe_taylor_prime random_shawe_taylor_prime_with_cert random_semiprime random_unrestricted_semiprime random_factored_integer primorial pn_primorial consecutive_integer_lcm gcdext chinese gcd lcm factor factor_exp divisors valuation hammingweight todigits fromdigits todigitstring sumdigits invmod sqrtmod addmod mulmod divmod powmod vecsum vecmin vecmax vecprod vecreduce vecextract vecany vecall vecnotall vecnone vecfirst vecfirstidx moebius mertens euler_phi jordan_totient exp_mangoldt liouville partitions bernfrac bernreal harmfrac harmreal chebyshev_theta chebyshev_psi divisor_sum carmichael_lambda kronecker hclassno inverse_totient ramanujan_tau ramanujan_sum binomial stirling znorder znprimroot znlog legendre_phi factorial factorialmod ExponentialIntegral LogarithmicIntegral RiemannZeta RiemannR LambertW Pi irand irand64 drand urandomb urandomm csrand random_bytes entropy_bytes ); our %EXPORT_TAGS = (all => [ @EXPORT_OK ], rand => [qw/srand rand irand irand64/], ); # These are only exported if specifically asked for push @EXPORT_OK, (qw/trial_factor fermat_factor holf_factor lehman_factor squfof_factor prho_factor pbrent_factor pminus1_factor pplus1_factor ecm_factor rand srand/); my %_Config; my %_GMPfunc; # List of available MPU::GMP functions # Similar to how boolean handles its option sub import { if ($] < 5.020) { # Prevent "used only once" warnings my $pkg = caller; no strict 'refs'; ## no critic(strict) ${"${pkg}::a"} = ${"${pkg}::a"}; ${"${pkg}::b"} = ${"${pkg}::b"}; } foreach my $opt (qw/nobigint secure/) { my @options = grep $_ ne "-$opt", @_; $_Config{$opt} = 1 if @options != @_; @_ = @options; } _XS_set_secure() if $_Config{'xs'} && $_Config{'secure'}; goto &Exporter::import; } ############################################################################# 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'; use constant INTMAX => (!OLD_PERL_VERSION || MPU_32BIT) ? ~0 : 562949953421312; 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; # Init rand Math::Prime::Util::csrand(); *prime_count = \&Math::Prime::Util::_generic_prime_count; *factor = \&Math::Prime::Util::_generic_factor; *factor_exp = \&Math::Prime::Util::_generic_factor_exp; }; $_Config{'secure'} = 0; $_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) { if (eval { require Math::Prime::Util::GMP; Math::Prime::Util::GMP->import(); 1; }) { $_Config{'gmp'} = int(100*$Math::Prime::Util::GMP::VERSION); } for my $e (@Math::Prime::Util::GMP::EXPORT_OK) { $Math::Prime::Util::_GMPfunc{"$e"} = $_Config{'gmp'}; } # If we have GMP, it is not seeded properly but we are, seed with our data. if ( $_Config{'gmp'} >= 42 && !Math::Prime::Util::GMP::is_csprng_well_seeded() && Math::Prime::Util::_is_csprng_well_seeded()) { Math::Prime::Util::GMP::seed_csprng(256, random_bytes(256)); } } } 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; # 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 foreach my $param (keys %params) { my $value = $params{$param}; $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') { $_HAVE_GMP = ($value) ? int(100*$Math::Prime::Util::GMP::VERSION) : 0; $_Config{'gmp'} = $_HAVE_GMP; $Math::Prime::Util::_GMPfunc{$_} = $_HAVE_GMP for keys %Math::Prime::Util::_GMPfunc; _XS_set_callgmp($_HAVE_GMP) if $_Config{'xs'}; } elsif ($param eq 'nobigint') { $_Config{'nobigint'} = ($value) ? 1 : 0; } elsif ($param eq 'secure') { croak "Cannot disable secure once set" if !$value && $_Config{'secure'}; if ($value) { $_Config{'secure'} = 1; _XS_set_secure() if $_Config{'xs'}; } } elsif ($param eq 'irand') { carp "ntheory irand option is deprecated"; } elsif ($param eq 'use_primeinc') { carp "ntheory use_primeinc option is deprecated"; } 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 (!defined($_[0]) || ref($_[0]) eq 'Math::BigInt') ? $_[0] : Math::BigInt->new("$_[0]"); } sub _to_gmpz { do { require Math::GMPz; } unless defined $Math::GMPz::VERSION; return (ref($_[0]) eq 'Math::GMPz') ? $_[0] : Math::GMPz->new($_[0]); } sub _to_gmp { do { require Math::GMP; } unless defined $Math::GMP::VERSION; return (ref($_[0]) eq 'Math::GMP') ? $_[0] : Math::GMP->new($_[0]); } sub _reftyped { return unless defined $_[1]; my $ref0 = ref($_[0]); if ($ref0) { return ($ref0 eq ref($_[1])) ? $_[1] : $ref0->new("$_[1]"); } if (OLD_PERL_VERSION) { # Perl 5.6 truncates arguments to doubles if you look at them funny return "$_[1]" if "$_[1]" <= INTMAX; } elsif ($_[1] >= 0) { # TODO: This wasn't working right in 5.20.0-RC1, verify correct return $_[1] if $_[1] <= ~0; } else { return $_[1] if ''.int($_[1]) >= -(~0>>1); } do { require Math::BigInt; Math::BigInt->import(try=>"GMP,Pari"); } unless defined $Math::BigInt::VERSION; return Math::BigInt->new("$_[1]"); } #*_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 <= '' . INTMAX; } elsif (ref($n) eq 'Math::GMPz') { croak "Parameter '$n' must be a positive integer" if Math::GMPz::Rmpz_sgn($n) < 0; $_[0] = _bigint_to_int($_[0]) if $n <= INTMAX; } else { my $strn = "$n"; croak "Parameter '$strn' must be a positive integer" if $strn eq '' || ($strn =~ tr/0123456789//c && $strn !~ /^\+?\d+$/); if ($n <= INTMAX) { $_[0] = $strn if ref($n); } else { #$_[0] = Math::BigInt->new($strn) $_[0] = _to_bigint($strn); } } $_[0]->upgrade(undef) if ref($_[0]) eq 'Math::BigInt' && $_[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; } ############################################################################# # These are called by the XS code to keep the GMP CSPRNG in sync with us. sub _srand_p { my($seedval) = @_; return unless $_Config{'gmp'} >= 42; $seedval = unpack("L",entropy_bytes(4)) unless defined $seedval; Math::Prime::Util::GMP::seed_csprng(4, pack("L",$seedval)); $seedval; } sub _csrand_p { my($str) = @_; return unless $_Config{'gmp'} >= 42; $str = entropy_bytes(256) unless defined $str; Math::Prime::Util::GMP::seed_csprng(length($str), $str); } ############################################################################# sub primes { my($low,$high) = @_; if (scalar @_ > 1) { _validate_num($low) || _validate_positive_integer($low); } 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 { _reftyped($_[0],$_) } @$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; } # Shortcut for primes returning an array instead of array reference. # sub aprimes { @{primes(@_)}; } sub twin_primes { my($low,$high) = @_; if (scalar @_ > 1) { _validate_num($low) || _validate_positive_integer($low); } else { ($low,$high) = (2, $low); } _validate_num($high) || _validate_positive_integer($high); return [] if ($low > $high) || ($high < 2); if ($high > $_XS_MAXVAL) { my @tp; if ($_HAVE_GMP && defined &Math::Prime::Util::GMP::sieve_twin_primes && $low > 2**31) { @tp = map { _reftyped($_[0],$_) } Math::Prime::Util::GMP::sieve_twin_primes($low, $high); } else { require Math::Prime::Util::PP; @tp = map { _reftyped($_[0],$_) } Math::Prime::Util::PP::sieve_prime_cluster($low,$high, 2); } return \@tp; } return segment_twin_primes($low, $high); } sub semi_primes { my($low,$high) = @_; if (scalar @_ > 1) { _validate_num($low) || _validate_positive_integer($low); } else { ($low,$high) = (4, $low); } _validate_num($high) || _validate_positive_integer($high); return [] if ($low > $high) || ($high < 4); return Math::Prime::Util::semi_prime_sieve($low,$high) if $high <= $_XS_MAXVAL && ($low <= 4 || ($high-$low+1) > ($high/(600*sqrt($high)))); my $sp = []; Math::Prime::Util::forsemiprimes(sub { push @$sp,$_; }, $low, $high); $sp; } sub ramanujan_primes { my($low,$high) = @_; if (scalar @_ > 1) { _validate_num($low) || _validate_positive_integer($low); } else { ($low,$high) = (2, $low); } _validate_num($high) || _validate_positive_integer($high); return [] if ($low > $high) || ($high < 2); if ($high > $_XS_MAXVAL) { require Math::Prime::Util::PP; return Math::Prime::Util::PP::_ramanujan_primes($low,$high); } return _ramanujan_primes($low, $high); } ############################################################################# # Random primes. These are front end functions that do input validation, # load the RandomPrimes module, and call its function. sub random_maurer_prime_with_cert { my($bits) = @_; _validate_num($bits, 2) || _validate_positive_integer($bits, 2); if ($Math::Prime::Util::_GMPfunc{"random_maurer_prime_with_cert"}) { my($n,$cert) = Math::Prime::Util::GMP::random_maurer_prime_with_cert($bits); return (Math::Prime::Util::_reftyped($_[0],$n), $cert); } require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_maurer_prime_with_cert($bits); } sub random_shawe_taylor_prime_with_cert { my($bits) = @_; _validate_num($bits, 2) || _validate_positive_integer($bits, 2); if ($Math::Prime::Util::_GMPfunc{"random_shawe_taylor_prime_with_cert"}) { my($n,$cert) =Math::Prime::Util::GMP::random_shawe_taylor_prime_with_cert($bits); return (Math::Prime::Util::_reftyped($_[0],$n), $cert); } require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_shawe_taylor_prime_with_cert($bits); } sub random_proven_prime_with_cert { my($bits) = @_; _validate_num($bits, 2) || _validate_positive_integer($bits, 2); # Go to Maurer with GMP if ($Math::Prime::Util::_GMPfunc{"random_maurer_prime_with_cert"}) { my($n,$cert) = Math::Prime::Util::GMP::random_maurer_prime_with_cert($bits); return (Math::Prime::Util::_reftyped($_[0],$n), $cert); } require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_proven_prime_with_cert($bits); } ############################################################################# # 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); return (1,1,2,6,6,30,30,210,210,210)[$n] if $n < 10; 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); return (1,2,6,30,210,2310,30030,510510,9699690,223092870)[$n] if $n < 10; 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 $oldforexit = Math::Prime::Util::_start_for_loop(); { my $pp; local *_ = \$pp; for (my $p = next_prime($beg-1); $p <= $end; $p = next_prime($p)) { $pp = $p; $sub->(); last if Math::Prime::Util::_get_forexit(); } } Math::Prime::Util::_end_for_loop($oldforexit); } sub _generic_forcomp_sub { my($what, $sub, $beg, $end) = @_; if (!defined $end) { $end = $beg; $beg = 0; } _validate_positive_integer($beg); _validate_positive_integer($end); my $cinc = 1; my $semiprimes = ($what eq 'semiprimes'); if ($what eq 'oddcomposites') { $beg = 9 if $beg < 9; $beg++ unless $beg & 1; $cinc = 2; } else { $beg = 4 if $beg < 4; } $end = Math::BigInt->new(''.~0) if ref($end) ne 'Math::BigInt' && $end == ~0; my $oldforexit = Math::Prime::Util::_start_for_loop(); { my $pp; local *_ = \$pp; for (my $p = next_prime($beg-1); $beg <= $end; $p = next_prime($p)) { for ( ; $beg < $p && $beg <= $end ; $beg += $cinc ) { next if $semiprimes && !is_semiprime($beg); $pp = $beg; $sub->(); last if Math::Prime::Util::_get_forexit(); } $beg += $cinc; last if Math::Prime::Util::_get_forexit(); } } Math::Prime::Util::_end_for_loop($oldforexit); } sub _generic_forcomposites { _generic_forcomp_sub('composites', @_); } sub _generic_foroddcomposites { _generic_forcomp_sub('oddcomposites', @_); } sub _generic_forsemiprimes { _generic_forcomp_sub('semiprimes', @_); } sub _generic_forfac { my($sf, $sub, $beg, $end) = @_; _validate_positive_integer($beg); if (defined $end) { _validate_positive_integer($end); $beg = 1 if $beg < 1; } else { ($beg,$end) = (1,$beg); } my $oldforexit = Math::Prime::Util::_start_for_loop(); { my $pp; local *_ = \$pp; while ($beg <= $end) { if (!$sf || is_square_free($beg)) { $pp = $beg; my @f = factor($beg); $sub->(@f); last if Math::Prime::Util::_get_forexit(); } $beg++; } } Math::Prime::Util::_end_for_loop($oldforexit); } sub _generic_forfactored { _generic_forfac(0, @_); } sub _generic_forsquarefree { _generic_forfac(1, @_); } sub _generic_fordivisors { my($sub, $n) = @_; _validate_positive_integer($n); my @divisors = divisors($n); my $oldforexit = Math::Prime::Util::_start_for_loop(); { my $pp; local *_ = \$pp; foreach my $d (@divisors) { $pp = $d; $sub->(); last if Math::Prime::Util::_get_forexit(); } } Math::Prime::Util::_end_for_loop($oldforexit); } sub formultiperm (&$) { ## no critic qw(ProhibitSubroutinePrototypes) my($sub, $iref) = @_; croak("formultiperm first argument must be an array reference") unless ref($iref) eq 'ARRAY'; my($sum, %h, @n) = (0); $h{$_}++ for @$iref; @n = map { [$_, $h{$_}] } sort(keys(%h)); $sum += $_->[1] for @n; require Math::Prime::Util::PP; my $oldforexit = Math::Prime::Util::_start_for_loop(); Math::Prime::Util::PP::_multiset_permutations( $sub, [], \@n, $sum ); Math::Prime::Util::_end_for_loop($oldforexit); } ############################################################################# # 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) { # This is simple and low memory, but slower than segments: # return sub { $p = next_prime($p); return $p; }; my $pr = []; return sub { if (scalar(@$pr) == 0) { # Once we're into bigints, just use next_prime return $p=next_prime($p) if $p >= MPU_MAXPRIME; # Get about 10k primes my $segment = ($p <= 1e4) ? 10_000 : int(10000*log($p)+1); $segment = ~0-$p if $p+$segment > ~0 && $p+1 < ~0; $pr = primes($p+1, $p+$segment); } return $p = shift(@$pr); }; } 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_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; #} if (ref($_[0])) { @factors = map { ($_ > ~0) ? ref($_[0])->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 _is_gaussian_prime { my($a,$b) = @_; return ((($b % 4) == 3) ? is_prime($b) : 0) if $a == 0; return ((($a % 4) == 3) ? is_prime($a) : 0) if $b == 0; is_prime( vecsum( vecprod($a,$a), vecprod($b,$b) ) ); } ############################################################################# # 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 { require Math::Prime::Util::PrimalityProving; return Math::Prime::Util::PrimalityProving::verify_cert(@_); } ############################################################################# sub RiemannZeta { my($n) = @_; croak("Invalid input to RiemannZeta: x must be > 0") if $n <= 0; return $n-$n if $n > 10_000_000; # Over 3M leading zeros return _XS_RiemannZeta($n) if !defined $bignum::VERSION && ref($n) ne 'Math::BigFloat' && $_Config{'xs'}; require Math::Prime::Util::PP; return Math::Prime::Util::PP::RiemannZeta($n); } sub RiemannR { my($n) = @_; croak("Invalid input to RiemannR: x must be > 0") if $n <= 0; return _XS_RiemannR($n) if !defined $bignum::VERSION && ref($n) ne 'Math::BigFloat' && $_Config{'xs'}; 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(@_); } sub LambertW { my($x) = @_; return _XS_LambertW($x) if !defined $bignum::VERSION && ref($x) ne 'Math::BigFloat' && $_Config{'xs'}; # TODO: Call GMP function here directly require Math::Prime::Util::PP; return Math::Prime::Util::PP::LambertW($x); } sub bernfrac { my($n) = @_; return map { _to_bigint($_) } (0,1) if defined $n && $n < 0; _validate_num($n) || _validate_positive_integer($n); return map { _to_bigint($_) } (0,1) if $n > 1 && ($n & 1); if ($Math::Prime::Util::_GMPfunc{"bernfrac"}) { return map { _to_bigint($_) } Math::Prime::Util::GMP::bernfrac($n); } require Math::Prime::Util::PP; return Math::Prime::Util::PP::bernfrac($n); } sub bernreal { my($n, $precision) = @_; do { require Math::BigFloat; Math::BigFloat->import(); } unless defined $Math::BigFloat::VERSION; if ($Math::Prime::Util::_GMPfunc{"bernreal"}) { return Math::BigFloat->new(Math::Prime::Util::GMP::bernreal($n)) if !defined $precision; return Math::BigFloat->new(Math::Prime::Util::GMP::bernreal($n,$precision),$precision); } my($num,$den) = bernfrac($n); return Math::BigFloat->bzero if $num->is_zero; scalar Math::BigFloat->new($num)->bdiv($den, $precision); } sub harmfrac { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); return map { _to_bigint($_) } (0,1) if $n <= 0; if ($Math::Prime::Util::_GMPfunc{"harmfrac"}) { return map { _to_bigint($_) } Math::Prime::Util::GMP::harmfrac($n); } require Math::Prime::Util::PP; Math::Prime::Util::PP::harmfrac($n); } sub harmreal { my($n, $precision) = @_; _validate_num($n) || _validate_positive_integer($n); do { require Math::BigFloat; Math::BigFloat->import(); } unless defined $Math::BigFloat::VERSION; return Math::BigFloat->bzero if $n <= 0; if ($Math::Prime::Util::_GMPfunc{"harmreal"}) { return Math::BigFloat->new(Math::Prime::Util::GMP::harmreal($n)) if !defined $precision; return Math::BigFloat->new(Math::Prime::Util::GMP::harmreal($n,$precision),$precision); } # If low enough precision, use native floating point. Fast. if (defined $precision && $precision <= 13) { return Math::BigFloat->new( ($n < 80) ? do { my $h = 0; $h += 1/$_ for 1..$n; $h; } : log($n) + 0.57721566490153286060651209 + 1/(2*$n) - 1/(12*$n*$n) + 1/(120*$n*$n*$n*$n) ,$precision ); } if ($Math::Prime::Util::_GMPfunc{"harmfrac"}) { my($num,$den) = map { _to_bigint($_) } Math::Prime::Util::GMP::harmfrac($n); return scalar Math::BigFloat->new($num)->bdiv($den, $precision); } require Math::Prime::Util::PP; Math::Prime::Util::PP::harmreal($n, $precision); } ############################################################################# use Math::Prime::Util::MemFree; 1; __END__ # ABSTRACT: Utilities related to prime numbers, including fast generators / sievers =pod =encoding utf8 =for stopwords Möbius Deléglise Bézout uniqued k-tuples von SoE primesieve primegen libtommath pari yafu fonction qui compte le nombre nombres voor PhD superset sqrt(N) gcd(A^M k-th (10001st untruncated OpenPFGW gmpy2 Über Primzahl-Zählfunktion n-te und verallgemeinerte multiset compositeness GHz significand TestU01 subfactorial s-gonal XSLoader =for test_synopsis use v5.14; my($k,$x); =head1 NAME Math::Prime::Util - Utilities related to prime numbers, including fast sieves and factoring =head1 VERSION Version 0.73 =head1 SYNOPSIS # Nothing is exported by default. List the functions, or use :all. use Math::Prime::Util ':all'; # import all functions # The ':rand' tag replaces srand and rand (not done by default) use Math::Prime::Util ':rand'; # import srand, rand, irand, irand64 # Get a big array reference of many primes my $aref = primes( 100_000_000 ); # All the primes between 5k and 10k inclusive $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) my $n = 1000003; # for example 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 undef if given input 2 or less) $n = prev_prime($n); # Return Pi(n) -- the number of primes E= n. my $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 my @prime_factors = factor( $n ); # Return ([p1,e1],[p2,e2], ...) for $n = p1^e1 * p2*e2 * ... my @pe = factor_exp( $n ); # Get all divisors other than 1 and n my @divisors = divisors( $n ); # Or just apply a block for each one my $sum = 0; 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); # Show all prime partitions of 25 forpart { say "@_" unless scalar grep { !is_prime($_) } @_ } 25; # List all 3-way combinations of an array my @cdata = qw/apple bread curry donut eagle/; forcomb { say "@cdata[@_]" } @cdata, 3; # or all permutations forperm { say "@cdata[@_]" } @cdata; # divisor sum my $sigma = divisor_sum( $n ); # sum of divisors my $sigma0 = divisor_sum( $n, 0 ); # count of divisors my $sigmak = divisor_sum( $n, $k ); my $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($rand_prime); $rand_prime = random_prime(1000); # random prime <= limit $rand_prime = random_prime(100, 10000); # random prime within a range $rand_prime = random_ndigit_prime(6); # random 6-digit prime $rand_prime = random_nbit_prime(128); # random 128-bit prime $rand_prime = random_strong_prime(256); # random 256-bit strong prime $rand_prime = random_maurer_prime(256); # random 256-bit provable prime $rand_prime = random_shawe_taylor_prime(256); # as above =head1 DESCRIPTION A module for number theory in Perl. This includes prime sieving, primality tests, primality proofs, integer factoring, counts / bounds / approximations for primes, nth primes, and twin primes, random prime generation, and much more. This module is the fastest on CPAN for almost all operations it supports. This includes 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. Also note that L is not thread-safe (and will crash as soon as it is loaded in threads), so if you use L rather than L or the default backend, things will go pear-shaped. 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 ENVIRONMENT VARIABLES There are two environment variables that affect operation. These are typically used for validation of the different methods or to simulate systems that have different support. =head2 MPU_NO_XS If set to C<1> then everything is run in pure Perl. No C functions are loaded or used, as XSLoader is not even called. All top-level XS functions are replaced by a pure Perl layer (the PPFE.pm module that supplies a "Pure Perl Front End"). Caveat: This does not change whether the GMP backend is used. For as much pure Perl as possible, you will need to set both variables. If this variable is not set or set to anything other than C<1>, the module operates normally. =head2 MPU_NO_GMP If set to C<1> then the L backend is not loaded, and operation will be exactly as if it was not installed. If this variable is not set or set to anything other than C<1>, the module operates normally. =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 a recent version of 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 * 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 or L which construct random provable primes. =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). C is returned if the input is C<2> or lower. The behavior in various programs of the I function is varied. Pari/GP and L returns the input if it is prime, as does L. When given an input such that the return value will be the first prime less than C<2>, L, L, Pari/GP, and older versions of MPU will return C<0>. L and the current MPU will return C. WolframAlpha returns C<-2>. Maple gives a range error. =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, L, are the numbers greater than 1 which are not prime: C<4, 6, 8, 9, 10, 12, 14, 15, ...>. =head2 foroddcomposites Similar to L, but skipping all even numbers. The odd composites, L, are the numbers greater than 1 which are not prime and not divisible by two: C<9, 15, 21, 25, 27, 33, 35, ...>. =head2 forsemiprimes Similar to L, but only giving composites with exactly two factors. The semiprimes, L, are the products of two primes: C<4, 6, 9, 10, 14, 15, 21, 22, 25, ...>. This is essentially equivalent to: forcomposites { if (is_semiprime($_)) { ... } } =head2 forfactored forfactored { say "$_: @_"; } 100; Given a block and either an end number or start/end pair, calls the block for each number in the inclusive range. C<$_> is set to the number while C<@_> holds the factors. Especially for small inputs or large ranges, This can be faster than calling L on each sequential value. Similar to the arrays returned by similar functions such as L, the values in C<@_> are read-only. Any attempt to modify them will result in undefined behavior. This corresponds to the Pari/GP 2.10 C function. =head2 forsquarefree Similar to L, but skipping numbers in the range that have a repeated factor. Inside the block, the moebius function can be cheaply computed as C<((scalar(@_) & 1) ? -1 : 1)> or similar. This corresponds to the Pari/GP 2.10 C function. =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 forpart forpart { say "@_" } 25; # unrestricted partitions forpart { say "@_" } 25,{n=>5} # ... with exactly 5 values forpart { say "@_" } 25,{nmax=>5} # ... with <=5 values Given a non-negative number C, the block is called with C<@_> set to the array of additive integer partitions. The operation is very similar to the C function in Pari/GP 2.6.x, though the ordering is different. The ordering is lexicographic. Use L to get just the count of unrestricted partitions. An optional hash reference may be given to produce restricted partitions. Each value must be a non-negative integer. The allowable keys are: n restrict to exactly this many values amin all elements must be at least this value amax all elements must be at most this value nmin the array must have at least this many values nmax the array must have at most this many values prime all elements must be prime (non-zero) or non-prime (zero) Like forcomb and forperm, the partition return values are read-only. Any attempt to modify them will result in undefined behavior. =head2 forcomp Similar to L, but iterates over integer compositions rather than partitions. This can be thought of as all ordering of partitions, or alternately partitions may be viewed as an ordered subset of compositions. The ordering is lexicographic. All options from L may be used. The number of unrestricted compositions of C is C<2^(n-1)>. =head2 forcomb Given non-negative arguments C and C, the block is called with C<@_> set to the C element array of values from C<0> to C representing the combinations in lexicographical order. While the L function gives the total number, this function can be used to enumerate the choices. Rather than give a data array as input, an integer is used for C. A convenient way to map to array elements is: forcomb { say "@data[@_]" } @data, 3; where the block maps the combination array C<@_> to array values, the argument for C is given the array since it will be evaluated as a scalar and hence give the size, and the argument for C is the desired size of the combinations. Like forpart and forperm, the index return values are read-only. Any attempt to modify them will result in undefined behavior. If the second argument C is not supplied, then all k-subsets are returned starting with the smallest set C and continuing to C. Each k-subset is in lexicographical order. This is the power set of C. This corresponds to the Pari/GP 2.10 C function. =head2 forperm Given non-negative argument C, the block is called with C<@_> set to the C element array of values from C<0> to C representing permutations in lexicographical order. The total number of calls will be C. Rather than give a data array as input, an integer is used for C. A convenient way to map to array elements is: forperm { say "@data[@_]" } @data; where the block maps the permutation array C<@_> to array values, and the argument for C is given the array since it will be evaluated as a scalar and hence give the size. Like forpart and forcomb, the index return values are read-only. Any attempt to modify them will result in undefined behavior. =head2 forderange Similar to forperm, but iterates over derangements. This is the set of permutations skipping any which maps an element to its original position. =head2 formultiperm # Show all anagrams of 'serpent': formultiperm { say join("",@_) } [split(//,"serpent")]; Similar to L but takes an array reference as an argument. This is treated as a multiset, and the block will be called with each multiset permutation. While the standard permutation iterator takes a scalar and returns index permutations, this takes the set itself. If all values are unique, then the results will be the same as a standard permutation. Otherwise, the results will be similar to a standard permutation removing duplicate entries. While generating all permutations and filtering out duplicates works, it is very slow for large sets. This iterator will be much more efficient. There is no ordering requirement for the input array reference. The results will be in lexicographic order. =head2 forsetproduct forsetproduct { say "@_" } [1,2,3],[qw/a b c/],[qw/@ $ !/]; Takes zero or more array references as arguments and iterates over the set product (i.e. Cartesian product or cross product) of the lists. The given subroutine is repeatedly called with C<@_> set to the current list. Since no de-duplication is done, this is not literally a C product. While zero or one array references are valid, the result is not very interesting. If any array reference is empty, the product is empty, so no subroutine calls are performed. The subroutine is given an array whose values are aliased to the inputs, and are I set to read-only. Hence modifying the array inside the subroutine will cause side-effects. As with other iterators, the C function will cause an early exit. =head2 lastfor forprimes { lastfor,return if $_ > 1000; $sum += $_; } 1e9; Calling lastfor requests that the current for... loop stop after this call. Ideally this would act exactly like a C inside a loop, but technical reasons mean it does not exit the block early, hence one typically adds a C if needed. =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>. For larger inputs various methods are used including Dusart (2010), Büthe (2014,2015), and Axler (2014). 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 can be used for very 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. A slightly faster but much less accurate answer can be obtained by averaging the upper and lower bounds. =head2 twin_primes Returns the lesser of twin primes between the lower and upper limits (inclusive), with a lower limit of C<2> if none is given. This is L. Given a twin prime pair C<(p,q)> with C, C

, and , this function uses C

to represent the pair. Hence the bounds need to include C

, and the returned list will have C

but not C. This works just like the L function, though only the first primes of twin prime pairs are returned. Like that function, an array reference is returned. =head2 twin_prime_count Similar to prime count, but returns the count of twin primes (primes C

where C is also prime). Takes either a single number indicating a count from 2 to the argument, or two numbers indicating a range. The primes being counted are the first value, so a range of C<(3,5)> will return a count of two, because both C<3> and C<5> are counted as twin primes. A range of C<(12,13)> will return a count of zero, because neither C<12+2> nor C<13+2> are prime. In contrast, C requires all elements of a constellation to be within the range to be counted, so would return one for the first example (C<5> is not counted because its pair C<7> is not in the range). There is no useful formula known for this, unlike prime counts. We sieve for the answer, using some small table acceleration. =head2 twin_prime_count_approx Returns an approximation to the twin prime count of C. This returns quickly and has a very small error for large values. The method used is conjecture B of Hardy and Littlewood 1922, as stated in Sebah and Gourdon 2002. For inputs under 10M, a correction factor is additionally applied to reduce the mean squared error. =head2 semi_primes Returns an array reference to semiprimes between the lower and upper limits (inclusive), with a lower limit of C<4> if none is given. This is L. The semiprimes are composite integers which are products of exactly two primes. This works just like the L function. Like that function, an array reference is returned. =head2 semiprime_count Similar to prime count, but returns the count of semiprimes (composites with exactly two factors). Takes either a single number indicating a count from 2 to the argument, or two numbers indicating a range. A fast method that requires computation only to the square root of the range end is used, unless the range is so small that walking it is faster. =head2 semiprime_count_approx Returns an approximation to the semiprime count of C. This returns quickly and is typically square root accurate. =head2 ramanujan_primes Returns the Ramanujan primes R_n between the upper and lower limits (inclusive), with a lower limit of C<2> if none is given. This is L. These are the Rn such that if C Rn> then L(n) - L(n/2) E= C. This has a similar API to the L and L functions, and like them, returns an array reference. Generating Ramanujan primes takes some effort, including overhead to cover a range. This will be substantially slower than generating standard primes. =head2 ramanujan_prime_count Similar to prime count, but returns the count of Ramanujan primes. Takes either a single number indicating a count from 2 to the argument, or two numbers indicating a range. While not nearly as efficient as L, this does use a number of speedups that result it in being much more efficient than generating all the Ramanujan primes. =head2 ramanujan_prime_count_approx A fast approximation of the count of Ramanujan primes under C. =head2 ramanujan_prime_count_lower A fast lower limit on the count of Ramanujan primes under C. =head2 ramanujan_prime_count_upper A fast upper limit on the count of Ramanujan primes under C. =head2 sieve_range my @candidates = sieve_range(2**1000, 10000, 40000); Given a start value C, and native unsigned integers C and C, a sieve of maximum depth C is done for the C consecutive numbers beginning with C. An array of offsets from the start is returned. The returned list contains those offsets in the range C to C where C has no prime factors less than C. =head2 sieve_prime_cluster my @s = sieve_prime_cluster(1, 1e9, 2,6,8,12,18,20); Efficiently finds prime clusters between the first two arguments C and C. The remaining arguments describe the cluster. The cluster values must be even, less than 31 bits, and strictly increasing. Given a cluster set C, the returned values are all primes in the range where C is prime for each C in the cluster set C. For returned values under C<2^64>, all cluster values are definitely prime. Above this range, all cluster values are BPSW probable primes (no counterexamples known). This function returns an array rather than an array reference. Typically the number of returned values is much lower than for other primes functions, so this uses the more convenient array return. This function has an identical signature to the function of the same name in L. The cluster is described as offsets from 0, with the implicit prime at 0. Hence an empty list is asking for all primes (the cluster C). A list with the single value C<2> will find all twin primes (the cluster where C and C are prime). The list C<2,6,8> will find prime quadruplets. Note that there is no requirement that the list denote a constellation (a cluster with minimal distance) -- the list C<42,92,606> is just fine. =head2 sum_primes Returns the summation of primes between the lower and upper limits (inclusive), with a lower limit of C<2> if none is given. This is essentially similar to either of: $sum = 0; forprimes { $sum += $_ } $low,$high; $sum; # or vecsum( @{ primes($low,$high) } ); but is much more efficient. The current implementation is a small-table-enhanced sieve count for sums that fit in a UV, an efficient sieve count for small ranges, and a Legendre sum method for larger values. While this is fairly efficient, the state of the art is Kim Walisch's L. It is recommended for very large values, as it can be hundreds of times faster. =head2 print_primes print_primes(1_000_000); # print the first 1 million primes print_primes(1000, 2000); # print primes in range print_primes(2,1000,fileno(STDERR)) # print to a different descriptor With a single argument this prints all primes from 2 to C to standard out. With two arguments it prints primes between C and C to standard output. With three arguments it prints primes between C and C to the file descriptor given. If the file descriptor cannot be written to, this will croak with "print_primes write error". It will produce identical output to: forprimes { say } $low,$high; The point of this function is just efficiency. It is over 10x faster than using C, C, or C, though much more limited in functionality. A later version may allow a file handle as the third argument. =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

such that C= n>. Like most programs with similar functionality, this is one-based. C returns C, C returns C<2>. 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 30 seconds. 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); # For all $n: $lower_limit <= nth_prime($n) <= $upper_limit Returns an analytical upper or lower bound on the Nth prime. No sieving is done, so these are fast even for large inputs. For tiny values of C. exact answers are returned. For small inputs, an inverse of the opposite prime count bound is used. For larger values, the Dusart (2010) and Axler (2013) bounds are used. =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. For values where the nth prime is smaller than C<2^64>, the inverse Riemann R function is used. For larger values, the inverse logarithmic integral is used. The value returned will not necessarily be prime. This applies to all the following nth prime approximations, where the returned value is close to the real value, but no effort is made to coerce the result to the nearest set element. =head2 nth_twin_prime Returns the Nth twin prime. This is done via sieving and counting, so is not very fast for large values. =head2 nth_twin_prime_approx Returns an approximation to the Nth twin prime. A curve fit is used for small inputs (under 1200), while for larger inputs a binary search is done on the approximate twin prime count. =head2 nth_semiprime Returns the Nth semiprime, similar to where a C loop would end after C iterations, but much more efficiently. =head2 nth_semiprime_approx Returns an approximation to the Nth semiprime. Curve fitting is used to get a fairly close approximation that is orders of magnitude better than the simple C approximation for large C. =head2 nth_ramanujan_prime Returns the Nth Ramanujan prime. For reasonable size values of C, e.g. under C<10^8> or so, this is relatively efficient for single calls. If multiple calls are being made, it will be much more efficient to get the list once. =head2 nth_ramanujan_prime_approx A fast approximation of the Nth Ramanujan prime. =head2 nth_ramanujan_prime_lower A fast lower limit on the Nth Ramanujan prime. =head2 nth_ramanujan_prime_upper A fast upper limit on the Nth Ramanujan prime. =head2 is_pseudoprime Takes a positive number C and one or more non-zero positive bases as input. Returns C<1> if the input is a probable prime to each base, C<0> if not. This is the simple Fermat primality test. Removing primes, given base 2 this produces the sequence L. For practical use, L is a much stronger test with similar or better performance. Note that there is a set of composites (the Carmichael numbers) that will pass this test for all bases. This downside is not shared by the Euler and strong probable prime tests (also called the Solovay-Strassen and Miller-Rabin tests). =head2 is_euler_pseudoprime Takes a positive number C and one or more non-zero positive bases as input. Returns C<1> if the input is an Euler probable prime to each base, C<0> if not. This is the Euler test, sometimes called the Euler-Jacobi test. Removing primes, given base 2 this produces the sequence L. If 0 is returned, then the number really is a composite. If 1 is returned, then it is either a prime or an Euler pseudoprime to all the given bases. Given enough distinct bases, the chances become very high that the number is actually prime. This test forms the basis of the Solovay-Strassen test, which is a precursor to the Miller-Rabin test (which uses the strong probable prime test). There are no analogies to the Carmichael numbers for this test. For the Euler test, at I 1/2 of witnesses pass for a composite, while at most 1/4 pass for the strong pseudoprime test. =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 C and one or more non-zero positive bases as input. Returns C<1> if the input is a strong probable prime to each base, C<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 high 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 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

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

as input and returns 1 if the Mersenne number C<2^p-1> is prime. Since an enormous effort has gone into testing these, a list of known Mersenne primes is used to accelerate this. Beyond the highest sequential Mersenne prime (currently 37,156,667) this performs pretesting followed by the Lucas-Lehmer test. The Lucas-Lehmer test is a deterministic unconditional test that runs very fast compared to other primality methods for numbers of comparable size, and vastly faster than any known general-form primality proof methods. While this test is fast, the GMP implementation is not nearly as fast as specialized programs such as C. Additionally, since we use the table for "small" numbers, testing via this function call will only occur for numbers with over 9.8 million digits. At this size, tools such as C are greatly preferred. =head2 is_ramanujan_prime Takes a positive number C as input and returns back either 0 or 1, indicating whether C is a Ramanujan prime. Numbers that can be produced by the functions L and L will return 1, while all other numbers will return 0. There is no simple function for this predicate, so Ramanujan primes through at least C are generated, then a search is performed for C. This is not efficient for multiple calls. =head2 is_power say "$n is a perfect square" if is_power($n, 2); say "$n is a perfect cube" if is_power($n, 3); say "$n is a ", is_power($n), "-th power"; Given a single non-negative integer input C, returns k if C for some integer C 1, k E 1>, and 0 otherwise. The k returned is the largest possible. This can be used in a boolean statement to determine if C is a perfect power. If given two arguments C and C, returns 1 if C is a C power, and 0 otherwise. For example, if C then this detects perfect squares. Setting C gives behavior like the first case (the largest root is found and its value is returned). If a third argument is present, it must be a scalar reference. If C is a k-th power, then this will be set to the k-th root of C. For example: my $n = 222657534574035968; if (my $pow = is_power($n, 0, \my $root)) { say "$n = $root^$pow" } # prints: 222657534574035968 = 2948^5 This corresponds to Pari/GP's C function with integer arguments. =head2 is_prime_power Given an integer input C, returns C if C for some prime p, and zero otherwise. If a second argument is present, it must be a scalar reference. If the return value is non-zero, then it will be set to C

. This corresponds to Pari/GP's C function. =head2 is_square Given a positive integer C, returns 1 if C is a perfect square, 0 otherwise. This is identical to C. This corresponds to Pari/GP's C function. =head2 sqrtint Given a non-negative integer input C, returns the integer square root. For native integers, this is equal to C. This corresponds to Pari/GP's C function. =head2 rootint Given an non-negative integer C and positive exponent C, return the integer k-th root of C. This is the largest integer C such that C= n>. If a third argument is present, it must be a scalar reference. It will be set to C. Technically if C is negative and C is odd, the root exists and is equal to C. It was decided to follow the behavior of Pari/GP and Math::BigInt and disallow negative C. This corresponds to Pari/GP's C function. =head2 logint say "decimal digits: ", 1+logint($n, 10); say "digits in base 12: ", 1+logint($n, 12); my $be; my $e = logint(1000,2, \$be); say "smallest power of 2 less than 1000: 2^$e = $be"; Given a non-zero positive integer C and an integer base C greater than 1, returns the largest integer C such that C= n>. If a third argument is present, it must be a scalar reference. It will be set to C. This corresponds to Pari/GP's C function. =head2 lucasu say "Fibonacci($_) = ", lucasu(1,-1,$_) for 0..100; Given integers C

, C, and the non-negative integer C, computes C for the Lucas sequence defined by C

,C. These include the Fibonacci numbers (C<1,-1>), the Pell numbers (C<2,-1>), the Jacobsthal numbers (C<1,-2>), the Mersenne numbers (C<3,2>), and more. This corresponds to OpenPFGW's C function and gmpy2's C function. =head2 lucasv say "Lucas($_) = ", lucasv(1,-1,$_) for 0..100; Given integers C

, C, and the non-negative integer C, computes C for the Lucas sequence defined by C

,C. These include the Lucas numbers (C<1,-1>). This corresponds to OpenPFGW's C function and gmpy2's C function. =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< |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 gcdext Given two integers C and C, returns C such that C and C. This uses the extended Euclidian algorithm to compute the values satisfying Bézout's Identity. This corresponds to Pari's C function, which was renamed from C out Pari 2.6. The results will hence match L. =head2 chinese say chinese( [14,643], [254,419], [87,733] ); # 87041638 Solves a system of simultaneous congruences using the Chinese Remainder Theorem (with extension to non-coprime moduli). A list of C<[a,n]> pairs are taken as input, each representing an equation C. If no solution exists, C is returned. If a solution is returned, the modulus is equal to the lcm of all the given moduli (see L. In the standard case where all values of C are coprime, this is just the product. The C values must be positive integers, while the C values are integers. Comparison to similar functions in other software: Math::ModInt::ChineseRemainder: cr_combine( mod(a1,m1), mod(a2,m2), ... ) Pari/GP: chinese( [Mod(a1,m1), Mod(a2,m2), ...] ) Mathematica: ChineseRemainder[{a1, a2, ...}{m1, m2, ...}] =head2 vecsum say "Totient sum 500,000: ", vecsum(euler_phi(0,500_000)); Returns the sum of all arguments, each of which must be an integer. This is similar to List::Util's L function, but has a very important difference. List::Util turns all inputs into doubles and returns a double, which will mean incorrect results with large integers. C sums (signed) integers and returns the untruncated result. Processing is done on native integers while possible. =head2 vecprod say "Totient product 5,000: ", vecprod(euler_phi(1,5_000)); Returns the product of all arguments, each of which must be an integer. This is similar to List::Util's L function, but keeps all results as integers and automatically switches to bigints if needed. =head2 vecmin say "Smallest Totient 100k-200k: ", vecmin(euler_phi(100_000,200_000)); Returns the minimum of all arguments, each of which must be an integer. This is similar to List::Util's L function, but has a very important difference. List::Util turns all inputs into doubles and returns a double, which gives incorrect results with large integers. C validates and compares all results as integers. The validation step will make it a little slower than L but this prevents accidental and unintentional use of floats. =head2 vecmax say "Largest Totient 100k-200k: ", vecmax(euler_phi(100_000,200_000)); Returns the maximum of all arguments, each of which must be an integer. This is similar to List::Util's L function, but has a very important difference. List::Util turns all inputs into doubles and returns a double, which gives incorrect results with large integers. C validates and compares all results as integers. The validation step will make it a little slower than L but this prevents accidental and unintentional use of floats. =head2 vecreduce say "Count of non-zero elements: ", vecreduce { $a + !!$b } (0,@v); my $checksum = vecreduce { $a ^ $b } @{twin_primes(1000000)}; Does a reduce operation via left fold. Takes a block and a list as arguments. The block uses the special local variables C and C representing the accumulation and next element respectively, with the result of the block being used for the new accumulation. No initial element is used, so C will be returned with an empty list. The interface is exactly the same as L. This was done to increase portability and minimize confusion. See chapter 7 of Higher Order Perl (or many other references) for a discussion of reduce with empty or singular-element lists. It is often a good idea to give an identity element as the first list argument. While operations like L, L, L, L, etc. can be fairly easily done with this function, it will not be as efficient. There are a wide variety of other functions that can be easily made with reduce, making it a useful tool. =head2 vecany =head2 vecall =head2 vecnone =head2 vecnotall =head2 vecfirst say "all values are Carmichael" if vecall { is_carmichael($_) } @n; Short circuit evaluations of a block over a list. Takes a block and a list as arguments. The block is called with C<$_> set to each list element, and evaluation on list elements is done until either all list values have been evaluated or the result condition can be determined. For instance, in the example of C above, evaluation stops as soon as any value returns false. The interface is exactly the same as the C, C, C, C, and C functions in L. This was done to increase portability and minimize confusion. Unlike other vector functions like C, C, C, etc. there is no added value to using these versus the ones from L. They are here for convenience. These operations can fairly easily be mapped to C, but that does not short-circuit and is less obvious. =head2 vecfirstidx say "first Carmichael is index ", vecfirstidx { is_carmichael($_) } @n; Returns the index of the first element in a list that evaluates to true. Just like vecfirst, but returns the index instead of the value. Returns -1 if the item could not be found. This interface matches C and C from L. =head2 vecextract say "Power set: ", join(" ",vecextract(\@v,$_)) for 0..2**scalar(@v)-1; @word = vecextract(["a".."z"], [15, 17, 8, 12, 4]); Extracts elements from an array reference based on a mask, with the result returned as an array. The mask is either an unsigned integer which is treated as a bit mask, or an array reference containing integer indices. If the second argument is an integer, each bit set in the mask results in the corresponding element from the array reference to be returned. Bits are read from the right, so a mask of C<1> returns the first element, while C<5> will return the first and third. The mask may be a bigint. If the second argument is an array reference, then its elements will be used as zero-based indices into the first array. Duplicate values are allowed and the ordering is preserved. Hence these are equivalent: vecextract($aref, $iref); @$aref[@$iref]; =head2 todigits say "product of digits of n: ", vecprod(todigits($n)); Given an integer C, return an array of digits of C<|n|>. An optional second integer argument specifies a base (default 10). For example, given a base of 2, this returns an array of binary digits of C. An optional third argument specifies a length for the returned array. The result will be either have upper digits truncated or have leading zeros added. This is most often used with base 2, 8, or 16. The values returned may be read-only. C returns an empty array. The base must be at least 2, and is limited to an int. Length must be at least zero and is limited to an int. This corresponds to Pari's C and C functions, and Mathematica's C function. =head2 todigitstring say "decimal 456 in hex is ", todigitstring(456, 16); say "last 4 bits of $n are: ", todigitstring($n, 2, 4); Similar to L but returns a string. For bases E= 10, this is equivalent to joining the array returned by L. For bases between 11 and 36, lower case characters C to C are used to represent larger values. This makes C return a usable hex string. This corresponds to Mathematica's C function. =head2 fromdigits say "hex 1c8 in decimal is ", fromdigits("1c8", 16); say "Base 3 array to number is: ", fromdigits([0,1,2,2,2,1,0],3); This takes either a string or array reference, and an optional base (default 10). With a string, each character will be interpreted as a digit in the given base, with both upper and lower case denoting values 11 through 36. With an array reference, the values indicate the entries in that location, and values larger than the base are allowed (results are carried). The result is a number (either a native integer or a bigint). This corresponds to Pari's C function and Mathematica's C function. =head2 sumdigits # Sum digits of primes to 1 million. my $s=0; forprimes { $s += sumdigits($_); } 1e6; say $s; Given an input C, return the sum of the digits of C. Any non-digit characters of C are ignored (including negative signs and decimal points). This is similar to the command C but faster, allows non-positive-integer inputs, and can sum in other bases. An optional second argument indicates the base of the input number. This defaults to 10, and must be between 2 and 36. Any character that is outside the range C<0> to C will be ignored. If no base is given and the input number C begins with C<0x> or C<0b> then it will be interpreted as a string in base 16 or 2 respectively. Regardless of the base, the output sum is a decimal number. This is similar but not identical to Pari's C function from version 2.8 and later. The Pari/GP function always takes the input as a decimal number, uses the optional base as a base to first convert to, then sums the digits. This can be done with either C or C. =head2 invmod say "The inverse of 42 mod 2017 = ", invmod(42,2017); Given two integers C and C, return the inverse of C modulo C. If not defined, undef is returned. If defined, then the return value multiplied by C equals C<1> modulo C. The results correspond to the Pari result of C. The semantics with respect to negative arguments match Pari. Notably, a negative C is negated, which is different from Math::BigInt, but in both cases the return value is still congruent to C<1> modulo C as expected. =head2 sqrtmod Given two integers C and C, return the square root of C mod C. If no square root exists, undef is returned. If defined, the return value C will always satisfy C. If the modulus is prime, the function will always return C, the smaller of the two square roots (the other being C<-r mod p>. If the modulus is composite, one of possibly many square roots will be returned, and it will not necessarily be the smallest. =head2 addmod Given three integers C, C, and C where C is positive, return C<(a+b) mod n>. This is particularly useful when dealing with numbers that are larger than a half-word but still native size. No bigint package is needed and this can be 10-200x faster than using one. =head2 mulmod Given three integers C, C, and C where C is positive, return C<(a*b) mod n>. This is particularly useful when C fits in a native integer. No bigint package is needed and this can be 10-200x faster than using one. =head2 powmod Given three integers C, C, and C where C is positive, return C<(a ** b) mod n>. Typically binary exponentiation is used, so the process is very efficient. With native size inputs, no bigint library is needed. =head2 divmod Given three integers C, C, and C where C is positive, return C<(a/b) mod n>. This is done as C<(a * (1/b mod n)) mod n>. If no inverse of C mod C exists then undef if returned. =head2 valuation say "$n is divisible by 2 ", valuation($n,2), " times."; Given integers C and C, returns the numbers of times C is divisible by C. This is a very limited version of the algebraic valuation meaning, just applied to integers. This corresponds to Pari's C function. C<0> is returned if C or C is one of the values C<-1>, C<0>, or C<1>. =head2 hammingweight Given an integer C, returns the binary Hamming weight of C. This is also called the population count, and is the number of 1s in the binary representation. This corresponds to Pari's C function for C arguments. =head2 is_square_free say "$n has no repeating factors" if is_square_free($n); Returns 1 if the input C has no repeated factor. =head2 is_carmichael for (1..1e6) { say if is_carmichael($_) } # Carmichaels under 1,000,000 Returns 1 if the input C is a Carmichael number. These are composites that satisfy C for all C<1 E b E n> relatively prime to C. Alternately Korselt's theorem says these are composites such that C is square-free and C divides C for all prime divisors C

of C. For inputs larger than 50 digits after removing very small factors, this uses a probabilistic test since factoring the number could take unreasonably long. The first 150 primes are used for testing. Any that divide C are checked for square-free-ness and the Korselt condition, while those that do not divide C are used as the pseudoprime base. The chances of a non-Carmichael passing this test are less than C<2^-150>. This is the L. =head2 is_quasi_carmichael Returns 0 if the input C is not a quasi-Carmichael number, and the number of bases otherwise. These are square-free composites that satisfy C divides C for all prime factors C

or C and for one or more non-zero integer C. This is the L. =head2 is_semiprime Given a positive integer C, returns 1 if C is a semiprime, 0 otherwise. A semiprime is the product of exactly two primes. The boolean result is the same as C, but this function performs shortcuts that can greatly speed up the operation. =head2 is_fundamental Given an integer C, returns 1 if C is a fundamental discriminant, 0 otherwise. We consider 1 to be a fundamental discriminant. This is the L (positive) and L (negative). This corresponds to Pari's C function. =head2 is_totient Given an integer C, returns 1 if there exists an integer C where C. This corresponds to Pari's C function, though without the optional second argument to return an C. L also has a similar function. Also see L which gives the count or list of values that produce a given totient. This function is more efficient than getting the full count or list. =head2 is_pillai Given a positive integer C, if there exists a C where C and C, then C is returned. Otherwise 0. For n prime, this is the L. =head2 is_polygonal Given integers C and C, return 1 if x is an s-gonal number, 0 otherwise. C must be greater than 2. If a third argument is present, it must be a scalar reference. It will be set to n if x is the nth s-gonal number. If the function returns 0, then it will be unchanged. This corresponds to Pari's C function. =head2 moebius say "$n is square free" if moebius($n) != 0; $sum += moebius($_) for (1..200); say "Mertens(200) = $sum"; say "Mertens(2000) = ", vecsum(moebius(0,2000)); 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.4s 0.1MB mertens(100_000_000) 3.0s 880MB vecsum(moebius(1,100_000_000)) 56s 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, even though they are shared constants, is not good for memory at this size. In comparison, this function will generate the equivalent output via a sieving method that is relatively memory frugal 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, Pari pre-2.6.2 raises an exception, and Pari 2.6.2 and newer returns 2. If called with two arguments, they define a range C to C, and the function returns a list with the totient of every n from low to high inclusive. =head2 inverse_totient In array context, given a positive integer C, returns the complete list of values C where C. This can be a memory intensive operation if there are many values. In scalar context, returns just the count of values. This is faster and uses substantially less memory. The list/scalar distinction is similar to L and L. This roughly corresponds to the Maple function C, and the hidden Mathematica function C. The algorithm used is from Max Alekseyev (2016). =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 Dedekind psi function, where C. =head2 ramanujan_sum Returns Ramanujan's sum of the two positive variables C and C. This is the sum of the nth powers of the primitive k-th roots of unity. =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>. This is effectively: my $s = 0; forprimes { $s += log($_) } $n; return $s; =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 but slower computation is as the summatory Mangoldt function, such as: my $s = 0; for (1..$n) { $s += log(exp_mangoldt($_)) } return $s; =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). The API is identical to Pari/GP's C function, and not dissimilar to Mathematica's C function. This function is useful for calculating things like aliquot sums, abundant numbers, perfect numbers, etc. With various C values, the results are the OEIS sequences L (C, number of divisors), L (C, sum of divisors), L (C, sum of squares of divisors), L (C, sum of cubes of divisors), 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 ramanujan_tau Takes a positive integer as input and returns the value of Ramanujan's tau function. The result is a signed integer. This corresponds to Pari v2.8's C function and Mathematica's C function. This currently uses a simple method based on divisor sums, which does not have a good computational growth rate. Pari's implementation uses Hurwitz class numbers and is more efficient for large inputs. =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: 70 Integer::Partition 90 MPU forpart { $n++ } 10_000 MPU pure Perl partitions 250_000 MPU GMP partitions 35_000_000 Pari's numbpart 500_000_000 Jonathan Bober's partitions_c.cc v0.6 If you want the enumerated partitions, see L. =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 prime C are: 0 a = 0 mod n 1 a is a quadratic residue mod n (a = x^2 mod n for some x) -1 a is a quadratic non-residue mod n (no a where a = x^2 mod 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, Mathematica's C function, and GMP's C, C, and C functions. =head2 factorial Given positive integer argument C, returns the factorial of C, defined as the product of the integers 1 to C with the special case of C. This corresponds to Pari's C and Mathematica's C functions. =head2 factorialmod Given two positive integer arguments C and C, returns C. This is much faster than computing the large C followed by a mod operation. While very efficient, this is not state of the art. Currently, Fredrik Johansson's fast multi-point polynomial evaluation method as used in FLINT is the fastest known method. This becomes noticeable for C E C<10^8> or so, and the O(n^.5) versus O(n) complexity makes it quite extreme as the input gets larger. =head2 binomial Given integer arguments C and C, returns the binomial coefficient C, also known as the choose function. Negative arguments use the L. This corresponds to Pari's C function, Mathematica's C function, and GMP's C function. For negative arguments, this matches Mathematica. Pari does not implement the C 0, k E= n> extension and instead returns C<0> for this case. GMP's API does not allow negative C but otherwise matches. L does not implement any extensions and the results for C 0, k > 0> are undefined. =head2 hclassno Returns 12 times the Hurwitz-Kronecker class number of the input integer C. This will always be an integer due to the pre-multiplication by 12. The result is C<0> for any input less than zero or congruent to 1 or 2 mod 4. This is related to Pari's C where C for positive C equals C<12 * qfbhclassno(n)> in Pari/GP. This is L. =head2 bernfrac Returns the Bernoulli number C for an integer argument C, as a rational number represented by two L objects. B_1 = 1/2. This corresponds to Pari's C and Mathematica's C functions. Having a modern version of L installed will make a big difference in speed. That module uses a fast Pi/Zeta method. Our pure Perl backend uses the Seidel method as shown by Peter Luschny. This is faster than L which uses an older algorithm, but quite a bit slower than modern Pari, Mathematica, or our GMP backend. This corresponds to Pari's C function and Mathematica's C function. =head2 bernreal Returns the Bernoulli number C for an integer argument C, as a L object using the default precision. An optional second argument may be given specifying the precision to be used. This corresponds to Pari's C function. =head2 stirling say "s(14,2) = ", stirling(14, 2); say "S(14,2) = ", stirling(14, 2, 2); say "L(14,2) = ", stirling(14, 2, 3); Returns the Stirling numbers of either the first kind (default), the second kind, or the third kind (the unsigned Lah numbers), with the kind selected as an optional third argument. It takes two non-negative integer arguments C and C plus the optional C. This corresponds to Pari's C function and Mathematica's C / C functions. Stirling numbers of the first kind are C<-1^(n-k)> times the number of permutations of C symbols with exactly C cycles. Stirling numbers of the second kind are the number of ways to partition a set of C elements into C non-empty subsets. The Lah numbers are the number of ways to split a set of C elements into C non-empty lists. =head2 harmfrac Returns the Harmonic number C for an integer argument C, as a rational number represented by two L objects. The harmonic numbers are the sum of reciprocals of the first C natural numbers: C<1 + 1/2 + 1/3 + ... + 1/n>. Binary splitting (Fredrik Johansson's elegant formulation) is used. This corresponds to Mathematica's C function. =head2 harmreal Returns the Harmonic number C for an integer argument C, as a L object using the default precision. An optional second argument may be given specifying the precision to be used. For large C values, using a lower precision may result in faster computation as an asymptotic formula may be used. For precisions of 13 or less, native floating point is used for even more speed. =head2 znorder $order = znorder(2, next_prime(10**16)-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 is_primitive_root Given two non-negative numbers C and C, returns C<1> if C is a primitive root modulo C, and C<0> if not. If C is a primitive root, then C is the smallest C for which C. =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 for native integers first applies Silver-Pohlig-Hellman on the group order to possibly reduce the problem to a set of smaller problems. The solutions are then performed using a mixture of trial, Shanks' BSGS, and Pollard's DLP Rho. The PP implementation is less sophisticated, with only a memory-heavy BSGS being used. =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. =head2 inverse_li $approx_prime_count = inverse_li(1000000000); Given a non-negative integer C, returns the least integer value C such that C E= n>. Since the logarithmic integral C is a good approximation to the number of primes less than C, this function is a good simple approximation to the nth prime. =head2 numtoperm @p = numtoperm(10,654321); # @p=(1,8,2,7,6,5,3,4,9,0) Given a non-negative integer C and integer C, return the rank C lexicographic permutation of C elements. C will be interpreted as mod C. This will match iteration number C (zero based) of L. This corresponds to Pari's C function, though Pari uses an implementation specific ordering rather than lexicographic. =head2 permtonum $k = permtonum([1,8,2,7,6,5,3,4,9,0]); # $k = 654321 Given an array reference containing integers from C<0> to C, returns the lexicographic permutation rank of the set. This is the inverse of the L function. All integers up to C must be present. This will match iteration number C (zero based) of L. The result will be between C<0> and C. This corresponds to Pari's C function, though Pari uses an implementation specific ordering rather than lexicographic. =head2 randperm @p = randperm(100); # returns shuffled 0..99 @p = randperm(100,4) # returns 4 elements from shuffled 0..99 @s = @data[randperm(1+$#data)]; # shuffle an array @p = @data[randperm(1+$#data,2)]; # pick 2 from an array With a single argument C, this returns a random permutation of the values from C<0> to C. When given a second argument C, the returned list will have only C elements. This is more efficient than truncating the full shuffled list. The randomness comes from our CSPRNG. =head2 shuffle @shuffled = shuffle(@data); Takes a list as input, and returns a random permutation of the list. Like randperm, the randomness comes from our CSPRNG. This function is functionally identical to the C function in L. The only difference is the random source (Chacha20 with better randomness, a larger period, and a larger state). This does make it slower. If the entire shuffled array is desired, this is faster than slicing with L as shown in its example above. If, however, a "pick" operation is desired, e.g. pick 2 random elements from a large array, then the slice technique can be hundreds of times faster. =head1 RANDOM NUMBERS =head2 OVERVIEW Prior to version 5.20, Perl's C function used the system rand function. This meant it varied by system, and was almost always a poor choice. For 5.20, Perl standardized on C and includes the source so there are no system dependencies. While this was an improvement, C is not a good PRNG. It really only has 32 bits of random values, and fails many statistical tests. See L for more information. There are much better choices for standard random number generators, such as the Mersenne Twister, PCG, or Xoroshiro128+. Someday perhaps Perl will get one of these to replace drand48. In the mean time, L provides numerous features and excellent performance, or this module. Since we often deal with random primes for cryptographic purposes, we have additional requirements. This module uses a CSPRNG for its random stream. In particular, ChaCha20, which is the same algorithm used by BSD's C and C on BSD and Linux 4.8+. Seeding is performed at startup using the Win32 Crypto API (on Windows), C, C, or L, whichever is found first. We use the original ChaCha definition rather than RFC7539. This means a 64-bit counter, resulting in a period of 2^72 bytes or 2^68 calls to L or . This compares favorably to the 2^48 period of Perl's C. It has a 512-bit state which is significantly larger than the 48-bit C state. When seeding, 320 bits (40 bytes) are used. Among other things, this means all 52! permutations of a shuffled card deck are possible, which is not true of L. One might think that performance would suffer from using a CSPRNG, but benchmarking shows it is less than one might expect. does not seem to be the case. The speed of irand, irand64, and drand are within 20% of the fastest existing modules using non-CSPRNG methods, and 2 to 20 times faster than most. While a faster underlying RNG is useful, the Perl call interface overhead is a majority of the time for these calls. Carefully tuning that interface is critical. For performance on large amounts of data, see the tables in L. Each thread uses its own context, meaning seeding in one thread has no impact on other threads. In addition to improved security, this is better for performance than a single context with locks. If explicit control of multiple independent streams are needed then using a more specific module is recommended. I believe L (part of L) and L are good alternatives. Using the C<:rand> export option will define C and C as similar but improved versions of the system functions of the same name, as well as L and L. =head2 irand $n32 = irand; # random 32-bit integer Returns a random 32-bit integer using the CSPRNG. =head2 irand64 $n64 = irand64; # random 64-bit integer Returns a random 64-bit integer using the CSPRNG (on 64-bit Perl). =head2 drand $f = drand; # random floating point value in [0,1) $r = drand(25.33); # random floating point value in [0,25.33) Returns a random NV (Perl's native floating point) using the CSPRNG. The API is similar to Perl's C but giving better results. The number of bits returned is equal to the number of significand bits of the NV type used in the Perl build. By default Perl uses doubles and the returned values have 53 bits (even on 32-bit Perl). If Perl is built with long double or quadmath support, each value may have 64 or even 113 bits. On newer Perls, one can check the L variable C to see how many are filled. This gives I better quality random numbers than the default Perl C function. Among other things, on modern Perl's, C uses drand48, which has 32 bits of not-very-good randomness and 16 more bits of obvious patterns (e.g. the 48th bit alternates, the 47th has a period of 4, etc.). Output from C fails at least 5 tests from the TestU01 SmallCrush suite, while our function easily passes. With the ":rand" tag, this function is additionally exported as C. =head2 random_bytes $str = random_bytes(32); # 32 random bytes Given an unsigned number C of bytes, returns a string filled with random data from the CSPRNG. Performance for large quantities: Module/Method Rate Type ------------- --------- ---------------------- Math::Prime::Util::GMP 1067 MB/s CSPRNG - ISAAC ntheory random_bytes 384 MB/s CSPRNG - ChaCha20 Crypt::PRNG 140 MB/s CSPRNG - Fortuna Crypt::OpenSSL::Random 32 MB/s CSPRNG - SHA1 counter Math::Random::ISAAC::XS 15 MB/s CSPRNG - ISAAC ntheory entropy_bytes 13 MB/s CSPRNG - /dev/urandom Crypt::Random 12 MB/s CSPRNG - /dev/urandom Crypt::Urandom 12 MB/s CSPRNG - /dev/urandom Bytes::Random::Secure 6 MB/s CSPRNG - ISAAC ntheory pure perl ISAAC 5 MB/s CSPRNG - ISAAC (no XS) Math::Random::ISAAC::PP 2.5 MB/s CSPRNG - ISAAC (no XS) ntheory pure perl ChaCha 1.0 MB/s CSPRNG - ChaCha20 (no XS) Data::Entropy::Algorithms 0.5 MB/s CSPRNG - AES-CTR Math::Random::MTwist 927 MB/s PRNG - Mersenne Twister Bytes::Random::XS 109 MB/s PRNG - drand48 pack CORE::rand 25 MB/s PRNG - drand48 (no XS) Bytes::Random 2.6 MB/s PRNG - drand48 (no XS) =head2 entropy_bytes Similar to random_bytes, but directly using the entropy source. This is not normally recommended as it can consume shared system resources and is typically slow -- on the computer that produced the L chart above, using C

generated the same 13 MB/s performance as our L function. The actual performance will be highly system dependent. =head2 urandomb $n32 = urandomb(32); # Classic irand32, returns a UV $n = urandomb(1024); # Random integer less than 2^1024 Given a number of bits C, returns a random unsigned integer less than C<2^b>. The result will be uniformly distributed between C<0> and C<2^b-1> inclusive. =head2 urandomm $n = urandomm(100); # random integer in [0,99] $n = urandomm(1024); # random integer in [0,1023] Given a positive integer C, returns a random unsigned integer less than C. The results will be uniformly distributed between C<0> and C inclusive. Care is taken to prevent modulo bias. =head2 csrand Takes a binary string C as input and seeds the internal CSPRNG. This is not normally needed as system entropy is used as a seed on startup. For best security this should be 16-128 bytes of good entropy. No more than 1024 bytes will be used. With no argument, reseeds using system entropy, which is preferred. If the C configuration has been set, then this will croak if given an argument. This allows for control of reseeding with entropy the module gets itself, but not user supplied. =head2 srand Takes a single UV argument and seeds the CSPRNG with it, as well as returning it. If no argument is given, a new UV seed is constructed. Note that this creates a very weak seed from a cryptographic standpoint, so it is useful for testing or simulations but L is recommended, or keep using the system entropy default seed. The API is nearly identical to the system function C. It uses a UV which can be 64-bit rather than always 32-bit. The behaviour for C, empty string, empty list, etc. is slightly different (we treat these as 0). This function is not exported with the ":all" tag, but is with ":rand". If the C configuration has been set, this function will croak. Manual seeding using C is not compatible with cryptographic security. =head2 rand An alias for L, not exported unless the ":rand" tag is used. =head2 random_factored_integer my($n, $factors) = random_factored_integer(1000000); Given a positive non-zero input C, returns a uniform random integer in the range C<1> to C, along with an array reference containing the factors. This uses Kalai's algorithm for generating random integers along with their factorization, and is much faster than the naive method of generating random integers followed by a factorization. A later implementation may use Bach's more efficient algorithm. =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. 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. =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. 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. 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 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. The performance with L installed is hundreds of times faster, so it is highly recommended. 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. If you don't need absolutely proven results, then it is somewhat faster to use L either by itself or with some additional tests, e.g. L and/or L. One could also run L on the result, but this will be slow. =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. =head2 random_shawe_taylor_prime my $bigprime = random_shawe_taylor_prime(8192); Construct an n-bit provable prime, using the Shawe-Taylor algorithm in section C.6 of FIPS 186-4. This uses 512 bits of randomness and SHA-256 as the hash. This is a slightly simpler and older (1986) method than Maurer's 1999 construction. It is a bit faster than Maurer's method, and uses less system entropy for large sizes. The primary reason to use this rather than Maurer's method is to use the FIPS 186-4 algorithm. 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. Also see L and L. 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. =head2 random_shawe_taylor_prime_with_cert my($n, $cert) = random_shawe_taylor_prime_with_cert(4096) 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. =head2 random_semiprime Takes a positive integer number of bits C, returns a random semiprime of exactly C bits. The result has exactly two prime factors (hence semiprime). The factors will be approximately equal size, which is typical for cryptographic use. For example, a 64-bit semiprime of this type is the product of two 32-bit primes. C must be C<4> or greater. Some effort is taken to select uniformly from the universe of C-bit semiprimes. This takes slightly longer than some methods that do not select uniformly. =head2 random_unrestricted_semiprime Takes a positive integer number of bits C, returns a random semiprime of exactly C bits. The result has exactly two prime factors (hence semiprime). The factors are uniformly selected from the universe of all C-bit semiprimes. This means semiprimes with one factor equal to C<2> will be most common, C<3> next most common, etc. C must be C<3> or greater. Some effort is taken to select uniformly from the universe of C-bit semiprimes. This takes slightly longer than some methods that do not select uniformly. =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: verbose verbose level. 1 or more will result in extra output. 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) secure disable ability to manually seed the CSPRNG =head2 prime_set_config prime_set_config( assume_rh => 1 ); Allows setting of some parameters. Currently the only parameters are: verbose The default setting of 0 will generate no extra output. Setting to 1 or higher results in extra output. For example, at setting 1 the AKS algorithm will indicate the chosen r and s values. At setting 2 it will output a sequence of dots indicating progress. Similarly, for random_maurer_prime, setting 3 shows real time progress. Factoring large numbers is another place where verbose settings can give progress indications. 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. secure The CSPRNG may no longer be manually seeded. Once set, this option cannot be disabled. L will croak if called, and L will croak if called with any arguments. L with no arguments is still allowed, as that will use system entropy without giving anything to the caller. The point of this option is to ensure that any called functions do not try to control the RNG. =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 does a little trial division, a check for perfect powers, followed by combinations of Pollard's Rho, SQUFOF, and Pollard's p-1. The combination is applied to each non-prime factor found. 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 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 (see Hardy and Wright section 16.7). This is L. The results is identical to evaluating the array in scalar context, but more efficient. This corresponds to Pari's C and Mathematica's C functions. Also see the L functions for looping over the divisors. =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. Like all the specific-algorithm C<*_factor> routines, this is not exported unless explicitly requested. =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. Overall it has the same advantages and disadvantages as Fermat's method. =head2 lehman_factor my @factors = lehman_factor($n); Produces factors, not necessarily prime, of the positive number input. An optional argument, defaulting to 0 (false), indicates whether to run trial division. Without trial division, is possible the function will be unable to find a factor, in which case a single element, the input, is returned. This is Warren D. Smith's Lehman core with minor modifications. It is limited to 42-bit inputs: C 8796393022208>. =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. =head2 ecm_factor my @factors = ecm_factor($n); my @factors = ecm_factor($n, 100, 400, 10); # B1, B2, # of curves Produces factors, not necessarily prime, of the positive number input. This is the elliptic curve method using two stages. =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 inputs, the result should be accurate to at least 14 digits. For BigInt / BigFloat inputs, full accuracy and performance is obtained only if L is installed. If this module is not available, then other methods are used and give at least 14 digits of accuracy: 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). =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 inputs, full accuracy and performance is obtained only if L is installed. =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 inputs, full accuracy and performance is obtained only if L is installed. If this module is not available, then other methods are used and give at least 14 digits of accuracy: Either Borwein (1991) algorithm 2, or the basic series. Math::BigFloat L can produce incorrect high-accuracy computations when GMP is not used. =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 inputs, full accuracy and performance is obtained only if L is installed. If this module are not available, accuracy should be 35 digits. =head2 LambertW Returns the principal branch of the Lambert W function of a real value. Given a value C this solves for C in the equation C. The input must not be less than C<-1/e>. This corresponds to Pari's C function and Mathematica's C / C function. This function handles all real value inputs with non-complex return values. This is a superset of Pari's C which is similar but only for positive arguments. Mathematica's function is much more detailed, with both branches, complex arguments, and complex results. Calculation will be done with C long doubles if the input is a standard scalar, but if bignum is in use or if the input is a BigFloat type, then extended precision results will be used. Speed of the native code is about half of the fastest native code (Veberic's C++), and about 30x faster than Pari/GP. However the bignum calculation is slower than Pari/GP. =head2 Pi my $tau = 2 * Pi; # $tau = 6.28318530717959 my $tau = 2 * Pi(40); # $tau = 6.283185307179586476925286766559005768394 With no arguments, returns the value of Pi as an NV. With a positive integer argument, returns the value of Pi with the requested number of digits (including the leading 3). The return value will be an NV if the number of digits fits in an NV (typically 15 or less), or a L object otherwise. For sizes over 10k digits, having either L or L installed will help performance. For sizes over 50k the one is highly recommended. =head1 EXAMPLES Print Fibonacci numbers: perl -Mntheory=:all -E 'say lucasu(1,-1,$_) for 0..20' 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); }' Generate Carmichael numbers (L): perl -Mntheory=:all -E 'foroddcomposites { say if is_carmichael($_) } 1e6;' # Less efficient, similar to Mathematica or MAGMA: perl -Mntheory=:all -E 'foroddcomposites { say if $_ % carmichael_lambda($_) == 1 } 1e6;' 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/sum_primes/; say sum_primes(2_000_000); # ... or do it a little more manually ... use Math::Prime::Util qw/forprimes/; my $sum = 0; forprimes { $sum += $_ } 2_000_000; say $sum; # ... or do it using a big list ... use Math::Prime::Util qw/vecsum primes/; say vecsum( @{primes(2_000_000)} ); Project Euler, problem 21 (Amicable numbers): use Math::Prime::Util qw/divisor_sum/; my $sum = 0; foreach my $x (1..10000) { my $y = divisor_sum($x)-$x; $sum += $x + $y if $y > $x && $x == divisor_sum($y)-$y; } say $sum; # Or using a pipeline: use Math::Prime::Util qw/vecsum divisor_sum/; say vecsum( map { divisor_sum($_) } grep { my $y = divisor_sum($_)-$_; $y > $_ && $_==(divisor_sum($y)-$y) } 1 .. 10000 ); 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 ($maxn, $maxratio) = (0,0); foreach my $n (1..1000000) { my $ndivphi = $n / euler_phi($n); ($maxn, $maxratio) = ($n, $ndivphi) if $ndivphi > $maxratio; } say "$maxn $maxratio"; 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, 1 to 2 minutes: use Math::Prime::Util qw/forcomposites factor/; my $nsemis = 0; forcomposites { $nsemis++ if scalar factor($_) == 2; } int(10**8)-1; say $nsemis; Here is one of the best ways for PE187: under 20 milliseconds from the command line. Much faster than Pari, and competitive with Mathematica. use Math::Prime::Util qw/forprimes prime_count/; my $limit = shift || int(10**8); $limit--; my ($sum, $pc) = (0, 1); forprimes { $sum += prime_count(int($limit/$_)) + 1 - $pc++; } int(sqrt($limit)); say $sum; To get the result of L: use Math::Prime::Util qw/divisors/; sub matches { my @d = divisors(shift); return map { [$d[$_],$d[$#d-$_]] } 1..(@d-1)>>1; } my $n = 139650; say "$n = ", join(" = ", map { "$_->[0]·$_->[1]" } matches($n)); or its C function with the C option: sub matches { my @d = divisors(shift); return map { [$d[$_],$d[$#d-$_]] } grep { my $div=$d[$_]; !scalar(grep {!($div % $d[$_])} 1..$_-1) } 1..(@d-1)>>1; } } Compute L just like CRG4s 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); } } Find the 7-digit palindromic primes in the first 20k digits of Pi: use Math::Prime::Util qw/Pi is_prime/; my $pi = "".Pi(20000); # make sure we only stringify once for my $pos (2 .. length($pi)-7) { my $s = substr($pi, $pos, 7); say "$s at $pos" if $s eq reverse($s) && is_prime($s); } # Or we could use the regex engine to find the palindromes: while ($pi =~ /(([1379])(\d)(\d)\d\4\3\2)/g) { say "$1 at ",pos($pi)-7 if is_prime($1) } The L B_n: sub B { my $n = shift; vecsum(map { stirling($n,$_,2) } 0..$n) } say "$_ ",B($_) for 1..50; Recognizing tetrahedral numbers (L): sub is_tetrahedral { my $n6 = vecprod(6,shift); my $k = rootint($n6,3); vecprod($k,$k+1,$k+2) == $n6; } Recognizing powerful numbers (e.g. C from Pari/GP): sub ispowerful { 0 + vecall { $_->[1] > 1 } factor_exp(shift); } Convert from binary to hex (3000x faster than Math::BaseConvert): my $hex_string = todigitstring(fromdigits($bin_string,2),16); Calculate and print derangements using permutations: my @data = qw/a b c d/; forperm { say "@data[@_]" unless vecany { $_[$_]==$_ } 0..$#_ } @data; # Using forderange directly is faster Compute the subfactorial of n (L): sub subfactorial { my $n = shift; vecsum(map{ vecprod((-1)**($n-$_),binomial($n,$_),factorial($_)) }0..$n); } Compute subfactorial (number of derangements) using simple recursion: sub subfactorial { my $n = shift; use bigint; ($n < 1) ? 1 : $n * subfactorial($n-1) + (-1)**$n; } =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 (not recent Pari/GP) 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. For example, it will indicate 9 is prime about 1 out of every 276k calls. =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. Because the loop functions like L use C, there is some odd behavior with anonymous sub creation inside the block. This is shared with most XS modules that use C, and is rarely seen because it is such an unusual use. An example is: forprimes { my $var = "p is $_"; push @subs, sub {say $var}; } 50; $_->() for @subs; This can be worked around by using double braces for the function, e.g. C. =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.0001 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, strong, and S-T) in addition to Maurer's algorithm. MPU does not have the critical bug L. MPU has 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 makes the speed vastly faster. Crypt::Primes is hardcoded to use L which uses /dev/random (blocking source), while MPU uses its own ChaCha20 implementation seeded from /dev/urandom or Win32. 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. Its functions do not support bigints. Both are implemented with trial division, meaning they are very fast for really small values, but become very slow as the input gets larger (factoring 19 digit semiprimes is over 1000 times slower). The function C can be done in MPU using C. See the L section for a 2-line function replicating C. 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 is very interesting and includes a built-in primes iterator as well as a C filter for arbitrary sequences. Unfortunately both are very slow. 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 2-4x 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 is similar to MPU's L, and in fact they use the same algorithm. The former module uses caching of moduli to speed up further operations. MPU does not do this. This would only be important for cases where the lcm is larger than a native int (noting that use in cryptography would always have large moduli). For combinations and permutations there are many alternatives. One difference with nearly all of them is that MPU's L and L functions don't operate directly on a user array but on generic indices. L and L have more features, but will be slower. L does permutations with an iterator. L and L are very similar but can be 2-10x faster than MPU (they use the same user-block structure but twiddle the user array each call). There are numerous modules to perform a set product (also called Cartesian product or cross product). These include L, L, L, and L, as well as a few others. The L module provides random access, albeit rather slowly. Our L matches L in both high performance and functionality (that module's single function L is essentially identical to ours). 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 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 much greater chance of false positives compared to the BPSW test -- some composites such as C<9>, C<88831>, C<38503>, etc. (L) have a surprisingly high chance of being indicated prime. Using C will perform an 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 an extra M-R test using a random base, 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. With bigint arguments, MPU is slightly faster than Math::Pari if the GMP backend is available, but very slow without. =item C, C, C, C, C, C Similar to MPU's L, 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, sometimes it hangs). MPU's L will always return the smallest root if it exists, and C otherwise. Similarly, MPU's L will return the smallest C and work with non-primitive-root C, which is similar to Pari/GP 2.6, but not the older versions in L. The performance of L is quite good compared to older Pari/GP, but much worse than 2.6's new methods. =item C Similar to MPU's L. MPU is ~10x faster when the result fits in a native integer. Once things overflow it is fairly similar in performance. However, using L can slow things down quite a bit, so for best performance in these cases using a L object is best. =item C, C Similar to MPU's L and L. These functions were introduced in Pari 2.3 and 2.6, hence are not in Math::Pari. C produce identical results to C, but Pari is I faster. L is very similar to Pari's function, but produces a different ordering (MPU is the standard anti-lexicographical, Pari uses a size sort). Currently Pari is somewhat faster due to Perl function call overhead. When using restrictions, Pari has much better optimizations. =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 Pari library used is about 10 years old now). For native integers, typically Math::Pari will be slower than MPU. For bigints, Math::Pari may be 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, MPU is the fastest solution I am aware of (it is faster than Pari 2.7, PFGW, and FLINT). For very 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 it is commonly used for fast filtering of 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 David Cleaver's 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.001 Math::Prime::Util 0.37 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.0s Math::Prime::Util (sieve lookup if prime_precalc used) 2.5s Math::Prime::FastSieve (sieve lookup) 3.3s Math::Prime::Util (trial + deterministic M-R) 10.4s Math::Prime::XS (trial) 19.1s Math::Pari w/2.3.5 (BPSW) 52.4s Math::Pari (10 random M-R) 480s Math::Primality (deterministic M-R) =item Large native inputs: is_prime from 10^16 to 10^16 + 20M 4.5s Math::Prime::Util (BPSW) 24.9s Math::Pari w/2.3.5 (BPSW) 117.0s Math::Pari (10 random M-R) 682s 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.2s Math::Prime::Util (BPSW + 1 random M-R) 2.7s Math::Pari w/2.3.5 (BPSW) 13.0s Math::Primality (BPSW) 35.2s Math::Pari (10 random M-R) 38.6s Math::Prime::Util w/o GMP (BPSW) 70.7s Math::Prime::Util (n-1 or ECPP proof) 102.9s 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 built with 2.3.5 not only has a better primality test versus the default 2.1.7, but runs faster. It still has quite a bit of overhead with native size integers. Pari/GP 2.5.0 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 may be 3000x faster). 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 included 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 early 2015 Macbook Pro (2.7 GHz i5) with L and L installed. bits random +testing Maurer Shw-Tylr CPMaurer ----- -------- -------- -------- -------- -------- 64 0.00002 +0.000009 0.00004 0.00004 0.019 128 0.00008 +0.00014 0.00018 0.00012 0.051 256 0.0004 +0.0003 0.00085 0.00058 0.13 512 0.0023 +0.0007 0.0048 0.0030 0.40 1024 0.019 +0.0033 0.034 0.025 1.78 2048 0.26 +0.014 0.41 0.25 8.02 4096 2.82 +0.11 4.4 3.0 66.7 8192 23.7 +0.65 50.8 38.7 929.4 random = random_nbit_prime (results pass BPSW) random+ = additional time for 3 M-R and a Frobenius test maurer = random_maurer_prime Shw-Tylr = random_shawe_taylor_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. With GMP installed this always uses Maurer's algorithm as it is the best compromise between speed and diversity. 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 similarly constructs a provable prime. It uses a simpler construction method. It is slightly faster than Maurer's algorithm but provides less diversity (even fewer primes in the range are selected, though for typical cryptographic sizes this is not important). The Perl implementation uses a single large random seed followed by SHA-256 as specified by FIPS 186-4. The GMP implementation uses the same FIPS 186-4 algorithm but uses its own CSPRNG which may not be SHA-256. L times are included for comparison. It is reasonably fast for small sizes but gets slow as the size increases. It is 10 to 500 times slower than this module's GMP methods. It does not perform any primality checks on the intermediate results or the final result (I highly recommended running 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). =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. 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 * Christian Axler, "New bounds for the prime counting function π(x)", September 2014. For large values, improved limits versus Dusart 2010. L =item * Christian Axler, "Über die Primzahl-Zählfunktion, die n-te Primzahl und verallgemeinerte Ramanujan-Primzahlen", January 2013. Prime count and nth-prime bounds in more detail. Thesis in German, but first part is easily read. 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 * 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 =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 and Henry C. Thacher, Jr., "Chebyshev approximations for the exponential integral Ei(x)", I, v23, pp 289-303, 1969. L =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 * 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 * 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 * 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 interested in prime number bounds. L =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-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 * 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 * 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 * Gabriel Mincu, "An Asymptotic Expansion", I, v4, n2, 2003. A very readable account of Cipolla's 1902 nth prime approximation. L =item * 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 * Hans Riesel, "Prime Numbers and Computer Methods for Factorization", Birkh?user, 2nd edition, 1994. Lots of information, some code, easy to follow. =item * David M. Smith, "Multiple-Precision Exponential Integral and Related Functions", I, v37, n4, 2011. 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 =back =head1 COPYRIGHT Copyright 2011-2018 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.73/ramanujan_primes.h0000644000076400007640000000120413204400603016412 0ustar danadana#ifndef MPU_RAMANUJAN_PRIMES_H #define MPU_RAMANUJAN_PRIMES_H #include "ptypes.h" extern UV* n_ramanujan_primes(UV n); extern UV* n_range_ramanujan_primes(UV nlo, UV nhi); extern UV* ramanujan_primes(UV* first, UV* last, UV low, UV high); extern int is_ramanujan_prime(UV n); extern UV ramanujan_prime_count(UV lo, UV hi); extern UV ramanujan_prime_count_upper(UV n); extern UV ramanujan_prime_count_lower(UV n); extern UV ramanujan_prime_count_approx(UV n); extern UV nth_ramanujan_prime(UV n); extern UV nth_ramanujan_prime_upper(UV n); extern UV nth_ramanujan_prime_lower(UV n); extern UV nth_ramanujan_prime_approx(UV n); #endif Math-Prime-Util-0.73/keyval.h0000644000076400007640000001277713373332062014405 0ustar danadana#ifndef MPU_KEYVAL_H #define MPU_KEYVAL_H #include "ptypes.h" typedef struct { UV key; UV val; } keyval_t; typedef struct { keyval_t *keyval; UV mask; long maxsize; long size; } set_t; #if BITS_PER_WORD == 32 static UV _hash(UV x) { x = ((x >> 16) ^ x) * 0x45d9f3b; x = ((x >> 16) ^ x) * 0x45d9f3b; x = (x >> 16) ^ x; return x; } #else static UV _hash(UV x) { x = (x ^ (x >> 30)) * UVCONST(0xbf58476d1ce4e5b9); x = (x ^ (x >> 27)) * UVCONST(0x94d049bb133111eb); x = x ^ (x >> 31); return x; } #endif /******************************************************************************/ static void init_set(set_t *S, UV isize) { int bits = 0; while (isize > 0) { bits++; isize >>= 1; } S->size = 0; S->maxsize = UVCONST(1) << ((bits < 3) ? 3 : bits); S->mask = S->maxsize - 1; Newz(0,S->keyval,S->maxsize,keyval_t); } static void free_set(set_t *S) { S->size = S->maxsize = 0; Safefree(S->keyval); } static void _set_expand(set_t *S) { long i, max = S->maxsize, newmax = max*2, newsize = 0, newmask = newmax-1; keyval_t *nkv; Newz(0, nkv, newmax, keyval_t); for (i = 0; i < max; i++) { UV key = S->keyval[i].key; if (key != 0) { UV h = _hash(key) & newmask; while (nkv[h].key > 0 && nkv[h].key != key) h = (h+1) & newmask; nkv[h] = S->keyval[i]; newsize++; } } Safefree(S->keyval); S->keyval = nkv; S->maxsize = newmax; S->mask = newmax-1; MPUassert(newsize == S->size, "keyval set size mismatch"); } static long set_search(set_t S, UV key) { long h = _hash(key) & S.mask; while (S.keyval[h].key > 0 && S.keyval[h].key != key) h = (h+1) & S.mask; /* Linear probe */ return (S.keyval[h].key == key) ? h : -1; } static UV set_getval(set_t S, UV key) { long i = set_search(S, key); return (i == -1) ? 0 : S.keyval[i].val; } static void set_addsum(set_t *S, keyval_t kv) { UV h = _hash(kv.key) & S->mask; while (S->keyval[h].key > 0 && S->keyval[h].key != kv.key) h = (h+1) & S->mask; if (S->keyval[h].key == kv.key) { /* if (kv.val > UV_MAX - S->keyval[h].val) croak("add overflow\n"); */ S->keyval[h].val += kv.val; } else { S->keyval[h] = kv; if (S->size++ > 0.65 * S->maxsize) _set_expand(S); } } static void set_merge(set_t *S, set_t T) { long j; for (j = 0; j < T.maxsize; j++) if (T.keyval[j].key > 0) set_addsum(S, T.keyval[j]); } /******************************************************************************/ typedef struct { UV key; UV *vals; long size; long maxsize; } keylist_t; typedef struct { keylist_t *keylist; UV mask; long maxsize; long size; } set_list_t; static void init_setlist(set_list_t *L, UV isize) { int bits = 0; while (isize > 0) { bits++; isize >>= 1; } L->size = 0; L->maxsize = UVCONST(1) << ((bits < 3) ? 3 : bits); L->mask = L->maxsize - 1; Newz(0, L->keylist, L->maxsize, keylist_t); } static void free_setlist(set_list_t *L) { long i; L->size = L->maxsize = 0; for (i = 0; i < L->maxsize; i++) if (L->keylist[i].size > 0) Safefree(L->keylist[i].vals); Safefree(L->keylist); } static void _setlist_expand(set_list_t *L) { long i, max = L->maxsize, newmax = max*2, newsize = 0, newmask = newmax-1; keylist_t *nlist; Newz(0, nlist, newmax, keylist_t); for (i = 0; i < max; i++) { UV key = L->keylist[i].key; if (key != 0) { UV h = _hash(key) & newmask; while (nlist[h].key > 0 && nlist[h].key != key) h = (h+1) & newmask; nlist[h] = L->keylist[i]; newsize++; } } Safefree(L->keylist); L->keylist = nlist; L->maxsize = newmax; L->mask = newmax-1; MPUassert(newsize == L->size, "setlist size mismatch"); } static long setlist_search(set_list_t L, UV key) { long h = _hash(key) & L.mask; while (L.keylist[h].key > 0 && L.keylist[h].key != key) h = (h+1) & L.mask; /* Linear probe */ return (L.keylist[h].key == key) ? h : -1; } static void setlist_addlist(set_list_t *L, UV key, long nvals, UV* list, UV mult) { UV *vptr; long j, h = _hash(key) & L->mask; while (L->keylist[h].key > 0 && L->keylist[h].key != key) h = (h+1) & L->mask; if (L->keylist[h].key == key) { long size = L->keylist[h].size; long maxsize = L->keylist[h].maxsize; if (size + nvals > maxsize) { maxsize = 2 * (size+nvals); Renew(L->keylist[h].vals, maxsize, UV); L->keylist[h].maxsize = maxsize; } vptr = L->keylist[h].vals + size; for (j = 0; j < nvals; j++) vptr[j] = list[j] * mult; L->keylist[h].size = size + nvals; } else { long maxsize = (nvals < 5) ? 12 : (nvals+1) * 2; New(0, L->keylist[h].vals, maxsize, UV); L->keylist[h].maxsize = maxsize; vptr = L->keylist[h].vals; for (j = 0; j < nvals; j++) vptr[j] = list[j] * mult; L->keylist[h].size = nvals; L->keylist[h].key = key; if (L->size++ > 0.65 * L->maxsize) _setlist_expand(L); } } static void setlist_addval(set_list_t *L, UV key, UV val) { setlist_addlist(L, key, 1, &val, 1); } static UV* setlist_getlist(UV *nvals, set_list_t L, UV key) { long i = setlist_search(L, key); if (i == -1) { *nvals = 0; return 0; } *nvals = L.keylist[i].size; return L.keylist[i].vals; } static void setlist_merge(set_list_t *L, set_list_t T) { long j; for (j = 0; j < T.maxsize; j++) { if (T.keylist[j].key > 0) { UV key = T.keylist[j].key; UV nvals = T.keylist[j].size; UV *vals = T.keylist[j].vals; setlist_addlist(L, key, nvals, vals, 1); } } } #endif Math-Prime-Util-0.73/META.yml0000664000076400007640000000335613373340013014200 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 7.34, CPAN::Meta::Converter version 2.150010' 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 provides: Math::Prime::Util: file: lib/Math/Prime/Util.pm version: '0.73' Math::Prime::Util::ChaCha: file: lib/Math/Prime/Util/ChaCha.pm version: '0.73' Math::Prime::Util::Entropy: file: lib/Math/Prime/Util/Entropy.pm version: '0.73' Math::Prime::Util::MemFree: file: lib/Math/Prime/Util/MemFree.pm version: '0.73' Math::Prime::Util::PP: file: lib/Math/Prime/Util/PP.pm version: '0.73' Math::Prime::Util::PrimeArray: file: lib/Math/Prime/Util/PrimeArray.pm version: '0.73' Math::Prime::Util::PrimeIterator: file: lib/Math/Prime/Util/PrimeIterator.pm version: '0.73' ntheory: file: lib/ntheory.pm version: '0.73' recommends: Digest::SHA: '5.87' Math::BigInt::GMP: '0' Math::Prime::Util::GMP: '0.51' requires: Carp: '0' Config: '0' Exporter: '5.57' Math::BigFloat: '1.59' Math::BigInt: '1.88' Math::Prime::Util::GMP: '0.50' 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.73' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Math-Prime-Util-0.73/semi_primes.c0000644000076400007640000003156513373330217015415 0ustar danadana#include #include #include #include "ptypes.h" #include "constants.h" #define FUNC_isqrt 1 #define FUNC_icbrt 1 #define FUNC_ctz 1 #include "util.h" #include "cache.h" #include "sieve.h" #include "lmo.h" #include "semi_primes.h" #define SP_SIEVE_THRESH 100 /* When to sieve vs. iterate */ /******************************************************************************/ /* SEMI PRIMES */ /******************************************************************************/ static const unsigned char _semiprimelist[] = {0,4,6,9,10,14,15,21,22,25,26,33,34,35,38,39,46,49,51,55,57,58,62,65,69,74, 77,82,85,86,87,91,93,94,95,106,111,115,118,119,121,122,123,129,133,134,141, 142,143,145,146,155,158,159,161,166,169,177,178,183,185,187,194,201,202, 203,205,206,209,213,214,215,217,218,219,221,226,235,237,247,249,253,254}; #define NSEMIPRIMELIST (sizeof(_semiprimelist)/sizeof(_semiprimelist[0])) static UV _bs_count(UV n, UV const* const primes, UV lastidx) { UV i = 0, j = lastidx; /* primes may not start at 0 */ MPUassert(n >= primes[0] && n < primes[lastidx], "prime count via binary search out of range"); while (i < j) { UV mid = i + (j-i)/2; if (primes[mid] <= n) i = mid+1; else j = mid; } return i-1; } static UV _semiprime_count(UV n) { UV pc = 0, sum = 0, sqrtn = prev_prime(isqrt(n)+1); UV xbeg = 0, xend = 0, xlim = 0, xoff = 0, xsize, *xarr = 0; UV const xmax = 200000000UL; if (n > 1000000) { /* Upfront work to speed up the many small calls */ UV nprecalc = (UV) pow(n, .75); if (nprecalc > _MPU_LMO_CROSSOVER) nprecalc = _MPU_LMO_CROSSOVER; prime_precalc(nprecalc); /* Make small calls even faster using binary search on a list */ xlim = (UV) pow(n, 0.70); } if (sqrtn >= 2) sum += LMO_prime_count(n/2) - pc++; if (sqrtn >= 3) sum += LMO_prime_count(n/3) - pc++; if (sqrtn >= 5) sum += LMO_prime_count(n/5) - pc++; if (sqrtn >= 7) { unsigned char* segment; UV seg_base, seg_low, seg_high, np, cnt; void* ctx = start_segment_primes(7, sqrtn, &segment); while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_base, seg_low, seg_high ) np = n/p; if (np < xlim) { if (xarr == 0 || np < xbeg) { if (xarr != 0) { Safefree(xarr); xarr = 0; } xend = np; xbeg = n/sqrtn; if (xend - xbeg > xmax) xbeg = xend - xmax; xbeg = prev_prime(xbeg); xend = next_prime(xend); xoff = LMO_prime_count(xbeg); xarr = array_of_primes_in_range(&xsize, xbeg, xend); xend = xarr[xsize-1]; } cnt = xoff + _bs_count(np, xarr, xsize-1); } else { cnt = LMO_prime_count(np); } sum += cnt - pc++; END_DO_FOR_EACH_SIEVE_PRIME } if (xarr != 0) { Safefree(xarr); xarr = 0; } end_segment_primes(ctx); } return sum; } /* TODO: This overflows, see p=3037000507,lo=10739422018595509581. * p2 = 9223372079518257049 => 9223372079518257049 + 9223372079518257049 * Also with lo=18446744073709551215,hi=18446744073709551515. */ #define PGTLO(ip,p,lo) ((ip)>=(lo)) ? (ip) : ((p)*((lo)/(p)) + (((lo)%(p))?(p):0)) #define MARKSEMI(p,arr,lo,hi) \ do { UV i, p2=(p)*(p); \ for (i = PGTLO(p2, p, lo); i >= lo && i <= hi; i += p) arr[i-lo]++; \ for (i = PGTLO(2*p2, p2, lo); i >= lo && i <= hi; i += p2) arr[i-lo]++; \ } while (0); UV range_semiprime_sieve(UV** semis, UV lo, UV hi) { UV *S, i, count = 0; if (lo < 4) lo = 4; if (hi > MPU_MAX_SEMI_PRIME) hi = MPU_MAX_SEMI_PRIME; if (hi <= _semiprimelist[NSEMIPRIMELIST-1]) { if (semis == 0) { for (i = 1; i < NSEMIPRIMELIST && _semiprimelist[i] <= hi; i++) if (_semiprimelist[i] >= lo) count++; } else { Newz(0, S, NSEMIPRIMELIST+1, UV); for (i = 1; i < NSEMIPRIMELIST && _semiprimelist[i] <= hi; i++) if (_semiprimelist[i] >= lo) S[count++] = _semiprimelist[i]; *semis = S; } } else { unsigned char* nfacs; UV cutn, sqrtn = isqrt(hi); Newz(0, nfacs, hi-lo+1, unsigned char); if (sqrtn*sqrtn < hi && sqrtn < (UVCONST(1)<<(BITS_PER_WORD/2))-1) sqrtn++; cutn = (sqrtn > 30000) ? 30000 : sqrtn; START_DO_FOR_EACH_PRIME(2, cutn) { MARKSEMI(p,nfacs,lo,hi); } END_DO_FOR_EACH_PRIME if (cutn < sqrtn) { unsigned char* segment; UV seg_base, seg_low, seg_high; void* ctx = start_segment_primes(cutn, sqrtn, &segment); while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_base, seg_low, seg_high ) MARKSEMI(p,nfacs,lo,hi); END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } if (semis == 0) { for (i = lo; i <= hi; i++) if (nfacs[i-lo] == 1) count++; } else { UV cn = 50 + 1.01 * (semiprime_count_approx(hi) - semiprime_count_approx(lo)); New(0, S, cn, UV); for (i = lo; i <= hi; i++) { if (nfacs[i-lo] == 1) { if (count >= cn) Renew(S, cn += 4000, UV); S[count++] = i; } } *semis = S; } Safefree(nfacs); } return count; } static UV _range_semiprime_count_iterate(UV lo, UV hi) { UV sum = 0; for (; lo < hi; lo++) /* TODO: We should walk composites */ if (is_semiprime(lo)) sum++; if (is_semiprime(hi)) sum++; return sum; } #if 0 static UV _range_semiprime_selection(UV** semis, UV lo, UV hi) { UV *S = 0, *pr, cn = 0, count = 0; UV i, xsize, lim = hi/2 + 1000, sqrtn = isqrt(hi); if (lo < 4) lo = 4; if (hi > MPU_MAX_SEMI_PRIME) hi = MPU_MAX_SEMI_PRIME; if (semis != 0) { cn = 50 + 1.01 * (semiprime_count_approx(hi) - semiprime_count_approx(lo)); New(0, S, cn, UV); } pr = array_of_primes_in_range(&xsize, 0, lim); for (i = 0; pr[i] <= sqrtn; i++) { UV const pi = pr[i], jlo = (lo+pi-1)/pi, jhi = hi/pi; UV skip, j = i; if (pr[j] < jlo) for (skip = 2048; skip > 0; skip >>= 1) while (j+skip-1 < xsize && pr[j+skip-1] < jlo) j += skip; if (semis == 0) { while (pr[j++] <= jhi) count++; } else { for (; pr[j] <= jhi; j++) { if (count >= cn) Renew(S, cn += 4000, UV); S[count++] = pi * pr[j]; } } } Safefree(pr); if (semis != 0) { qsort(S, count, sizeof(UV), _numcmp); *semis = S; } return count; } #endif UV semiprime_count(UV lo, UV hi) { if (lo > hi || hi < 4) return 0; /* tiny sizes fastest with the sieving code */ if (hi <= 400) return range_semiprime_sieve(0, lo, hi); /* Large sizes best with the prime count method */ if (lo <= 4) return _semiprime_count(hi); /* Now it gets interesting. lo > 4, hi > 400. */ if ((hi-lo+1) < hi / (isqrt(hi)*200)) { MPUverbose(2, "semiprimes %"UVuf"-%"UVuf" via iteration\n", lo, hi); return _range_semiprime_count_iterate(lo,hi); } /* TODO: Determine when _range_semiprime_selection(0,lo,hi) is better */ if ((hi-lo+1) < hi / (isqrt(hi)/4)) { MPUverbose(2, "semiprimes %"UVuf"-%"UVuf" via sieving\n", lo, hi); return range_semiprime_sieve(0, lo, hi); } MPUverbose(2, "semiprimes %"UVuf"-%"UVuf" via prime count\n", lo, hi); return _semiprime_count(hi) - _semiprime_count(lo-1); } UV semiprime_count_approx(UV n) { if (n <= _semiprimelist[NSEMIPRIMELIST-1]) { UV i = 0; while (i < NSEMIPRIMELIST-1 && n >= _semiprimelist[i+1]) i++; return i; } else { UV lo, hi; double init, logn = log(n), loglogn = log(logn); /* init = n * loglogn / logn; */ /* init = (n/logn) * (0.11147910114 + 0.00223801350*logn + 0.44233207922*loglogn + 1.65236647896*log(loglogn)); */ init = n * (loglogn + 0.302) / logn; if (1.05*init >= (double)UV_MAX) return init; lo = 0.90 * init - 5, hi = 1.05 * init; while (lo < hi) { UV mid = lo + (hi-lo)/2; if (nth_semiprime_approx(mid) < n) lo = mid+1; else hi = mid; } return lo; } } UV nth_semiprime_approx(UV n) { double logn,log2n,log3n,log4n, err_lo, err_md, err_hi, err_factor, est; if (n < NSEMIPRIMELIST) return _semiprimelist[n]; /* Piecewise with blending. Hacky and maybe overkill, but it makes * a big performance difference, especially at the high end. * Interp Range Crossover to next * lo 2^8 - 2^28 2^26 - 2^27 * md 2^25 - 2^48 2^46 - 2^47 * hi 2^45 - 2^64 */ logn = log(n); log2n = log(logn); log3n = log(log2n); log4n=log(log3n); err_lo = 1.000 - 0.00018216088*logn + 0.18099609886*log2n - 0.51962474356*log3n - 0.01136143381*log4n; err_md = 0.968 - 0.00073297945*logn + 0.09731690314*log2n - 0.25212500749*log3n - 0.01366795346*log4n; err_hi = 0.968 - 0.00008034109*logn + 0.01522628393*log2n - 0.04020257367*log3n - 0.01266447175*log4n; if (n <= (1UL<<26)) { err_factor = err_lo; } else if (n < (1UL<<27)) { /* Linear interpolate the two in the blend area */ double x = (n - 67108864.0L) / 67108864.0L; err_factor = ((1.0L-x) * err_lo) + (x * err_md); } else if (logn <= 31.88477030575) { err_factor = err_md; } else if (logn < 32.57791748632) { double x = (n - 70368744177664.0L) / 70368744177664.0L; err_factor = ((1.0L-x) * err_md) + (x * err_hi); } else { err_factor = err_hi; } est = 0.5 + err_factor * n * logn / log2n; if (est >= UV_MAX) return 0; return (UV)est; } static UV _next_semiprime(UV n) { while (!is_semiprime(++n)) ; return n; } static UV _prev_semiprime(UV n) { while (!is_semiprime(--n)) ; return n; } UV nth_semiprime(UV n) { UV guess, spcnt, sptol, gn, ming = 0, maxg = UV_MAX; if (n < NSEMIPRIMELIST) return _semiprimelist[n]; guess = nth_semiprime_approx(n); /* Initial guess */ sptol = 16*icbrt(n); /* Guess until within this many SPs */ MPUverbose(2, " using exact counts until within %"UVuf"\n",sptol); /* Make successive interpolations until small enough difference */ for (gn = 2; gn < 20; gn++) { IV adjust; while (!is_semiprime(guess)) guess++; /* Guess is a semiprime */ MPUverbose(2, " %"UVuf"-th semiprime is around %"UVuf" ... ", n, guess); /* Compute exact count at our nth-semiprime guess */ spcnt = _semiprime_count(guess); MPUverbose(2, "(%"IVdf")\n", (IV)(n-spcnt)); /* Stop guessing if within our tolerance */ if (n==spcnt || (n>spcnt && n-spcnt < sptol) || (n ming) ming = guess; /* Previous guesses */ if (spcnt >= n && guess < maxg) maxg = guess; guess += adjust; if (guess <= ming || guess >= maxg) MPUverbose(2, " fix min/max for %"UVuf"\n",n); if (guess <= ming) guess = ming + sptol - 1; if (guess >= maxg) guess = maxg - sptol + 1; } /* If we have far enough to go, sieve for semiprimes */ if (n > spcnt && (n-spcnt) > SP_SIEVE_THRESH) { /* sieve forwards */ UV *S, count, i, range; while (n > spcnt) { range = nth_semiprime_approx(n) - nth_semiprime_approx(spcnt); range = 1.10 * range + 100; if (range > guess) range = guess; /* just in case */ if (range > 125000000) range = 125000000; /* Not too many at a time */ /* Get a bunch of semiprimes */ MPUverbose(2, " sieving forward %"UVuf"\n", range); count = range_semiprime_sieve(&S, guess+1, guess+range); if (spcnt+count <= n) { guess = S[count-1]; spcnt += count; } else { /* Walk forwards */ for (i = 0; i < count && spcnt < n; i++) { guess = S[i]; spcnt++; } } Safefree(S); } } else if (n < spcnt && (spcnt-n) > SP_SIEVE_THRESH) { /* sieve backwards */ UV *S, count, range; while (n < spcnt) { range = nth_semiprime_approx(spcnt) - nth_semiprime_approx(n); range = 1.10 * range + 100; if (range > guess) range = guess; /* just in case */ if (range > 125000000) range = 125000000; /* Not too many at a time */ /* Get a bunch of semiprimes */ MPUverbose(2, " sieving backward %"UVuf"\n", range); count = range_semiprime_sieve(&S, guess-range, guess-1); if (spcnt-count >= n) { guess = S[0]; spcnt -= count; } else { /* Walk backwards */ while (count > 0 && n < spcnt) { guess = S[--count]; spcnt--; } } Safefree(S); } } /* Finally, iterate over semiprimes until we hit the exact spot */ for (; spcnt > n; spcnt--) guess = _prev_semiprime(guess); for (; spcnt < n; spcnt++) guess = _next_semiprime(guess); return guess; } Math-Prime-Util-0.73/bench/0000755000076400007640000000000013373340013013775 5ustar danadanaMath-Prime-Util-0.73/bench/bench-miller-rabin.pl0000755000076400007640000000355112776251142020005 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::BigInt try=>"GMP,Pari"; #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.73/bench/factor-gnufactor.pl0000755000076400007640000001433313204400603017600 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/factor srand urandomm/; 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; my $semiprimes = 0; # 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; }; } { # 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; if ($semiprimes) { # This is a lousy way to do it. We should generate a half-size prime, then # generate a prime whose product with the first falls in range. Or even # just two half-size until the product is in range. for (1.. $howmany) { my $c; while (1) { $c = $base + urandomm($max-$base); my @f = factor($c); next if scalar(@f) != 2; last if $digits < 8; last if $digits < 12 && $f[0] > 1000; last if $digits < 16 && $f[0] > 100000; last if $f[0] > 10000000; } push @nums, $c; } } else { @nums = map { $base + urandomm($max-$base) } (1 .. $howmany); } #for (@nums) { print "$_ [",join(" ",factor($_)),"] " } 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.73/bench/bench-mp-psrp.pl0000755000076400007640000000201212776251142017015 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util; use Math::Prime::Util::GMP; use Math::Prime::Util::PP; 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::is_strong_pseudoprime($_,3) for @nums;}, 'MPU GMP' =>sub {Math::Prime::Util::GMP::is_strong_pseudoprime($_,3) for @nums;}, }); } Math-Prime-Util-0.73/bench/bench-mp-nextprime.pl0000755000076400007640000000213113204400603020027 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::srand(29); 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.73/bench/bench-factor-extra.pl0000755000076400007640000000760213204400603020011 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/-nobigint urandomm srand/; 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. 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 + urandomm($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 + urandomm($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.73/bench/bench-mp-prime_count.pl0000755000076400007640000000174213204400603020347 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util; use Math::Prime::Util::GMP; use Math::Prime::Util::PP; 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::_segment_pi($n); }, #'MPU XS Lehmer'=>sub { die unless $exp == Math::Prime::Util::_lehmer_pi($n); }, 'MPU XS LMO' =>sub { die unless $exp == Math::Prime::Util::_LMO_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.73/bench/bench-random-bytes.pl0000644000076400007640000001141213204400603020005 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util; use Math::Prime::Util::GMP; use Math::Prime::Util::ChaCha; use Math::Prime::Util::ISAAC; use Bytes::Random::XS; # XS version calling Drand01() use Bytes::Random; # Just a loop around CORE::rand! use Bytes::Random::Secure; use Math::Random::MTwist; use Crypt::PRNG; #use Crypt::Random; #use Data::Entropy::Algorithms; use Crypt::OpenSSL::Random; # note rand_bytes == rand_pseudo_bytes use Rand::Urandom; use Benchmark qw/:all/; Math::Prime::Util::ISAAC::srand; Math::Prime::Util::ChaCha::srand; use Math::Random::ISAAC::PP; my $mripp=Math::Random::ISAAC::PP->new(); use Math::Random::ISAAC::XS; my $mrixs=Math::Random::ISAAC::XS->new(); # On a Macbook early 2015, the fastest XS methods can pump out over 1 GB/s. # In theory we could see 4+ GB/s from a module. my $trial = shift || -1; if (0) { print "# 8 random bytes\n"; cmpthese($trial,{ "MPU" => sub { Math::Prime::Util::random_bytes(8); }, "MPU::GMP" => sub { Math::Prime::Util::GMP::random_bytes(8); }, "BRXS" => sub { Bytes::Random::XS::random_bytes(8); }, "BR" => sub { Bytes::Random::random_bytes(8); }, "BRS" => sub { Bytes::Random::Secure::random_bytes(8); }, "MRMT" => sub { Math::Random::MTwist::_randstr(8); }, # "DEA" => sub { Data::Entropy::Algorithms::rand_bits(8*8); }, "Crypt::PRNG" => sub { Crypt::PRNG::random_bytes(8); }, "rand" => sub { pack('C*', map { int(rand 256) } 1..8); }, # "Crypt::Random" => sub { Crypt::Random::makerandom_octet(Length=>8,Strength=>0); }, }); } if (0) { print "# 256 random bytes\n"; cmpthese($trial,{ "MPU" => sub { Math::Prime::Util::random_bytes(256); }, "MPU X" => sub { Math::Prime::Util::GMP::random_bytes(256); }, "BRXS" => sub { Bytes::Random::XS::random_bytes(256); }, "PP MPU ISAAC" => sub { Math::Prime::Util::ISAAC::random_bytes(256); }, "PP MPU ChaCha" => sub { Math::Prime::Util::ChaCha::random_bytes(256); }, "PP MR ISAAC" => sub { pack("L*",map{$mripp->irand}1..64); }, "XS MR ISAAC" => sub { pack("L*",map{$mrixs->irand}1..64); }, "XS MR ISAAC2" => sub { my$s='';$s.=pack("L",$mrixs->irand)for 1..64;$s; }, "CryptX" => sub { Crypt::PRNG::random_bytes(256); }, "BRS" => sub { Bytes::Random::Secure::random_bytes(256); }, "MRMTwist" => sub { Math::Random::MTwist::_randstr(256); }, "rand" => sub { pack('L*', map { int(rand 4294967296) } 1..64); }, "DEA" => sub { Data::Entropy::Algorithms::rand_bits(8*256); }, "Crypt::Random" => sub { Crypt::Random::makerandom_octet(Length=>256,Strength=>0); }, "BR" => sub { Bytes::Random::random_bytes(256); }, }); } if (0) { print "# 16384 random bytes\n"; cmpthese($trial,{ "MPU" => sub { Math::Prime::Util::random_bytes(16384); }, "MPU X" => sub { Math::Prime::Util::xrandom_bytes(16384); }, #"MPU::GMP" => sub { Math::Prime::Util::GMP::random_bytes(16384); }, "BRXS" => sub { Bytes::Random::XS::random_bytes(16384); }, #"BR" => sub { Bytes::Random::random_bytes(16384); }, #"BRS" => sub { Bytes::Random::Secure::random_bytes(16384); }, #"MRMT" => sub { Math::Random::MTwist::_randstr(16384); }, # "DEA" => sub { Data::Entropy::Algorithms::rand_bits(8*16384); }, #"CryptX" => sub { Crypt::PRNG::random_bytes(16384); }, #"rand" => sub { pack('C*', map { int(rand 256) } 1..16384); }, # "Crypt::Random" => sub { Crypt::Random::makerandom_octet(Length=>16384,Strength=>0); }, }); } if (1) { print "# 64k random bytes\n"; cmpthese($trial,{ "entropy" => sub { Math::Prime::Util::entropy_bytes(64*1024); }, "MPU" => sub { Math::Prime::Util::random_bytes(64*1024); }, "MPU X" => sub { Math::Prime::Util::GMP::random_bytes(64*1024); }, "BRXS" => sub { Bytes::Random::XS::random_bytes(64*1024); }, "PP MPU ISAAC" => sub { Math::Prime::Util::ISAAC::random_bytes(64*1024); }, "PP MPU ChaCha" => sub { Math::Prime::Util::ChaCha::random_bytes(64*1024); }, "PP MR ISAAC" => sub { pack("L*",map{$mripp->irand}1..16384); }, "XS MR ISAAC" => sub { pack("L*",map{$mrixs->irand}1..16384); }, "XS MR ISAAC2" => sub { my$s='';$s.=pack("L",$mrixs->irand)for 1..16384;$s; }, "CryptX" => sub { Crypt::PRNG::random_bytes(64*1024); }, "BRS" => sub { Bytes::Random::Secure::random_bytes(64*1024); }, "MRMTwist" => sub { Math::Random::MTwist::_randstr(64*1024); }, "rand" => sub { pack('L*', map { int(rand 4294967296) } 1..16384); }, #"DEA" => sub { Data::Entropy::Algorithms::rand_bits(8*65536); }, #"Crypt::Random" => sub { Crypt::Random::makerandom_octet(Length=>65536,Strength=>0); }, "BR" => sub { Bytes::Random::random_bytes(64*1024); }, "OpenSSL" => sub { Crypt::OpenSSL::Random::random_bytes(64*1024); }, "Urandom" => sub { Rand::Urandom::rand_bytes(64*1024); }, }); } Math-Prime-Util-0.73/bench/bench-pp-isprime.pl0000755000076400007640000001770713204400603017506 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 @testnums = (0..1000, 5_000_000 .. 5_001_000, 50_000_000 .. 50_050_000); my $ip_subs = { #"Abigail" => sub { my$r;$r=abigail($_) for @numlist; $r;}, "Monks1" => sub { my$r;$r=monks1($_) 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;}, "DJ1" => sub { my$r;$r=dj1($_) 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 "dj1($n) != mpu($n)" unless dj1($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; die "monks1($n) != mpu($n)" unless monks1($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; } } sub monks1 { my $i = shift; use POSIX; my ($j,$h,$sentinel) = (0,0,0,0); return ($i == 2) if $i <= 2; # if $i is an even number, it can't be a prime if($i%2==0){} else { $h=POSIX::floor(sqrt($i)); $sentinel=0; # since $i can't be even -> only divide by odd numbers for($j=3; $j<=$h; $j+=2){ if($i%$j==0){ $sentinel++; # $i is not a prime, we can get out of the loop $j=$h; } } return 1 if $sentinel == 0; } 0; } # Terrifically clever, but useless for large numbers sub abigail { ('1' x shift) !~ /^1?$|^(11+?)\1+$/ } sub dj { my $n = shift; return 2 if $n == 2; return 0 if $n <= 1 || $n % 2 == 0; my $limit = int(sqrt($n)); for (my $i = 3; $i <= $limit; $i += 2) { return 0 if $n % $i == 0; } 2; } sub dj1 { 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.73/bench/bench-factor-semiprime.pl0000755000076400007640000000573513204400603020665 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util qw/factor urandomm srand/; 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; srand(377); 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 + urandomm($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.73/bench/bench-drand.pl0000644000076400007640000000742413204400603016501 0ustar danadanause strict; use warnings; use Benchmark qw/cmpthese/; use Math::Random::ISAAC; # 32-bit 2^32-1 use Math::Random::MT; # 32-bit 2^32 use Math::Random::MT::Auto; # 52-bit (x>>12)*2^-52+2^-53 use Math::Random::Xorshift; # 32-bit 2^32-1 use Math::Random::MTwist; # :rand 52-bit x*2^-53 use Math::Random::Secure; # 32-bit 2^32 use ntheory; # :rand NV bit x*2^-64 use Math::Prime::Util::GMP; # 53+bit x*2^-64 use Crypt::PRNG; # 53? (a*2^32+b)/2^53 # core 48-bit strong periods # Could also use Data::Entropy::Algorithms but: # 1) its dependencies have been broken for a while # 2) it's really slow # It is a nice idea, using AES counters. Doubles are filled with only 48 bits. my $trials = shift || -1; # There isn't any good reason to expressly seed. my $time = time; srand($time); Math::Random::Xorshift::srand($time); ntheory::srand($time); Math::Random::Secure::srand($time.$time.$time.$time); my $isaac = Math::Random::ISAAC->new($time); my $mt = Math::Random::MT->new($time); my $xor = Math::Random::Xorshift->new($time); use Math::Random::ISAAC::XS; my $mrixs = Math::Random::ISAAC::XS->new($time); use Math::Random::ISAAC::PP; my $mripp = Math::Random::ISAAC::PP->new($time); # Performance / Quality: # CORE::rand 29000k/s ++++ / --- drand48 has many bad points # Xorshift 16000k/s +++ / --- 32-bit, old alg, closed interval # MTwist 14000k/s +++ / ++ # MPU::GMP 14000k/s +++ / +++ ISAAC CSPRNG # ntheory 12000k/s +++ / +++ ChaCha20 CSPRNG # MT::Auto 4800k/s + / ++ MTwist is faster # ISAAC 2400k/s - / -- 32-bit, bad seeding, closed interval # MT 2200k/s - / ++ 32-bit, MTwist is faster # Crypt::PRNG 705k/s -- / +++ # Secure 426k/s --- / --- 32-bit # ntheory PP 110k/s ---- / +++ ChaCha20, very very slow # # Also see http://www.pcg-random.org/statistical-tests.html # https://blogs.unity3d.com/2015/01/07/a-primer-on-repeatable-random-numbers/ cmpthese($trials, { # These are known to fail TestU01 SmallCrush 'CORE::rand' => sub { CORE::rand for 1..1000 }, 'M::R::Xorshift->rand' => sub { $xor->rand for 1..1000 }, 'M::R::Xorshift::rand' => sub { Math::Random::Xorshift::rand for 1..1000 }, # doubles with only 32-bits of random data 'M::R::ISAAC::XS' => sub { $mrixs->rand for 1..1000 }, 'M::R::ISAAC::PP' => sub { $mripp->rand for 1..1000 }, 'M::R::ISAAC->rand' => sub { $isaac->rand for 1..1000 }, 'M::R::Secure::rand' => sub { Math::Random::Secure::rand for 1..1000 }, 'M::R::MT->rand' => sub { $mt->rand for 1..1000 }, # 52-bit, 53-bit doubles 'M::R::MT::A::rand' => sub { Math::Random::MT::Auto::rand for 1..1000 }, 'M::R::MTwist::rand' => sub { Math::Random::MTwist::_rand for 1..1000 }, 'Crypt::PRNG::rand' => sub { Crypt::PRNG::rand for 1..1000 }, # 53-bit or 64-bit NVs 'MPU::GMP' => sub { Math::Prime::Util::GMP::drand for 1..1000 }, # Fill all NV significand bits (24,53,64,113) 'ntheory::drand' => sub { ntheory::drand for 1..1000 }, }); # TestU01 SmallCrush on floating point output # Passes # ntheory # Crypt::PRNG # Math::Random::MTwist # Math::Random::MT # Math::Random::MT::Auto # Math::Random::ISAAC (32-bit, [0,1]) # Math::Random::ISAAC::XS (32-bit, [0,1]) # Data::Entropy::Algorithms (AES, 48-bit) # Math::Random::Secure (ISAAC, 32-bit) # Fails # 5 CORE::rand # 2 Math::Random::Xorshift (32-bit, [0,1]) # perl -MMath::Random::Xorshift=rand -E 'say rand for 1..52000000' >/tmp/fr.txt # bat2 # bat2.c: bbattery_SmallCrushFile("/tmp/fr.txt"); Math-Prime-Util-0.73/bench/bench-nthprime.pl0000755000076400007640000000216412532503145017246 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.73/bench/bench-primecount.pl0000755000076400007640000000650413204400603017577 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::_segment_pi($_) for @{$darray[2-2]} }, ' 3' => sub { prime_memfree(); $sum += Math::Prime::Util::_segment_pi($_) for @{$darray[3-2]} }, ' 4' => sub { prime_memfree(); $sum += Math::Prime::Util::_segment_pi($_) for @{$darray[4-2]} }, ' 5' => sub { prime_memfree(); $sum += Math::Prime::Util::_segment_pi($_) for @{$darray[5-2]} }, ' 6' => sub { prime_memfree(); $sum += Math::Prime::Util::_segment_pi($_) for @{$darray[6-2]} }, ' 7' => sub { prime_memfree(); $sum += Math::Prime::Util::_segment_pi($_) for @{$darray[7-2]} }, ' 8' => sub { prime_memfree(); $sum += Math::Prime::Util::_segment_pi($_) for @{$darray[8-2]} }, #' 9' => sub { $sum += Math::Prime::Util::_segment_pi($_) for @{$darray[9-2]} }, #'10' => sub { $sum += Math::Prime::Util::_segment_pi($_) for @{$darray[10-2]} }, }); if (0) { print "\n"; print "Direct Lehmer:\n"; cmpthese($count,{ ' 2' => sub { prime_memfree(); $sum += Math::Prime::Util::_lehmer_pi($_) for @{$darray[2-2]} }, ' 3' => sub { prime_memfree(); $sum += Math::Prime::Util::_lehmer_pi($_) for @{$darray[3-2]} }, ' 4' => sub { prime_memfree(); $sum += Math::Prime::Util::_lehmer_pi($_) for @{$darray[4-2]} }, ' 5' => sub { prime_memfree(); $sum += Math::Prime::Util::_lehmer_pi($_) for @{$darray[5-2]} }, ' 6' => sub { prime_memfree(); $sum += Math::Prime::Util::_lehmer_pi($_) for @{$darray[6-2]} }, ' 7' => sub { prime_memfree(); $sum += Math::Prime::Util::_lehmer_pi($_) for @{$darray[7-2]} }, ' 8' => sub { prime_memfree(); $sum += Math::Prime::Util::_lehmer_pi($_) for @{$darray[8-2]} }, ' 9' => sub { prime_memfree(); $sum += Math::Prime::Util::_lehmer_pi($_) for @{$darray[9-2]} }, '10' => sub { prime_memfree(); $sum += Math::Prime::Util::_lehmer_pi($_) for @{$darray[10-2]} }, }); } print "\n"; print "Direct LMO:\n"; cmpthese($count,{ ' 2' => sub { prime_memfree(); $sum += Math::Prime::Util::_LMO_pi($_) for @{$darray[2-2]} }, ' 3' => sub { prime_memfree(); $sum += Math::Prime::Util::_LMO_pi($_) for @{$darray[3-2]} }, ' 4' => sub { prime_memfree(); $sum += Math::Prime::Util::_LMO_pi($_) for @{$darray[4-2]} }, ' 5' => sub { prime_memfree(); $sum += Math::Prime::Util::_LMO_pi($_) for @{$darray[5-2]} }, ' 6' => sub { prime_memfree(); $sum += Math::Prime::Util::_LMO_pi($_) for @{$darray[6-2]} }, ' 7' => sub { prime_memfree(); $sum += Math::Prime::Util::_LMO_pi($_) for @{$darray[7-2]} }, ' 8' => sub { prime_memfree(); $sum += Math::Prime::Util::_LMO_pi($_) for @{$darray[8-2]} }, ' 9' => sub { prime_memfree(); $sum += Math::Prime::Util::_LMO_pi($_) for @{$darray[9-2]} }, '10' => sub { prime_memfree(); $sum += Math::Prime::Util::_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.73/bench/bench-random-prime-bigint.pl0000755000076400007640000000067712532503145021273 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.73/bench/bench-primearray.pl0000755000076400007640000001767313204400603017576 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 fetch' => sub { $s=0; my $o = tie my @p, "Math::Prime::Util::PrimeArray"; $s += $o->FETCH($_) for 0..$ilimit; 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"; # Note: using last inside each is Very Bad Stuff. 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.73/bench/bench-is-prime.pl0000755000076400007640000000373113204400603017136 0ustar danadana#!/usr/bin/env perl use strict; use warnings; #use Math::Primality; use Math::Prime::XS; use Math::Prime::Util qw/urandomm/;; #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. use Math::Prime::Util::RandomPrimes; 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 + urandomm($max-$base) } (1 .. $howmany); my @nums; while (@nums < $howmany) { my $n = $base + urandomm($max-$base); push @nums, $n if $n % 2 && $n % 3 && $n % 5 && $n % 7; } 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.73/bench/bench-pp-count.pl0000755000076400007640000003117412532503145017170 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.73/bench/bench-pp-sieve.pl0000755000076400007640000003010512532503145017144 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.73/bench/bench-isprime-bpsw.pl0000755000076400007640000000345213204400603020032 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util qw/urandomm urandomb srand/; 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 @rns; while (@rns < 50) { my $n = urandomb(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::is_strong_pseudoprime($_,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;}, }); Math-Prime-Util-0.73/bench/bench-random-prime.pl0000755000076400007640000000075212532503145020013 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.73/bench/bench-irand.pl0000644000076400007640000000651313352074136016520 0ustar danadanause strict; use warnings; no warnings 'void'; use Benchmark qw/cmpthese/; use Math::Random::ISAAC; use Math::Random::ISAAC::XS; use Math::Random::MT; use Math::Random::MT::Auto; use Math::Random::Xorshift; use Math::Random::MTwist; use Math::Random::PCG32; use Math::Prime::Util::GMP; use Math::Prime::Util; use Bytes::Random::Secure; use Bytes::Random::Secure::Tiny; use Crypt::PRNG; my $trials = shift || -1; # There is no real point in seeding here. my $time = time; srand($time); Math::Random::Xorshift::srand($time); Math::Prime::Util::srand($time); my $isaac = Math::Random::ISAAC::XS->new($time); my $mt = Math::Random::MT->new($time); my $xor = Math::Random::Xorshift->new($time); my $brs = Bytes::Random::Secure->new(NonBlocking=>1); my $brst = Bytes::Random::Secure::Tiny->new(NonBlocking=>1); my $pcg = Math::Random::PCG32->new(42,54); cmpthese($trials, { 'CORE::rand' => sub { int(CORE::rand(4294967295)) for 1..1000; }, 'MRMT::irand' => sub { $mt->irand for 1..1000; }, 'M::R::ISAAC#irand' => sub { $isaac->irand for 1..1000; }, 'M::R::Xorshift::irand' => sub { Math::Random::Xorshift::irand for 1..1000; }, # 'M::R::Xorshift#irand' => sub { $xor->irand for 1..1000; }, 'BRS#irand' => sub { $brs->irand for 1..1000; }, 'BRST#irand' => sub { $brst->irand for 1..1000; }, 'Crypt::PRNG::irand' => sub { Crypt::PRNG::irand for 1..1000; }, 'MRMTA::irand' => sub { (0xFFFFFFFF & Math::Random::MT::Auto::irand) for 1..1000; }, 'M::R::MTwist::irand32' => sub { Math::Random::MTwist::_irand32 for 1..1000; }, 'M::R::PCG32::rand' => sub { $pcg->rand for 1..1000; }, 'MPUGMP::irand' => sub { Math::Prime::Util::GMP::irand for 1..1000; }, 'MPU::irand' => sub { Math::Prime::Util::irand for 1..1000; }, }) if 1; cmpthese($trials, { # These have only 32-bit irand, nothing else. #'CORE::rand' => sub { int(CORE::rand(4294967295)) for 1..1000; }, 'MRMT::irand 32x2' => sub { (($mt->irand <<32)|$mt->irand) for 1..1000; }, 'M::R::ISAAC 32x2' => sub { (($isaac->irand <<32)|$isaac->irand) for 1..1000; }, 'M::R::PCG32 32x2' => sub { (($pcg->rand <<32)|$pcg->rand) for 1..1000; }, #'M::R::Xorshift#irand' => sub { $xor->irand for 1..1000; }, 'M::R::Xorshift 32x2' => sub { ((Math::Random::Xorshift::irand <<32)|Math::Random::Xorshift::irand) for 1..1000; }, # These don't have 64-bit irand functions, but have random bytes. # Select the fastest of the two options. #'BRS prb' => sub { unpack("Q",$brs->bytes(8)) for 1..1000; }, 'BRS 32x2' => sub { (($brs->irand << 32)|$brs->irand) for 1..1000; }, #'BRST prb' => sub { unpack("Q",$brst->bytes(8)) for 1..1000; }, 'BRST 32x2' => sub { (($brst->irand << 32)|$brst->irand) for 1..1000; }, 'Crypt::PRNG prb' => sub { unpack("Q",Crypt::PRNG::random_bytes(8)) for 1..1000; }, #'Crypt::PRNG 32x2' => sub { ((Crypt::PRNG::irand << 32)|Crypt::PRNG::irand) for 1..1000; }, # These have 64-bit irand functions 'MRMTA::irand' => sub { Math::Random::MT::Auto::irand for 1..1000; }, 'M::R::MTwist::irand64' => sub { Math::Random::MTwist::_irand64 for 1..1000; }, 'MPUGMP::irand64' => sub { Math::Prime::Util::GMP::irand64 for 1..1000; }, 'MPU::irand64' => sub { Math::Prime::Util::irand64 for 1..1000; }, #'MPU prb' => sub { unpack("Q",Math::Prime::Util::random_bytes(8)) for 1..1000; }, #'MPU 32x2' => sub { ((Math::Prime::Util::irand << 32)|Math::Prime::Util::irand) for 1..1000; }, }) if 1; Math-Prime-Util-0.73/bench/bench-factor.pl0000755000076400007640000000600712532503145016676 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.73/bench/bench-pcapprox.pl0000755000076400007640000000204212532503145017247 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.73/ppport.h0000644000076400007640000060660513341730004014426 0ustar danadana#if 0 <<'SKIP'; #endif /* ---------------------------------------------------------------------- ppport.h -- Perl/Pollution/Portability Version 3.42 Automatically created by Devel::PPPort running under perl 5.029002. 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.42 =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.20. =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 automagically 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 SvRX() NEED_SvRX NEED_SvRX_GLOBAL caller_cx() NEED_caller_cx NEED_caller_cx_GLOBAL croak_xs_usage() NEED_croak_xs_usage NEED_croak_xs_usage_GLOBAL die_sv() NEED_die_sv NEED_die_sv_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 gv_fetchpvn_flags() NEED_gv_fetchpvn_flags NEED_gv_fetchpvn_flags_GLOBAL load_module() NEED_load_module NEED_load_module_GLOBAL mess() NEED_mess NEED_mess_GLOBAL mess_nocontext() NEED_mess_nocontext NEED_mess_nocontext_GLOBAL mess_sv() NEED_mess_sv NEED_mess_sv_GLOBAL mg_findext() NEED_mg_findext NEED_mg_findext_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 sv_unmagicext() NEED_sv_unmagicext NEED_sv_unmagicext_GLOBAL vload_module() NEED_vload_module NEED_vload_module_GLOBAL vmess() NEED_vmess NEED_vmess_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 send a bug report to 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.42; 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.024000| BhkENABLE||5.024000| BhkENTRY_set||5.024000| BhkENTRY||| BhkFLAGS||| CALL_BLOCK_HOOKS||| CLASS|||n CPERLscope|5.005000||p CX_CURPAD_SAVE||| CX_CURPAD_SV||| C_ARRAY_END|5.013002||p C_ARRAY_LENGTH|5.008001||p 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||| CvPADLIST||5.008001| CvSTASH||| CvWEAKOUTSIDE||| DECLARATION_FOR_LC_NUMERIC_MANIPULATION||5.021010|n DEFSV_set|5.010001||p DEFSV|5.004050||p DO_UTF8||5.006000| 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||| GvSV||| Gv_AMupdate||5.011000| HEf_SVKEY|5.003070||p HeHASH||5.003070| HeKEY||5.003070| HeKLEN||5.003070| HePV||5.004000| HeSVKEY_force||5.003070| HeSVKEY_set||5.004000| HeSVKEY||5.003070| HeUTF8|5.010001|5.008000|p HeVAL||5.003070| 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.024000| MUTABLE_PTR|5.010001||p MUTABLE_SV|5.010001||p MY_CXT_CLONE|5.009002||p MY_CXT_INIT|5.007003||p MY_CXT|5.007003||p MoveD|5.009002|5.004050|p Move||| 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| OP_TYPE_IS_OR_WAS||5.019010| OP_TYPE_IS||5.019007| ORIGMARK||| OpHAS_SIBLING|5.021007||p OpLASTSIB_set|5.021011||p OpMAYBESIB_set|5.021011||p OpMORESIB_set|5.021011||p OpSIBLING|5.021007||p 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_ARGS_ASSERT_CROAK_XS_USAGE|||p PERL_BCDVERSION|5.024000||p PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p PERL_HASH|5.003070||p PERL_INT_MAX|5.003070||p PERL_INT_MIN|5.003070||p PERL_LONG_MAX|5.003070||p PERL_LONG_MIN|5.003070||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.024000||p PERL_MAGIC_isaelem|5.007002||p PERL_MAGIC_isa|5.007002||p PERL_MAGIC_mutex|5.024000||p PERL_MAGIC_nkeys|5.007002||p PERL_MAGIC_overload_elem|5.024000||p PERL_MAGIC_overload_table|5.007002||p PERL_MAGIC_overload|5.024000||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.003070||p PERL_QUAD_MIN|5.003070||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.003070||p PERL_SHORT_MIN|5.003070||p PERL_SIGNALS_UNSAFE_FLAG|5.008001||p PERL_SUBVERSION|5.006000||p PERL_SYS_INIT3||5.006000| PERL_SYS_INIT||| PERL_SYS_TERM||5.024000| PERL_UCHAR_MAX|5.003070||p PERL_UCHAR_MIN|5.003070||p PERL_UINT_MAX|5.003070||p PERL_UINT_MIN|5.003070||p PERL_ULONG_MAX|5.003070||p PERL_ULONG_MIN|5.003070||p PERL_UNUSED_ARG|5.009003||p PERL_UNUSED_CONTEXT|5.009004||p PERL_UNUSED_DECL|5.007002||p PERL_UNUSED_RESULT|5.021001||p PERL_UNUSED_VAR|5.007002||p PERL_UQUAD_MAX|5.003070||p PERL_UQUAD_MIN|5.003070||p PERL_USE_GCC_BRACE_GROUPS|5.009004||p PERL_USHORT_MAX|5.003070||p PERL_USHORT_MIN|5.003070||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.024000||p PL_bufptr|5.024000||p PL_check||5.006000| PL_compiling|5.004050||p PL_comppad_name||5.017004| PL_comppad||5.008001| PL_copline|5.024000||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.024000||p PL_expect|5.024000||p PL_hexdigit|5.005000||p PL_hints|5.005000||p PL_in_my_stash|5.024000||p PL_in_my|5.024000||p PL_keyword_plugin||5.011002| PL_last_in_gv|||n PL_laststatval|5.005000||p PL_lex_state|5.024000||p PL_lex_stuff|5.024000||p PL_linestr|5.024000||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||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.024000||p PL_rsfp|5.024000||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.024000||p POP_MULTICALL||5.024000| POPi|||n POPl|||n POPn|||n POPpbytex||5.007001|n POPpx||5.005030|n POPp|||n POPs|||n POPul||5.006000|n POPu||5.004000|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.024000| PUSHi||| PUSHmortal|5.009002||p PUSHn||| PUSHp||| PUSHs||| PUSHu|5.004000||p PUTBACK||| PadARRAY||5.024000| PadMAX||5.024000| PadlistARRAY||5.024000| PadlistMAX||5.024000| PadlistNAMESARRAY||5.024000| PadlistNAMESMAX||5.024000| PadlistNAMES||5.024000| PadlistREFCNT||5.017004| PadnameIsOUR||| PadnameIsSTATE||| PadnameLEN||5.024000| PadnameOURSTASH||| PadnameOUTER||| PadnamePV||5.024000| PadnameREFCNT_dec||5.024000| PadnameREFCNT||5.024000| PadnameSV||5.024000| PadnameTYPE||| PadnameUTF8||5.021007| PadnamelistARRAY||5.024000| PadnamelistMAX||5.024000| PadnamelistREFCNT_dec||5.024000| PadnamelistREFCNT||5.024000| 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_restore_errno||| PerlIO_save_errno||| 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| PoisonFree|5.009004||p PoisonNew|5.009004||p PoisonWith|5.009004||p Poison|5.008000||p READ_XDIGIT||5.017006| RESTORE_LC_NUMERIC||5.024000| 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 STORE_LC_NUMERIC_FORCE_TO_UNDERLYING||5.024000| STORE_LC_NUMERIC_SET_TO_NEEDED||5.024000| 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||p SvRX|5.009005||p 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 UTF8SKIP||5.006000| UTF8_MAXBYTES|5.009002||p UVCHR_SKIP||5.022000| 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.024000||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||p XCPT_TRY_END|5.009002||p XCPT_TRY_START|5.009002||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.024000| XS_EXTERNAL||5.024000| XS_INTERNAL||5.024000| XS_VERSION_BOOTCHECK||5.024000| XS_VERSION||| XSprePUSH|5.006000||p XS||| XopDISABLE||5.024000| XopENABLE||5.024000| XopENTRYCUSTOM||5.024000| XopENTRY_set||5.024000| XopENTRY||5.024000| XopFLAGS||5.013007| ZeroD|5.009002||p Zero||| _aMY_CXT|5.007003||p _core_swash_init||| _load_PL_utf8_foldclosures||| _pMY_CXT|5.007003||p _to_fold_latin1||| _to_upper_title_latin1||| _to_utf8_case||| aMY_CXT_|5.007003||p aMY_CXT|5.007003||p aTHXR_|5.024000||p aTHXR|5.024000||p aTHX_|5.006000||p aTHX|5.006000||p add_above_Latin1_folds||| add_data|||n add_multi_match||| add_utf16_textfilter||| adjust_size_and_find_bucket|||n advance_one_LB||| advance_one_SB||| advance_one_WB||| alloc_maybe_populate_EXACT||| 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||| apply_attrs_my||| apply_attrs||| apply||| assert_uft8_cache_coherent||| assignment_type||| atfork_lock||5.007003|n atfork_unlock||5.007003|n av_arylen_p||5.009003| av_clear||| 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 backup_one_LB||| backup_one_SB||| backup_one_WB||| bad_type_gv||| bad_type_pv||| bind_match||| block_end||5.004000| block_gimme||5.004000| block_start||5.004000| blockhook_register||5.013003| boolSV|5.004000||p boot_core_PerlIO||| boot_core_UNIVERSAL||| boot_core_mro||| bytes_cmp_utf8||5.013007| cBOOL|5.013000||p 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|5.006000|p calloc||5.007002|n cando||| cast_i32||5.006000|n cast_iv||5.006000|n cast_ulong||5.006000|n cast_uv||5.006000|n check_type_and_open||| check_uni||| 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| clear_defarray||5.023008| clear_special_blocks||| clone_params_del|||n clone_params_new|||n closest_cop||| cntrl_to_mnemonic|||n compute_EXACTish|||n construct_ahocorasick_from_trie||| 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| 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.024000| cophh_store_pvn||5.013007| cophh_store_pvs||5.013007| cophh_store_pv||5.013007| cophh_store_sv||5.013007| core_prototype||| coresub_op||| cr_textfilter||| croak_memory_wrap|5.019003||pn croak_no_mem|||n croak_no_modify|5.013003||pn croak_nocontext|||pvn croak_popstack|||n croak_sv|5.013001||p croak_xs_usage|5.010001||pn croak|||v csighandler||5.009003|n current_re_engine||| curse||| custom_op_desc||5.007003| custom_op_get_field||| custom_op_name||5.007003| custom_op_register||5.013007| custom_op_xop||5.013007| cv_clone_into||| cv_clone||| cv_const_sv_or_av|||n cv_const_sv||5.003070|n cv_dump||| cv_forget_slab||| cv_get_call_checker||5.013006| cv_name||5.021005| cv_set_call_checker_flags||5.021004| cv_set_call_checker||5.013006| cv_undef_flags||| cv_undef||| cvgv_from_hek||| 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.024000||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||| delimcpy||5.004000|n deprecate_commaless_var_list||| despatch_signals||5.007001| destroy_matcher||| die_nocontext|||vn die_sv|5.013001||p 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_open9||5.006000| do_openn||5.007001| do_open||5.003070| do_pmop_dump||5.006000| 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_compile||| dofile||| dofindlabel||| doform||| doing_taint||5.008001|n dooneliner||| doopen_pm||| doparseform||| dopoptoeval||| dopoptogivenfor||| dopoptolabel||| dopoptoloop||| dopoptosub_at||| dopoptowhen||| doref||5.009003| dounwind||| dowantarray||| drand48_init_r|||n drand48_r|||n dtrace_probe_call||| dtrace_probe_load||| dtrace_probe_op||| dtrace_probe_phase||| dump_all_perl||| dump_all||5.006000| dump_c_backtrace||| dump_eval||5.006000| dump_exec_pos||| 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||| edit_distance|||n 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_default_stash||| find_hash_subscript||| find_in_my_stash||| find_lexical_cv||| find_runcv_where||| find_runcv||5.008001| find_rundefsv||5.013002| find_script||| first_symbol|||n fixup_errno_string||| foldEQ_latin1||5.013008|n foldEQ_locale||5.013002|n 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||5.004000|v fp_dup||| fprintf_nocontext|||vn free_c_backtrace||| free_global_struct||| free_tied_hv_pool||| free_tmps||| gen_constant_list||| get_ANYOF_cp_list_for_ssc||| get_and_check_backslash_N_name||| get_aux_mg||| get_av|5.006000||p get_c_backtrace_dump||| get_c_backtrace||| get_context||5.006000|n get_cvn_flags||| 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_mstats||| get_no_modify||| get_num||| get_op_descs||5.005000| get_op_names||5.005000| get_opargs||| get_ppaddr||5.006000| get_sv|5.006000||p get_vtbl||5.005030| getcwd_sv||5.007002| getenv_len||| glob_2number||| glob_assign_glob||| gp_dup||| gp_free||| gp_ref||| grok_atoUV|||n grok_bin|5.007003||p grok_bslash_N||| grok_hex|5.007003||p grok_infnan||5.021004| grok_number_flags||5.021002| 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.003070| gv_efullname4||5.006001| gv_efullname||| gv_fetchfile_flags||5.009005| gv_fetchfile||| gv_fetchmeth_autoload||5.007003| gv_fetchmeth_internal||| 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||| gv_fetchmeth||| gv_fetchpvn_flags|5.009002||p gv_fetchpvs|5.009004||p gv_fetchpv||| gv_fetchsv||| gv_fullname3||5.003070| gv_fullname4||5.006001| gv_fullname||| gv_handler||5.007001| gv_init_pvn||| gv_init_pv||5.015004| gv_init_svtype||| gv_init_sv||5.015004| gv_init||| gv_is_in_main||| gv_magicalize_isa||| gv_magicalize||| gv_name_set||5.009004| gv_override||| gv_setref||| gv_stashpvn_internal||| gv_stashpvn|5.003070||p gv_stashpvs|5.009003||p gv_stashpv||| gv_stashsvpvn_cached||| gv_stashsv||| handle_named_backref||| handle_possible_posix||| handle_regex_sets||| he_dup||| hek_dup||| hfree_next_entry||| hsplit||| hv_assert||| hv_auxinit_internal|||n hv_auxinit||| 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_ent||5.003070| hv_delete||| hv_eiter_p||5.009003| hv_eiter_set||5.009003| hv_ename_add||| hv_ename_delete||| hv_exists_ent||5.003070| hv_exists||| hv_fetch_ent||5.003070| hv_fetchs|5.009003||p hv_fetch||| hv_fill||5.013002| hv_free_ent_ret||| hv_free_entries||| hv_free_ent||5.004000| hv_iterinit||| hv_iterkeysv||5.003070| hv_iterkey||| hv_iternextsv||| hv_iternext||| hv_iterval||| hv_ksplit||5.003070| 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.018000| hv_riter_p||5.009003| hv_riter_set||5.009003| hv_scalar||5.009001| hv_store_ent||5.003070| 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_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||5.004000| intuit_method||| intuit_more||| invert||| invoke_exception_hook||| io_close||| isALNUMC|5.006000||p isALPHANUMERIC||5.017008| isALPHA||| isASCII|5.006000||p isBLANK|5.006001||p isCNTRL|5.006000||p isDIGIT||| isFOO_lc||| isFOO_utf8_lc||| isGCB|||n isGRAPH|5.006000||p isIDCONT||5.017008| isIDFIRST||| isLB||| isLOWER||| isOCTAL||5.013005| isPRINT|5.004000||p isPSXSPC|5.006001||p isPUNCT|5.006000||p isSB||| isSPACE||| isUPPER||| isUTF8_CHAR||5.021001| isWB||| isWORDCHAR||5.013006| isXDIGIT|5.006000||p is_an_int||| is_ascii_string||5.011000| is_handle_constructor|||n is_invariant_string||5.021007|n is_lvalue_sub||5.007001| is_safe_syscall||5.019004| is_ssc_worth_it|||n is_utf8_char_buf||5.015008|n is_utf8_common||| is_utf8_string_loclen||5.009003|n is_utf8_string_loc||5.008001|n is_utf8_string||5.006001|n isa_lookup||| isinfnansv||| isinfnan||5.021004|n items|||n ix|||n jmaybe||| join_exact||| keyword_plugin_standard||| keyword||| leave_scope||| lex_stuff_pvs||5.013005| 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 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_getdebugvar||| 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_setdebugvar||| magic_setdefelem||| magic_setenv||| magic_sethint||| magic_setisa||| magic_setlvref||| 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||| malloc_good_size|||n malloced_size|||n malloc||5.007002|n markstack_grow||5.021001| matcher_matches_sv||| maybe_multimagic_gv||| mayberelocate||| measure_struct||| memEQs|5.009005||p memEQ|5.004000||p memNEs|5.009005||p memNE|5.004000||p mem_collxfrm||| mem_log_alloc|||n mem_log_common|||n mem_log_free|||n mem_log_realloc|||n mess_alloc||| mess_nocontext|||pvn mess_sv|5.013001||p mess|5.006000||pv mfree||5.007002|n mg_clear||| mg_copy||| mg_dup||| mg_find_mglob||| mg_findext|5.013008||pn mg_find|||n mg_free_type||5.013006| mg_free||| mg_get||| mg_localize||| mg_magical|||n mg_set||| mg_size||5.005000| mini_mktime||5.007002|n minus_v||| missingterm||| mode_from_discipline||| modkids||| more_bodies||| more_sv||| moreswitches||| move_proto_attr||| 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 multideref_stringify||| my_atof2||5.007002| my_atof||5.006000| my_attrs||| my_bcopy||5.004050|n my_bytes_to_utf8|||n my_bzero|||n my_chsize||| my_clearenv||| my_cxt_index||| my_cxt_init||| my_dirfd||5.009005|n 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.024000| my_memcmp|||n my_memset|||n my_pclose||5.003070| my_popen_list||5.007001| my_popen||5.003070| my_setenv||| my_snprintf|5.009004||pvn my_socketpair||5.007003|n my_sprintf|5.009003||pvn my_stat_flags||| my_stat||5.024000| 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_x||| newATTRSUB||5.006000| newAVREF||| newAV||| newBINOP||| newCONDOP||| newCONSTSUB_flags||5.015006| newCONSTSUB|5.004050||p newCVREF||| newDEFSVOP||5.021006| newFORM||| newFOROP||5.013007| newGIVENOP||5.009003| newGIVWHENOP||| newGVOP||| newGVREF||| newGVgen_flags||5.015004| newGVgen||| newHVREF||| newHVhv||5.005000| newHV||| newIO||| newLISTOP||| newLOGOP||| newLOOPEX||| newLOOPOP||| newMETHOP_internal||| newMETHOP_named||5.021005| newMETHOP||5.021005| 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 newSVavdefelem||| 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||| newUNOP_AUX||5.021007| newUNOP||| newWHENOP||5.009003| newWHILEOP||5.013007| newXS_deffile||| newXS_len_flags||| newXSproto||5.006000| newXS||5.006000| new_constant||| new_he||| new_logop||| new_stackinfo||5.005000| new_version||5.009000| next_symbol||| nextargv||| nextchar||| ninstr|||n no_bareword_allowed||| no_fh_allowed||| no_op||| noperl_die|||vn 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_contextualize||5.013006| op_convert_list||5.021006| op_dump||5.006000| op_free||| op_integerize||| op_linklist||5.013006| op_lvalue_flags||| op_null||5.007002| op_parent|||n op_prepend_elem||5.013006| op_refcnt_lock||5.009002| op_refcnt_unlock||5.009002| op_relocate_sv||| op_sibling_splice||5.021002|n op_std_init||| open_script||| openn_cleanup||| openn_setup||| opmethod_stash||| opslab_force_free||| opslab_free_nopad||| opslab_free||| output_or_return_posix_warnings||| 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_add_weakref||| pad_alloc_name||| 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_push||| pad_reset||| pad_setsv||| pad_sv||| pad_swipe||| padlist_dup||| padlist_store||| padname_dup||| padname_free||| padnamelist_dup||| padnamelist_free||| parse_body||| parse_gv_stash_name||| parse_ident||| parse_lparen_question_flags||| parse_subsignature||| 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| pmruntime||| pmtrans||| pop_scope||| populate_ANYOF_from_invlist||| populate_isa|||v pregcomp||5.009005| pregexec||| pregfree2||5.011000| pregfree||| prescan_version||5.011004| printbuf||| printf_nocontext|||vn process_special_blocks||| ptr_hash|||n 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_charclass_bitmap_innards_common||| put_charclass_bitmap_innards_invlist||| put_charclass_bitmap_innards||| put_code_point||| put_range||| pv_display|5.006000||p pv_escape|5.009004||p pv_pretty|5.009004||p pv_uni_display||5.007003| qerror||| qsortsvu||| quadmath_format_needed|||n quadmath_format_single|||n re_compile||5.009005| re_croak2||| re_dup_guts||| re_exec_indentf|||v re_indentf|||v re_intuit_start||5.019001| re_intuit_string||5.006000| re_op_compile||| re_printf|||v realloc||5.007002|n reentrant_free||5.024000| reentrant_init||5.024000| reentrant_retry||5.024000|vn reentrant_size||5.024000| 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.024000| reg2Lanode||| reg_check_named_buff_matched|||n 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|||n reg_temp_copy||| reganode||| regatom||| regbranch||| regclass||| regcppop||| regcppush||| regcurly|||n regdump_extflags||| regdump_intflags||| regdump||5.005000| regdupe_internal||| regex_set_precedence|||n regexec_flags||5.005000| regfree_internal||5.009005| reghop3|||n reghop4|||n reghopmaybe3|||n reginclass||| reginitcolors||5.006000| reginsert||| regmatch||| regnext||5.005000| regnode_guts||| regpiece||| regprop||| regrepeat||| regtail_study||| regtail||| regtry||| 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_strlen||| 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||| search_const||| seed||5.008001| sequence_num||| set_ANYOF_arg||| set_caret_X||| set_context||5.006000|n set_numeric_local||5.006000| set_numeric_radix||5.006000| set_numeric_standard||5.006000| set_padlist|||n setdefout||| share_hek_flags||| share_hek||5.004000| should_warn_nl|||n si_dup||| sighandler|||n simplify_sort||| skip_to_be_ignored_text||| skipspace_flags||| softref2xv||| sortcv_stacked||| sortcv_xsub||| sortcv||| sortsv_flags||5.009003| sortsv||5.007003| space_join_names_mortal||| ss_dup||| ssc_add_range||| ssc_and||| ssc_anything||| ssc_clear_locale|||n ssc_cp_and||| ssc_finalize||| ssc_init||| ssc_intersection||| ssc_is_anything|||n ssc_is_cp_posixl_init|||n ssc_or||| ssc_union||| stack_grow||| 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_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|||n sv_bless||| sv_buf_to_ro||| sv_buf_to_rw||| 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_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_free_arenas||| sv_free||| sv_gets||5.003070| 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_len_utf8_nomg||| sv_len_utf8||5.006000| sv_len||| sv_magic_portable|5.024000|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_only_taint_gmagic|||n sv_or_pv_pos_u2b||| 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||5.015004| 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.024000| sv_setref_pv||| sv_setref_uv||5.007001| 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||p 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_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 svtype||| swallow_bom||| swatch_get||| sync_locale||5.021004| 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_p||| toFOLD_utf8||5.019001| toFOLD_uvchr||5.023009| toFOLD||5.019001| toLOWER_L1||5.019001| toLOWER_LC||5.004000| toLOWER_utf8||5.015007| toLOWER_uvchr||5.023009| toLOWER||| toTITLE_utf8||5.015007| toTITLE_uvchr||5.023009| toTITLE||5.019001| toUPPER_utf8||5.015007| toUPPER_uvchr||5.023009| toUPPER||| to_byte_substr||| to_lower_latin1|||n to_utf8_fold||5.015007| to_utf8_lower||5.015007| to_utf8_substr||| to_utf8_title||5.015007| to_utf8_upper||5.015007| tokenize_use||| tokeq||| tokereport||| too_few_arguments_pv||| too_many_arguments_pv||| translate_substr_offsets|||n 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.003070| 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|n utf8_length||5.007001| utf8_mg_len_cache_update||| utf8_mg_pos_cache_update||| utf8_to_uvchr_buf||5.015009| utf8n_to_uvchr||5.007001| utf8n_to_uvuni||5.007001| utilize||| uvchr_to_utf8_flags||5.007003| uvchr_to_utf8||5.007001| uvoffuni_to_utf8_flags||5.019004| uvuni_to_utf8_flags||5.007003| uvuni_to_utf8||5.007001| 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|5.006000|p 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|||pvn warn_sv|5.013001||p 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||| xs_boot_epilog||| xs_handshake|||vn 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 D_PPP_DEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10)) #define PERL_BCDVERSION ((D_PPP_DEC2BCD(PERL_REVISION)<<24)|(D_PPP_DEC2BCD(PERL_VERSION)<<12)|D_PPP_DEC2BCD(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_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 #ifndef cBOOL # define cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0) #endif #ifndef OpHAS_SIBLING # define OpHAS_SIBLING(o) (cBOOL((o)->op_sibling)) #endif #ifndef OpSIBLING # define OpSIBLING(o) (0 + (o)->op_sibling) #endif #ifndef OpMORESIB_set # define OpMORESIB_set(o, sib) ((o)->op_sibling = (sib)) #endif #ifndef OpLASTSIB_set # define OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL) #endif #ifndef OpMAYBESIB_set # define OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib)) #endif #ifndef HEf_SVKEY # define HEf_SVKEY -2 #endif #ifndef SvRX #if defined(NEED_SvRX) static void * DPPP_(my_SvRX)(pTHX_ SV *rv); static #else extern void * DPPP_(my_SvRX)(pTHX_ SV *rv); #endif #if defined(NEED_SvRX) || defined(NEED_SvRX_GLOBAL) #ifdef SvRX # undef SvRX #endif #define SvRX(a) DPPP_(my_SvRX)(aTHX_ a) void * DPPP_(my_SvRX)(pTHX_ SV *rv) { if (SvROK(rv)) { SV *sv = SvRV(rv); if (SvMAGICAL(sv)) { MAGIC *mg = mg_find(sv, PERL_MAGIC_qr); if (mg && mg->mg_obj) { return mg->mg_obj; } } } return 0; } #endif #endif #ifndef SvRXOK # define SvRXOK(sv) (!!SvRX(sv)) #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 PERL_UNUSED_RESULT # if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT) # define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END # else # define PERL_UNUSED_RESULT(v) ((void)(v)) # 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 #ifndef WIDEST_UTYPE # ifdef QUADKIND # ifdef U64TYPE # define WIDEST_UTYPE U64TYPE # else # define WIDEST_UTYPE Quad_t # endif # else # define WIDEST_UTYPE U32 # endif #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 /* Until we figure out how to support this in older perls... */ #if (PERL_BCDVERSION >= 0x5008000) #ifndef HeUTF8 # define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \ SvUTF8(HeKEY_sv(he)) : \ (U32)HeKUTF8(he)) #endif #endif #ifndef C_ARRAY_LENGTH # define C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0])) #endif #ifndef C_ARRAY_END # define C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a)) #endif #ifndef MUTABLE_PTR #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) # define MUTABLE_PTR(p) ({ void *_p = (p); _p; }) #else # define MUTABLE_PTR(p) ((void *) (p)) #endif #endif #ifndef MUTABLE_SV # define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p)) #endif #ifdef NEED_mess_sv #define NEED_mess #endif #ifdef NEED_mess #define NEED_mess_nocontext #define NEED_vmess #endif #ifndef croak_sv #if (PERL_BCDVERSION >= 0x5007003) || ( (PERL_BCDVERSION >= 0x5006001) && (PERL_BCDVERSION < 0x5007000) ) # if ( (PERL_BCDVERSION >= 0x5008000) && (PERL_BCDVERSION < 0x5008009) ) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5010001) ) # define D_PPP_FIX_UTF8_ERRSV(errsv, sv) \ STMT_START { \ if (sv != ERRSV) \ SvFLAGS(ERRSV) = (SvFLAGS(ERRSV) & ~SVf_UTF8) | \ (SvFLAGS(sv) & SVf_UTF8); \ } STMT_END # else # define D_PPP_FIX_UTF8_ERRSV(errsv, sv) STMT_START {} STMT_END # endif # define croak_sv(sv) \ STMT_START { \ if (SvROK(sv)) { \ sv_setsv(ERRSV, sv); \ croak(NULL); \ } else { \ D_PPP_FIX_UTF8_ERRSV(ERRSV, sv); \ croak("%" SVf, SVfARG(sv)); \ } \ } STMT_END #elif (PERL_BCDVERSION >= 0x5004000) # define croak_sv(sv) croak("%" SVf, SVfARG(sv)) #else # define croak_sv(sv) croak("%s", SvPV_nolen(sv)) #endif #endif #ifndef die_sv #if defined(NEED_die_sv) static OP * DPPP_(my_die_sv)(pTHX_ SV *sv); static #else extern OP * DPPP_(my_die_sv)(pTHX_ SV *sv); #endif #if defined(NEED_die_sv) || defined(NEED_die_sv_GLOBAL) #ifdef die_sv # undef die_sv #endif #define die_sv(a) DPPP_(my_die_sv)(aTHX_ a) #define Perl_die_sv DPPP_(my_die_sv) OP * DPPP_(my_die_sv)(pTHX_ SV *sv) { croak_sv(sv); return (OP *)NULL; } #endif #endif #ifndef warn_sv #if (PERL_BCDVERSION >= 0x5004000) # define warn_sv(sv) warn("%" SVf, SVfARG(sv)) #else # define warn_sv(sv) warn("%s", SvPV_nolen(sv)) #endif #endif #ifndef vmess #if defined(NEED_vmess) static SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args); static #else extern SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args); #endif #if defined(NEED_vmess) || defined(NEED_vmess_GLOBAL) #ifdef vmess # undef vmess #endif #define vmess(a,b) DPPP_(my_vmess)(aTHX_ a,b) #define Perl_vmess DPPP_(my_vmess) SV* DPPP_(my_vmess)(pTHX_ const char* pat, va_list* args) { mess(pat, args); return PL_mess_sv; } #endif #endif #if (PERL_BCDVERSION < 0x5006000) #undef mess #endif #if !defined(mess_nocontext) && !defined(Perl_mess_nocontext) #if defined(NEED_mess_nocontext) static SV * DPPP_(my_mess_nocontext)(const char * pat, ...); static #else extern SV * DPPP_(my_mess_nocontext)(const char * pat, ...); #endif #if defined(NEED_mess_nocontext) || defined(NEED_mess_nocontext_GLOBAL) #define mess_nocontext DPPP_(my_mess_nocontext) #define Perl_mess_nocontext DPPP_(my_mess_nocontext) SV* DPPP_(my_mess_nocontext)(const char* pat, ...) { dTHX; SV *sv; va_list args; va_start(args, pat); sv = vmess(pat, &args); va_end(args); return sv; } #endif #endif #ifndef mess #if defined(NEED_mess) static SV * DPPP_(my_mess)(pTHX_ const char * pat, ...); static #else extern SV * DPPP_(my_mess)(pTHX_ const char * pat, ...); #endif #if defined(NEED_mess) || defined(NEED_mess_GLOBAL) #define Perl_mess DPPP_(my_mess) SV* DPPP_(my_mess)(pTHX_ const char* pat, ...) { SV *sv; va_list args; va_start(args, pat); sv = vmess(pat, &args); va_end(args); return sv; } #ifdef mess_nocontext #define mess mess_nocontext #else #define mess Perl_mess_nocontext #endif #endif #endif #ifndef mess_sv #if defined(NEED_mess_sv) static SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume); static #else extern SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume); #endif #if defined(NEED_mess_sv) || defined(NEED_mess_sv_GLOBAL) #ifdef mess_sv # undef mess_sv #endif #define mess_sv(a,b) DPPP_(my_mess_sv)(aTHX_ a,b) #define Perl_mess_sv DPPP_(my_mess_sv) SV * DPPP_(my_mess_sv)(pTHX_ SV *basemsg, bool consume) { SV *tmp; SV *ret; if (SvPOK(basemsg) && SvCUR(basemsg) && *(SvEND(basemsg)-1) == '\n') { if (consume) return basemsg; ret = mess(""); SvSetSV_nosteal(ret, basemsg); return ret; } if (consume) { sv_catsv(basemsg, mess("")); return basemsg; } ret = mess(""); tmp = newSVsv(ret); SvSetSV_nosteal(ret, basemsg); sv_catsv(ret, tmp); sv_dec(tmp); return ret; } #endif #endif #ifndef warn_nocontext #define warn_nocontext warn #endif #ifndef croak_nocontext #define croak_nocontext croak #endif #ifndef croak_no_modify #define croak_no_modify() croak_nocontext("%s", PL_no_modify) #define Perl_croak_no_modify() croak_no_modify() #endif #ifndef croak_memory_wrap #if (PERL_BCDVERSION >= 0x5009002) || ( (PERL_BCDVERSION >= 0x5008006) && (PERL_BCDVERSION < 0x5009000) ) # define croak_memory_wrap() croak_nocontext("%s", PL_memory_wrap) #else # define croak_memory_wrap() croak_nocontext("panic: memory wrap") #endif #endif #ifndef croak_xs_usage #if defined(NEED_croak_xs_usage) static void DPPP_(my_croak_xs_usage)(const CV * const cv, const char * const params); static #else extern void DPPP_(my_croak_xs_usage)(const CV * const cv, const char * const params); #endif #if defined(NEED_croak_xs_usage) || defined(NEED_croak_xs_usage_GLOBAL) #define croak_xs_usage DPPP_(my_croak_xs_usage) #define Perl_croak_xs_usage DPPP_(my_croak_xs_usage) #ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE #define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params) #endif void DPPP_(my_croak_xs_usage)(const CV *const cv, const char *const params) { dTHX; const GV *const gv = CvGV(cv); PERL_ARGS_ASSERT_CROAK_XS_USAGE; if (gv) { const char *const gvname = GvNAME(gv); const HV *const stash = GvSTASH(gv); const char *const hvname = stash ? HvNAME(stash) : NULL; if (hvname) croak("Usage: %s::%s(%s)", hvname, gvname, params); else croak("Usage: %s(%s)", gvname, params); } else { /* Pants. I don't think that it should be possible to get here. */ croak("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params); } } #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 * doing. 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 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL) #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) 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 && SvTRUEx(ERRSV)) croak_sv(ERRSV); 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 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL) #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) 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); #elif (PERL_BCDVERSION > 0x5003000) utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(), 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 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL) #ifdef load_module # undef load_module #endif #define load_module DPPP_(my_load_module) #define Perl_load_module DPPP_(my_load_module) 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 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL) #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) 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 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) #ifdef newCONSTSUB # undef newCONSTSUB #endif #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c) #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB) /* 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 #if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL) #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) 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 #if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL) #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) 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 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL) #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) 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 #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL) #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) 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 #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL) #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) 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 D_PPP_SVPV_NOLEN_LP_ARG &PL_na #else # define D_PPP_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, D_PPP_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, D_PPP_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, D_PPP_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, D_PPP_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, D_PPP_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 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL) #ifdef vnewSVpvf # undef vnewSVpvf #endif #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b) #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf) 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 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL) #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg) 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 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL) #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) 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 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL) #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg) 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 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL) #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) 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 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL) #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) 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 gv_fetchpvn_flags #if defined(NEED_gv_fetchpvn_flags) static GV* DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types); static #else extern GV* DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types); #endif #if defined(NEED_gv_fetchpvn_flags) || defined(NEED_gv_fetchpvn_flags_GLOBAL) #ifdef gv_fetchpvn_flags # undef gv_fetchpvn_flags #endif #define gv_fetchpvn_flags(a,b,c,d) DPPP_(my_gv_fetchpvn_flags)(aTHX_ a,b,c,d) #define Perl_gv_fetchpvn_flags DPPP_(my_gv_fetchpvn_flags) GV* DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types) { char *namepv = savepvn(name, len); GV* stash = gv_fetchpv(namepv, TRUE, SVt_PVHV); Safefree(namepv); return stash; } #endif #endif #ifndef GvSVn # define GvSVn(gv) GvSV(gv) #endif #ifndef isGV_with_GP # define isGV_with_GP(gv) isGV(gv) #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 gv_init_pvn # define gv_init_pvn(gv, stash, ptr, len, flags) gv_init(gv, stash, ptr, len, flags & GV_ADDMULTI ? TRUE : FALSE) #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 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL) #define Perl_warner DPPP_(my_warner) 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 /* 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 #if !defined(mg_findext) #if defined(NEED_mg_findext) static MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl); static #else extern MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl); #endif #if defined(NEED_mg_findext) || defined(NEED_mg_findext_GLOBAL) #define mg_findext DPPP_(my_mg_findext) #define Perl_mg_findext DPPP_(my_mg_findext) MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl) { if (sv) { MAGIC *mg; #ifdef AvPAD_NAMELIST assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv))); #endif for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) { if (mg->mg_type == type && mg->mg_virtual == vtbl) return mg; } } return NULL; } #endif #endif #if !defined(sv_unmagicext) #if defined(NEED_sv_unmagicext) static int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl); static #else extern int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl); #endif #if defined(NEED_sv_unmagicext) || defined(NEED_sv_unmagicext_GLOBAL) #ifdef sv_unmagicext # undef sv_unmagicext #endif #define sv_unmagicext(a,b,c) DPPP_(my_sv_unmagicext)(aTHX_ a,b,c) #define Perl_sv_unmagicext DPPP_(my_sv_unmagicext) int DPPP_(my_sv_unmagicext)(pTHX_ SV *const sv, const int type, MGVTBL *vtbl) { MAGIC* mg; MAGIC** mgp; if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv)) return 0; mgp = &(SvMAGIC(sv)); for (mg = *mgp; mg; mg = *mgp) { const MGVTBL* const virt = mg->mg_virtual; if (mg->mg_type == type && virt == vtbl) { *mgp = mg->mg_moremagic; if (virt && virt->svt_free) virt->svt_free(aTHX_ sv, mg); if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) { if (mg->mg_len > 0) Safefree(mg->mg_ptr); else if (mg->mg_len == HEf_SVKEY) /* Questionable on older perls... */ SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr)); else if (mg->mg_type == PERL_MAGIC_utf8) Safefree(mg->mg_ptr); } if (mg->mg_flags & MGf_REFCOUNTED) SvREFCNT_dec(mg->mg_obj); Safefree(mg); } else mgp = &mg->mg_moremagic; } if (SvMAGIC(sv)) { if (SvMAGICAL(sv)) /* if we're under save_magic, wait for restore_magic; */ mg_magical(sv); /* else fix the flags now */ } else { SvMAGICAL_off(sv); SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; } return 0; } #endif #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 */ #if (PERL_BCDVERSION >= 0x5006000) #ifndef caller_cx # if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL) static I32 DPPP_dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock) { I32 i; for (i = startingblock; i >= 0; i--) { register const PERL_CONTEXT * const cx = &cxstk[i]; switch (CxTYPE(cx)) { default: continue; case CXt_EVAL: case CXt_SUB: case CXt_FORMAT: return i; } } return i; } # endif # if defined(NEED_caller_cx) static const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp); static #else extern const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp); #endif #if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL) #ifdef caller_cx # undef caller_cx #endif #define caller_cx(a,b) DPPP_(my_caller_cx)(aTHX_ a,b) #define Perl_caller_cx DPPP_(my_caller_cx) const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp) { register I32 cxix = DPPP_dopoptosub_at(cxstack, cxstack_ix); register const PERL_CONTEXT *cx; register const PERL_CONTEXT *ccstack = cxstack; const PERL_SI *top_si = PL_curstackinfo; for (;;) { /* we may be in a higher stacklevel, so dig down deeper */ while (cxix < 0 && top_si->si_type != PERLSI_MAIN) { top_si = top_si->si_prev; ccstack = top_si->si_cxstack; cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix); } if (cxix < 0) return NULL; /* caller() should not report the automatic calls to &DB::sub */ if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 && ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub)) count++; if (!count--) break; cxix = DPPP_dopoptosub_at(ccstack, cxix - 1); } cx = &ccstack[cxix]; if (dbcxp) *dbcxp = cx; if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1); /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the field below is defined for any cx. */ /* caller() should not report the automatic calls to &DB::sub */ if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub)) cx = &ccstack[dbcxix]; } return cx; } # endif #endif /* caller_cx */ #endif /* 5.6.0 */ #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 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL) #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) 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 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL) #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) 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 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL) #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) 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 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL) #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) 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 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL) #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) 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 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL) #define my_snprintf DPPP_(my_my_snprintf) #define Perl_my_snprintf DPPP_(my_my_snprintf) 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 #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL) #define my_sprintf DPPP_(my_my_sprintf) #define Perl_my_sprintf DPPP_(my_my_sprintf) 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 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL) #define my_strlcat DPPP_(my_my_strlcat) #define Perl_my_strlcat DPPP_(my_my_strlcat) 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 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL) #define my_strlcpy DPPP_(my_my_strlcpy) #define Perl_my_strlcpy DPPP_(my_my_strlcpy) 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 #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL) #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) 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 #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL) #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) 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 #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL) #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) 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.73/prime_nth_count.c0000644000076400007640000011177013355740241016275 0ustar danadana#include #include #include #define FUNC_popcnt 1 #define FUNC_isqrt 1 #include "ptypes.h" #include "sieve.h" #include "cache.h" #include "lmo.h" #include "constants.h" #include "prime_nth_count.h" #include "util.h" #include #if _MSC_VER || defined(__IBMC__) || defined(__IBMCPP__) || (defined(__STDC_VERSION__) && __STDC_VERSION >= 199901L) /* math.h should give us these as functions or macros. * * extern long double floorl(long double); * extern long double ceill(long double); * extern long double sqrtl(long double); * extern long double logl(long double); */ #else #define floorl(x) (long double) floor( (double) (x) ) #define ceill(x) (long double) ceil( (double) (x) ) #define sqrtl(x) (long double) sqrt( (double) (x) ) #define logl(x) (long double) log( (double) (x) ) #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 /* TODO: This data is duplicated in util.c. */ 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])) 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])) 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; } /* 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, 0, 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, 0, 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, 0, 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, 0, 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. * */ #include "prime_count_tables.h" UV segment_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 !defined(BENCH_SEGCOUNT) if (low == 7 && high <= 30*NPRIME_SIEVE30) { count += count_segment_ranged(prime_sieve30, NPRIME_SIEVE30, low, high); return count; } /* If we have sparse prime count tables, use them here. These will adjust * 'low' and 'count' appropriately for a value slightly less than ours. * This should leave just a small amount of sieving left. They stop at * some point, e.g. 3000M, so we'll get the answer to that point then have * to sieve all the rest. We should be using LMO or Lehmer much earlier. */ #ifdef APPLY_TABLES APPLY_TABLES #endif #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(UV lo, UV hi) { if (lo > hi || hi < 2) return 0; #if defined(BENCH_SEGCOUNT) return segment_prime_count(lo, hi); #endif /* We use table acceleration so this is preferable for small inputs */ if (hi < _MPU_LMO_CROSSOVER) return segment_prime_count(lo, hi); { /* Rough empirical threshold for when segment faster than LMO */ UV range_threshold = hi / (isqrt(hi)/200); if ( (hi-lo+1) < range_threshold ) return segment_prime_count(lo, hi); } return LMO_prime_count(hi) - ((lo < 2) ? 0 : LMO_prime_count(lo-1)); } UV prime_count_approx(UV n) { if (n < 3000000) return segment_prime_count(2, n); return (UV) (RiemannR( (long double) n ) + 0.5 ); } /* See http://numbers.computation.free.fr/Constants/Primes/twin.pdf, page 5 */ /* Upper limit is in Wu, Acta Arith 114 (2004). 4.48857*x/(log(x)*log(x) */ UV twin_prime_count_approx(UV n) { /* Best would be another estimate for n < ~ 5000 */ if (n < 2000) return twin_prime_count(3,n); { /* Sebah and Gourdon 2002 */ const long double two_C2 = 1.32032363169373914785562422L; const long double two_over_log_two = 2.8853900817779268147198494L; long double ln = (long double) n; long double logn = logl(ln); long double li2 = Ei(logn) + two_over_log_two-ln/logn; /* try to minimize MSE */ if (n < 32000000) { long double fm; if (n < 4000) fm = 0.2952; else if (n < 8000) fm = 0.3152; else if (n < 16000) fm = 0.3090; else if (n < 32000) fm = 0.3096; else if (n < 64000) fm = 0.3100; else if (n < 128000) fm = 0.3089; else if (n < 256000) fm = 0.3099; else if (n < 600000) fm = .3091 + (n-256000) * (.3056-.3091) / (600000-256000); else if (n < 1000000) fm = .3062 + (n-600000) * (.3042-.3062) / (1000000-600000); else if (n < 4000000) fm = .3067 + (n-1000000) * (.3041-.3067) / (4000000-1000000); else if (n <16000000) fm = .3033 + (n-4000000) * (.2983-.3033) / (16000000-4000000); else fm = .2980 + (n-16000000) * (.2965-.2980) / (32000000-16000000); li2 *= fm * logl(12+logn); } return (UV) (two_C2 * li2 + 0.5L); } } UV prime_count_lower(UV n) { long double fn, fl1, fl2, lower, a; if (n < 33000) return segment_prime_count(2, n); fn = (long double) n; fl1 = logl(n); fl2 = fl1 * fl1; /* Axler 2014: https://arxiv.org/abs/1409.1780 (v7 2016), Cor 3.6 * show variations of this. */ if (n <= 300000) { /* Quite accurate and avoids calling Li for speed. */ a = (n < 70200) ? 947 : (n < 176000) ? 904 : 829; lower = fn / (fl1 - 1 - 1/fl1 - 2.85/fl2 - 13.15/(fl1*fl2) + a/(fl2*fl2)); } else if (n < UVCONST(4000000000)) { /* Loose enough that FP differences in Li(n) should be ok. */ a = (n < 88783) ? 4.0L : (n < 300000) ? -3.0L : (n < 303000) ? 5.0L : (n < 1100000) ? -7.0L : (n < 4500000) ? -37.0L : (n < 10200000) ? -70.0L : (n < 36900000) ? -53.0L : (n < 38100000) ? -29.0L : -84.0L; lower = Li(fn) - (sqrtl(fn)/fl1) * (1.94L + 2.50L/fl1 + a/fl2); } else if (fn < 1e19) { /* Büthe 2015 1.9 1511.02032v1.pdf */ lower = Li(fn) - (sqrtl(fn)/fl1) * (1.94L + 3.88L/fl1 + 27.57L/fl2); } else { /* Büthe 2014 v3 7.2 1410.7015v3.pdf */ lower = Li(fn) - fl1*sqrtl(fn)/25.132741228718345907701147L; } return (UV) ceill(lower); } typedef struct { UV thresh; float aval; } thresh_t; static const thresh_t _upper_thresh[] = { { 59000, 2.48 }, { 355991, 2.54 }, { 3550000, 2.51 }, { 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, fl1, fl2, upper, a; if (n < 33000) return segment_prime_count(2, n); fn = (long double) n; fl1 = logl(n); fl2 = fl1 * fl1; /* Axler 2014: https://arxiv.org/abs/1409.1780 (v7 2016), Cor 3.5 * * upper = fn/(fl1-1.0L-1.0L/fl1-3.35L/fl2-12.65L/(fl2*fl1)-89.6L/(fl2*fl2)); * return (UV) floorl(upper); */ if (BITS_PER_WORD == 32 || fn <= 821800000.0) { /* Dusart 2010, page 2 */ for (i = 0; i < (int)NUPPER_THRESH; i++) if (n < _upper_thresh[i].thresh) break; a = (i < (int)NUPPER_THRESH) ? _upper_thresh[i].aval : 2.334L; upper = fn/fl1 * (1.0L + 1.0L/fl1 + a/fl2); } else if (fn < 1e19) { /* Büthe 2015 1.10 Skewes number lower limit */ a = (fn < 1100000000.0) ? 0.032 /* Empirical */ : (fn < 10010000000.0) ? 0.027 /* Empirical */ : (fn < 101260000000.0) ? 0.021 /* Empirical */ : 0.0; upper = Li(fn) - a * fl1*sqrtl(fn)/25.132741228718345907701147L; } else { /* Büthe 2014 7.4 */ upper = Li(fn) + fl1*sqrtl(fn)/25.132741228718345907701147L; } return (UV) floorl(upper); } static void simple_nth_limits(UV *lo, UV *hi, long double n, long double logn, long double loglogn) { const long double a = (n < 228) ? .6483 : (n < 948) ? .8032 : (n < 2195) ? .8800 : (n < 39017) ? .9019 : .9484; *lo = n * (logn + loglogn - 1.0 + ((loglogn-2.10)/logn)); *hi = n * (logn + loglogn - a); if (*hi < *lo) *hi = MPU_MAX_PRIME; } /* 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) { UV lo,hi; simple_nth_limits(&lo, &hi, fn, flogn, flog2n); while (lo < hi) { UV mid = lo + (hi-lo)/2; if (prime_count_lower(mid) < n) lo = mid+1; else hi = mid; } return lo; } /* Dusart 2010 page 2 */ upper = fn * (flogn + flog2n - 1.0 + ((flog2n-2.00)/flogn)); if (n >= 46254381) { /* Axler 2017 http://arxiv.org/pdf/1706.03651.pdf Corollary 1.2 */ upper -= fn * ((flog2n*flog2n-6*flog2n+10.667)/(2*flogn*flogn)); } else if (n >= 8009824) { /* Axler 2013 page viii Korollar G */ upper -= fn * ((flog2n*flog2n-6*flog2n+10.273)/(2*flogn*flogn)); } 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) floorl(upper); } /* The nth prime will be greater than or equal to this number */ UV nth_prime_lower(UV n) { double fn, flogn, flog2n, lower; if (n < NPRIMES_SMALL) return primes_small[n]; fn = (double) n; flogn = log(n); flog2n = log(flogn); /* For small values, do a binary search on the inverse prime count */ if (n < 2000000) { UV lo,hi; simple_nth_limits(&lo, &hi, fn, flogn, flog2n); while (lo < hi) { UV mid = lo + (hi-lo)/2; if (prime_count_upper(mid) < n) lo = mid+1; else hi = mid; } return lo; } { /* Axler 2017 http://arxiv.org/pdf/1706.03651.pdf Corollary 1.4 */ double b1 = (n < 56000000) ? 11.200 : 11.508; lower = fn * (flogn + flog2n-1.0 + ((flog2n-2.00)/flogn) - ((flog2n*flog2n-6*flog2n+b1)/(2*flogn*flogn))); } return (UV) ceill(lower); } UV nth_prime_approx(UV n) { return (n < NPRIMES_SMALL) ? primes_small[n] : inverse_R(n); } UV nth_prime(UV n) { const unsigned char* cache_sieve; unsigned char* segment; UV upper_limit, segbase, segment_size, p, count, target; /* 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"); p = count = 0; target = n-3; /* 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 = 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 += inverse_li(isqrt(n))/4; segment_size = lower_limit / 30; lower_limit = 30 * segment_size - 1; count = prime_count(2,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, is_prime(lower_limit) ? "is" : "is not"); */ if (count >= n) { /* Too far. Walk backwards */ if (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 ); } /******************************************************************************/ /* TWIN PRIMES */ /******************************************************************************/ #if BITS_PER_WORD < 64 static const UV twin_steps[] = {58980,48427,45485,43861,42348,41457,40908,39984,39640,39222, 373059,353109,341253,332437,326131,320567,315883,312511,309244, 2963535,2822103,2734294,2673728, }; static const unsigned int twin_num_exponents = 3; static const unsigned int twin_last_mult = 4; /* 4000M */ #else static const UV twin_steps[] = {58980,48427,45485,43861,42348,41457,40908,39984,39640,39222, 373059,353109,341253,332437,326131,320567,315883,312511,309244, 2963535,2822103,2734294,2673728,2626243,2585752,2554015,2527034,2501469, 24096420,23046519,22401089,21946975,21590715,21300632,21060884,20854501,20665634, 199708605,191801047,186932018,183404596,180694619,178477447,176604059,174989299,173597482, 1682185723,1620989842,1583071291,1555660927,1534349481,1517031854,1502382532,1489745250, 1478662752, 14364197903,13879821868,13578563641,13361034187,13191416949,13053013447,12936030624,12835090276, 12746487898, 124078078589,120182602778,117753842540,115995331742,114622738809,113499818125,112551549250,111732637241,111012321565, 1082549061370,1050759497170,1030883829367,1016473645857,1005206830409,995980796683,988183329733,981441437376,975508027029, 9527651328494, 9264843314051, 9100153493509, 8980561036751, 8886953365929, 8810223086411, 8745329823109, 8689179566509, 8639748641098, 84499489470819, 82302056642520, 80922166953330, 79918799449753, 79132610984280, 78487688897426, 77941865286827, 77469296499217, 77053075040105, 754527610498466, 735967887462370, 724291736697048, }; static const unsigned int twin_num_exponents = 12; static const unsigned int twin_last_mult = 4; /* 4e19 */ #endif UV twin_prime_count(UV beg, UV end) { unsigned char* segment; UV sum = 0; /* First use the tables of #e# from 1e7 to 2e16. */ if (beg <= 3 && end >= 10000000) { UV mult, exp, step = 0, base = 10000000; for (exp = 0; exp < twin_num_exponents && end >= base; exp++) { for (mult = 1; mult < 10 && end >= mult*base; mult++) { sum += twin_steps[step++]; beg = mult*base; if (exp == twin_num_exponents-1 && mult >= twin_last_mult) break; } base *= 10; } } if (beg <= 3 && end >= 3) sum++; if (beg <= 5 && end >= 5) sum++; if (beg < 11) beg = 7; if (beg <= end) { /* Make end points odd */ beg |= 1; end = (end-1) | 1; /* Cheesy way of counting the partial-byte edges */ while ((beg % 30) != 1) { if (is_prime(beg) && is_prime(beg+2) && beg <= end) sum++; beg += 2; } while ((end % 30) != 29) { if (is_prime(end) && is_prime(end+2) && beg <= end) sum++; end -= 2; if (beg > end) break; } } if (beg <= end) { UV seg_base, seg_low, seg_high; void* ctx = start_segment_primes(beg, end, &segment); while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { UV bytes = seg_high/30 - seg_low/30 + 1; unsigned char s; const unsigned char* sp = segment; const unsigned char* const spend = segment + bytes - 1; while (sp < spend) { s = *sp++; if (!(s & 0x0C)) sum++; if (!(s & 0x30)) sum++; if (!(s & 0x80) && !(*sp & 0x01)) sum++; } s = *sp; if (!(s & 0x0C)) sum++; if (!(s & 0x30)) sum++; if (!(s & 0x80) && is_prime(seg_high+2)) sum++; } end_segment_primes(ctx); } return sum; } UV nth_twin_prime(UV n) { unsigned char* segment; double dend; UV nth = 0; UV beg, end; if (n < 6) { switch (n) { case 0: nth = 0; break; case 1: nth = 3; break; case 2: nth = 5; break; case 3: nth =11; break; case 4: nth =17; break; case 5: default: nth =29; break; } return nth; } end = UV_MAX - 16; dend = 800.0 + 1.01L * (double)nth_twin_prime_approx(n); if (dend < (double)end) end = (UV) dend; beg = 2; if (n > 58980) { /* Use twin_prime_count tables to accelerate if possible */ UV mult, exp, step = 0, base = 10000000; for (exp = 0; exp < twin_num_exponents && end >= base; exp++) { for (mult = 1; mult < 10 && n > twin_steps[step]; mult++) { n -= twin_steps[step++]; beg = mult*base; if (exp == twin_num_exponents-1 && mult >= twin_last_mult) break; } base *= 10; } } if (beg == 2) { beg = 31; n -= 5; } { UV seg_base, seg_low, seg_high; void* ctx = start_segment_primes(beg, end, &segment); while (n && next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { UV p, bytes = seg_high/30 - seg_low/30 + 1; UV s = ((UV)segment[0]) << 8; for (p = 0; p < bytes; p++) { s >>= 8; if (p+1 < bytes) s |= (((UV)segment[p+1]) << 8); else if (!is_prime(seg_high+2)) s |= 0xFF00; if (!(s & 0x000C) && !--n) { nth=seg_base+p*30+11; break; } if (!(s & 0x0030) && !--n) { nth=seg_base+p*30+17; break; } if (!(s & 0x0180) && !--n) { nth=seg_base+p*30+29; break; } } } end_segment_primes(ctx); } return nth; } UV nth_twin_prime_approx(UV n) { long double fn = (long double) n; long double flogn = logl(n); long double fnlog2n = fn * flogn * flogn; UV lo, hi; if (n < 6) return nth_twin_prime(n); /* Binary search on the TPC estimate. * Good results require that the TPC estimate is both fast and accurate. * These bounds are good for the actual nth_twin_prime values. */ lo = (UV) (0.9 * fnlog2n); hi = (UV) ( (n >= 1e16) ? (1.04 * fnlog2n) : (n >= 1e13) ? (1.10 * fnlog2n) : (n >= 1e7 ) ? (1.31 * fnlog2n) : (n >= 1200) ? (1.70 * fnlog2n) : (2.3 * fnlog2n + 5) ); if (hi <= lo) hi = UV_MAX; while (lo < hi) { UV mid = lo + (hi-lo)/2; if (twin_prime_count_approx(mid) < fn) lo = mid+1; else hi = mid; } return lo; } /******************************************************************************/ /* SUMS */ /******************************************************************************/ /* The fastest way to compute the sum of primes is using a combinatorial * algorithm such as Deleglise 2012. Since this code is purely native, * it will overflow a 64-bit result quite quickly. Hence a relatively small * table plus sum over sieved primes works quite well. * * The following info is useful if we ever return 128-bit results or for a * GMP implementation. * * Combinatorial sum of primes < n. Call with phisum(n, isqrt(n)). * Needs optimization, either caching, Lehmer, or LMO. * http://mathoverflow.net/questions/81443/fastest-algorithm-to-compute-the-sum-of-primes * http://www.ams.org/journals/mcom/2009-78-268/S0025-5718-09-02249-2/S0025-5718-09-02249-2.pdf * http://mathematica.stackexchange.com/questions/80291/efficient-way-to-sum-all-the-primes-below-n-million-in-mathematica * Deleglise 2012, page 27, simple Meissel: * y = x^1/3 * a = Pi(y) * Pi_f(x) = phisum(x,a) + Pi_f(y) - 1 - P_2(x,a) * P_2(x,a) = sum prime p : y < p <= sqrt(x) of f(p) * Pi_f(x/p) - * sum prime p : y < p <= sqrt(x) of f(p) * Pi_f(p-1) */ static const unsigned char byte_sum[256] = {120,119,113,112,109,108,102,101,107,106,100,99,96,95,89,88,103,102,96,95,92, 91,85,84,90,89,83,82,79,78,72,71,101,100,94,93,90,89,83,82,88,87,81,80,77, 76,70,69,84,83,77,76,73,72,66,65,71,70,64,63,60,59,53,52,97,96,90,89,86,85, 79,78,84,83,77,76,73,72,66,65,80,79,73,72,69,68,62,61,67,66,60,59,56,55,49, 48,78,77,71,70,67,66,60,59,65,64,58,57,54,53,47,46,61,60,54,53,50,49,43,42, 48,47,41,40,37,36,30,29,91,90,84,83,80,79,73,72,78,77,71,70,67,66,60,59,74, 73,67,66,63,62,56,55,61,60,54,53,50,49,43,42,72,71,65,64,61,60,54,53,59,58, 52,51,48,47,41,40,55,54,48,47,44,43,37,36,42,41,35,34,31,30,24,23,68,67,61, 60,57,56,50,49,55,54,48,47,44,43,37,36,51,50,44,43,40,39,33,32,38,37,31,30, 27,26,20,19,49,48,42,41,38,37,31,30,36,35,29,28,25,24,18,17,32,31,25,24,21, 20,14,13,19,18,12,11,8,7,1,0}; #if BITS_PER_WORD == 64 /* We have a much more limited range, so use a fixed interval. We should be * able to get any 64-bit sum in under a half-second. */ static const UV sum_table_2e8[] = {1075207199997324,3071230303170813,4990865886639877,6872723092050268,8729485610396243,10566436676784677,12388862798895708,14198556341669206,15997206121881531,17783028661796383,19566685687136351,21339485298848693,23108856419719148, 24861364231151903,26619321031799321,28368484289421890,30110050320271201,31856321671656548,33592089385327108,35316546074029522,37040262208390735,38774260466286299,40490125006181147,42207686658844380,43915802985817228,45635106002281013, 47337822860157465,49047713696453759,50750666660265584,52449748364487290,54152689180758005,55832433395290183,57540651847418233,59224867245128289,60907462954737468,62597192477315868,64283665223856098,65961576139329367,67641982565760928, 69339211720915217,71006044680007261,72690896543747616,74358564592509127,76016548794894677,77694517638354266,79351385193517953,81053240048141953,82698120948724835,84380724263091726,86028655116421543,87679091888973563,89348007111430334, 90995902774878695,92678527127292212,94313220293410120,95988730932107432,97603162494502485,99310622699836698,100935243057337310,102572075478649557,104236362884241550,105885045921116836,107546170993472638,109163445284201278, 110835950755374921,112461991135144669,114116351921245042,115740770232532531,117408250788520189,119007914428335965,120652479429703269,122317415246500401,123951466213858688,125596789655927842,127204379051939418,128867944265073217, 130480037123800711,132121840147764197,133752985360747726,135365954823762234,137014594650995101,138614165689305879,140269121741383097,141915099618762647,143529289083557618,145146413750649432,146751434858695468,148397902396643807, 149990139346918801,151661665434334577,153236861034424304,154885985064643097,156500983286383741,158120868946747299,159735201435796748,161399264792716319,162999489977602579,164566400448130092,166219688860475191,167836981098849796, 169447127305804401,171078187147848898,172678849082290997,174284436375728242,175918609754056455,177525046501311788,179125593738290153,180765176633753371,182338473848291683,183966529541155489,185585792988238475,187131988176321434, 188797837140841381,190397649440649965,191981841583560122,193609739194967419,195166830650558070,196865965063113041,198400070713177440,200057161591648721,201621899486413406,203238279253414934,204790684829891896,206407676204061001, 208061050481364659,209641606658938873,211192088300183855,212855420483750498,214394145510853736,216036806225784861,217628995137940563,219277567478725189,220833877268454872,222430818525363309,224007307616922530,225640739533952807, 227213096159236934,228853318075566255,230401824696558125,231961445347821085,233593317860593895,235124654760954338,236777716068869769,238431514923528303,239965003913481640,241515977959535845,243129874530821395}; #define N_SUM_TABLE (sizeof(sum_table_2e8)/sizeof(sum_table_2e8[0])) #endif /* Add n to the double-word hi,lo */ #define ADD_128(hi, lo, n) \ do { UV _n = n; \ if (_n > (UV_MAX-lo)) { hi++; if (hi == 0) overflow = 1; } \ lo += _n; } while (0) #define SET_128(hi, lo, n) \ do { hi = (UV) (((n) >> 64) & UV_MAX); \ lo = (UV) (((n) ) & UV_MAX); } while (0) /* Legendre method for prime sum */ int sum_primes128(UV n, UV *hi_sum, UV *lo_sum) { #if BITS_PER_WORD == 64 && HAVE_UINT128 uint128_t *V, *S; UV j, k, r = isqrt(n), r2 = r + n/(r+1); New(0, V, r2+1, uint128_t); New(0, S, r2+1, uint128_t); for (k = 0; k <= r2; k++) { uint128_t v = (k <= r) ? k : n/(r2-k+1); V[k] = v; S[k] = (v*(v+1))/2 - 1; } START_DO_FOR_EACH_PRIME(2, r) { uint128_t a, b, sp = S[p-1], p2 = ((uint128_t)p) * p; for (j = k-1; j > 1 && V[j] >= p2; j--) { a = V[j], b = a/p; if (a > r) a = r2 - n/a + 1; if (b > r) b = r2 - n/b + 1; S[a] -= p * (S[b] - sp); /* sp = sum of primes less than p */ } } END_DO_FOR_EACH_PRIME; SET_128(*hi_sum, *lo_sum, S[r2]); Safefree(V); Safefree(S); return 1; #else return 0; #endif } int sum_primes(UV low, UV high, UV *return_sum) { UV sum = 0; int overflow = 0; if ((low <= 2) && (high >= 2)) sum += 2; if ((low <= 3) && (high >= 3)) sum += 3; if ((low <= 5) && (high >= 5)) sum += 5; if (low < 7) low = 7; /* If we know the range will overflow, return now */ #if BITS_PER_WORD == 64 if (low == 7 && high >= 29505444491) return 0; if (low >= 1e10 && (high-low) >= 32e9) return 0; if (low >= 1e13 && (high-low) >= 5e7) return 0; #else if (low == 7 && high >= 323381) return 0; #endif #if 1 && BITS_PER_WORD == 64 /* Tables */ if (low == 7 && high >= 2e8) { UV step; for (step = 1; high >= (step * 2e8) && step < N_SUM_TABLE; step++) { sum += sum_table_2e8[step-1]; low = step * 2e8; } } #endif if (low <= high) { unsigned char* segment; UV seg_base, seg_low, seg_high; void* ctx = start_segment_primes(low, high, &segment); while (!overflow && next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { UV bytes = seg_high/30 - seg_low/30 + 1; unsigned char s; unsigned char* sp = segment; unsigned char* const spend = segment + bytes - 1; UV i, p, pbase = 30*(seg_low/30); /* Clear primes before and after our range */ p = pbase; for (i = 0; i < 8 && p+wheel30[i] < low; i++) if ( (*sp & (1< high ) *spend |= (1 << i); while (sp <= spend) { s = *sp++; if (sum < (UV_MAX >> 3) && pbase < (UV_MAX >> 5)) { /* sum block of 8 all at once */ sum += pbase * byte_zeros[s] + byte_sum[s]; } else { /* sum block of 8, checking for overflow at each step */ for (i = 0; i < byte_zeros[s]; i++) { if (sum+pbase < sum) overflow = 1; sum += pbase; } if (sum+byte_sum[s] < sum) overflow = 1; sum += byte_sum[s]; if (overflow) break; } pbase += 30; } } end_segment_primes(ctx); } if (!overflow && return_sum != 0) *return_sum = sum; return !overflow; } double ramanujan_sa_gn(UV un) { long double n = (long double) un; long double logn = logl(n); long double log2 = logl(2); return (double)( (logn + logl(logn) - log2 - 0.5) / (log2 + 0.5) ); } Math-Prime-Util-0.73/examples/0000755000076400007640000000000013373340013014534 5ustar danadanaMath-Prime-Util-0.73/examples/fibprime-serial.pl0000755000076400007640000000231112776251142020155 0ustar danadana#!/usr/bin/env perl use strict; use warnings; # 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; my $time_start = [gettimeofday]; prime_precalc(1_000_000); { my @fibstate; my $nth = 1; my $n = 0; 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++; my $Fk = fib_n($k, \@fibstate); if (is_prob_prime($Fk)) { my $time_int = tv_interval($time_start); printf "%3d %7d %20.5f\n", ++$n, $k, $time_int; } } } 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; } Math-Prime-Util-0.73/examples/twin_primes.pl0000755000076400007640000000572413216607633017456 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 nth_twin_prime_approx prime_precalc/; my $count = shift || 20; # Find twin primes (numbers where p and p+2 are prime) # Time for the first 1M: # # Not iterators: # 0.4s say join "\n", @{twin_primes(2,nth_twin_prime(1e6))} # 1.3s $l=2; forprimes { say $l if $l+2==$_; $l=$_; } 2+nth_twin_prime(1e6) # 0.4s bin/primes.pl --twin 2 252427601 # # Iterators with precalc: # 4.5s get_twin_prime_iterator2 (next_prime) # 5.4s get_twin_prime_iterator1 (prime_iterator) # 9.4s get_twin_prime_iterator3 (Iterator::Simple) # 13.8s get_twin_prime_iterator4 (object iterator) # # Iterators without precalc: # 11.6s get_twin_prime_iterator2 # 5.3s get_twin_prime_iterator1 # 9.3s get_twin_prime_iterator3 # 28.0s get_twin_prime_iterator4 (object iterator) # # Alternative iterator: # 3944.4s Math::NumSeq::TwinPrimes (Perl 5.27.2, Math::NumSeq 72) # # Alternative non-iterators: # 14.5s perl -MMath::PariInit=primes=255000000 -MMath::Pari=forprime,PARI -E # '$l=2;forprime($x,2,252427603,sub{say $l if $l+2==$x;$l=int("$x");});' # 4.7s perl -MMath::Prime::FastSieve -E 'my $s=Math::Prime::FastSieve::Sieve->new(255000000); for my $p (@{$s->primes(252427601)}) { say $p if $s->isprime($p+2); }' # This speeds things up, but isn't necessary. # Easy but estimates very high: #my $estimate = 5000 + int( nth_prime_upper($count) * 1.4 * log($count) ); # Relatively tight upper bound #my $estimate = 800 + int(1.01 * nth_twin_prime_approx($count)); # Simple and fastest: Use the estimate directly. my $estimate = nth_twin_prime_approx($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.73/examples/project_euler_070.pl0000644000076400007640000000073412776251142020337 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/:all/; sub is_perm { my($a,$b) = @_; return length($a) == length($b) && join("",sort split(//,$a)) eq join("",sort split(//,$b)); } my ($maxn, $minratio, $totient, $ratio) = (0, 1000000); foreach my $n (2 .. 10_000_000) { $totient = euler_phi($n); $ratio = $n / $totient; ($maxn, $minratio) = ($n, $ratio) if $ratio < $minratio && is_perm($totient, $n); } print "$maxn $minratio\n"; Math-Prime-Util-0.73/examples/project_euler_010.pl0000644000076400007640000000022012776251142020317 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/:all/; my $sum = 0; forprimes { $sum += $_ } 2_000_000; print "$sum\n"; Math-Prime-Util-0.73/examples/fibprime-mce.pl0000755000076400007640000000520713335125715017447 0ustar danadana#!/usr/bin/env perl use strict; use warnings; # 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); use MCE::Util qw(get_ncpu); use MCE; $| = 1; # Find Fibonacci primes in parallel, using Math::Prime::Util and MCE. # # Dana Jacobsen, 2012. # Mario Roy, 2014. # # Runs about the same speed as the threads version, but doesn't need # a threaded Perl. # # n32 ( F50833) in 4776s on 3930k 4.2GHz, SERIAL # n32 ( F50833) in 754s on 3930k 4.2GHz, 12 CPU # n32 ( F50833) in 472s on EC2 c3.8xlarge, 32 CPU # n32 ( F50833) in 323s on EC2 c4.8xlarge, 36 CPU # n32 ( F50833) in 214s on EC2 r4.16xlarge, 64 CPU # n32 ( F50833) in 122s on EC2 c5.18xlarge, 72 CPU # # n36 (F148091) in 26245s on 3930k 4.2GHz, 12 CPU # n36 (F148091) in 14380s on EC2 c3.8xlarge, 32 CPU # n36 (F148091) in 12009s on EC2 c4.8xlarge, 36 CPU # n36 (F148091) in 6565s on EC2 r4.16xlarge, 64 CPU # n36 (F148091) in 4523s on EC2 c5.18xlarge, 72 CPU # my $time_start = [gettimeofday]; my $nworkers = get_ncpu(); warn "Using $nworkers CPUs\n"; prime_precalc(10_000_000); 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 nth_iter { my $n = 0; my $order_id = 1; my %tmp; return sub { $tmp{$_[0]} = $_[1]; ## @_ = ( $nth, [ $k, $time_int ] ) while (1) { last if not exists $tmp{$order_id}; if (defined $tmp{$order_id}) { my ($k, $time_int) = @{ $tmp{$order_id} }; printf "%3d %7d %20.5f\n", ++$n, $k, $time_int; } delete $tmp{$order_id++}; } } } my $mce = MCE->new( max_workers => $nworkers, gather => nth_iter, user_func => sub { my @fibstate; my $nth = MCE->wid(); 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); my $Fk = fib_n($k, \@fibstate); if (is_prob_prime($Fk)) { MCE->gather($nth, [ $k, tv_interval($time_start) ]); } else { MCE->gather($nth, undef); } $nth += $nworkers; } } )->run; Math-Prime-Util-0.73/examples/project_euler_069.pl0000644000076400007640000000061612776251142020346 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/euler_phi pn_primorial/; # Better way my $n = 0; $n++ while pn_primorial($n+1) < 1000000; print pn_primorial($n), "\n"; # Brute force my ($maxn, $maxratio, $ratio) = (0, 0); foreach my $n (1 .. 1000000) { $ratio = $n / euler_phi($n); ($maxn, $maxratio) = ($n, $ratio) if $ratio > $maxratio; } print "$maxn $maxratio\n"; Math-Prime-Util-0.73/examples/project_euler_021.pl0000644000076400007640000000034112776251142020325 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/:all/; my $sum = 0; foreach my $a (1..10000) { my $b = divisor_sum($a)-$a; $sum += $a + $b if $b > $a && $a == divisor_sum($b)-$b; } print "$sum\n"; Math-Prime-Util-0.73/examples/README0000644000076400007640000000414712776251142015434 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. inverse_totient.pl Computes the image of phi(n) for a given m. That is, given a number m, the function computes all n where euler_phi(n) = m. It returns just the count in scalar context (which can be faster and lower memory for inputs such as factorials that have huge images). project_euler_*.pl Example solutions for some Project Euler problems. If you participate in PE, you really should solve the problems yourself first. These provide good examples how how to use some of the module functionality. 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.73/examples/verify-gmp-ecpp-cert.pl0000755000076400007640000000353312453427654021064 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.73/examples/csrand-gmp.pl0000644000076400007640000000712512776251142017143 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::GMP; use Math::Prime::Util qw/:all/; use Bytes::Random::Secure; $|=1; # Example of Blum-Micali, Blum-Blum-Shub, and Micali-Schnorr CSPRNGs. # Not very practical, but works as an example. if (!@ARGV) { die < [] [] An example showing two classic CSPRNGs (cryptographically secure pseudorandom number generators). These are generally not used in practice for performance reasons, with things like AES-CTR, ISAAC, Yarrow/Fortuna, or stream ciphers like Salsa20 instead being used. : how many bits should be generated. : one of: "MS" (Micali-Schnorr) <- default "BM" (Blum-Micali) "BBS" (Blum-Blum-Shub) : How large of primes are used for P (BM) or P,Q (BBS,MS). Default 512. EOU } my $nbits = shift || 10; my $type = shift || 'MS'; # BM or BBS or MS my $bits = shift; die "Type must be BM, BBS, or MS" unless $type =~ /^(BBS|BM|MS)$/; if (!defined $bits) { $bits = ($type eq 'BBS') ? 4096 : 512; } die "Bits must be > 64" unless $bits > 64; my $rng = Bytes::Random::Secure->new(NonBlocking => 1); my $rbytes = int(($bits+7)/8); if ($type eq 'BM') { my($p, $xn); # Select P do { $p = 2 * Math::GMP->new(random_nbit_prime($bits-1))+1 } while !is_prime($p); # Get generator my $g = Math::GMP->new(znprimroot($p)); do { # Select the seed x0 $xn = Math::GMP->new($rng->bytes_hex($rbytes), 16) % $p; } while $xn <= 1; # Generate bits my $thresh = Math::GMP::div_2exp_gmp($p-1, 1); while ($nbits-- > 0) { $xn = Math::GMP::powm_gmp($g, $xn, $p); print 0 + ($xn < $thresh); } print "\n"; } elsif ($type eq 'BBS') { die "Blum-Blum-Shub must have bits >= 3500\n" unless $bits >= 3500; my($M,$xn); # Select M = p*q while (1) { my($p,$q); do { $p = Math::GMP->new(random_nbit_prime($bits)); } while ($p % 4) != 3; do { $q = Math::GMP->new(random_nbit_prime($bits)); } while ($q % 4) != 3; if ($bits < 200) { my $gcd = gcd(euler_phi($p-1),euler_phi($q-1)); next if $gcd > 10000; } $M = $p * $q; last; } do { # Select the seed x0 $xn = Math::GMP->new($rng->bytes_hex($rbytes), 16) % $M; } while $xn <= 1 || gcd($xn,$M) != 1; # Generate bits my $two = Math::GMP->new(2); while ($nbits-- > 0) { $xn = Math::GMP::powm_gmp($xn, $two, $M); print Math::GMP::gmp_tstbit($xn,0) ? "1" : "0"; } print "\n"; } else { # Micali-Schnorr die "Micali-Schnorr must have bits >= 120\n" unless $bits >= 120; my $tries = 1; my ($n, $e, $N); while (1) { my $p = Math::GMP->new(random_nbit_prime($bits)); my $q = Math::GMP->new(random_nbit_prime($bits)); $n = $p * $q; my $phi = ($p-1) * ($q-1); $N = Math::GMP::sizeinbase_gmp($n, 2); # For efficiency, choose largest e possible. e will always be odd. $e = int($N/80); $e-- while $e > 1 && gcd($e,$phi) != 1; last if $e > 1 && $e < $phi && 80*$e <= $N && gcd($e,$phi) == 1; die "Unable to find a proper e for MS\n" if $tries++ > 100; } my $k = int($N * (1-2/$e)); my $r = $N - $k; my $xn = Math::GMP->new($rng->bytes_hex(int(($r+7)/8)),16) % (Math::GMP->new(2) ** $r); my $twok = Math::GMP->new(2) ** $k; while ($nbits > 0) { # y_i = x_{i-1} ^ e mod n my $yi = Math::GMP::powm_gmp($xn, $e, $n); # x_i = r most significant bits of y_i $xn = Math::GMP::div_2exp_gmp($yi, $k); # $xn = $yi >> $k; # z_i = k least significant bits of y_i # output is the sequence of z_i $twok = Math::GMP->new(2) ** $nbits if $nbits < $k; print Math::GMP::get_str_gmp( $yi % $twok, 2); $nbits -= $k; } print "\n"; } Math-Prime-Util-0.73/examples/project_euler_072.pl0000644000076400007640000000022612776251142020335 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/euler_phi/; my $sum = 0; $sum += $_ for euler_phi(2,1000000); print "$sum\n"; Math-Prime-Util-0.73/examples/project_euler_131.pl0000644000076400007640000000061612776251142020334 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/is_prime/; my $limit = shift || 1000000; # Any prime p where n^3 + n^2*p = m^3 must be the difference of (i+1)^3 - i^3. # So we'll just walk them looking for primes. my $sum = 0; foreach my $i (1 .. 2650070) { my $j = $i+1; my $p = $j*$j*$j - $i*$i*$i; last if $p > $limit; $sum++ if is_prime($p); } print "$sum\n"; Math-Prime-Util-0.73/examples/project_euler_037.pl0000644000076400007640000000066612776251142020346 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/:all/; my @tp; my $p = 7; while (1) { $p = next_prime($p); next unless $p =~ /^[2357]/ && $p =~ /[2357]$/; # p ends are prime my $len = 1; while (++$len < length($p)) { last unless is_prime(substr($p, 0, $len)) && is_prime(substr($p, -$len)); } next unless $len == length($p); push @tp, $p; last if scalar @tp >= 11; } print vecsum(@tp), "\n"; Math-Prime-Util-0.73/examples/verify-cert.pl0000755000076400007640000004423612532503145017347 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.73/examples/ktuplet-threads.pl0000755000076400007640000000435413204400603020215 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use threads; use threads::shared; # TODO: Should have a pretty front end with option arguments etc. # TODO: Should figure out the number of threads automatically. use ntheory ":all"; use Math::BigInt; $|=1; my $nthreads = 8; my $low = Math::BigInt->new(1); my $high = Math::BigInt->new(10) ** 16; my $range = Math::BigInt->new(10) ** 12; # 10^13 or 10^14 for large clusters #my @cl = (2,6,8,12,18,20,26,30,32); # A027569 #my @cl = (6,12,16,18,22,28,30,36,40,42,46,48); # A214947 #my @cl = (2,6,8,12,18,20,26,30,32,36,42,48,50); # A257167 #my @cl = (2,6,8,12,18,20,26,30,32,36,42,48,50,56); # A257304 #my @cl = (2,6,12,14,20,24,26,30,36,42,44,50,54,56,62,66); # 17 number 4 #my @cl = (6,10,12,16,22,24,30,34,36,40,42); # A213601 #my @cl = (2,6,8,12,18,20,26,30,32,36,42); # A213645 #my @cl = (6,12,16,18,22,28,30,36,40,42,46,48); # A214947 #my @cl = (4,6,10,16,18,24,28,30,34,40,46,48); # A257137 #my @cl = (4,6,10,16,18,24,28,30,34,36,46,48); # A257138 my @cl = (2,6,8,18,20,30,32,36,38); # Federighi my $totresults = int( ($high+$range-1) / $range ) - 1; #print "totresults: $totresults\n"; my @done :shared; my @results :shared; my $n :shared; my @threads; push @threads, threads->create('findtuple', $_) for 0 .. $nthreads-1; $_->join() for (@threads); while ($n <= $totresults && $done[$n]) { print "$results[$n]\n" if length($results[$n]) > 0; undef $results[$n]; $n++; } sub findtuple { my $tnum = shift; my($res, $m, $tlow, $thigh); $m = $tnum; $tlow = $low + $m*$range; $n = 0 if $tnum == 0; while ($tlow <= $high) { $thigh = $tlow + $range - 1; $thigh = $high if $thigh > $high; if (scalar(@cl) > 9) { $res = join("\n", Math::Prime::Util::GMP::sieve_prime_cluster($tlow, $thigh, @cl)); } else { $res = join("\n", sieve_prime_cluster($tlow, $thigh, @cl)); } { lock(@done); $done[$m] = 1; $results[$m] = $res; if (1 && $tnum == 0) { while ($n <= $totresults && $done[$n]) { print "$results[$n]\n" if length($results[$n]) > 0; undef $results[$n]; $n++; } } } $m += $nthreads; #$tlow = $low + $m*$range; $tlow += $nthreads * $range; } return 1; } Math-Prime-Util-0.73/examples/project_euler_142.pl0000644000076400007640000000245412776251142020340 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/:all/; # x+y = a^2 x = a^2 - y # x-y = b^2 a^2-y-y = b^2 2y = b^2-a^2 y = (b^2-a^2)/2 # x+z = c^2 z = c^2 - z # x-z = d^2 c^2-z-z=d^2 2z = c^2-d^2 z = (c^2-d^2)/2 # y+z = e^2 # y-z = f^2 x = (e^2-f^2)/2 # x+y = a^2 x-y = b^2 ===> 2x = a^2+b^2 x=(a^2+b^2)/2 # x+z = c^2 x-z = d^2 ===> 2z = c^2-d^2 z=(c^2-d^2)/2 # y+z = e^2 y-z = f^2 ===> 2y = e^2+f^2 y=(e^2+f^2)/2 # a^2 = x+y = x+y+z-z = x+z + y-z = c^2 + f^2 # e^2 = y+z = y+z+x-x = y+x -(x-z) = a^2 - d^2 # b^2 = x-y = x-y+z-z = x+z -(y+z) = c^2 - e^2 foreach my $a (4 .. 1000000) { my $a2 = $a*$a; foreach my $c (3 .. $a-1) { my $c2 = $c*$c; my $f2 = $a2 - $c2; next unless $f2 >= 0 && is_power($f2,2); foreach my $d (1 .. $c-1) { next if ($d ^ $c) & 1; # c and d must have same parity my $d2 = $d*$d; my $e2 = $a2 - $d2; my $b2 = $c2 - $e2; next if $e2 <= 0 || $b2 <= 0; #next if (($a2+$b2) & 1) || (($e2+$f2) & 1) || (($c2-$d2) & 1); next unless is_power($e2,2) && is_power($b2,2); my $x = ($a2+$b2) >> 1; my $y = ($e2+$f2) >> 1; my $z = ($c2-$d2) >> 1; my $result = $x+$y+$z; die "$result [$x $y $z]\n"; } } } Math-Prime-Util-0.73/examples/abundant.pl0000755000076400007640000000211612532503145016673 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.73/examples/project_euler_211.pl0000644000076400007640000000056512776251142020336 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/:all/; # Brute force using MPU's divisor_sum. # MPU v0.38 1.5 minutes # Pari 3.5 minutes: # s=0; for(n=1,64000000-1,if(issquare(sigma(n,2)),s=s+n;)) my $n = shift || 64_000_000; my $sum = 0; foreach my $i (0 .. $n-1) { $sum += $i if is_power( divisor_sum($i, 2) , 2); } print "$sum\n"; Math-Prime-Util-0.73/examples/verify-sage-ecpp-cert.pl0000755000076400007640000000323712453427654021221 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.73/examples/project_euler_357.pl0000644000076400007640000000213312776251142020342 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/:all/; use List::MoreUtils qw/all/; my $maxn = shift || 100_000_000; prime_precalc($maxn); # Speeds up is_prime, but not necessary my($sum, $n) = (1, 0); forprimes { $n = 2*$_ - 4; # 2+$n/2 is prime if (is_prime($n+1)) { # 1+$n/1 is prime if (moebius($n) != 0) { # n should be square free $sum += $n if all { is_prime($_+$n/$_) } divisors($n); } } } int($maxn/2); print "$sum\n"; # This version is a little more direct. # my($sum, $n) = (0, 0); # forprimes { # $n = $_-1; # 1+$n/1 is prime (hence n=1 or even) # if (is_prime(2+($n>>1))) { # 2+$n/2 is prime (noting n is even or 1) # if (moebius($n) != 0) { # n should be square free # $sum += $n if all { is_prime($_+$n/$_) } divisors($n); # } # } # } $maxn; # print "$sum\n"; # We could additionally check these: # if ( (($n+2) % 4) == 0 || $n == 1) { # Using all is more efficient, but this works: # $sum += $n unless scalar grep { !is_prime($_+$n/$_) } divisors($n); Math-Prime-Util-0.73/examples/ktuplet.pl0000644000076400007640000000604213204400603016556 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use ntheory ":all"; use bigint; $|=1; prime_set_config(verbose=>0); # Whether to output indices before the values my $outbstyle = 0; my $type = shift || die "Must supply type"; my $low = shift || 1; my $high = shift || 1e9; my $range = (($high-$low) > 1e15) ? 1e14 : 1+int(($high-$low)/100); my %patterns = ( # 2-tuples (twin) 'A001359' => [2], # 3-tuples 'A022004' => [2,6], 'A022005' => [4,6], # 4-tuples 'A007530' => [2,6,8], # 5-tuples 'A022007' => [4,6,10,12], 'A022006' => [2,6,8,12], # 6-tuples 'A022008' => [4,6,10,12,16], # 7-tuples 'A022009' => [2,6,8,12,18,20], 'A022010' => [2,8,12,14,18,20], # 8-tuples 'A022011' => [2,6,8,12,18,20,26], 'A022012' => [2,6,12,14,20,24,26], 'A022013' => [6,8,14,18,20,24,26], # 9-tuples 'A022547' => [4,6,10,16,18,24,28,30], 'A022548' => [4,10,12,18,22,24,28,30], 'A022545' => [2,6,8,12,18,20,26,30], 'A022546' => [2,6,12,14,20,24,26,30], # 10-tuples 'A022569' => [2,6,8,12,18,20,26,30,32], 'A022570' => [2,6,12,14,20,24,26,30,32], # 11-tuples 'A213646' => [4,6,10,16,18,24,28,30,34,36], 'A213647' => [2,6,8,12,18,20,26,30,32,36], # 12-tuples 'A213601' => [6,10,12,16,22,24,30,34,36,40,42], 'A213645' => [2,6,8,12,18,20,26,30,32,36,42], # 13-tuples 'A214947' => [6,12,16,18,22,28,30,36,40,42,46,48], 'A257137' => [4,6,10,16,18,24,28,30,34,40,46,48], 'A257138' => [4,6,10,16,18,24,28,30,34,36,46,48], 'A257139' => [2,6,8,12,18,20,26,30,32,36,42,48], 'A257140' => [2,8,14,18,20,24,30,32,38,42,44,48], 'A257141' => [2,12,14,18,20,24,30,32,38,42,44,48], # 14-tuples 'A257167' => [2,6,8,12,18,20,26,30,32,36,42,48,50], 'A257168' => [2,8,14,18,20,24,30,32,38,42,44,48,50], # 15-tuples 'A257304' => [2,6,8,12,18,20,26,30,32,36,42,48,50,56], # A257167 + 56 'A257305' => [2,6,12,14,20,24,26,30,36,42,44,50,54,56], 'A257306' => [2,6,12,14,20,26,30,32,36,42,44,50,54,56], 'A257307' => [6,8,14,20,24,26,30,36,38,44,48,50,54,56], # other 'A257375' => [4,6,10,16,18,24,28,30,34,40,46,48,54,58,60,66], '5TP39' => [2,6,8,18,20,30,32,36,38], ); die "Unknown type" unless exists $patterns{$type}; my @cl = @{ $patterns{$type} }; # 30 minutes on Macbook Pro to find first 52 entries of A213601: # my $high = 25777719656829367; # my @cl = (6,10,12,16,22,24,30,34,36,40,42); # which makes it ~3-4x slower than JKA's old hand-tuned code. # # 69 seconds on Macbook Pro for the Federighi (5TP39) sequence: # my $high = 1e14; # my @cl = (2,6,8,18,20,30,32,36,38); # which comes out to about 1.5x slower than JKA's 2007 result. my $i = 0; my @p; while ($low < $high) { my $chigh = $low + $range - 1; $chigh = $high if $chigh > $high; # The GMP code will use more residues so favor it with big clusters if (scalar(@cl) > 9) { @p = Math::Prime::Util::GMP::sieve_prime_cluster($low, $chigh, @cl); } else { @p = sieve_prime_cluster($low, $chigh, @cl); } prime_set_config(verbose=>0); if ($outbstyle) { print ++$i," $_\n" for @p; } else { print "$_\n" for @p; } $low += $range; } Math-Prime-Util-0.73/examples/project_euler_214.pl0000644000076400007640000000056212776251142020336 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/forprimes euler_phi/; my $limit = shift || 40000000; my $cl = shift || 25; my @c; sub totchainlen { my $n = shift; return $n if $n <= 2; $c[$n] //= 1 + totchainlen(euler_phi($n)); return $c[$n]; } my $sum = 0; forprimes { $sum += $_ if totchainlen($_) == $cl; } $limit; print "$sum\n"; Math-Prime-Util-0.73/examples/project_euler_049.pl0000644000076400007640000000102712776251142020341 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/is_prime primes/; sub is_perm { my($a,$b) = @_; return length($a) == length($b) && join("",sort split(//,$a)) eq join("",sort split(//,$b)); } foreach my $inc2 (1 .. 1700) { my $inc = $inc2 * 2; foreach my $p (@{primes(1000,9999)}) { my($p2, $p3) = ($p+$inc, $p+$inc+$inc); last if $p3 > 9999; next unless is_prime($p2) && is_prime($p3); next unless is_perm($p, $p2) && is_perm($p, $p3); print "$p/$inc: $p $p2 $p3\n"; } } Math-Prime-Util-0.73/examples/find_mr_bases.pl0000755000076400007640000000367412532503145017704 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.73/examples/verify-primegaps.pl0000755000076400007640000001064413204400603020365 0ustar danadana#!/usr/bin/env perl # Verify prime gaps, version 1.0 # Dana Jacobsen, 2014 # # This is an alternative to T.R. Nicely's cglp4 program from: # http://www.trnicely.net/#Downloads # This runs 2-4x faster on my machines. If cglp4 can use PFGW, then it will # cross over speed around 3000 digits, and PFGW is much faster at 10k+. # # It will use the extra-strong BPSW test plus a Frobenius-Underwood test # for the endpoints so is more stringent about endpoint testing (cglp4 uses # the strong BPSW test). # # The gaps are in one of the formats: # # # PRP#### = # # This program will DIE if an invalid gap is found. I believe this is # preferable to printing a 0 result in a list which may be thousands of # lines long, and hence missed. If the gaps have been properly supplied, # this should never come up. use warnings; use strict; use Math::BigInt lib=>"GMP"; use Math::Prime::Util qw/:all/; use Math::Prime::Util::GMP; # Ensure we're using this use Time::HiRes qw(gettimeofday tv_interval); $|=1; # TODO: Use a command line argument my $use_pfgw = 0; #my $pfgw_exec = "/users/jacobsen/src/pfgw-3.7.10/pfgw64"; my $pfgw_exec = "pfgw64"; my $pfgw_thresh = 2400; # PFGW faster only for this many digits my $fstart = [gettimeofday]; my $procn = 0; while (<>) { chomp; next if /^#/ || /^\s*$/; my($mer, $gap, $expr); if (/^\s*(\d+) (\S+) (\S+)$/) { ($mer, $gap, $expr) = ($2, $1, $3); } elsif (/^\s*(\S+)\s+(\d+)\s+PRP\d+ = (.*)/) { ($mer, $gap, $expr) = ($1, $2, $3); } elsif (/^(\d+) (\S+)$/) { ($gap, $expr) = ($1, $2); } else { warn "skipping $_\n"; next; } $procn++; my $start = [gettimeofday]; $expr =~ s/^1\*//; my $orig_expr = $expr; my $n = numerate($expr); my $end = $n + $gap; my $dstr = length($n) . "D"; my $dstr2 = length($end) . "D"; my $log2n = int(length($n) * 3.322); # approx printf "G=%7d %10.2fs Checking P1 ($dstr)...\r", $gap, tv_interval($start); die "beg of '$expr' is not prime" unless test($n); printf "G=%7d %10.2fs Checking P2 ($dstr2)... \r", $gap, tv_interval($start); die "end of '$expr' is not prime" unless test($end); my $next; # To avoid all the overhead of timing and printing, for very small # gaps we can just call next_prime which will check all the interior # points. The only downside is that we're losing some manual control. if (0 && $gap < 15000 && $log2n < 800) { printf "G=%7d %10.2fs Checking P1 ($dstr) interval... \r", $gap, tv_interval($start); $next = next_prime($n); } else { my $depth = int( 1.2 * $log2n * $log2n * log($log2n) ); printf "G=%7d %10.2fs Sieving to $depth ...%s \r", $gap, tv_interval($start), " " x 30; my @list = sieve_range($n+1, $gap-1, $depth); my $gapstart = [gettimeofday]; my $ntests = scalar(@list); my $i = 0; my $nexti = 1; printf "G=%7d %10.2fs Checking P1 ($dstr) + %d... \r", $gap, tv_interval($start), $list[0]-$n; foreach my $rgap (@list) { my $pgap = $rgap + 1; # We sieved from $n+1 die "Interior point $expr + $pgap is prime\n" if testint($n+$pgap); $i++; if ($i >= $nexti) { my $startint = tv_interval($start); my $gaptime = tv_interval($gapstart); my $est = $startint + ($ntests-$i) * $gaptime/$i; printf "G=%7d %10.2fs (est %.2fs) Checking P1 ($dstr) + $pgap... \r", $gap, $startint, $est; my $display_intervals = int(0.4 / ($gaptime/$i)); #$display_intervals = 256 if $display_intervals > 256; $nexti = $i + $display_intervals; } } $next = $end; } if ($next == $end) { printf "G=%7d P1=%-40sOK BPSW+FU=1 (%.3fs)\n", $gap, $expr, tv_interval($start); } else { die "gap $gap for $expr should be ", $next-$n, "\n"; } } printf "\n Errors=0. OK=%d. T=%.3f.\n", $procn, tv_interval($fstart); sub numerate { my $expr = shift; $expr =~ s/\b(\d+)#/primorial($1)/g; $expr =~ s/\^/**/; $expr =~ s/(\d+)/ Math::BigInt->new("$1") /g; my $n = eval $expr; die "Cannot eval: $expr\n" if !defined $n; return $n; } sub test { my $n = shift; return is_bpsw_prime($n) && is_frobenius_underwood_pseudoprime($n); } sub testint { my $n = shift; if ($use_pfgw && length($n) >= $pfgw_thresh) { return 0 if system("$pfgw_exec -k -Cquiet -f0 -u0 -q\"$n\" >/dev/null 2>1"); } return is_bpsw_prime($n) && is_frobenius_underwood_pseudoprime($n); } Math-Prime-Util-0.73/examples/project_euler_193.pl0000644000076400007640000000334612776251142020347 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/moebius mertens/; my $lim = shift || 2**50; my $method = shift || 'mertens'; # See http://arxiv.org/pdf/1107.4890v1.pdf # 2.9s mertens # 9.8s block # 10.0s monolithic # 33.0s simple # lots brute my $sum = 0; if ($method eq 'brute') { # Far too slow for (1 .. $lim) { $sum++ if moebius($_) } } elsif ($method eq 'simple') { # Basic application of theorem 1. for (1 .. int(sqrt($lim)+0.001)) { $sum += moebius($_) * int($lim/($_*$_)); } } elsif ($method eq 'monolithic') { # Efficient theorem 1, but lots of memory. my @mob = moebius(0, int(sqrt($lim)+0.001)); for (1 .. $#mob) { $sum += $mob[$_] * int($lim/($_*$_)) if $mob[$_]; } } elsif ($method eq 'block') { # Break up into chunks to constrain memory. my($beg,$end,$mlim) = (1, 1, int(sqrt($lim)+0.001)); while ($beg < $mlim) { $end = $beg + 100_000 - 1; $end = $mlim if $end > $mlim; my @mob = moebius($beg,$end); for ($beg .. $end) { $sum += $mob[$_-$beg] * int($lim/($_*$_)) if $mob[$_-$beg]; } $beg = $end+1; } } elsif ($method eq 'mertens') { # Pawlewicz's method, using chunked S1, and no optimization for Mertens. my $I = 50; # Tune as desired. my $D = int(sqrt($lim/$I)+0.00001); my ($S1, $S2) = (0,0); # S1 my $chunk = 100_000; for (my $beg = 1; $beg < $D; $beg += $chunk) { my $end = $beg + $chunk - 1; $end = $D if $end > $D; my @mob = moebius($beg,$end); for ($beg .. $end) { $S1 += $mob[$_-$beg] * int($lim/($_*$_)) if $mob[$_-$beg]; } } # S2 for (1 .. $I-1) { my $xi = int(sqrt($lim/$_)+0.00001); $S2 += mertens($xi); } $S2 -= ($I-1) * mertens($D); $sum = $S1 + $S2; } print "$sum\n"; Math-Prime-Util-0.73/examples/csrand.pl0000644000076400007640000000721513204400603016343 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::BigInt try => "GMP,Pari"; use Math::Prime::Util qw/:all/; use Bytes::Random::Secure; $|=1; # Example of Blum-Micali, Blum-Blum-Shub, and Micali-Schnorr CSPRNGs. # Not very practical, but works as an example. if (!@ARGV) { die < [] [] An example showing two classic CSPRNGs (cryptographically secure pseudorandom number generators). These are generally not used in practice for performance reasons, with things like AES-CTR, ISAAC, Yarrow/Fortuna, or stream ciphers like Salsa20 instead being used. : how many bits should be generated. : one of: "MS" (Micali-Schnorr) <- default "BM" (Blum-Micali) "BBS" (Blum-Blum-Shub) : How large of primes are used for P (BM) or P,Q (BBS,MS). Default 512. EOU } my $nbits = shift || 10; my $type = shift || 'MS'; # BM or BBS or MS my $bits = shift; die "Type must be BM, BBS, or MS" unless $type =~ /^(BBS|BM|MS)$/; if (!defined $bits) { $bits = ($type eq 'BBS') ? 4096 : 512; } die "Bits must be > 64" unless $bits > 64; my $rng = Bytes::Random::Secure->new(NonBlocking => 1); my $rbytes = int(($bits+7)/8); if ($type eq 'BM') { my($p, $xn); # Select P do { $p = 2*random_nbit_prime($bits-1)+1 } while !is_prime($p); # Get generator my $g = Math::BigInt->new( "" . znprimroot($p) ); do { # Select the seed x0 $xn = Math::BigInt->new("0x".$rng->bytes_hex($rbytes))->bmod($p); } while $xn <= 1; # Generate bits my $thresh = ($p-1) >> 1; while ($nbits-- > 0) { $xn = $g->copy->bmodpow($xn,$p); # could use $xn = powmod($g, $xn, $p); print 0 + ($xn < $thresh); } print "\n"; } elsif ($type eq 'BBS') { die "Blum-Blum-Shub must have bits >= 3500\n" unless $bits >= 3500; my($M,$xn); # Select M = p*q while (1) { my($p,$q); do { $p = random_nbit_prime($bits); } while ($p % 4) != 3; do { $q = random_nbit_prime($bits); } while ($q % 4) != 3; if ($bits < 200) { my $gcd = gcd(euler_phi($p-1),euler_phi($q-1)); next if $gcd > 10000; } $M = $p * $q; last; } do { # Select the seed x0 $xn = Math::BigInt->new("0x".$rng->bytes_hex($rbytes))->bmod($M); } while $xn <= 1 || gcd($xn,$M) != 1; # Generate bits my $two = Math::BigInt->new(2); while ($nbits-- > 0) { $xn->bmodpow($two,$M); # Could use: $xn = mulmod($xn, $xn, $M); print $xn->is_odd ? 1 : 0; } print "\n"; } else { # Micali-Schnorr die "Micali-Schnorr must have bits >= 120\n" unless $bits >= 120; my $tries = 1; my ($n, $e, $N); while (1) { my $p = random_nbit_prime($bits); my $q = random_nbit_prime($bits); $n = $p * $q; my $phi = ($p-1) * ($q-1); $N = length($n->as_bin)-2; # For efficiency, choose largest e possible. e will always be odd. $e = int($N/80); $e-- while $e > 1 && gcd($e,$phi) != 1; last if $e > 1 && $e < $phi && 80*$e <= $N && gcd($e,$phi) == 1; die "Unable to find a proper e for MS\n" if $tries++ > 100; } my $k = int($N * (1-2/$e)); my $r = $N - $k; my $xn = Math::BigInt->new("0x".$rng->bytes_hex(int(($r+7)/8)))->bmod(Math::BigInt->new(2)->bpow($r)); while ($nbits > 0) { # y_i = x_{i-1} ^ e mod n my $yistr = $xn->copy->bmodpow($e, $n)->as_bin; # x_i = r most significant bits of y_i $xn = $xn->from_bin(substr($yistr, 0, 2+$r)); # could do this: # my $yistr = todigitstring(powmod($xn,$e,$n),2); # $xn = fromdigits(substr($yistr, 0, $r),2); # z_i = k least significant bits of y_i # output is the sequence of z_i my $outbits = ($nbits >= $k) ? $k : $nbits; print substr($yistr,-$outbits); $nbits -= $outbits; } print "\n"; } Math-Prime-Util-0.73/examples/project_euler_095.pl0000644000076400007640000000225112776251142020342 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/:all/; # Fill in the chains my @achain = ( [0] ); foreach my $n (0 .. 50_000) { next if defined $achain[$n]; my @seq = aliquot_sequence($n, 1_000_000); #print "chain for $n = ", join(",", @seq), "\n"; while (@seq) { my $s = shift @seq; $achain[$s] = [$s, @seq] if !defined $achain[$s]; } } # Find max chain length my ($maxlen, $maxn) = (0, 0); foreach my $n (0 .. 1_000_000) { next unless defined $achain[$n]; next unless $achain[$n]->[0] == $achain[$n]->[-1]; my $len = scalar @{$achain[$n]} - 1; ($maxlen, $maxn) = ($len, $n) if $len > $maxlen; } print "Max length: $maxlen. n = $maxn\n"; print "Chain for $maxn: ", join(",", @{$achain[$maxn]}), "\n"; sub aliquot_sequence { my ($n, $max) = @_; my %hash; undef $hash{$n}; my @seq = ($n); foreach my $len (1 .. 1000) { $n = divisor_sum($n)-$n; # Stop if we have exceeded the threshold last if $n > $max; # If we know how this chain ends, return it now return @seq, @{$achain[$n]} if defined $achain[$n]; push @seq, $n; return @seq if exists $hash{$n} || $n == 0; undef $hash{$n}; } return (); } Math-Prime-Util-0.73/examples/inverse_totient.pl0000644000076400007640000000623313204400603020311 0ustar danadanause warnings; use strict; use Math::Prime::Util qw/:all/; use Getopt::Long; my %opts; GetOptions(\%opts, 'count', 'help', ) || die_usage(); die_usage() if exists $opts{'help'}; my $n = shift; die_usage() unless defined $n && length($n) > 0 && $n !~ tr/0123456789//c; if (exists $opts{'count'}) { print scalar inverse_euler_phi($n), "\n"; } else { print join("\n", inverse_euler_phi($n)), "\n"; } sub die_usage { die "Usage: $0 [-count] \n\nPrint all n such that euler_phi(n) = m.\nIf -count is used, just prints the number of such n.\n"; } sub inverse_euler_phi { my $N = shift; my $do_bigint = ($N > 2**49); if ($do_bigint) { # Math::GMPz and Math::GMP are fast. Math::BigInt::GMP is 10x slower. eval { use Math::GMPz; $do_bigint = "Math::GMPz"; 1; } || eval { use Math::GMP; $do_bigint = "Math::GMP"; 1; } || eval { use Math::BigInt try=>"GMP,Pari"; $do_bigint = "Math::BigInt"; 1; }; $N = $do_bigint->new("$N"); } return wantarray ? (1,2) : 2 if $N == 1; return wantarray ? () : 0 if $N < 1 || ($N & 1); if (is_prime($N >> 1)) { # Coleman Remark 3.3 (Thm 3.1) and Prop 6.2 return wantarray ? () : 0 if !is_prime($N+1); return wantarray ? ($N+1, 2*$N+2) : 2 if $N >= 10; } #if (!wantarray) { return a014197($N) } # Based on invphi.gp v1.3 by Max Alekseyev my @L; fordivisors { $n=$_; $n = $do_bigint->new("$n") if $do_bigint; my $p = $n+1; if (is_prime($p)) { if ( ($N % $p) != 0 ) { push @L, [ [$n, $p] ]; } else { my $v = valuation($N, $p); my $t = $N / $p**$v; push @L, [ [$n,$p], map { [$n*$p**($_-1), $p**$_] } 2..$v+1 ]; } } } $N; if (!wantarray) { # Just count. Much less memory. my %r = ( 1 => 1 ); foreach my $Li (@L) { my %t; foreach my $Lij (@$Li) { my($l0, $l1) = @$Lij; fordivisors { $t{$_*$l0} += $r{$_} if defined $r{$_}; } $N / $l0; } while (my($i,$vec) = each(%t)) { $r{$i} += $t{$i}; } } return (defined $r{$N}) ? $r{$N} : 0; } my %r = ( 1 => [1] ); my($l0, $l1); foreach my $Li (@L) { my %t; foreach my $Lij (@$Li) { my($l0, $l1) = @$Lij; foreach my $n (divisors($N / $l0)) { push @{ $t{$n*$l0} }, map { $_ * $l1 } @{ $r{$n} } if defined $r{$n}; } } while (my($i,$vec) = each(%t)) { push @{$r{$i}}, @$vec; } } return () unless defined $r{$N}; delete @r{ grep { $_ != $N } keys %r }; # Delete all intermediate results my @result = sort { $a <=> $b } @{$r{$N}}; return @result; } # Simple recursive count translated from Pari. sub a014197 { my($n,$m) = @_; $m=1 unless defined $m; return 1+($m<2) if $n == 1; # TODO: divisor_sum with sub ought to be faster #divisor_sum( $n, sub { my $d=shift; # return 0 if $d < $m || !is_prime($d+1); # my($p, $q) = ($d+1, $n/$d); # vecsum( map { a014197($q/($p**$_), $p) } 0 .. valuation($q,$p) ); #} ); my($sum,$p,$q) = (0); fordivisors { if ($_ >= $m && is_prime($_+1)) { ($p,$q)=($_+1,$n/$_); $sum += vecsum( map { a014197($q/($p**$_), $p) } 0 .. valuation($q,$p) ); } } $n; $sum; } Math-Prime-Util-0.73/examples/project_euler_342.pl0000644000076400007640000000532012776251142020335 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/:all/; use Math::GMPz; # Sum of all n where is_power(euler_phi(n^2),3) = 1 # Simple but very slow way. The brute force method later in this file is # basically the same thing, but using the more efficient ranged moebius and # totient calls over intervals. # # Pari: # s=0; for(n=2,limit,if(ispower(n*eulerphi(n),3),s=s+n)); print(s) # Perl/MPU: # my $s=0; # for my $n (2..$limit) { $s += $n if is_power($n*euler_phi($n),3); } # say $s; # # TIMING: # 10^7 2*10^7 10^8 10^10 # Clever 0.06s 0.09s 0.24s 5s # Brute 5.0s 10.2s 52.9s 5 hours # Simple MPU 10.8s 24.6s 159s 1 day? # Simple Pari 13.6s 33.4s 277s 5 days? # my $limit = shift || 10**10-1; my $method = lc(shift || 'clever'); die "Method must be 'clever' or 'brute'\n" unless $method =~ /^(clever|brute)$/; my $sum = 0; if ($method eq 'clever') { # About 5 seconds for 10^10-1 my $cblimit = int( ($limit*$limit) ** 0.3334 + 0.01 ); foreach my $k (2 .. $cblimit) { next if $k & 1; my($p, $e) = @{ (factor_exp($k))[-1] }; $e *= 3; next unless $e & 1; my $m = int($k / ($p ** int($e/3))); $m **= 3; next if $m % ($p-1); $m = int($m / ($p-1)); my $n = $p ** (($e+1) >> 1); next if $n >= $limit; while ($m > 1) { my ($p,$e) = @{ (factor_exp($m))[-1] }; last unless $e & 1; last if $m % ($p-1); $n *= $p ** (($e+1) >> 1); last if $n >= $limit; $m = int($m / ( ($p-1) * ($p**$e) ) ); } if ($m == 1) { #print "$n\n"; $sum += $n; } } } else { # About 5 hours for 10^10-1 my $interval = 10_000_000; # Window size for moebius/totient #prime_precalc(10**9); # Slightly faster ranged phi my($beg,$end) = (0,0); while ($beg < $limit) { $end = $beg + $interval - 1; $end = $limit if $end > $limit; my $start = ($beg<2)?2:$beg; my $glim = int(~0 / $end); my @m = moebius($beg, $end); my @t = euler_phi($beg, $end); if ($end <= $glim) { # Totient($n) * $n will always be < ~0 foreach my $n ($start .. $end) { next unless $m[$n-$beg] == 0; my $totn2 = $n * $t[$n-$beg]; if (is_power($totn2,3)) { # print "$n\n"; $sum += $n } } } else { foreach my $n ($start .. $end) { next unless $m[$n-$beg] == 0; my $tot = $t[$n-$beg]; if ($tot <= $glim) { print "$n\n" if is_power($n * $tot, 3); } else { $tot = Math::GMPz->new($n) * $tot; print "$n\n" if Math::GMPz::Rmpz_perfect_power_p($tot) && is_power($tot,3); } } } $beg = $end+1; } } print "$sum\n"; Math-Prime-Util-0.73/examples/numseqs.pl0000755000076400007640000003743213204400603016573 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/:all/; use Math::BigInt try=>"GMP"; # This shows examples of many sequences from: # https://metacpan.org/release/Math-NumSeq # Some of them are faster, some are much faster, a few are slower. # This usually shows up once past ~ 10k values, or for large preds/iths. # # For comparison, we can use something like: # perl -MMath::NumSeq::Emirps -E 'my $seq = Math::NumSeq::Emirps->new; say 0+($seq->next)[1] for 1..1000' # perl -MMath::NumSeq::Factorials -E 'my $seq = Math::NumSeq::Factorials->new; say join(" ",map { ($seq->next)[1] } 1..1000)' | md5sum # In general, these will work just fine for values up to 2^64, and typically # quite well beyond that. This is in contrast to many Math::NumSeq sequences # which limit themselves to 2^32 because Math::Factor::XS and Math::Prime::XS # do not scale well. Some other sequences such as Factorials and LucasNumbers # are implemented well in Math::NumSeq. # The argument method is really simple -- this is just to show code. # Note that this completely lacks the framework of the module, and Math::NumSeq # often implements various options that aren't always here. It's just # showing some examples of using MPU to solve these sort of problems. # The lucas_sequence function covers about 45 different OEIS sequences, # including Fibonacci, Lucas, Pell, Jacobsthal, Jacobsthal-Lucas, etc. # These use the simple method of joining the results. For very large counts # this consumes a lot of memory, but is purely for the printing. my $type = shift || 'AllPrimeFactors'; my $count = shift || 100; my $arg = shift; $arg = '' unless defined $arg; my @n; if ($type eq 'Abundant') { my $i = 1; if ($arg eq 'deficient') { while (@n < $count) { $i++ while divisor_sum($i)-$i >= $i; push @n, $i++; } } elsif ($arg eq 'primitive') { while (@n < $count) { $i++ while divisor_sum($i)-$i <= $i || abundant_divisors($i); push @n, $i++; } } elsif ($arg eq 'non-primitive') { while (@n < $count) { $i++ while divisor_sum($i)-$i <= $i || !abundant_divisors($i); push @n, $i++; } } else { while (@n < $count) { $i++ while divisor_sum($i)-$i <= $i; push @n, $i++; } } print join " ", @n; } elsif ($type eq 'All') { print join " ", 1..$count; } elsif ($type eq 'AllPrimeFactors') { my $i = 2; if ($arg eq 'descending') { push(@n, reverse factor($i++)) while scalar @n < $count; } else { push(@n, factor($i++)) while scalar @n < $count; } print join " ", @n[0..$count-1]; } elsif ($type eq 'AlmostPrimes') { $arg = 2 unless $arg =~ /^\d+$/; my $i = 1; while (@n < $count) { # use factor_exp for distinct $i++ while scalar factor($i) != $arg; push @n, $i++; } print join " ", @n; } elsif ($type eq 'Catalan') { # Done via ith. Much faster than MNS ith, but much slower than iterator @n = map { binomial( $_<<1, $_) / ($_+1) } 0 .. $count-1; print join " ", @n; } elsif ($type eq 'Cubes') { # Done via pred to show use my $i = 0; while (@n < $count) { $i++ while !is_power($i,3); push @n, $i++; } print join " ", @n; } elsif ($type eq 'DedekindPsiCumulative') { my $c = 0; print join " ", map { $c += psi($_) } 1..$count; } elsif ($type eq 'DedekindPsiSteps') { print join " ", map { dedekind_psi_steps($_) } 1..$count; } elsif ($type eq 'DeletablePrimes') { my $i = 0; while (@n < $count) { $i++ while !is_deletable_prime($i); push @n, $i++; } print join " ", @n; } elsif ($type eq 'DivisorCount') { print join " ", map { scalar divisors($_) } 1..$count; } elsif ($type eq 'DuffinianNumbers') { my $i = 0; while (@n < $count) { $i++ while !is_duffinian($i); push @n, $i++; } print join " ", @n; } elsif ($type eq 'Emirps') { # About 15x faster until 200k or so, then exponentially faster. my($i, $inc) = (13, 100+10*$count); while (@n < $count) { forprimes { push @n, $_ if is_prime(reverse $_) && $_ ne reverse($_) } $i, $i+$inc-1; ($i, $inc) = ($i+$inc, int($inc * 1.03) + 1000); } splice @n, $count; print join " ", @n; } elsif ($type eq 'ErdosSelfridgeClass') { if ($arg eq 'primes') { # Note we wouldn't have problems doing ith, as we have a fast nth_prime. print "1" if $count >= 1; forprimes { print " ", erdos_selfridge_class($_); } 3, nth_prime($count); } else { $arg = 1 unless $arg =~ /^-?\d+$/; print join " ", map { erdos_selfridge_class($_,$arg) } 1..$count; } } elsif ($type eq 'Factorials') { print join " ", map { factorial($_) } 0..$count-1; } elsif ($type eq 'Fibonacci') { print join " ", map { lucasu(1, -1, $_) } 0..$count-1; } elsif ($type eq 'GoldbachCount') { if ($arg eq 'even') { print join " ", map { goldbach_count($_<<1) } 1..$count; } else { print join " ", map { goldbach_count($_) } 1..$count; } } elsif ($type eq 'LemoineCount') { print join " ", map { lemoine_count($_) } 1..$count; } elsif ($type eq 'LiouvilleFunction') { print join " ", map { liouville($_) } 1..$count; } elsif ($type eq 'LucasNumbers') { # Note the different starting point print join " ", map { lucasv(1, -1, $_) } 1..$count; } elsif ($type eq 'MephistoWaltz') { print join " ", map { mephisto_waltz($_) } 0..$count-1; } elsif ($type eq 'MobiusFunction') { print join " ", moebius(1,$count); } elsif ($type eq 'MoranNumbers') { my $i = 1; while (@n < $count) { $i++ while !is_moran($i); push @n, $i++; } print join " ", @n; } elsif ($type eq 'Pell') { print join " ", map { lucasu(2, -1, $_) } 0..$count-1; } elsif ($type eq 'PisanoPeriod') { print join " ", map { pisano($_) } 1..$count; } elsif ($type eq 'PolignacObstinate') { my $i = 1; while (@n < $count) { $i += 2 while !is_polignac_obstinate($i); push @n, $i; $i += 2; } print join " ", @n; } elsif ($type eq 'PowerFlip') { print join " ", map { powerflip($_) } 1..$count; } elsif ($type eq 'Powerful') { my($which,$power) = ($arg =~ /^(all|some)?(\d+)?$/); $which = 'some' unless defined $which; $power = 2 unless defined $power; my $i = 1; if ($which eq 'some' && $power == 2) { while (@n < $count) { $i++ while moebius($i); push @n, $i++; } } else { my(@pe,$nmore); $i = 0; while (@n < $count) { do { @pe = factor_exp(++$i); $nmore = scalar grep { $_->[1] >= $power } @pe; } while ($which eq 'some' && $nmore == 0) || ($which eq 'all' && $nmore != scalar @pe); push @n, $i; } } print join " ", @n; } elsif ($type eq 'PowerPart') { $arg = 2 unless $arg =~ /^\d+$/; print join " ", map { power_part($_,$arg) } 1..$count; } elsif ($type eq 'Primes') { print join " ", @{primes($count)}; } elsif ($type eq 'PrimeFactorCount') { if ($arg eq 'distinct') { print join " ", map { scalar factor_exp($_) } 1..$count; } else { print join " ", map { scalar factor($_) } 1..$count; } } elsif ($type eq 'PrimeIndexPrimes') { $arg = 2 unless $arg =~ /^\d+$/; print join " ", map { primeindexprime($_,$arg) } 1..$count; } elsif ($type eq 'PrimeIndexOrder') { if ($arg eq 'primes') { print "1" if $count >= 1; forprimes { print " ", prime_index_order($_); } 3, nth_prime($count); } else { print join " ", map { prime_index_order($_) } 1..$count; } } elsif ($type eq 'Primorials') { print join " ", map { pn_primorial($_) } 0..$count-1; } elsif ($type eq 'ProthNumbers') { # The pred is faster and far simpler than MNS's pred, but slow as a sequence. my $i = 0; while (@n < $count) { $i++ while !is_proth($i); push @n, $i++; } print join " ", @n; } elsif ($type eq 'PythagoreanHypots') { my $i = 2; if ($arg eq 'primitive') { while (@n < $count) { $i++ while scalar grep { 0 != ($_-1) % 4 } factor($i); push @n, $i++; } } else { while (@n < $count) { $i++ while !scalar grep { 0 == ($_-1) % 4 } factor($i); push @n, $i++; } } print join " ", @n; } elsif ($type eq 'SophieGermainPrimes') { my $estimate = sg_upper_bound($count); my $numfound = 0; forprimes { push @n, $_ if is_prime(2*$_+1); } $estimate; print join " ", @n[0..$count-1]; } elsif ($type eq 'Squares') { # Done via pred to show use my $i = 0; while (@n < $count) { $i++ while !is_power($i,2); push @n, $i++; } print join " ", @n; } elsif ($type eq 'SternDiatomic') { # Slow direct way for ith value: # vecsum( map { binomial($i-$_-1,$_) % 2 } 0..(($i-1)>>1) ); # Bitwise method described in MNS documentation: print join " ", map { stern_diatomic($_) } 0..$count-1; } elsif ($type eq 'Totient') { print join " ", euler_phi(1,$count); } elsif ($type eq 'TotientCumulative') { # ith: vecsum(euler_phi(0,$_[0])); my $c = 0; print join " ", map { $c += euler_phi($_) } 0..$count-1; } elsif ($type eq 'TotientPerfect') { my $i = 1; while (@n < $count) { $i += 2 while $i != totient_steps_sum($i,0); push @n, $i; $i += 2; } print join " ", @n; } elsif ($type eq 'TotientSteps') { print join " ", map { totient_steps($_) } 1..$count; } elsif ($type eq 'TotientStepsSum') { print join " ", map { totient_steps_sum($_) } 1..$count; } elsif ($type eq 'TwinPrimes') { my $l = 2; my $upper = 400 + int(1.01 * nth_twin_prime_approx($count)); $l=2; forprimes { push @n, $l if $l+2==$_; $l=$_; } $upper; print join " ", @n[0..$count-1]; } else { # The following sequences, other than those marked TODO, do not exercise the # features of MPU, hence there is little point reproducing them here. # AlgebraicContinued # AllDigits # AsciiSelf # BalancedBinary # Base::IterateIth # Base::IteratePred # BaumSweet # Beastly # CollatzSteps # ConcatNumbers # CullenNumbers # DigitCount # DigitCountHigh # DigitCountLow # DigitLength # DigitLengthCumulative # DigitProduct # DigitProductSteps # DigitSum # DigitSumModulo # Even # Expression # Fibbinary # FibbinaryBitCount # FibonacciRepresentations # FibonacciWord # File # FractionDigits # GolayRudinShapiro # GolayRudinShapiroCumulative # GolombSequence # HafermanCarpet # HappyNumbers # HappySteps # HarshadNumbers # HofstadterFigure # JugglerSteps # KlarnerRado # Kolakoski # LuckyNumbers # MaxDigitCount # Modulo # Multiples # NumAronson # OEIS # OEIS::Catalogue # OEIS::Catalogue::Plugin # Odd # Palindromes # Perrin # PisanoPeriodSteps # Polygonal # Pronic # RadixConversion # RadixWithoutDigit # ReReplace # ReRound # RepdigitAny # RepdigitRadix # Repdigits # ReverseAdd # ReverseAddSteps # Runs # SelfLengthCumulative # SpiroFibonacci # SqrtContinued # SqrtContinuedPeriod # SqrtDigits # SqrtEngel # StarNumbers # Tetrahedral # Triangular -stirling($_+1,$_) is a complicated solution # UlamSequence # UndulatingNumbers # WoodallNumbers # Xenodromes die "sequence '$type' is not implemented here\n"; } print "\n"; exit(0); # DedekindPsi sub psi { jordan_totient(2,$_[0])/jordan_totient(1,$_[0]) } sub dedekind_psi_steps { my $n = shift; my $class = 0; while (1) { return $class if $n < 5; my @pe = factor_exp($n); return $class if scalar @pe == 1 && ($pe[0]->[0] == 2 || $pe[0]->[0] == 3); return $class if scalar @pe == 2 && $pe[0]->[0] == 2 && $pe[1]->[0] == 3; $class++; $n = jordan_totient(2,$n)/jordan_totient(1,$n); # psi($n) } } sub is_duffinian { my $n = shift; return 0 if $n < 4 || is_prime($n); my $dsum = divisor_sum($n); foreach my $d (divisors($n)) { return 0 unless $d == 1 || $dsum % $d; } 1; } sub is_moran { my $n = shift; my $digsum = sum(split('',$n)); return 0 if $n % $digsum; return 0 unless is_prime($n/$digsum); 1; } sub is_polignac_obstinate { my $n = shift; return (0,1,0,0)[$n] if $n <= 3; return 0 unless $n & 1; my $k = 1; while (($n >> $k) > 0) { return 0 if is_prime($n - (1 << $k)); $k++; } 1; } sub is_proth { my $v = $_[0] - 1; my $n2 = 1 << valuation($v,2); $v/$n2 < $n2 && $v > 1; } # Lemoine Count (A046926) sub lemoine_count { my($n, $count) = (shift, 0); return is_prime(($n>>1)-1) ? 1 : 0 unless $n & 1; forprimes { $count++ if is_prime($n-2*$_) } $n>>1; $count; } sub powerflip { my($n, $prod) = (shift, 1); # The spiffy log solution for bigints taken from Math::NumSeq my $log = 0; foreach my $pe (factor_exp($n)) { my ($p,$e) = @$pe; $log += $p * log($e); $e = Math::BigInt->new($e) if $log > 31; $prod *= $e ** $p; } $prod; } sub primeindexprime { my($n,$level) = @_; $n = nth_prime($n) for 1..$level; $n; } sub prime_index_order { my $n = shift; return is_prime($n) ? 1+prime_index_order(prime_count($n)) : 0; } # TotientSteps sub totient_steps { my($n, $count) = (shift,0); while ($n > 1) { $n = euler_phi($n); $count++; } $count; } # TotientStepsSum sub totient_steps_sum { my $n = shift; my $sum = shift; $sum = $n unless defined $sum; while ($n > 1) { $n = euler_phi($n); $sum += $n; } $sum; } # Sophie-Germaine primes upper bound. Messy. 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; } sub erdos_selfridge_class { my($n,$add) = @_; return 0 unless is_prime($n); $n += (defined $add) ? $add : 1; my $class = 1; foreach my $pe (factor_exp($n)) { next if $pe->[0] == 2 || $pe->[0] == 3; my $nc = 1+erdos_selfridge_class($pe->[0],$add); $class = $nc if $class < $nc; } $class; } sub abundant_divisors { my($n,$is_abundant) = (shift, 0); fordivisors { $is_abundant = 1 if $_ > 1 && $_ < $n && divisor_sum($_)-$_ > $_; } $n; $is_abundant; } sub is_deletable_prime { my $n = shift; # Not deletable prime if n isn't itself prime return 0 unless is_prime($n); my $len = length($n); # Length 1, return 1 because n is a prime return 1 if $len == 1; # Leading zeros aren't allowed, so check pos 1 specially. return 1 if substr($n,1,1) != "0" && is_deletable_prime(substr($n,1)); # Now check deleting each other position. foreach my $pos (1 .. $len-1) { return 1 if is_deletable_prime(substr($n,0,$pos) . substr($n,$pos+1)); } 0; } sub power_part { my($n, $power) = @_; return 1 if $power == 2 && moebius($n); foreach my $d (reverse divisors($n)) { if (is_power($d,$power,\my $root)) { return $root; } } 1; } # This isn't faster, but it was interesting. sub mephisto_waltz { my($n,$i) = (shift, 0); while ($n > 1) { $n /= 3**valuation($n,3); $i++ if 2 == $n % 3; $n = int($n/3); } $i % 2; } # This is simple and low memory, but not as fast as can be done with a prime # list. See Data::BitStream::Code::Additive for example. sub goldbach_count { my $n = shift; return is_prime($n-2) ? 1 : 0 if $n & 1; my $count = 0; forprimes { $count++ if is_prime($n-$_); } int($n/2); $count; } sub pisano { my $i = shift; my @pe = factor_exp($i); my @periods = (1); foreach my $pe (@pe) { my $period = $pe->[0] ** ($pe->[1] - 1); my $modulus = $pe->[0]; { my($f0,$f1,$per) = (0,1,1); for ($per = 0; $f0 != 0 || $f1 != 1 || !$per; $per++) { ($f0,$f1) = ($f1, ($f0+$f1) % $modulus); } $period *= $per; } push @periods, $period; } lcm(@periods); } sub stern_diatomic { my ($p,$q,$i) = (0,1,shift); while ($i) { if ($i & 1) { $p += $q; } else { $q += $p; } $i >>= 1; } $p; } Math-Prime-Util-0.73/examples/fibprime-threads.pl0000755000076400007640000000636112776251142020341 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, 32, and 64 cores. # # You will want Math::Prime::Util::GMP installed for performance. # # Also see the MCE example. # # On my 12-core computer: # 24 5387 0.51088 # 25 9311 2.74327 # 26 9677 3.56398 # 27 14431 11.46177 # 28 25561 76.52618 # 29 30757 130.26143 # 30 35999 262.94690 # 31 37511 306.67707 # 32 50833 746.35491 # # 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(10_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.73/examples/porter.pl0000755000076400007640000000632512776251142016427 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use 5.14.0; use Math::Prime::Util qw/:all/; 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.73/examples/sophie_germain.pl0000755000076400007640000000536412776251142020107 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.73/examples/project_euler_047.pl0000644000076400007640000000052712776251142020343 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/:all/; 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); print "$n\n"; Math-Prime-Util-0.73/MANIFEST0000644000076400007640000001144213373340013014051 0ustar danadanaChanges cpanfile lib/ntheory.pm 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 lib/Math/Prime/Util/ChaCha.pm lib/Math/Prime/Util/Entropy.pm LICENSE Makefile.PL MANIFEST README TODO XS.xs ptypes.h montmath.h multicall.h mulmod.h aks.h aks.c cache.h cache.c constants.h entropy.h entropy.c factor.h factor.c keyval.h lehmer.h lehmer.c lmo.h lmo.c ppport.h primality.h primality.c prime_count_tables.h prime_nth_count.h prime_nth_count.c ramanujan_primes.h ramanujan_primes.c random_prime.h random_prime.c semi_primes.h semi_primes.c sieve.h sieve.c sieve_cluster.h sieve_cluster.c threadlock.h util.h util.c csprng.h csprng.c chacha.h chacha.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-irand.pl bench/bench-drand.pl bench/bench-random-bytes.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/csrand.pl examples/csrand-gmp.pl examples/sophie_germain.pl examples/twin_primes.pl examples/abundant.pl examples/find_mr_bases.pl examples/inverse_totient.pl examples/ktuplet.pl examples/ktuplet-threads.pl examples/numseqs.pl examples/fibprime-serial.pl examples/fibprime-threads.pl examples/fibprime-mce.pl examples/porter.pl examples/verify-gmp-ecpp-cert.pl examples/verify-sage-ecpp-cert.pl examples/verify-cert.pl examples/project_euler_010.pl examples/project_euler_021.pl examples/project_euler_037.pl examples/project_euler_047.pl examples/project_euler_049.pl examples/project_euler_069.pl examples/project_euler_070.pl examples/project_euler_072.pl examples/project_euler_095.pl examples/project_euler_131.pl examples/project_euler_142.pl examples/project_euler_193.pl examples/project_euler_211.pl examples/project_euler_214.pl examples/project_euler_342.pl examples/project_euler_357.pl examples/verify-primegaps.pl bin/primes.pl bin/factor.pl t/01-load.t t/02-can.t t/011-load-ntheory.t t/022-can-ntheory.t t/03-init.t t/04-inputvalidation.t t/10-isprime.t t/11-primes.t t/11-ramanujanprimes.t t/11-semiprimes.t t/11-twinprimes.t t/11-sumprimes.t t/11-clusters.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-chebyshev.t t/19-chinese.t t/19-divisorsum.t t/19-gcd.t t/19-kronecker.t t/19-legendrephi.t t/19-liouville.t t/19-mangoldt.t t/19-moebius.t t/19-popcount.t t/19-primroots.t t/19-ramanujan.t t/19-rootint.t t/19-totients.t t/19-valuation.t t/19-znorder.t t/20-jordantotient.t t/20-primorial.t t/21-conseq-lcm.t t/22-aks-prime.t t/23-primality-proofs.t t/23-random-certs.t t/24-partitions.t t/25-lucas_sequences.t t/26-combinatorial.t t/26-digits.t t/26-iscarmichael.t t/26-isfundamental.t t/26-ispower.t t/26-issemiprime.t t/26-issquarefree.t t/26-istotient.t t/26-mod.t t/26-pillai.t t/26-polygonal.t t/26-vec.t t/27-bernfrac.t t/28-pi.t t/29-mersenne.t t/30-relations.t t/31-threading.t t/32-iterators.t t/33-examples.t t/34-random.t t/35-cipher.t t/35-rand-tag.t t/50-factoring.t t/51-randfactor.t t/51-znlog.t t/52-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 t/97-synopsis.t xt/check-nth-bounds.pl xt/chinese.pl xt/create-pc-tables.pl 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-chacha20-inner.pl 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-primecount.pl xt/test-primes-script.pl xt/test-primes-script2.pl xt/test-factor-yafu.pl xt/test-nextprime-yafu.pl xt/test-ispower.pl xt/test-znlog.pl xt/twin_prime_count.t xt/nth_twin_prime.t xt/lucasuv.pl xt/make-perrin-data.pl xt/test-pcbounds.pl .travis.yml inc/Devel/CheckLib.pm META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Math-Prime-Util-0.73/cache.c0000644000076400007640000001422613204400603014125 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 "threadlock.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; MUTEX_DECL(segment); READ_WRITE_LOCK_DECL(primary_cache); 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(primary_cache); _erase_and_fill_prime_cache(n); WRITE_LOCK_END(primary_cache); } 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(primary_cache); while (prime_cache_size < n) { /* The cache isn't big enough. Expand it. */ READ_LOCK_END(primary_cache); /* thread reminder: the world can change right here */ WRITE_LOCK_START(primary_cache); if (prime_cache_size < n) _erase_and_fill_prime_cache(n); WRITE_LOCK_END(primary_cache); /* thread reminder: the world can change right here */ READ_LOCK_START(primary_cache); } 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(primary_cache); } #endif /* The segment everyone is trying to share */ #define PRIMARY_SEGMENT_CHUNK_SIZE UVCONST(32*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(32*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; /* This can happen in global destructor, and PL_dirty has porting issues */ /* MPUassert(mutex_init == 1, "cache mutexes have not been initialized"); */ if (mutex_init == 0) return; 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(primary_cache); /* Put primary cache back to initial state */ _erase_and_fill_prime_cache(_MPU_INITIAL_CACHE_SIZE); WRITE_LOCK_END(primary_cache); } void _prime_memfreeall(void) { /* No locks. We're shutting everything down. */ if (mutex_init) { mutex_init = 0; MUTEX_DESTROY(&segment_mutex); MUTEX_DESTROY(&primary_cache_mutex); COND_DESTROY(&primary_cache_turn); } 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.73/aks.h0000644000076400007640000000014113204400603013634 0ustar danadana#ifndef MPU_AKS_H #define MPU_AKS_H #include "ptypes.h" extern int is_aks_prime(UV n); #endif Math-Prime-Util-0.73/entropy.h0000644000076400007640000000020513204400603014557 0ustar danadana#ifndef MPU_ENTROPY_H #define MPU_ENTROPY_H #include "ptypes.h" extern UV get_entropy_bytes(UV bytes, unsigned char* buf); #endif Math-Prime-Util-0.73/inc/0000755000076400007640000000000013373340013013467 5ustar danadanaMath-Prime-Util-0.73/inc/Devel/0000755000076400007640000000000013373340013014526 5ustar danadanaMath-Prime-Util-0.73/inc/Devel/CheckLib.pm0000644000076400007640000004577413204400603016544 0ustar danadana# $Id: CheckLib.pm,v 1.25 2008/10/27 12:16:23 drhyde Exp $ package # Devel::CheckLib; use 5.00405; #postfix foreach use strict; use vars qw($VERSION @ISA @EXPORT); $VERSION = '1.11'; use Config qw(%Config); use Text::ParseWords 'quotewords'; use File::Spec; use File::Temp; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(assert_lib check_lib_or_exit check_lib); # localising prevents the warningness leaking out of this module local $^W = 1; # use warnings is a 5.6-ism _findcc(); # bomb out early if there's no compiler =head1 NAME Devel::CheckLib - check that a library is available =head1 DESCRIPTION Devel::CheckLib is a perl module that checks whether a particular C library and its headers are available. =head1 SYNOPSIS use Devel::CheckLib; check_lib_or_exit( lib => 'jpeg', header => 'jpeglib.h' ); check_lib_or_exit( lib => [ 'iconv', 'jpeg' ] ); # or prompt for path to library and then do this: check_lib_or_exit( lib => 'jpeg', libpath => $additional_path ); =head1 USING IT IN Makefile.PL or Build.PL If you want to use this from Makefile.PL or Build.PL, do not simply copy the module into your distribution as this may cause problems when PAUSE and search.cpan.org index the distro. Instead, use the use-devel-checklib script. =head1 HOW IT WORKS You pass named parameters to a function, describing to it how to build and link to the libraries. It works by trying to compile some code - which defaults to this: int main(int argc, char *argv[]) { return 0; } and linking it to the specified libraries. If something pops out the end which looks executable, it gets executed, and if main() returns 0 we know that it worked. That tiny program is built once for each library that you specify, and (without linking) once for each header file. If you want to check for the presence of particular functions in a library, or even that those functions return particular results, then you can pass your own function body for main() thus: check_lib_or_exit( function => 'foo();if(libversion() > 5) return 0; else return 1;' incpath => ... libpath => ... lib => ... header => ... ); In that case, it will fail to build if either foo() or libversion() don't exist, and main() will return the wrong value if libversion()'s return value isn't what you want. =head1 FUNCTIONS All of these take the same named parameters and are exported by default. To avoid exporting them, C. =head2 assert_lib This takes several named parameters, all of which are optional, and dies with an error message if any of the libraries listed can not be found. B: dying in a Makefile.PL or Build.PL may provoke a 'FAIL' report from CPAN Testers' automated smoke testers. Use C instead. The named parameters are: =over =item lib Must be either a string with the name of a single library or a reference to an array of strings of library names. Depending on the compiler found, library names will be fed to the compiler either as C<-l> arguments or as C<.lib> file names. (E.g. C<-ljpeg> or C) =item libpath a string or an array of strings representing additional paths to search for libraries. =item LIBS a C-style space-separated list of libraries (each preceded by '-l') and directories (preceded by '-L'). This can also be supplied on the command-line. =item debug If true - emit information during processing that can be used for debugging. =back And libraries are no use without header files, so ... =over =item header Must be either a string with the name of a single header file or a reference to an array of strings of header file names. =item incpath a string or an array of strings representing additional paths to search for headers. =item INC a C-style space-separated list of incpaths, each preceded by '-I'. This can also be supplied on the command-line. =item ccflags Extra flags to pass to the compiler. =item ldflags Extra flags to pass to the linker. =item analyze_binary a callback function that will be invoked in order to perform custom analysis of the generated binary. The callback arguments are the library name and the path to the binary just compiled. It is possible to use this callback, for instance, to inspect the binary for further dependencies. =back =head2 check_lib_or_exit This behaves exactly the same as C except that instead of dieing, it warns (with exactly the same error message) and exits. This is intended for use in Makefile.PL / Build.PL when you might want to prompt the user for various paths and things before checking that what they've told you is sane. If any library or header is missing, it exits with an exit value of 0 to avoid causing a CPAN Testers 'FAIL' report. CPAN Testers should ignore this result -- which is what you want if an external library dependency is not available. =head2 check_lib This behaves exactly the same as C except that it is silent, returning false instead of dieing, or true otherwise. =cut sub check_lib_or_exit { eval 'assert_lib(@_)'; if($@) { warn $@; exit; } } sub check_lib { eval 'assert_lib(@_)'; return $@ ? 0 : 1; } # borrowed from Text::ParseWords sub _parse_line { my($delimiter, $keep, $line) = @_; my($word, @pieces); no warnings 'uninitialized'; # we will be testing undef strings while (length($line)) { # This pattern is optimised to be stack conservative on older perls. # Do not refactor without being careful and testing it on very long strings. # See Perl bug #42980 for an example of a stack busting input. $line =~ s/^ (?: # double quoted string (") # $quote ((?>[^\\"]*(?:\\.[^\\"]*)*))" # $quoted | # --OR-- # singe quoted string (') # $quote ((?>[^\\']*(?:\\.[^\\']*)*))' # $quoted | # --OR-- # unquoted string ( # $unquoted (?:\\.|[^\\"'])*? ) # followed by ( # $delim \Z(?!\n) # EOL | # --OR-- (?-x:$delimiter) # delimiter | # --OR-- (?!^)(?=["']) # a quote ) )//xs or return; # extended layout my ($quote, $quoted, $unquoted, $delim) = (($1 ? ($1,$2) : ($3,$4)), $5, $6); return() unless( defined($quote) || length($unquoted) || length($delim)); if ($keep) { $quoted = "$quote$quoted$quote"; } else { $unquoted =~ s/\\(.)/$1/sg; if (defined $quote) { $quoted =~ s/\\(.)/$1/sg if ($quote eq '"'); } } $word .= substr($line, 0, 0); # leave results tainted $word .= defined $quote ? $quoted : $unquoted; if (length($delim)) { push(@pieces, $word); push(@pieces, $delim) if ($keep eq 'delimiters'); undef $word; } if (!length($line)) { push(@pieces, $word); } } return(@pieces); } sub assert_lib { my %args = @_; my (@libs, @libpaths, @headers, @incpaths); # FIXME: these four just SCREAM "refactor" at me @libs = (ref($args{lib}) ? @{$args{lib}} : $args{lib}) if $args{lib}; @libpaths = (ref($args{libpath}) ? @{$args{libpath}} : $args{libpath}) if $args{libpath}; @headers = (ref($args{header}) ? @{$args{header}} : $args{header}) if $args{header}; @incpaths = (ref($args{incpath}) ? @{$args{incpath}} : $args{incpath}) if $args{incpath}; my $analyze_binary = $args{analyze_binary}; my @argv = @ARGV; push @argv, _parse_line('\s+', 0, $ENV{PERL_MM_OPT}||''); # work-a-like for Makefile.PL's LIBS and INC arguments # if given as command-line argument, append to %args for my $arg (@argv) { for my $mm_attr_key (qw(LIBS INC)) { if (my ($mm_attr_value) = $arg =~ /\A $mm_attr_key = (.*)/x) { # it is tempting to put some \s* into the expression, but the # MM command-line parser only accepts LIBS etc. followed by =, # so we should not be any more lenient with whitespace than that $args{$mm_attr_key} .= " $mm_attr_value"; } } } # using special form of split to trim whitespace if(defined($args{LIBS})) { foreach my $arg (split(' ', $args{LIBS})) { die("LIBS argument badly-formed: $arg\n") unless($arg =~ /^-[lLR]/); push @{$arg =~ /^-l/ ? \@libs : \@libpaths}, substr($arg, 2); } } if(defined($args{INC})) { foreach my $arg (split(' ', $args{INC})) { die("INC argument badly-formed: $arg\n") unless($arg =~ /^-I/); push @incpaths, substr($arg, 2); } } my ($cc, $ld) = _findcc($args{debug}, $args{ccflags}, $args{ldflags}); my @missing; my @wrongresult; my @wronganalysis; my @use_headers; # first figure out which headers we can't find ... for my $header (@headers) { push @use_headers, $header; my($ch, $cfile) = File::Temp::tempfile( 'assertlibXXXXXXXX', SUFFIX => '.c' ); my $ofile = $cfile; $ofile =~ s/\.c$/$Config{_o}/; print $ch qq{#include <$_>\n} for @use_headers; print $ch qq{int main(void) { return 0; }\n}; close($ch); my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe}; my @sys_cmd; # FIXME: re-factor - almost identical code later when linking if ( $Config{cc} eq 'cl' ) { # Microsoft compiler require Win32; @sys_cmd = ( @$cc, $cfile, "/Fe$exefile", (map { '/I'.Win32::GetShortPathName($_) } @incpaths), "/link", @$ld, split(' ', $Config{libs}), ); } elsif($Config{cc} =~ /bcc32(\.exe)?/) { # Borland @sys_cmd = ( @$cc, @$ld, (map { "-I$_" } @incpaths), "-o$exefile", $cfile ); } else { # Unix-ish: gcc, Sun, AIX (gcc, cc), ... @sys_cmd = ( @$cc, @$ld, $cfile, (map { "-I$_" } @incpaths), "-o", "$exefile" ); } warn "# @sys_cmd\n" if $args{debug}; my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd); push @missing, $header if $rv != 0 || ! -x $exefile; _cleanup_exe($exefile); unlink $cfile; } # now do each library in turn with headers my($ch, $cfile) = File::Temp::tempfile( 'assertlibXXXXXXXX', SUFFIX => '.c' ); my $ofile = $cfile; $ofile =~ s/\.c$/$Config{_o}/; print $ch qq{#include <$_>\n} foreach (@headers); print $ch "int main(int argc, char *argv[]) { ".($args{function} || 'return 0;')." }\n"; close($ch); for my $lib ( @libs ) { my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe}; my @sys_cmd; if ( $Config{cc} eq 'cl' ) { # Microsoft compiler require Win32; my @libpath = map { q{/libpath:} . Win32::GetShortPathName($_) } @libpaths; # this is horribly sensitive to the order of arguments @sys_cmd = ( @$cc, $cfile, "${lib}.lib", "/Fe$exefile", (map { '/I'.Win32::GetShortPathName($_) } @incpaths), "/link", @$ld, split(' ', $Config{libs}), (map {'/libpath:'.Win32::GetShortPathName($_)} @libpaths), ); } elsif($Config{cc} eq 'CC/DECC') { # VMS } elsif($Config{cc} =~ /bcc32(\.exe)?/) { # Borland @sys_cmd = ( @$cc, @$ld, "-o$exefile", (map { "-I$_" } @incpaths), (map { "-L$_" } @libpaths), "-l$lib", $cfile); } else { # Unix-ish # gcc, Sun, AIX (gcc, cc) @sys_cmd = ( @$cc, @$ld, $cfile, "-o", "$exefile", (map { "-I$_" } @incpaths), (map { "-L$_" } @libpaths), "-l$lib", ); } warn "# @sys_cmd\n" if $args{debug}; local $ENV{LD_RUN_PATH} = join(":", grep $_, @libpaths, $ENV{LD_RUN_PATH}) unless $^O eq 'MSWin32'; local $ENV{PATH} = join(";", @libpaths).";".$ENV{PATH} if $^O eq 'MSWin32'; my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd); if ($rv != 0 || ! -x $exefile) { push @missing, $lib; } else { my $absexefile = File::Spec->rel2abs($exefile); $absexefile = '"'.$absexefile.'"' if $absexefile =~ m/\s/; if (system($absexefile) != 0) { push @wrongresult, $lib; } else { if ($analyze_binary) { push @wronganalysis, $lib if !$analyze_binary->($lib, $exefile) } } } _cleanup_exe($exefile); } unlink $cfile; my $miss_string = join( q{, }, map { qq{'$_'} } @missing ); die("Can't link/include C library $miss_string, aborting.\n") if @missing; my $wrong_string = join( q{, }, map { qq{'$_'} } @wrongresult); die("wrong result: $wrong_string\n") if @wrongresult; my $analysis_string = join(q{, }, map { qq{'$_'} } @wronganalysis ); die("wrong analysis: $analysis_string") if @wronganalysis; } sub _cleanup_exe { my ($exefile) = @_; my $ofile = $exefile; $ofile =~ s/$Config{_exe}$/$Config{_o}/; # List of files to remove my @rmfiles; push @rmfiles, $exefile, $ofile, "$exefile\.manifest"; if ( $Config{cc} eq 'cl' ) { # MSVC also creates foo.ilk and foo.pdb my $ilkfile = $exefile; $ilkfile =~ s/$Config{_exe}$/.ilk/; my $pdbfile = $exefile; $pdbfile =~ s/$Config{_exe}$/.pdb/; push @rmfiles, $ilkfile, $pdbfile; } foreach (@rmfiles) { if ( -f $_ ) { unlink $_ or warn "Could not remove $_: $!"; } } return } # return ($cc, $ld) # where $cc is an array ref of compiler name, compiler flags # where $ld is an array ref of linker flags sub _findcc { my ($debug, $user_ccflags, $user_ldflags) = @_; # Need to use $keep=1 to work with MSWin32 backslashes and quotes my $Config_ccflags = $Config{ccflags}; # use copy so ASPerl will compile my @Config_ldflags = (); for my $config_val ( @Config{qw(ldflags)} ){ push @Config_ldflags, $config_val if ( $config_val =~ /\S/ ); } my @ccflags = grep { length } quotewords('\s+', 1, $Config_ccflags||'', $user_ccflags||''); my @ldflags = grep { length && $_ !~ m/^-Wl/ } quotewords('\s+', 1, @Config_ldflags, $user_ldflags||''); my @paths = split(/$Config{path_sep}/, $ENV{PATH}); my @cc = split(/\s+/, $Config{cc}); if (check_compiler ($cc[0], $debug)) { return ( [ @cc, @ccflags ], \@ldflags ); } # Find the extension for executables. my $exe = $Config{_exe}; if ($^O eq 'cygwin') { $exe = ''; } foreach my $path (@paths) { # Look for "$path/$cc[0].exe" my $compiler = File::Spec->catfile($path, $cc[0]) . $exe; if (check_compiler ($compiler, $debug)) { return ([ $compiler, @cc[1 .. $#cc], @ccflags ], \@ldflags) } next if ! $exe; # Look for "$path/$cc[0]" without the .exe, if necessary. $compiler = File::Spec->catfile($path, $cc[0]); if (check_compiler ($compiler, $debug)) { return ([ $compiler, @cc[1 .. $#cc], @ccflags ], \@ldflags) } } die("Couldn't find your C compiler.\n"); } sub check_compiler { my ($compiler, $debug) = @_; if (-f $compiler && -x $compiler) { if ($debug) { warn("# Compiler seems to be $compiler\n"); } return 1; } return ''; } # code substantially borrowed from IPC::Run3 sub _quiet_system { my (@cmd) = @_; # save handles local *STDOUT_SAVE; local *STDERR_SAVE; open STDOUT_SAVE, ">&STDOUT" or die "CheckLib: $! saving STDOUT"; open STDERR_SAVE, ">&STDERR" or die "CheckLib: $! saving STDERR"; # redirect to nowhere local *DEV_NULL; open DEV_NULL, ">" . File::Spec->devnull or die "CheckLib: $! opening handle to null device"; open STDOUT, ">&" . fileno DEV_NULL or die "CheckLib: $! redirecting STDOUT to null handle"; open STDERR, ">&" . fileno DEV_NULL or die "CheckLib: $! redirecting STDERR to null handle"; # run system command my $rv = system(@cmd); # restore handles open STDOUT, ">&" . fileno STDOUT_SAVE or die "CheckLib: $! restoring STDOUT handle"; open STDERR, ">&" . fileno STDERR_SAVE or die "CheckLib: $! restoring STDERR handle"; return $rv; } =head1 PLATFORMS SUPPORTED You must have a C compiler installed. We check for C<$Config{cc}>, both literally as it is in Config.pm and also in the $PATH. It has been tested with varying degrees of rigorousness on: =over =item gcc (on Linux, *BSD, Mac OS X, Solaris, Cygwin) =item Sun's compiler tools on Solaris =item IBM's tools on AIX =item SGI's tools on Irix 6.5 =item Microsoft's tools on Windows =item MinGW on Windows (with Strawberry Perl) =item Borland's tools on Windows =item QNX =back =head1 WARNINGS, BUGS and FEEDBACK This is a very early release intended primarily for feedback from people who have discussed it. The interface may change and it has not been adequately tested. Feedback is most welcome, including constructive criticism. Bug reports should be made using L or by email. When submitting a bug report, please include the output from running: perl -V perl -MDevel::CheckLib -e0 =head1 SEE ALSO L L =head1 AUTHORS David Cantrell Edavid@cantrell.org.ukE David Golden Edagolden@cpan.orgE Yasuhiro Matsumoto Emattn@cpan.orgE Thanks to the cpan-testers-discuss mailing list for prompting us to write it in the first place; to Chris Williams for help with Borland support; to Tony Cook for help with Microsoft compiler command-line options =head1 COPYRIGHT and LICENCE Copyright 2007 David Cantrell. Portions copyright 2007 David Golden. This module is free-as-in-speech software, and may be used, distributed, and modified under the same conditions as perl itself. =head1 CONSPIRACY This module is also free-as-in-mason software. =cut 1; Math-Prime-Util-0.73/primality.c0000644000076400007640000012025313370623653015112 0ustar danadana#include #include #include #include #include "ptypes.h" #define FUNC_is_strong_pseudoprime 1 #include "primality.h" #include "mulmod.h" #define FUNC_gcd_ui 1 #define FUNC_is_perfect_square #include "util.h" #include "montmath.h" /* Fast Montgomery math */ /* Primality related functions */ /******************************************************************************/ static int jacobi_iu(IV in, UV m) { int j = 1; UV n = (in < 0) ? -in : in; if (m <= 0 || (m%2) == 0) return 0; if (in < 0 && (m%4) == 3) j = -j; while (n != 0) { while ((n % 2) == 0) { n >>= 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; } static UV select_extra_strong_parameters(UV n, UV increment) { int j; UV D, P = 3; while (1) { D = P*P - 4; j = jacobi_iu(D, n); if (j == 0) return 0; if (j == -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 */ return P; } /* Fermat pseudoprime */ int is_pseudoprime(UV const n, UV a) { if (n < 4) return (n == 2 || n == 3); if (!(n&1) && !(a&1)) return 0; if (a < 2) croak("Base %"UVuf" is invalid", a); if (a >= n) { a %= n; if (a <= 1) return (a == 1); if (a == n-1) return !(a & 1); } #if USE_MONTMATH if (n & 1) { /* The Montgomery code only works for odd n */ const uint64_t npi = mont_inverse(n), mont1 = mont_get1(n); const uint64_t monta = (a == 2) ? mont_get2(n) : mont_geta(a, n); return mont_powmod(monta, n-1, n) == mont1; } #endif return powmod(a, n-1, n) == 1; /* a^(n-1) = 1 mod n */ } /* Euler (aka Euler-Jacobi) pseudoprime: a^((n-1)/2) = (a|n) mod n */ int is_euler_pseudoprime(UV const n, UV a) { if (n < 5) return (n == 2 || n == 3); if (!(n&1)) return 0; if (a < 2) croak("Base %"UVuf" is invalid", a); if (a > 2) { if (a >= n) { a %= n; if (a <= 1) return (a == 1); if (a == n-1) return !(a & 1); } if ((n % a) == 0) return 0; } { #if USE_MONTMATH const uint64_t npi = mont_inverse(n), mont1 = mont_get1(n); const uint64_t monta = mont_geta(a, n); UV ap = mont_powmod(monta, (n-1)>>1, n); if (ap != mont1 && ap != n-mont1) return 0; if (a == 2) { uint32_t nmod8 = n & 0x7; return (nmod8 == 1 || nmod8 == 7) ? (ap == mont1) : (ap == n-mont1); } else { return (kronecker_uu(a,n) >= 0) ? (ap == mont1) : (ap == n-mont1); } #else UV ap = powmod(a, (n-1)>>1, n); if (ap != 1 && ap != n-1) return 0; if (a == 2) { uint32_t nmod8 = n & 0x7; return (nmod8 == 1 || nmod8 == 7) ? (ap == 1) : (ap == n-1); } else { return (kronecker_uu(a,n) >= 0) ? (ap == 1) : (ap == n-1); } #endif } } /* Colin Plumb's extended Euler Criterion test. * A tiny bit (~1 percent) faster than base 2 Fermat or M-R. * More stringent than base 2 Fermat, but a subset of base 2 M-R. */ int is_euler_plumb_pseudoprime(UV const n) { UV ap; uint32_t nmod8 = n & 0x7; if (n < 5) return (n == 2 || n == 3); if (!(n&1)) return 0; #if USE_MONTMATH { const uint64_t npi = mont_inverse(n), mont1 = mont_get1(n); const uint64_t mont2 = mont_get2(n); ap = mont_powmod(mont2, (n-1) >> (1 + (nmod8 == 1)), n); if (ap == mont1) return (nmod8 == 1 || nmod8 == 7); if (ap == n-mont1) return (nmod8 == 1 || nmod8 == 3 || nmod8 == 5); } #else ap = powmod(2, (n-1) >> (1 + (nmod8 == 1)), n); if (ap == 1) return (nmod8 == 1 || nmod8 == 7); if (ap == n-1) return (nmod8 == 1 || nmod8 == 3 || nmod8 == 5); #endif return 0; } /* 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 miller_rabin(UV const n, const UV *bases, int nbases) { #if USE_MONTMATH MPUassert(n > 3, "MR called with n <= 3"); if ((n & 1) == 0) return 0; { const uint64_t npi = mont_inverse(n), mont1 = mont_get1(n); uint64_t a, ma, md, u = n-1; int i, j, t = 0; while (!(u&1)) { t++; u >>= 1; } for (j = 0; j < nbases; j++) { a = bases[j]; if (a < 2) croak("Base %"UVuf" is invalid", (UV)a); if (a >= n) { a %= n; if (a == 0 || (a == n-1 && a&1)) return 0; } ma = mont_geta(a,n); if (a == 1 || a == n-1 || !ma) continue; md = mont_powmod(ma, u, n); if (md != mont1 && md != n-mont1) { for (i=1; i 3, "MR called with n <= 3"); if ((n & 1) == 0) return 0; 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 == 0 || (a == n-1 && a&1)) return 0; } 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; } #endif return 1; } int 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_MONTMATH return is_strong_pseudoprime(n, 2) && is_almost_extra_strong_lucas_pseudoprime(n,1); #else { const uint64_t npi = mont_inverse(n), mont1 = mont_get1(n); const uint64_t mont2 = mont_get2(n); uint64_t md, u = n-1; int i, t = 0; UV P, V, d, s; /* M-R with base 2 */ while (!(u&1)) { t++; u >>= 1; } md = mont_powmod(mont2, u, n); if (md != mont1 && md != n-mont1) { for (i=1; i>= 1; } { const uint64_t montP = mont_geta(P, n); UV W, b; W = submod( mont_mulmod( montP, montP, n), mont2, n); V = montP; { UV v = d; b = 1; while (v >>= 1) b++; } while (b-- > 1) { UV T = submod( mont_mulmod(V, W, n), montP, n); if ( (d >> (b-1)) & UVCONST(1) ) { V = T; W = submod( mont_mulmod(W, W, n), mont2, n); } else { W = T; V = submod( mont_mulmod(V, V, n), mont2, n); } } } if (V == mont2 || V == (n-mont2)) return 1; while (s-- > 1) { if (V == 0) return 1; V = submod( mont_mulmod(V, V, n), mont2, n); if (V == mont2) return 0; } } return 0; #endif } /* Alternate modular lucas sequence code. * A bit slower than the normal one, but works with even valued n. */ static void alt_lucas_seq(UV* Uret, UV* Vret, UV* Qkret, UV n, UV Pmod, UV Qmod, UV k) { UV Uh, Vl, Vh, Ql, Qh; int j, s, m; Uh = 1; Vl = 2; Vh = Pmod; Ql = 1; Qh = 1; s = 0; m = 0; { UV v = k; while (!(v & 1)) { v >>= 1; s++; } } { UV v = k; while (v >>= 1) m++; } if (Pmod == 1 && Qmod == (n-1)) { int Sl = Ql, Sh = Qh; for (j = m; j > s; j--) { Sl *= Sh; Ql = (Sl==1) ? 1 : n-1; if ( (k >> j) & UVCONST(1) ) { Sh = -Sl; Uh = mulmod(Uh, Vh, n); Vl = submod(mulmod(Vh, Vl, n), Ql, n); Vh = submod(sqrmod(Vh, n), (Sh==1) ? 2 : n-2, n); } else { Sh = Sl; Uh = submod(mulmod(Uh, Vl, n), Ql, n); Vh = submod(mulmod(Vh, Vl, n), Ql, n); Vl = submod(sqrmod(Vl, n), (Sl==1) ? 2 : n-2, n); } } Sl *= Sh; Ql = (Sl==1) ? 1 : n-1; Uh = submod(mulmod(Uh, Vl, n), Ql, n); Vl = submod(mulmod(Vh, Vl, n), Ql, n); for (j = 0; j < s; j++) { Uh = mulmod(Uh, Vl, n); Vl = submod(sqrmod(Vl, n), (j>0) ? 2 : n-2, n); } *Uret = Uh; *Vret = Vl; *Qkret = (s>0)?1:n-1; return; } for (j = m; j > s; j--) { Ql = mulmod(Ql, Qh, n); if ( (k >> j) & UVCONST(1) ) { Qh = mulmod(Ql, Qmod, n); Uh = mulmod(Uh, Vh, n); Vl = submod(mulmod(Vh, Vl, n), mulmod(Pmod, Ql, n), n); Vh = submod(sqrmod(Vh, n), mulmod(2, Qh, n), n); } else { Qh = Ql; Uh = submod(mulmod(Uh, Vl, n), Ql, n); Vh = submod(mulmod(Vh, Vl, n), mulmod(Pmod, Ql, n), n); Vl = submod(sqrmod(Vl, n), mulmod(2, Ql, n), n); } } Ql = mulmod(Ql, Qh, n); Qh = mulmod(Ql, Qmod, n); Uh = submod(mulmod(Uh, Vl, n), Ql, n); Vl = submod(mulmod(Vh, Vl, n), mulmod(Pmod, Ql, n), n); Ql = mulmod(Ql, Qh, n); for (j = 0; j < s; j++) { Uh = mulmod(Uh, Vl, n); Vl = submod(sqrmod(Vl, n), mulmod(2, Ql, n), n); Ql = sqrmod(Ql, n); } *Uret = Uh; *Vret = Vl; *Qkret = Ql; } /* 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; MPUassert(n > 1, "lucas_sequence: modulus n must be > 1"); if (k == 0) { *Uret = 0; *Vret = 2; *Qkret = Q; return; } Qmod = (Q < 0) ? (UV) (Q + (IV)(((-Q/n)+1)*n)) : (UV)Q % n; Pmod = (P < 0) ? (UV) (P + (IV)(((-P/n)+1)*n)) : (UV)P % n; Dmod = submod( mulmod(Pmod, Pmod, n), mulmod(4, Qmod, n), n); if (Dmod == 0) { b = Pmod >> 1; *Uret = mulmod(k, powmod(b, k-1, n), n); *Vret = mulmod(2, powmod(b, k, n), n); *Qkret = powmod(Qmod, k, n); return; } if ((n % 2) == 0) { alt_lucas_seq(Uret, Vret, Qkret, n, Pmod, Qmod, k); return; } 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; } #define OVERHALF(v) ( (UV)((v>=0)?v:-v) > (UVCONST(1) << (BITS_PER_WORD/2-1)) ) int lucasu(IV* U, IV P, IV Q, UV k) { IV Uh, Vl, Vh, Ql, Qh; int j, s, n; if (U == 0) return 0; if (k == 0) { *U = 0; return 1; } Uh = 1; Vl = 2; Vh = P; Ql = 1; Qh = 1; s = 0; n = 0; { UV v = k; while (!(v & 1)) { v >>= 1; s++; } } { UV v = k; while (v >>= 1) n++; } for (j = n; j > s; j--) { if (OVERHALF(Uh) || OVERHALF(Vh) || OVERHALF(Vl) || OVERHALF(Ql) || OVERHALF(Qh)) return 0; Ql *= Qh; if ( (k >> j) & UVCONST(1) ) { Qh = Ql * Q; Uh = Uh * Vh; Vl = Vh * Vl - P * Ql; Vh = Vh * Vh - 2 * Qh; } else { Qh = Ql; Uh = Uh * Vl - Ql; Vh = Vh * Vl - P * Ql; Vl = Vl * Vl - 2 * Ql; } } if (OVERHALF(Ql) || OVERHALF(Qh)) return 0; Ql = Ql * Qh; Qh = Ql * Q; if (OVERHALF(Uh) || OVERHALF(Vh) || OVERHALF(Vl) || OVERHALF(Ql) || OVERHALF(Qh)) return 0; Uh = Uh * Vl - Ql; Vl = Vh * Vl - P * Ql; Ql = Ql * Qh; for (j = 0; j < s; j++) { if (OVERHALF(Uh) || OVERHALF(Vl) || OVERHALF(Ql)) return 0; Uh *= Vl; Vl = Vl * Vl - 2 * Ql; Ql *= Ql; } *U = Uh; return 1; } int lucasv(IV* V, IV P, IV Q, UV k) { IV Vl, Vh, Ql, Qh; int j, s, n; if (V == 0) return 0; if (k == 0) { *V = 2; return 1; } Vl = 2; Vh = P; Ql = 1; Qh = 1; s = 0; n = 0; { UV v = k; while (!(v & 1)) { v >>= 1; s++; } } { UV v = k; while (v >>= 1) n++; } for (j = n; j > s; j--) { if (OVERHALF(Vh) || OVERHALF(Vl) || OVERHALF(Ql) || OVERHALF(Qh)) return 0; Ql *= Qh; if ( (k >> j) & UVCONST(1) ) { Qh = Ql * Q; Vl = Vh * Vl - P * Ql; Vh = Vh * Vh - 2 * Qh; } else { Qh = Ql; Vh = Vh * Vl - P * Ql; Vl = Vl * Vl - 2 * Ql; } } if (OVERHALF(Ql) || OVERHALF(Qh)) return 0; Ql = Ql * Qh; Qh = Ql * Q; if (OVERHALF(Vh) || OVERHALF(Vl) || OVERHALF(Ql) || OVERHALF(Qh)) return 0; Vl = Vh * Vl - P * Ql; Ql = Ql * Qh; for (j = 0; j < s; j++) { if (OVERHALF(Vl) || OVERHALF(Ql)) return 0; Vl = Vl * Vl - 2 * Ql; Ql *= Ql; } *V = Vl; return 1; } /* Lucas tests: * 0: Standard * 1: Strong * 2: Stronger (Strong + page 1401 extra tests) * 3: Extra Strong (Mo/Jones/Grantham) * * None of them have any false positives for the BPSW test. Also see the * "almost extra strong" test. */ int is_lucas_pseudoprime(UV n, int strength) { IV P, Q, D; UV U, V, Qk, d, s; if (n < 5) return (n == 2 || n == 3); if ((n % 2) == 0 || n == UV_MAX) return 0; if (strength < 3) { UV Du = 5; IV sign = 1; int j; while (1) { D = Du * sign; j = jacobi_iu(D, n); if (j != 1 && Du != n) break; if (Du == 21 && is_perfect_square(n)) return 0; Du += 2; sign = -sign; } if (j != -1) return 0; P = 1; Q = (1 - D) / 4; if (strength == 2 && Q == -1) P=Q=D=5; /* Method A* */ /* Check gcd(n,2QD). gcd(n,2D) already done. */ Qk = (Q >= 0) ? Q % n : n-(((UV)(-Q)) % n); if (gcd_ui(Qk,n) != 1) return 0; } else { P = select_extra_strong_parameters(n, 1); if (P == 0) return 0; Q = 1; D = P*P - 4; } MPUassert( D == (P*P - 4*Q) , "is_lucas_pseudoprime: incorrect DPQ"); #if 0 /* Condition 2, V_n+1 = 2Q mod n */ { UV us, vs, qs; lucas_seq(&us, &vs, &qs, n, P, Q, n+1); return (vs == addmod(Q,Q,n)); } #endif #if 0 /* Condition 3, n is a epsp(Q) */ return is_euler_pseudoprime(n,Qk); #endif d = n+1; s = 0; if (strength > 0) while ( (d & 1) == 0 ) { s++; d >>= 1; } #if USE_MONTMATH { const uint64_t npi = mont_inverse(n), mont1 = mont_get1(n); const uint64_t mont2 = mont_get2(n); const uint64_t montP = (P == 1) ? mont1 : (P >= 0) ? mont_geta(P, n) : n - mont_geta(-P, n); const uint64_t montQ = (Q == 1) ? mont1 : (Q >= 0) ? mont_geta(Q, n) : n - mont_geta(-Q, n); const uint64_t montD = (D >= 0) ? mont_geta(D, n) : n - mont_geta(-D, n); 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_mulmod(U, V, n); if (sign == 1) V = submod( mont_sqrmod(V,n), mont2, n); else V = addmod( mont_sqrmod(V,n), mont2, n); sign = 1; if ( (d >> b) & UVCONST(1) ) { UV t2 = mont_mulmod(U, montD, n); if (P == 1) { U = addmod(U, V, n); V = addmod(V, t2, n); } else { U = addmod( mont_mulmod(U, montP, n), V, n); V = addmod( mont_mulmod(V, montP, n), 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 { Qk = montQ; while (b--) { U = mont_mulmod(U, V, n); V = submod( mont_sqrmod(V,n), addmod(Qk,Qk,n), n); Qk = mont_sqrmod(Qk,n); if ( (d >> b) & UVCONST(1) ) { UV t2 = mont_mulmod(U, montD, n); U = addmod( mont_mulmod(U, montP, n), V, n); if (U & 1) { U = (n>>1) + (U>>1) + 1; } else { U >>= 1; } V = addmod( mont_mulmod(V, montP, n), t2, n); if (V & 1) { V = (n>>1) + (V>>1) + 1; } else { V >>= 1; } Qk = mont_mulmod(Qk, montQ, n); } } } 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_sqrmod(V,n), addmod(Qk,Qk,n), n); Qk = mont_sqrmod(Qk,n); } } } else if (strength == 2) { UV Ql = 0, Qj = 0; int qjacobi, is_slpsp = 0; if (U == 0) is_slpsp = 1; while (s--) { if (V == 0) is_slpsp = 1; Ql = Qk; V = submod( mont_sqrmod(V,n), addmod(Qk,Qk,n), n); Qk = mont_sqrmod(Qk,n); } if (!is_slpsp) return 0; /* slpsp */ if (V != addmod(montQ,montQ,n)) return 0; /* V_{n+1} != 2Q mod n */ qjacobi = jacobi_iu(Q,n); Qj = (qjacobi == 0) ? 0 : (qjacobi == 1) ? montQ : n-montQ; if (Ql != Qj) return 0; /* n is epsp base Q */ return 1; } else { if ( U == 0 && (V == mont2 || V == (n-mont2)) ) return 1; s--; while (s--) { if (V == 0) return 1; if (s) V = submod( mont_sqrmod(V,n), mont2, n); } } return 0; } #else 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 (strength == 2) { UV Ql = 0, Qj = 0; UV Qu = (Q >= 0) ? Q % n : n-(((UV)(-Q)) % n); int qjacobi, is_slpsp = 0; if (U == 0) is_slpsp = 1; while (s--) { if (V == 0) is_slpsp = 1; Ql = Qk; V = mulsubmod(V, V, addmod(Qk,Qk,n), n); Qk = sqrmod(Qk, n); } if (!is_slpsp) return 0; /* slpsp */ if (V != addmod(Qu,Qu,n)) return 0; /* V_{n+1} != 2Q mod n */ qjacobi = jacobi_iu(Q,n); Qj = (qjacobi == 0) ? 0 : (qjacobi == 1) ? Qu : n-Qu; if (Ql != Qj) return 0; /* n is epsp base Q */ return 1; } 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; #endif } /* A generalization of Pari's shortcut to the extra-strong Lucas test. * * This only calculates and tests V, which means less work, but it does result * in a few more pseudoprimes than the full extra-strong 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. * * 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 is_almost_extra_strong_lucas_pseudoprime(UV n, UV increment) { UV P, V, W, d, s, b; if (n < 13) return (n == 2 || n == 3 || n == 5 || n == 7 || n == 11); if ((n % 2) == 0 || n == UV_MAX) return 0; if (increment < 1 || increment > 256) croak("Invalid lucas parameter increment: %"UVuf"\n", increment); /* Ensure small primes work with large increments. */ if ( (increment >= 16 && n <= 331) || (increment > 148 && n <= 631) ) return !!is_prob_prime(n); P = select_extra_strong_parameters(n, increment); if (P == 0) return 0; d = n+1; s = 0; while ( (d & 1) == 0 ) { s++; d >>= 1; } { UV v = d; b = 0; while (v >>= 1) b++; } #if USE_MONTMATH { const uint64_t npi = mont_inverse(n), mont1 = mont_get1(n); const uint64_t mont2 = mont_get2(n); const uint64_t montP = mont_geta(P, n); W = submod( mont_mulmod( montP, montP, n), mont2, n); V = montP; while (b--) { UV T = submod( mont_mulmod(V, W, n), montP, n); if ( (d >> b) & UVCONST(1) ) { V = T; W = submod( mont_mulmod(W, W, n), mont2, n); } else { W = T; V = submod( mont_mulmod(V, V, n), mont2, n); } } if (V == mont2 || V == (n-mont2)) return 1; s--; while (s--) { if (V == 0) return 1; if (s) V = submod( mont_mulmod(V, V, n), mont2, n); } return 0; } #else 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; #endif } typedef struct { unsigned short div; unsigned short period; unsigned short offset; } _perrin; #define NPERRINDIV 19 /* 1112 mask bytes */ static const uint32_t _perrinmask[] = {22,523,514,65890,8519810,130,4259842,0,526338,2147483904U,1644233728,1,8194,1073774592,1024,134221824,128,512,181250,2048,0,1,134217736,1049600,524545,2147500288U,0,524290,536870912,32768,33554432,2048,0,2,2,256,65536,64,536875010,32768,256,64,0,32,1073741824,0,1048576,1048832,371200000,0,0,536887552,32,2147487744U,2097152,32768,1024,0,1024,536870912,128,512,0,0,512,0,2147483650U,45312,128,0,8388640,0,8388608,8388608,0,2048,4096,92800000,262144,0,65536,4,0,4,4,4194304,8388608,1075838976,536870956,0,134217728,8192,0,8192,8192,0,2,0,268435458,134223392,1073741824,268435968,2097152,67108864,0,8192,1073741840,0,0,128,0,0,512,1450000,8,131136,536870928,0,4,2097152,4096,64,0,32768,0,0,131072,371200000,2048,33570816,4096,32,1024,536870912,1048576,16384,0,8388608,0,0,0,2,512,0,128,0,134217728,2,32,0,0,0,0,8192,0,1073742080,536870912,0,4096,16777216,526336,32,0,65536,33554448,708,67108864,2048,0,0,536870912,0,536870912,33554432,33554432,2147483648U,512,64,0,1074003968,512,0,524288,0,0,0,67108864,524288,1048576,0,131076,0,33554432,131072,0,2,8390656,16384,16777216,134217744,0,131104,0,2,32768,0,0,0,1450000,32768,0,0,0,0,0,16,0,1024,16400,1048576,32,1024,0,260,536870912,269484032,0,16384,0,524290,0,0,512,65536,0,0,0,134217732,0,67108880,536887296,0,0,32,0,65568,0,524288,2147483648U,0,4096,4096,134217984,268500992,0,33554432,131072,0,0,0,16777216,0,0,0,0,0,524288,0,0,67108864,0,0,2,0,2,32,1024,0}; static _perrin _perrindata[NPERRINDIV] = { {2, 7, 0}, {3, 13, 1}, {4, 14, 2}, {5, 24, 3}, {7, 48, 4}, {9, 39, 6}, {11, 120, 8}, {13, 183, 12}, {17, 288, 18}, {19, 180, 27}, {23, 22, 33}, {25, 120, 34}, {29, 871, 38}, {31, 993, 66}, {37, 1368, 98}, {41, 1723, 141}, {43, 231, 195}, {47, 2257, 203}, {223, 111, 274} }; /* Calculate signature using the doubling rule from Adams and Shanks 1982 */ static void calc_perrin_sig(UV* S, UV n) { #if USE_MONTMATH uint64_t npi = 0, mont1; int i; #endif UV T[6], T01, T34, T45; int b; /* Signature for n = 1 */ S[0] = 1; S[1] = n-1; S[2] = 3; S[3] = 3; S[4] = 0; S[5] = 2; if (n <= 1) return; #if USE_MONTMATH if ( (n&1) ) { npi = mont_inverse(n); mont1 = mont_get1(n); S[0] = mont1; S[1] = n-mont1; S[5] = addmod(mont1,mont1,n); S[2] = addmod(S[5],mont1,n); S[3] = S[2]; } #endif /* Bits in n */ { UV v = n; b = 1; while (v >>= 1) b++; } while (b-- > 1) { /* Double */ #if USE_MONTMATH if (n&1) { T[0] = submod(submod(mont_sqrmod(S[0],n), S[5],n), S[5],n); T[1] = submod(submod(mont_sqrmod(S[1],n), S[4],n), S[4],n); T[2] = submod(submod(mont_sqrmod(S[2],n), S[3],n), S[3],n); T[3] = submod(submod(mont_sqrmod(S[3],n), S[2],n), S[2],n); T[4] = submod(submod(mont_sqrmod(S[4],n), S[1],n), S[1],n); T[5] = submod(submod(mont_sqrmod(S[5],n), S[0],n), S[0],n); } else #endif { T[0] = submod(submod(sqrmod(S[0],n), S[5],n), S[5],n); T[1] = submod(submod(sqrmod(S[1],n), S[4],n), S[4],n); T[2] = submod(submod(sqrmod(S[2],n), S[3],n), S[3],n); T[3] = submod(submod(sqrmod(S[3],n), S[2],n), S[2],n); T[4] = submod(submod(sqrmod(S[4],n), S[1],n), S[1],n); T[5] = submod(submod(sqrmod(S[5],n), S[0],n), S[0],n); } /* Move to S, filling in */ T01 = submod(T[2], T[1], n); T34 = submod(T[5], T[4], n); T45 = addmod(T34, T[3], n); if ( (n >> (b-1)) & 1U ) { S[0] = T[0]; S[1] = T01; S[2] = T[1]; S[3] = T[4]; S[4] = T45; S[5] = T[5]; } else { S[0] = T01; S[1] = T[1]; S[2] = addmod(T01,T[0],n); S[3] = T34; S[4] = T[4]; S[5] = T45; } } #if USE_MONTMATH if (n&1) { /* Recover result from Montgomery form */ for (i = 0; i < 6; i++) S[i] = mont_recover(S[i],n); } #endif } int is_perrin_pseudoprime(UV n, int restricted) { int jacobi, i; UV S[6]; if (n < 3) return (n >= 2); if (!(n&1) && restricted > 2) return 0; /* Odds only for restrict > 2 */ /* Hard code the initial tests. 60% of composites caught by 4 tests. */ { uint32_t n32 = n % 10920; if (!(n32&1) && !(( 22 >> (n32% 7)) & 1)) return 0; if (!(n32%3) && !(( 523 >> (n32%13)) & 1)) return 0; if (!(n32%5) && !((65890 >> (n32%24)) & 1)) return 0; if (!(n32%4) && !(( 514 >> (n32%14)) & 1)) return 0; } for (i = 4; i < NPERRINDIV; i++) { if ((n % _perrindata[i].div) == 0) { const uint32_t *mask = _perrinmask + _perrindata[i].offset; unsigned short mod = n % _perrindata[i].period; if (!((mask[mod/32] >> (mod%32)) & 1)) return 0; } } /* Depending on which filters are used, 10-20% of composites are left. */ calc_perrin_sig(S, n); if (S[4] != 0) return 0; /* P(n) = 0 mod n */ if (restricted == 0) return 1; if (S[1] != n-1) return 0; /* P(-n) = -1 mod n */ if (restricted == 1) return 1; /* Full restricted test looks for an acceptable signature. * * restrict = 2 is Adams/Shanks without quadratic form test * * restrict = 3 is Arno or Grantham: No qform, also reject mults of 2 and 23 * * See: * Adams/Shanks 1982 pages 257-261 * Arno 1991 pages 371-372 * Grantham 2000 pages 5-6 */ jacobi = kronecker_su(-23,n); if (jacobi == -1) { /* Q-type */ UV B = S[2], B2 = sqrmod(B,n); UV A = submod(addmod(1,mulmod(B,3,n),n),B2,n); UV C = submod(mulmod(B2,3,n),2,n); if (S[0] == A && S[2] == B && S[3] == B && S[5] == C && B != 3 && submod(mulmod(B2,B,n),B,n) == 1) { MPUverbose(2, "%"UVuf" Q-Type %"UVuf" -1 %"UVuf" %"UVuf" 0 %"UVuf"\n", n, A, B, B, C); return 1; } } else { /* S-Type or I-Type */ if (jacobi == 0 && n != 23 && restricted > 2) { MPUverbose(2, "%"UVuf" Jacobi %d\n",n,jacobi); return 0; /* Adams/Shanks allows (-23|n) = 0 for S-Type */ } if (S[0] == 1 && S[2] == 3 && S[3] == 3 && S[5] == 2) { MPUverbose(2, "%"UVuf" S-Type 1 -1 3 3 0 2\n",n); return 1; } else if (S[0] == 0 && S[5] == n-1 && S[2] != S[3] && addmod(S[2],S[3],n) == n-3 && sqrmod(submod(S[2],S[3],n),n) == n-(23%n)) { MPUverbose(2, "%"UVuf" I-Type 0 -1 %"UVuf" %"UVuf" 0 -1\n",n, S[2], S[3]); return 1; } } MPUverbose(2, "%"UVuf" ? %2d ? %"UVuf" -1 %"UVuf" %"UVuf" 0 %"UVuf"\n", n, jacobi, S[0],S[2],S[3],S[5]); return 0; } int is_frobenius_pseudoprime(UV n, IV P, IV Q) { UV U, V, Qk, Vcomp; int k = 0; IV D; UV Du, Pu, Qu; if (n < 7) return (n == 2 || n == 3 || n == 5); if ((n % 2) == 0 || n == UV_MAX) return 0; if (P == 0 && Q == 0) { P = -1; Q = 2; if (n == 7) P = 1; /* So we don't test kronecker(-7,7) */ do { P += 2; if (P == 3) P = 5; /* P=3,Q=2 -> D=9-8=1 => k=1, so skip */ D = P*P-4*Q; Du = D >= 0 ? D : -D; k = kronecker_su(D, n); if (P == 10001 && is_perfect_square(n)) return 0; } while (k == 1); if (k == 0) return 0; /* D=P^2-8 will not be a perfect square */ MPUverbose(1, "%"UVuf" Frobenius (%"IVdf",%"IVdf") : x^2 - %"IVdf"x + %"IVdf"\n", n, P, Q, P, Q); Vcomp = 4; } else { D = P*P-4*Q; Du = D >= 0 ? D : -D; if (D != 5 && is_perfect_square(Du)) croak("Frobenius invalid P,Q: (%"IVdf",%"IVdf")", P, Q); } Pu = (P >= 0 ? P : -P) % n; Qu = (Q >= 0 ? Q : -Q) % n; Qk = gcd_ui(n, Pu*Qu*Du); if (Qk != 1) { if (Qk == n) return !!is_prob_prime(n); return 0; } if (k == 0) { k = kronecker_su(D, n); if (k == 0) return 0; if (k == 1) { Vcomp = 2; } else { Qu = addmod(Qu,Qu,n); Vcomp = (Q >= 0) ? Qu : n-Qu; } } lucas_seq(&U, &V, &Qk, n, P, Q, n-k); /* MPUverbose(1, "%"UVuf" Frobenius U = %"UVuf" V = %"UVuf"\n", n, U, V); */ if (U == 0 && V == Vcomp) return 1; return 0; } /* * Khashin, July 2018, https://arxiv.org/pdf/1807.07249.pdf * "Evaluation of the Effectiveness of the Frobenius Primality Test" * * See also the earlier https://arxiv.org/abs/1307.7920 * "Counterexamples for Frobenius primality test" * * 1. select c as first in [-1,2,3,4,5,6,...] where (c|n)=-1 * 2. Check this holds: * (2+sqrt(c)^n = 2-sqrt(c) mod n for c = -1,2 * (1+sqrt(c)^n = 1-sqrt(c) mod n for c = 3,4,5,6,... * * The paper claims there are no 64-bit counterexamples. */ int is_frobenius_khashin_pseudoprime(UV n) { int k = 2; UV ea, ra, rb, a, b, d = n-1, c = 1; 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; if (n % 4 == 3) c = d; else if (n % 8 == 5) c = 2; else do { /* c = first odd prime where (c|n)=-1 */ c += 2; if (c==9 || (c>=15 && (!(c%3) || !(c%5) || !(c%7) || !(c%11) || !(c%13)))) continue; k = kronecker_uu(c, n); } while (k == 1); if (k == 0 || (k == 2 && n % 3 == 0)) return 0; #if USE_MONTMATH { const uint64_t npi = mont_inverse(n); const uint64_t mont1 = mont_get1(n); const uint64_t montc = mont_geta(c, n); ra = a = ea = (k == 2) ? mont_get2(n) : mont1; rb = b = mont1; while (d) { if (d & 1) { UV ta=ra, tb=rb; ra = addmod( mont_mulmod(ta,a,n), mont_mulmod(mont_mulmod(tb,b,n),montc,n), n ); rb = addmod( mont_mulmod(tb,a,n), mont_mulmod(ta,b,n), n); } d >>= 1; if (d) { UV t = mont_mulmod(mont_mulmod(b,b,n),montc,n); b = mont_mulmod(b,a,n); b = addmod(b,b,n); a = addmod(mont_mulmod(a,a,n),t,n); } } return (ra == ea && rb == n-mont1); } #else ra = a = ea = (k == 2) ? 2 : 1; rb = b = 1; while (d) { if (d & 1) { /* This is faster than the 3-mulmod 5-addmod version */ UV ta=ra, tb=rb; ra = addmod( mulmod(ta,a,n), mulmod(mulmod(tb,b,n),c,n), n ); rb = addmod( mulmod(tb,a,n), mulmod(ta,b,n), n); } d >>= 1; if (d) { UV t = mulmod(sqrmod(b,n),c,n); b = mulmod(b,a,n); b = addmod(b,b,n); a = addmod(sqrmod(a,n),t,n); } } return (ra == ea && rb == n-1); #endif } /* * The Frobenius-Underwood test has no known counterexamples below 2^50, 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 is_frobenius_underwood_pseudoprime(UV n) { int j, 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; for (x = 0; x < 1000000; x++) { if (x==2 || x==4 || x==7 || x==8 || x==10 || x==14 || x==16 || x==18) continue; t = (IV)(x*x) - 4; j = jacobi_iu(t, n); if (j == -1) break; if (j == 0 || (x == 20 && is_perfect_square(n))) return 0; } if (x >= 1000000) croak("FU test failure, unable to find suitable a"); t1 = gcd_ui(n, (x+4)*(2*x+5)); if (t1 != 1 && t1 != n) return 0; np1 = n+1; { UV v = np1; len = 1; while (v >>= 1) len++; } #if USE_MONTMATH { const uint64_t npi = mont_inverse(n), mont1 = mont_get1(n); const uint64_t mont2 = mont_get2(n); const uint64_t mont5 = mont_geta(5, n); x = mont_geta(x, n); a = mont1; b = mont2; if (x == 0) { result = mont5; for (bit = len-2; bit >= 0; bit--) { t1 = addmod(b, b, n); b = mont_mulmod(submod(b, a, n), addmod(b, a, n), n); a = mont_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, mont2, n); result = addmod( addmod(x, x, n), mont5, n); for (bit = len-2; bit >= 0; bit--) { t1 = addmod( mont_mulmod(a, x, n), addmod(b, b, n), n); b = mont_mulmod(submod(b, a, n), addmod(b, a, n), n); a = mont_mulmod(a, t1, n); if ( (np1 >> bit) & UVCONST(1) ) { t1 = b; b = submod( addmod(b, b, n), a, n); a = addmod( mont_mulmod(a, multiplier, n), t1, n); } } } return (a == 0 && b == result); } #else 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); } } } MPUverbose(2, "%"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; #endif } /* We have a native-UV Lucas-Lehmer test with simple pretest. If 2^p-1 is * prime but larger than a UV, we'll have to bail, and they'll run the nice * GMP version. However, they're just asking if this is a Mersenne prime, and * there are millions of CPU years that have gone into enumerating them, so * instead we'll use a table. */ #define NUM_KNOWN_MERSENNE_PRIMES 50 static const uint32_t _mersenne_primes[NUM_KNOWN_MERSENNE_PRIMES] = {2,3,5,7,13,17,19,31,61,89,107,127,521,607,1279,2203,2281,3217,4253,4423,9689,9941,11213,19937,21701,23209,44497,86243,110503,132049,216091,756839,859433,1257787,1398269,2976221,3021377,6972593,13466917,20996011,24036583,25964951,30402457,32582657,37156667,42643801,43112609,57885161,74207281,77232917}; #define LAST_CHECKED_MERSENNE 45313991 int is_mersenne_prime(UV p) { int i; for (i = 0; i < NUM_KNOWN_MERSENNE_PRIMES; i++) if (p == _mersenne_primes[i]) return 1; return (p < LAST_CHECKED_MERSENNE) ? 0 : -1; } int lucas_lehmer(UV p) { UV k, V, mp; if (p == 2) return 1; if (!is_prob_prime(p)) return 0; if (p > BITS_PER_WORD) croak("lucas_lehmer with p > BITS_PER_WORD"); V = 4; mp = UV_MAX >> (BITS_PER_WORD - p); for (k = 3; k <= p; k++) { V = mulsubmod(V, V, 2, mp); } return (V == 0); } /******************************************************************************/ /* Hashing similar to Forišek and Jančina 2015, trial with 2/3/5/7/11. */ static const uint16_t mr_bases_hash32[256] = { 446,1150,304,24041,1595,15524,1743,6698,1724,2427,1088,7349,504,995,6399,2013,598,3314,3367,1930,3006,1845,2079,1843,694,2502,6957,1053,585,626,789,2115,1109,1105,3702,783,1324,2239,1553,5609,515,548,1371,2637,8606,532,3556,831,587,862,1355,501,6358,317,2585,12311,6181,145,3839,2976,2674,8124,2147,19598,8051,1178,3159,6184,9867,1954,7857,602,5023,5113,3152,4583,2361,101,464,1860,1862,5185,1368,15885,368,1068,307,12626,18646,26337,569,1690,551,1782,226,3235,1158,24247,8361,1719,56,14647,1687,1920,8109,6090,1725,1248,536,2869,1047,2512,13510,1026,250,1867,3694,2379,5175,2235,5885,5107,1079,290,2121,20729,1329,2168,34,15326,3226,2989,2313,710,4333,7861,166,11650,10876,777,30291,746,1278,6347,7751,179,2351,16695,1615,3575,5772,11790,5203,591,1354,12303,3827,702,7,5607,4246,440,566,1997,7315,1241,1193,2324,1530,1423,1664,16705,2012,6305,2410,39,1361,6440,1507,3065,1807,5486,19498,8599,9338,1522,238,1226,8103,15634,3559,3288,2898,21063,287,1011,4457,563,7654,5738,1621,3907,117,442,1124,12921,16838,164,41,313,1692,1574,1091,2804,1160,1263,4611,8508,3790,20765,3894,1304,1344,7628,10955,1045,7760,973,103,1621,10479,4064,5553,272,2213,1989,2074,2137,5201,1391,924,227,911,22969,3802,212,1391,1213,7517,4931,7789,3303,10669,137,4129,2734 }; int MR32(uint32_t n) { uint32_t x = n; if (x < 13) return (x == 2 || x == 3 || x == 5 || x == 7 || x == 11); if (!(x&1) || !(x%3) || !(x%5) || !(x%7) || !(x%11) ) return 0; x = (((x >> 16) ^ x) * 0x45d9f3b) & 0xFFFFFFFFUL; x = ((x >> 16) ^ x) & 255; return is_strong_pseudoprime(n, mr_bases_hash32[x]); } /******************************************************************************/ int is_prob_prime(UV n) { if (n < 11) { if (n == 2 || n == 3 || n == 5 || n == 7) return 2; else return 0; } #if BITS_PER_WORD == 64 if (n > UVCONST(4294967295)) { /* input is >= 2^32, UV is 64-bit*/ if (!(n%2) || !(n%3) || !(n%5) || !(n%7)) return 0; 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%59) || !(n%61) || !(n%67) || !(n%71)) return 0; if (!(n%73) || !(n%79) || !(n%83) || !(n%89)) return 0; /* AESLSP test costs about 1.5 Selfridges, vs. ~2.2 for strong Lucas. * This makes the full BPSW test cost about 2.5x M-R tests for a prime. */ return 2*BPSW(n); } else { #else { #endif uint32_t x = n; if (!(x%2) || !(x%3) || !(x%5) || !(x%7)) return 0; if (x < 121) /* 11*11 */ return 2; if (!(x%11) || !(x%13) || !(x%17) || !(x%19) || !(x%23) || !(x%29) || !(x%31) || !(x%37) || !(x%41) || !(x%43) || !(x%47) || !(x%53)) return 0; if (x < 3481) /* 59*59 */ return 2; /* Trial division crossover point depends on platform */ if (!USE_MONTMATH && n < 200000) { uint32_t f = 59; uint32_t limit = isqrt(n); while (f <= limit) { { if ((x%f) == 0) return 0; } f += 2; { if ((x%f) == 0) return 0; } f += 6; { if ((x%f) == 0) return 0; } f += 4; { if ((x%f) == 0) return 0; } f += 2; { if ((x%f) == 0) return 0; } f += 4; { if ((x%f) == 0) return 0; } f += 2; { if ((x%f) == 0) return 0; } f += 4; { if ((x%f) == 0) return 0; } f += 6; } return 2; } return 2*MR32(x); } } Math-Prime-Util-0.73/prime_nth_count.h0000644000076400007640000000141313355737466016311 0ustar danadana#ifndef MPU_PRIME_NTH_COUNT_H #define MPU_PRIME_NTH_COUNT_H #include "ptypes.h" extern UV prime_count(UV low, UV high); extern UV segment_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_upper(UV x); extern UV prime_count_lower(UV x); extern UV prime_count_approx(UV x); extern UV twin_prime_count(UV low, UV high); extern UV twin_prime_count_approx(UV n); extern UV nth_twin_prime(UV n); extern UV nth_twin_prime_approx(UV n); extern int sum_primes(UV low, UV high, UV *sum); extern int sum_primes128(UV n, UV *hisum, UV *losum); /* Used for a possible Ramanujan prime upper bound */ extern double ramanujan_sa_gn(UV un); #endif Math-Prime-Util-0.73/Makefile.PL0000644000076400007640000001404313373337725014712 0ustar danadanause ExtUtils::MakeMaker; use lib 'inc'; # load our bundled version of Devel::CheckLib use Devel::CheckLib; my %require_mpugmp; my $have_gmp = check_lib(lib => 'gmp', header => 'gmp.h'); if ($have_gmp) { warn "\n It looks like you have the GMP C library.\n"; warn " Adding Math::Prime::Util::GMP to dep list.\n\n"; $require_mpugmp{'Math::Prime::Util::GMP'} = '0.50'; } else { warn "\n It looks like you don't have the GMP library. Sad face.\n"; } 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 ' . 'random_prime.o ' . 'sieve.o ' . 'sieve_cluster.o ' . 'ramanujan_primes.o ' . 'semi_primes.o ' . 'prime_nth_count.o ' . 'util.o ' . 'entropy.o ' . 'csprng.o ' . 'chacha.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.57', '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', # Add in MPU::GMP if we can %require_mpugmp, }, META_MERGE => { 'meta-spec' => { version => '2', url => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec', }, dynamic_config => 1, # Check for GMP on install resources => { license => [ 'http://dev.perl.org/licenses/' ], homepage => 'https://github.com/danaj/Math-Prime-Util', repository => { url => 'https://github.com/danaj/Math-Prime-Util', }, }, provides => { 'ntheory' => { version => '0.73', file => 'lib/ntheory.pm', }, 'Math::Prime::Util' => { version => '0.73', file => 'lib/Math/Prime/Util.pm', }, 'Math::Prime::Util::MemFree' => { version => '0.73', file => 'lib/Math/Prime/Util/MemFree.pm', }, 'Math::Prime::Util::PP' => { version => '0.73', file => 'lib/Math/Prime/Util/PP.pm', }, 'Math::Prime::Util::PrimeArray' => { version => '0.73', file => 'lib/Math/Prime/Util/PrimeArray.pm', }, 'Math::Prime::Util::PrimeIterator' => { version => '0.73', file => 'lib/Math/Prime/Util/PrimeIterator.pm', }, 'Math::Prime::Util::Entropy' => { version => '0.73', file => 'lib/Math/Prime/Util/Entropy.pm', }, 'Math::Prime::Util::ChaCha' => { version => '0.73', file => 'lib/Math/Prime/Util/ChaCha.pm', }, # Skip: PPFE, PrimalityProving, RandomPrimes, ZetaBigFloat, # ECAffinePoint, ECProjectivePoint }, prereqs => { runtime => { recommends => { 'Math::Prime::Util::GMP' => 0.51, 'Math::BigInt::GMP' => 0, 'Digest::SHA' => 5.87, }, }, 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.73/ramanujan_primes.c0000644000076400007640000004231213357250560016430 0ustar danadana#include #include #include #include "ptypes.h" #define FUNC_log2floor 1 #include "util.h" #define FUNC_is_prime_in_sieve 1 #include "prime_nth_count.h" #include "sieve.h" #include "ramanujan_primes.h" /******************************************************************************/ /* RAMANUJAN PRIMES */ /******************************************************************************/ /* For Ramanujan prime estimates: * - counts are done via inverse nth, so only one thing to tune. * - For nth tables, upper values ok if too high, lower values ok if too low. * - both upper & lower empirically tested to 175e9 (175 thousand million), * with a return value of over 10^13. */ /* These are playing loose with Sondow/Nicholson/Noe 2011 theorem 4. * The last value should be rigorously checked using actual R_n values. */ static const uint32_t small_ram_upper_idx[] = { 3970,3980,5218,5221,5224,5226,5262,5270,5272,5278,5281,5553,5556,7432, 7449,7453,8580,8584,8607,12589,12603,12620,12729,18119,18134,18174,18289, 18300,18401,18419,25799,27247,27267,28663,39635,40061,40366,45338,51320, 64439,65566,65829,84761,89055,104959,107852,146968,151755,186499,217258, 223956,270700,332195,347223,440804,508096,565039,768276,828377,1090285, 1277320,1568165,1896508,2375799,3300765,4162908,5124977,6522443,9298256, 11406250, 15873245, 21307556, 29899174, 40666215, 57180770, 81543888, 119596564, 177392936, 266391665, 411512446, 646331578, 1043239835, 1723380058, UVCONST(2919198776), UVCONST(4294967295) }; #define SMALL_NRAM_UPPER_MULT 2852 #define SMALL_NRAM_UPPER (sizeof(small_ram_upper_idx)/sizeof(small_ram_upper_idx[0])) #if BITS_PER_WORD == 64 static const UV large_ram_upper_idx[] = { UVCONST( 2256197513), UVCONST( 2556868249), UVCONST( 2919198776), /* 11071, 11070, 11069, 11068, 11067, 11066, 11065, 11064, 11063 */ UVCONST( 3371836636), UVCONST( 3874119737), UVCONST( 4467380631), UVCONST( 5163817509), UVCONST( 5950413657), UVCONST( 6901033442), UVCONST( 8015893438), UVCONST( 9322299866), UVCONST( 10845166831), /* 11062, 11061, 11060, 11059, 11058, 11057, 11056, 11055, 11054 */ UVCONST( 12727569836), UVCONST( 14852585181), UVCONST( 17463419944), UVCONST( 20585027534), UVCONST( 24252210453), UVCONST( 28704897522), UVCONST( 34003499133), UVCONST( 40436019651), UVCONST( 48229247660), /* 11053, 11052, 11051, 11050, 11049, 11048, 11047, 11046, 11045 */ UVCONST( 57558675911), UVCONST( 69028965312), UVCONST( 83015434548), UVCONST( 100138535684), UVCONST( 121051505524), UVCONST( 146783829698), UVCONST( 178727808587), UVCONST( 218113299173), UVCONST( 267104085772), /* 11044, 11043, 11042, 11041, 11040, 11039, 11038, 11037, 11036 */ UVCONST( 328057281739), UVCONST( 404608665617), UVCONST( 500552556306), UVCONST( 621794385742), UVCONST( 774739900202), UVCONST( 969943548548), UVCONST( 1218276754392), UVCONST( 1536655221634), UVCONST( 1946308957195), /* 11035, 11034, 11033, 11032, 11031, 11030, 11029, 11028, 11027 */ UVCONST( 2475456777850), UVCONST( 3162491651655), UVCONST( 4058282334559), UVCONST( 5233096936468), UVCONST( 6776539822896), UVCONST( 8821085181511), UVCONST( 11539712635284), UVCONST( 15171808426849), UVCONST( 20056581407599), /* 11026, 11025, 11024, 11023, 11022, 11021, 11020, 11019, 11018 */ UVCONST( 26656864542121), UVCONST( 35627338984775), UVCONST( 47899755943330), UVCONST( 64773009691258), UVCONST( 88134778026475), UVCONST(120680838280663), UVCONST(166331208358410), UVCONST(230783974844445), UVCONST(322443487572932), /* 11017, 11016, 11015, 11014, 11013, 11012, 11011, 11010, 11009 */ UVCONST(453738479744216), UVCONST(643248344602940), UVCONST(918867804392140), UVCONST(1322953724888193),UVCONST(1920282116080684), 1.47*UVCONST(1920282116080684), /* Estimates for larger */ 2.3*UVCONST(1920282116080684), 3.4*UVCONST(1920282116080684), 5.1*UVCONST(1920282116080684), 7.9*UVCONST(1920282116080684), 12.2*UVCONST(1920282116080684), }; #define LARGE_NRAM_UPPER_MULT 11075 #define LARGE_NRAM_UPPER (sizeof(large_ram_upper_idx)/sizeof(large_ram_upper_idx[0])) #endif UV nth_ramanujan_prime_upper(UV n) { UV i, mult, res; if (n <= 2) return (n==0) ? 0 : (n==1) ? 2 : 11; res = nth_prime_upper(3*n); if (n < UVCONST(2256197512) || BITS_PER_WORD < 64) { /* While p_3n is a complete upper bound, Rp_n tends to p_2n, and * SNN(2011) theorem 4 shows how we can find (m,c) values where m < 1, * Rn < m*p_3n for all n > c. Here we use various quantized m values * and the table gives us c values where it applies. */ if (n < 20) mult = 3580; else if (n < 98) mult = 3340; else if (n < 1580) mult = 3040; else if (n < 3242) mult = 2885; else { for (i = 0; i < SMALL_NRAM_UPPER; i++) if (small_ram_upper_idx[i] > n) break; mult = SMALL_NRAM_UPPER_MULT-i; } if (res > (UV_MAX/mult)) res = (UV) (((long double) mult / 4096.0L) * res); else res = (res * mult) >> 12; #if BITS_PER_WORD == 64 } else { for (i = 0; i < LARGE_NRAM_UPPER; i++) if (large_ram_upper_idx[i] > n) break; mult = (LARGE_NRAM_UPPER_MULT-i); if (res > (UV_MAX/mult)) res = (UV) (((long double) mult / 16384.0L) * res); else res = (res * mult) >> 14; #endif } if (n > 43 && n < 10000) { /* Calculate upper bound using Srinivasan and Arés 2017 */ /* TODO We should construct a tighter bound like this. */ double s = (2 * (double)n) * (1.0L + 1.0L/ramanujan_sa_gn(n)); UV ps = nth_prime_upper( (UV) s ); if (ps < res) res = ps; } return res; } static const uint32_t small_ram_lower_idx[] = { 2785, 2800, 4275, 5935, 6107, 8797, 9556, 13314, 13641, 20457, 23745, 34432, 50564, 69194, 97434, 149399, 224590, 337116, 514260, 804041, 1317612, 2340461, 4332796, 8393680, 17227225, 38996663, 94437897, 253560792, 763315838, UVCONST(2663598260), UVCONST(4294967295) }; #define SMALL_NRAM_LOWER_MULT 557 #define SMALL_NRAM_LOWER (sizeof(small_ram_lower_idx)/sizeof(small_ram_lower_idx[0])) #if BITS_PER_WORD == 64 static const UV large_ram_lower_idx[] = { UVCONST( 2267483962), UVCONST( 2663598260), UVCONST( 3152476871), UVCONST( 3742932857), UVCONST( 4446913643), UVCONST( 5298293978), UVCONST( 6318053149), UVCONST( 7608807497), UVCONST( 9140758346), UVCONST( 11015956390), UVCONST( 13351265915), UVCONST( 16199147294), /* 4213, 4212, 4211, 4210, 4209, 4208, 4207, 4206, 4205 */ UVCONST( 19739499402), UVCONST( 24137542585), UVCONST( 29629560254), UVCONST( 36435870727), UVCONST( 45085624406), UVCONST( 55940244390), UVCONST( 69713814138), UVCONST( 87221199999), UVCONST( 109606558728), /* 4204, 4203, 4202, 4201, 4200, 4199, 4198, 4197, 4196 */ UVCONST( 138227790751), UVCONST( 175290761423), UVCONST( 223132516788), UVCONST( 285315117360), UVCONST( 366761235749), UVCONST( 473606049986), UVCONST( 614858505562), UVCONST( 802552362351), UVCONST( 1052957884730), /* 4195, 4194, 4193, 4192, 4191, 4190, 4189, 4188, 4187 */ UVCONST( 1389550174208), UVCONST( 1843854433659), UVCONST( 2461728402552), UVCONST( 3306766457564), UVCONST( 4469341663210), UVCONST( 6080948095909), UVCONST( 8329279118918), UVCONST( 11488848759561), UVCONST( 15959135388235), /* 4186, 4185, 4184, 4183, 4182, 4181, 4180, 4179, 4178 */ UVCONST( 22336622435614), UVCONST( 31501671598985), UVCONST( 44779902229212), UVCONST( 64180867011184), UVCONST( 92772523880955), UVCONST(135282253437392), UVCONST(199079826917291), UVCONST(295746797998912), UVCONST(443667118326600), /* 4177, 4176, 4175, 4174, 4173, 4172, 4171, 4170, 4169 */ UVCONST(672350086039900),UVCONST(1029719394152693),UVCONST(1594365662292999), 1.55*UVCONST(1594365662292999), /* estimates here and further */ 2.45*UVCONST(1594365662292999), 3.90*UVCONST(1594365662292999), 6.30*UVCONST(1594365662292999), 10.4*UVCONST(1594365662292999), 17.2*UVCONST(1594365662292999), }; #define LARGE_NRAM_LOWER_MULT 4225 #define LARGE_NRAM_LOWER (sizeof(large_ram_lower_idx)/sizeof(large_ram_lower_idx[0])) #endif UV nth_ramanujan_prime_lower(UV n) { UV res, i, mult; if (n <= 2) return (n==0) ? 0 : (n==1) ? 2 : 11; res = nth_prime_lower(2*n); if (n < UVCONST(2267483962) || BITS_PER_WORD < 64) { for (i = 0; i < SMALL_NRAM_LOWER; i++) if (small_ram_lower_idx[i] > n) break; mult = (SMALL_NRAM_LOWER_MULT-i); if (res > (UV_MAX/mult)) res = (UV) (((long double) mult / 512.0L) * res); else res = (res * mult) >> 9; #if BITS_PER_WORD == 64 } else { if (n < large_ram_lower_idx[LARGE_NRAM_LOWER-1]) { for (i = 0; i < LARGE_NRAM_LOWER; i++) if (large_ram_lower_idx[i] > n) break; mult = (LARGE_NRAM_LOWER_MULT-i); if (res > (UV_MAX/mult)) res = (UV) (((long double) mult / 4096.0L) * res); else res = (res * mult) >> 12; } #endif } return res; } /* An advantage of making these binary searches on the inverse is that we * don't have to tune them separately, and nothing changes if the prime * count bounds are modified. We do need to keep up to date with any * changes to nth_prime_{lower,upper} however. */ UV ramanujan_prime_count_lower(UV n) { UV lo, hi; if (n < 29) return (n < 2) ? 0 : (n < 11) ? 1 : (n < 17) ? 2 : 3; /* Binary search on nth_ramanujan_prime_upper */ /* We know we're between p_2n and p_3n, probably close to the former. */ lo = prime_count_lower(n)/3; hi = prime_count_upper(n) >> 1; while (lo < hi) { UV mid = lo + (hi-lo)/2; if (nth_ramanujan_prime_upper(mid) < n) lo = mid+1; else hi = mid; } return lo-1; } UV ramanujan_prime_count_upper(UV n) { /* return prime_count_upper(n) >> 1; */ /* Simple bound */ UV lo, hi; if (n < 29) return (n < 2) ? 0 : (n < 11) ? 1 : (n < 17) ? 2 : 3; /* Binary search on nth_ramanujan_prime_upper */ /* We know we're between p_2n and p_3n, probably close to the former. */ lo = prime_count_lower(n)/3; hi = prime_count_upper(n) >> 1; while (lo < hi) { UV mid = lo + (hi-lo)/2; if (nth_ramanujan_prime_lower(mid) < n) lo = mid+1; else hi = mid; } return lo-1; } /* Return array of first n ramanujan primes. Use Noe's algorithm. */ UV* n_ramanujan_primes(UV n) { UV max, k, s, *L; unsigned char* sieve; max = nth_ramanujan_prime_upper(n); /* Rn <= max, so we can sieve to there */ MPUverbose(2, "sieving to %"UVuf" for first %"UVuf" Ramanujan primes\n", max, n); Newz(0, L, n, UV); L[0] = 2; sieve = sieve_erat30(max); for (s = 0, k = 7; k <= max; k += 2) { if (is_prime_in_sieve(sieve, k)) s++; if (s < n) L[s] = k+1; if ((k & 3) == 1 && is_prime_in_sieve(sieve, (k+1)>>1)) s--; if (s < n) L[s] = k+2; } Safefree(sieve); return L; } UV* n_range_ramanujan_primes(UV nlo, UV nhi) { UV mink, maxk, k, s, *L; if (nlo == 0) nlo = 1; if (nhi == 0) nhi = 1; /* If we're starting from 1, just do single monolithic sieve */ if (nlo == 1) return n_ramanujan_primes(nhi); Newz(0, L, nhi-nlo+1, UV); if (nlo <= 1 && nhi >= 1) L[1-nlo] = 2; if (nlo <= 2 && nhi >= 2) L[2-nlo] = 11; if (nhi < 3) return L; mink = nth_ramanujan_prime_lower(nlo) - 1; maxk = nth_ramanujan_prime_upper(nhi) + 1; if (mink < 15) mink = 15; if (mink % 2 == 0) mink--; MPUverbose(2, "Rn[%"UVuf"] to Rn[%"UVuf"] Noe's: %"UVuf" to %"UVuf"\n", nlo, nhi, mink, maxk); s = 1 + prime_count(2,mink-2) - prime_count(2,(mink-1)>>1); { unsigned char *segment, *seg2 = 0; void* ctx = start_segment_primes(mink, maxk, &segment); UV seg_base, seg_low, seg_high, new_size, seg2beg, seg2end, seg2size = 0; while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { seg2beg = 30 * (((seg_low+1)>>1)/30); seg2end = 30 * ((((seg_high+1)>>1)+29)/30); new_size = (seg2end - seg2beg)/30 + 1; if (new_size > seg2size) { if (seg2size > 0) Safefree(seg2); New(0, seg2, new_size, unsigned char); seg2size = new_size; } (void) sieve_segment(seg2, seg2beg/30, seg2end/30); for (k = seg_low; k <= seg_high; k += 2) { if (is_prime_in_sieve(segment, k-seg_base)) s++; if (s >= nlo && s <= nhi) L[s-nlo] = k+1; if ((k & 3) == 1 && is_prime_in_sieve(seg2, ((k+1)>>1)-seg2beg)) s--; if (s >= nlo && s <= nhi) L[s-nlo] = k+2; } } end_segment_primes(ctx); Safefree(seg2); } MPUverbose(2, "Generated %"UVuf" Ramanujan primes from %"UVuf" to %"UVuf"\n", nhi-nlo+1, L[0], L[nhi-nlo]); return L; } UV nth_ramanujan_prime(UV n) { UV rn, *L; if (n <= 2) return (n == 0) ? 0 : (n == 1) ? 2 : 11; L = n_range_ramanujan_primes(n, n); rn = L[0]; Safefree(L); return rn; } /* Returns array of Ram primes between low and high, results from first->last */ UV* ramanujan_primes(UV* first, UV* last, UV low, UV high) { UV nlo, nhi, *L, lo, hi, mid; if (high < 2 || high < low) return 0; if (low < 2) low = 2; nlo = ramanujan_prime_count_lower(low); nhi = ramanujan_prime_count_upper(high); L = n_range_ramanujan_primes(nlo, nhi); /* Search for first entry in range */ for (lo = 0, hi = nhi-nlo+1; lo < hi; ) { mid = lo + (hi-lo)/2; if (L[mid] < low) lo = mid+1; else hi = mid; } *first = lo; /* Search for last entry in range */ for (hi = nhi-nlo+1; lo < hi; ) { mid = lo + (hi-lo)/2; if (L[mid] <= high) lo = mid+1; else hi = mid; } *last = lo-1; return L; } int is_ramanujan_prime(UV n) { UV beg, end, *L; if (!is_prime(n)) return 0; if (n < 17) return (n == 2 || n == 11); /* Generate Ramanujan primes and see if we're in the list. Slow. */ L = ramanujan_primes(&beg, &end, n, n); Safefree(L); return (beg <= end); } UV ramanujan_prime_count_approx(UV n) { /* Binary search on nth_ramanujan_prime_approx */ UV lo, hi; if (n < 29) return (n < 2) ? 0 : (n < 11) ? 1 : (n < 17) ? 2 : 3; lo = ramanujan_prime_count_lower(n); hi = ramanujan_prime_count_upper(n); while (lo < hi) { UV mid = lo + (hi-lo)/2; if (nth_ramanujan_prime_approx(mid) < n) lo = mid+1; else hi = mid; } return lo-1; } UV nth_ramanujan_prime_approx(UV n) { UV lo = nth_ramanujan_prime_lower(n), hi = nth_ramanujan_prime_upper(n); /* Our upper bounds come out much closer, so weight toward them. */ double weight = (n <= UVCONST(4294967295)) ? 1.62 : 1.51; return lo + weight * ((hi-lo) >> 1); } #if BITS_PER_WORD == 64 #define RAMPC2 56 static const UV ramanujan_counts_pow2[RAMPC2+1] = { 0, 1, 1, 1, 2, 4, 7, 13, 23, 42, 75, 137, 255, 463, 872, 1612, 3030, 5706, 10749, 20387, 38635, 73584, 140336, 268216, 513705, 985818, 1894120, 3645744, 7027290, 13561906, 26207278, 50697533, 98182656, 190335585, 369323301, 717267167, UVCONST( 1394192236), UVCONST( 2712103833), UVCONST( 5279763823), UVCONST( 10285641777), UVCONST( 20051180846), UVCONST( 39113482639), UVCONST( 76344462797), UVCONST( 149100679004), UVCONST( 291354668495), UVCONST( 569630404447), UVCONST( 1114251967767), UVCONST( 2180634225768), UVCONST( 4269555883751), UVCONST( 8363243713305), UVCONST( 16388947026629), UVCONST( 32129520311897), UVCONST( 63012603695171), UVCONST(123627200537929), UVCONST(242637500756376), UVCONST(476379740340417), UVCONST(935609435783647) }; #else #define RAMPC2 31 /* input limited */ static const UV ramanujan_counts_pow2[RAMPC2+1] = { 0, 1, 1, 1, 2, 4, 7, 13, 23, 42, 75, 137, 255, 463, 872, 1612, 3030, 5706, 10749, 20387, 38635, 73584, 140336, 268216, 513705, 985818, 1894120, 3645744, 7027290, 13561906, 26207278, 50697533 }; #endif static UV _ramanujan_prime_count(UV n) { UV i, v, rn, *L, window, swin, ewin, wlen, log2 = log2floor(n), winmult = 1; if (n <= 10) return (n < 2) ? 0 : 1; /* We have some perfect powers of 2 in our table */ if ((n & (n-1)) == 0 && log2 <= RAMPC2) return ramanujan_counts_pow2[log2]; MPUverbose(1, "ramanujan_prime_count calculating Pi(%"UVuf")\n",n); v = prime_count(2,n) - prime_count(2,n >> 1); /* For large enough n make a slightly bigger window */ if (n > 1000000000U) winmult = 16; while (1) { window = 20 * winmult; swin = (v <= window) ? 1 : v-window; ewin = v+window; wlen = ewin-swin+1; L = n_range_ramanujan_primes(swin, ewin); if (L[0] < n && L[wlen-1] > n) { /* Naive linear search from the start. */ for (i = 1; i < wlen; i++) if (L[i] > n && L[i-1] <= n) break; if (i < wlen) break; } winmult *= 2; MPUverbose(1, " ramanujan_prime_count increasing window\n"); } rn = swin + i - 1; Safefree(L); return rn; } UV ramanujan_prime_count(UV lo, UV hi) { UV count; if (hi < 2 || hi < lo) return 0; #if 1 count = _ramanujan_prime_count(hi); if (lo > 2) count -= _ramanujan_prime_count(lo-1); #else { UV beg, end, *L; /* Generate all Rp from lo to hi */ L = ramanujan_primes(&beg, &end, lo, hi); count = (L && end >= beg) ? end-beg+1 : 0; Safefree(L); } #endif return count; } Math-Prime-Util-0.73/sieve.h0000644000076400007640000001577713352074136014232 0ustar danadana#ifndef MPU_SIEVE_H #define MPU_SIEVE_H #include "ptypes.h" #define FUNC_ctz 1 #include "util.h" extern unsigned char* sieve_erat30(UV end); extern int sieve_segment_partial(unsigned char* mem, UV startd, UV endd, UV depth); 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); extern void* array_of_primes_in_range(UV* count, UV beg, UV end); 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 wheelretreat30[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}; /* Given a sieve byte, this indicates the first zero */ static const unsigned char nextzero30[256] = {0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,5,0,1,0,2,0,1, 0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,6,0,1,0,2,0,1,0,3,0,1,0,2, 0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1, 0,2,0,1,0,3,0,1,0,2,0,1,0,7,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3, 0,1,0,2,0,1,0,5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1, 0,6,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,5,0,1,0,2, 0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,8}; /* At this m (p-30*(p/30)), OR with this to clear previous entries */ static const unsigned char clearprev30[30] = { 0, 0, 1, 1, 1, 1, 1, 1, 3, 3, 3, 3, 7, 7, 15, 15, 15, 15, 31, 31, 63, 63, 63, 63,127,127,127,127,127,127}; #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; unsigned char s; if (p < 7) return (p < 2) ? 2 : (p < 3) ? 3 : (p < 5) ? 5 : 7; p++; if (p >= lastp) return 0; d = p/30; m = p - d*30; s = sieve[d] | clearprev30[m]; while (s == 0xFF) { d++; if (d*30 >= lastp) return 0; s = sieve[d]; } return d*30 + wheel30[nextzero30[s]]; } #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 #if 0 /* Useful macros for the wheel-30 sieve array */ #define START_DO_FOR_EACH_SIEVE_PRIME(sieve, base, a, b) \ { \ const unsigned char* sieve_ = sieve; \ UV base_ = base; \ UV p = a-base_; \ UV l_ = b; \ UV d_ = p/30; \ UV lastd_ = (l_-base_)/30; \ unsigned char bit_, s_ = sieve_[d_] | clearprev30[p-d_*30]; \ base_ += d_*30; \ while (1) { \ if (s_ == 0xFF) { \ do { \ base_ += 30; d_++; \ if (d_ > lastd_) break; \ s_ = sieve_[d_]; \ } while (s_ == 0xFF); \ if (d_ > lastd_) break; \ } \ bit_ = nextzero30[s_]; \ s_ |= 1 << bit_; \ p = base_ + wheel30[bit_]; \ if (p > l_ || p < base_) break; /* handle overflow */ \ { #define END_DO_FOR_EACH_SIEVE_PRIME \ } \ } \ } #else /* Extract word at a time, good suggestion from Kim Walisch */ static const unsigned char wheel240[] = {1,7,11,13,17,19,23,29,31,37,41,43,47,49,53,59,61,67,71,73,77,79,83,89,91,97,101,103,107,109,113,119,121,127,131,133,137,139,143,149,151,157,161,163,167,169,173,179,181,187,191,193,197,199,203,209,211,217,221,223,227,229,233,239}; #define START_DO_FOR_EACH_SIEVE_PRIME(sieve, base, a, b) \ { \ const UV* sieve_ = (const UV*)sieve; /* word ptr to sieve */ \ const UV nperw_ = 30*sizeof(UV); /* nums per word */ \ UV base_ = base; /* start of sieve n */ \ UV b_ = a; /* begin value n */ \ UV f_ = b; /* final value n */ \ UV begw_ = (b_-base_)/nperw_; /* first word */ \ UV endw_ = (f_-base_)/nperw_; /* first word */ \ UV sw_, tz_, p; \ base_ += begw_*nperw_; \ while (begw_ <= endw_) { \ sw_ = ~ LEUV(sieve_[begw_]); \ while (sw_ != 0) { \ tz_ = ctz(sw_); \ sw_ &= ~(UVCONST(1) << tz_); \ p = base_ + wheel240[tz_]; \ if (p > f_) break; \ if (p >= b_) { #define END_DO_FOR_EACH_SIEVE_PRIME \ } \ } \ begw_++; \ base_ += nperw_; \ } \ } #endif #define START_DO_FOR_EACH_PRIME(a, b) \ { \ const unsigned char* sieve_; \ UV p = a; \ UV l_ = b; \ UV d_ = p/30; \ UV lastd_ = l_/30; \ unsigned char s_, bit_; \ get_prime_cache(l_, &sieve_); \ if (p == 2) p = 1; \ s_ = sieve_[d_] | clearprev30[p-d_*30]; \ while (1) { \ if (p < 5) { \ p = (p < 2) ? 2 : (p < 3) ? 3 : 5; \ } else { \ if (s_ == 0xFF) { \ do { \ d_++; \ if (d_ > lastd_) break; \ s_ = sieve_[d_]; \ } while (s_ == 0xFF); \ if (d_ > lastd_) break; \ } \ bit_ = nextzero30[s_]; \ s_ |= 1 << bit_; \ p = d_*30 + wheel30[bit_]; \ if (p < d_*30) break; \ } \ if (p > l_) break; \ { \ #define RETURN_FROM_EACH_PRIME(retstmt) \ do { release_prime_cache(sieve_); retstmt; } while (0) #define END_DO_FOR_EACH_PRIME \ } \ } \ release_prime_cache(sieve_); \ } #endif Math-Prime-Util-0.73/chacha.c0000644000076400007640000002441513204400603014272 0ustar danadana/* * The ChaCha(20) CSPRNG interface. * New simple core, 10 Apr 2017, Dana Jacobsen */ /* Some benchmarks, repeatedly calling random_bytes(32768). Time is * shown as nanoseconds per 32-bit word. * * 3700 ns/word ChaCha20 in Perl * 760 ns/word ISAAC in Perl * * 16.89 ns/word ChaCha20 (simple from insane coding) * 11.20 ns/word ChaCha20 (openbsd) * 10.31 ns/word ChaCha20 (dj) * 3.26 ns/word ISAAC * 2.23 ns/word ChaCha20 (AVX2 Neves) * 1.95 ns/word PCG64 * 1.84 ns/word ChaCha20 (AVX2 chacha-opt) * 1.48 ns/word Xoroshiro128+ * 1.16 ns/word SplitMix64 */ #include #include #include #include "ptypes.h" #include "chacha.h" #define CHACHA_ROUNDS 20 #define RUN_INTERNAL_TESTS 1 #define RESEED_ON_REFILL 0 /*****************************************************************************/ /* Chacha routines: init, quarter round, core, keystream */ /*****************************************************************************/ /* On UltraSparc, Perl's versions of these macros will crash. */ #if !defined(__x86_64__) #undef U8TO32_LE #undef U32TO8_LE #endif #ifndef U8TO32_LE #define U8TO32_LE(p) \ (((uint32_t)((p)[0]) ) | \ ((uint32_t)((p)[1]) << 8) | \ ((uint32_t)((p)[2]) << 16) | \ ((uint32_t)((p)[3]) << 24)) #endif #ifndef U32TO8_LE #define U32TO8_LE(p, v) \ do { uint32_t _v = v; \ (p)[0] = (((_v) ) & 0xFFU); \ (p)[1] = (((_v) >> 8) & 0xFFU); \ (p)[2] = (((_v) >> 16) & 0xFFU); \ (p)[3] = (((_v) >> 24) & 0xFFU); } while (0) #endif static void init_context(chacha_context_t *ctx, const unsigned char *seed, int init_buffer) { uint32_t *x = ctx->state; x[ 0] = 0x61707865; x[ 1] = 0x3320646e; x[ 2] = 0x79622d32; x[ 3] = 0x6b206574; x[ 4] = U8TO32_LE((seed + 0)); x[ 5] = U8TO32_LE((seed + 4)); x[ 6] = U8TO32_LE((seed + 8)); x[ 7] = U8TO32_LE((seed + 12)); x[ 8] = U8TO32_LE((seed + 16)); x[ 9] = U8TO32_LE((seed + 20)); x[10] = U8TO32_LE((seed + 24)); x[11] = U8TO32_LE((seed + 28)); x[12] = 0; x[13] = 0; x[14] = U8TO32_LE((seed + 32)); x[15] = U8TO32_LE((seed + 36)); if (init_buffer) { memset(ctx->buf, 0, BUFSZ); ctx->have = 0; } } static INLINE uint32_t rotl32(uint32_t x, const unsigned int n) { return (x << n) | (x >> (-n & 31)); } #define QUARTERROUND(a,b,c,d) \ a += b; d = rotl32(d ^ a, 16); \ c += d; b = rotl32(b ^ c, 12); \ a += b; d = rotl32(d ^ a, 8); \ c += d; b = rotl32(b ^ c, 7); \ /* Produces buffer from state, does not change state */ static void chacha_core(unsigned char* buf, const chacha_context_t *ctx) { uint32_t i, x[16]; const uint32_t *s = ctx->state; memcpy(x, s, 16*sizeof(uint32_t)); for (i = 0; i < CHACHA_ROUNDS; i += 2) { QUARTERROUND( x[ 0], x[ 4], x[ 8], x[12] ); QUARTERROUND( x[ 1], x[ 5], x[ 9], x[13] ); QUARTERROUND( x[ 2], x[ 6], x[10], x[14] ); QUARTERROUND( x[ 3], x[ 7], x[11], x[15] ); QUARTERROUND( x[ 0], x[ 5], x[10], x[15] ); QUARTERROUND( x[ 1], x[ 6], x[11], x[12] ); QUARTERROUND( x[ 2], x[ 7], x[ 8], x[13] ); QUARTERROUND( x[ 3], x[ 4], x[ 9], x[14] ); } for (i = 0; i < 16; i++) x[i] += s[i]; #if __LITTLE_ENDIAN__ || (defined(BYTEORDER) && (BYTEORDER == 0x1234 || BYTEORDER == 0x12345678)) memcpy(buf, x, 16*sizeof(uint32_t)); #else for (i = 0; i < 16; i++) U32TO8_LE( buf+4*i, x[i] ); #endif } static INLINE void increment_chacha_counter(chacha_context_t *ctx) { /* Arguably we should continue this into their nonce */ if (++ctx->state[12] == 0) ctx->state[13]++; } static uint32_t chacha_keystream(unsigned char* buf, uint32_t n, chacha_context_t *ctx) { uint32_t r = n; while (r >= CORESZ) { chacha_core(buf, ctx); increment_chacha_counter(ctx); buf += CORESZ; r -= CORESZ; } if (r > 0) { unsigned char sbuf[CORESZ]; chacha_core(sbuf, ctx); increment_chacha_counter(ctx); memcpy(buf, sbuf, r); } return n; } /* The method for refilling our buffer. * This includes reseeding policy. */ static uint32_t _refill_buffer(chacha_context_t *ctx) { #if RESEED_ON_REFILL ctx->have = chacha_keystream(ctx->buf, BUFSZ, ctx); init_context(ctx, ctx->buf, 0); memset(ctx->buf, 0, KEYSZ); ctx->have = BUFSZ - KEYSZ; #else ctx->have = chacha_keystream(ctx->buf, BUFSZ, ctx); #endif return ctx->have; } /*****************************************************************************/ /* Test vectors */ /*****************************************************************************/ #if RUN_INTERNAL_TESTS static int _test_qr(void) { uint32_t i; uint32_t tv1i[4] = {0x11111111, 0x01020304, 0x9b8d6f43, 0x01234567}; uint32_t tv1o[4] = {0xea2a92f4, 0xcb1cf8ce, 0x4581472e, 0x5881c4bb}; uint32_t tv2i[4] = {0x516461b1, 0x2a5f714c, 0x53372767, 0x3d631689}; uint32_t tv2o[4] = {0xbdb886dc, 0xcfacafd2, 0xe46bea80, 0xccc07c79}; if (CHACHA_ROUNDS != 20) return 0; QUARTERROUND(tv1i[0],tv1i[1],tv1i[2],tv1i[3]); QUARTERROUND(tv2i[0],tv2i[1],tv2i[2],tv2i[3]); for (i = 0; i < 4; i++) { if (tv1i[i] != tv1o[i]) croak("QR test 2.1.1 fail %u\n",i); if (tv2i[i] != tv2o[i]) croak("QR test 2.2.1 fail %u\n",i); } return 1; } static int _test_core(void) { uint32_t test, i; unsigned char keys[6][40] = { {0},{0},{0},{0},{0} }; char ebuf[6][129] = { "76b8e0ada0f13d90405d6ae55386bd28bdd219b8a08ded1aa836efcc8b770dc7da41597c5157488d7724e03fb8d84a376a43b8f41518a11cc387b669b2ee6586", "4540f05a9f1fb296d7736e7b208e3c96eb4fe1834688d2604f450952ed432d41bbe2a0b6ea7566d2a5d1e7e20d42af2c53d792b1c43fea817e9ad275ae546963", "de9cba7bf3d69ef5e786dc63973f653a0b49e015adbff7134fcb7df137821031e85a050278a7084527214f73efc7fa5b5277062eb7a0433e445f41e31afab757", "ef3fdfd6c61578fbf5cf35bd3dd33b8009631634d21e42ac33960bd138e50d32111e4caf237ee53ca8ad6426194a88545ddc497a0b466e7d6bbdb0041b2f586b", "f798a189f195e66982105ffb640bb7757f579da31602fc93ec01ac56f85ac3c134a4547b733b46413042c9440049176905d3be59ea1c53f15916155c2be8241a", "10f1e7e4d13b5915500fdd1fa32071c4c7d1f4c733c068030422aa9ac3d46c4ed2826446079faa0914c2d705d98b02a2b5129cd1de164eb9cbd083e8a2503c4e", }; keys[1][31] = 1; keys[2][39] = 1; keys[3][32] = 1; for (i = 0; i < 32; i++) keys[4][ 0+i] = i; for (i = 0; i < 8; i++) keys[4][32+i] = i; for (i = 0; i < 32; i++) keys[5][ 0+i] = i; keys[5][35] = 0x4a; if (CHACHA_ROUNDS != 20) return 0; for (test = 0; test < 6; test++) { unsigned char* key = keys[test]; char* expout = ebuf[test]; char got[129]; chacha_context_t ctx; init_context(&ctx, key, 1); if (test == 5) { ctx.state[12]=1; ctx.state[13]=0x09000000; } chacha_core(ctx.buf, &ctx); if (test == 0) { for (i = 5; i < 16; i++) if (ctx.state[i] != 0) croak("core modified state"); } for (i = 0; i < 64; i++) sprintf(got+2*i,"%02x", ctx.buf[i]); got[128] = '\0'; if (memcmp(got, expout, 128)) croak("fail core test vector %u:\n exp %s\n got %s\n",test,expout,got); } return 1; } static int _test_keystream(void) { uint32_t test, i; unsigned char keys[2][40] = { {0},{0} }; char ebuf[2][1024+1] = { "f798a189f195e66982105ffb640bb7757f579da31602fc93ec01ac56f85ac3c134a4547b733b46413042c9440049176905d3be59ea1c53f15916155c2be8241a38008b9a26bc35941e2444177c8ade6689de95264986d95889fb60e84629c9bd9a5acb1cc118be563eb9b3a4a472f82e09a7e778492b562ef7130e88dfe031c79db9d4f7c7a899151b9a475032b63fc385245fe054e3dd5a97a5f576fe064025d3ce042c566ab2c507b138db853e3d6959660996546cc9c4a6eafdc777c040d70eaf46f76dad3979e5c5360c3317166a1c894c94a371876a94df7628fe4eaaf2ccb27d5aaae0ad7ad0f9d4b6ad3b54098746d4524d38407a6deb3ab78fab78c9", "af051e40bba0354981329a806a140eafd258a22a6dcb4bb9f6569cb3efe2deaf837bd87ca20b5ba12081a306af0eb35c41a239d20dfc74c81771560d9c9c1e4b224f51f3401bd9e12fde276fb8631ded8c131f823d2c06e27e4fcaec9ef3cf788a3b0aa372600a92b57974cded2b9334794cba40c63e34cdea212c4cf07d41b769a6749f3f630f4122cafe28ec4dc47e26d4346d70b98c73f3e9c53ac40c5945398b6eda1a832c89c167eacd901d7e2bf363", }; for (i = 0; i < 32; i++) keys[0][ 0+i] = i; for (i = 0; i < 8; i++) keys[0][32+i] = i; for (i = 0; i < 32; i++) keys[1][ 0+i] = i; keys[1][35] = 0x4a; if (CHACHA_ROUNDS != 20) return 0; for (test = 0; test < 2; test++) { unsigned char* key = keys[test]; char* expout = ebuf[test]; unsigned char kbuf[512]; char got[1024+1]; uint32_t gen, len = strlen(expout) / 2; chacha_context_t ctx; if (len > 512) croak("Test vector too large"); init_context(&ctx, key, 1); gen = chacha_keystream(kbuf, len, &ctx); if (gen < len) croak("short keystream"); /* Check state block counter */ for (i = 0; i < len; i++) sprintf(got+2*i,"%02x", kbuf[i]); got[2*len] = '\0'; if (memcmp(got, expout, 2*len)) croak("fail keystream test vector %u:\n exp %s\n got %s\n",test,expout,got); } return 1; } int chacha_selftest(void) { if (_test_qr() && _test_core() && _test_keystream()) return 1; return 0; } #else int chacha_selftest(void) { return 1; } #endif /*****************************************************************************/ /* API */ /*****************************************************************************/ void chacha_seed(chacha_context_t *cs, uint32_t bytes, const unsigned char* data, char good) { if (bytes < 40) croak("Not enough seed bytes given to ChaCha\n"); init_context(cs, data, 1); cs->goodseed = good; } void chacha_rand_bytes(chacha_context_t *cs, uint32_t bytes, unsigned char* data) { while (bytes > 0) { uint32_t copybytes; if (cs->have == 0) _refill_buffer(cs); copybytes = (bytes > cs->have) ? cs->have : bytes; memcpy(data, cs->buf + BUFSZ - cs->have, copybytes); data += copybytes; cs->have -= copybytes; bytes -= copybytes; } } uint32_t chacha_irand32(chacha_context_t *cs) { uint32_t a; unsigned char* ptr; if (cs->have < 4) _refill_buffer(cs); ptr = cs->buf + BUFSZ - cs->have; cs->have -= 4; a = U8TO32_LE(ptr); return a; } #if BITS_PER_WORD == 64 UV chacha_irand64(chacha_context_t *cs) { uint32_t a = chacha_irand32(cs); uint32_t b = chacha_irand32(cs); return (((UV)a) << 32) | b; } #else UV chacha_irand64(chacha_context_t *cs) { return chacha_irand32(cs); } #endif Math-Prime-Util-0.73/mulmod.h0000644000076400007640000001042313204400603014357 0ustar danadana#ifndef MPU_MULMOD_H #define MPU_MULMOD_H #include "ptypes.h" /* if n is smaller than this, you can multiply without overflow */ #define HALF_WORD (UVCONST(1) << (BITS_PER_WORD/2)) /* This will be true if we think mulmods are fast */ #define MULMODS_ARE_FAST 1 #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), "r"(b), "r"(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 t = a-n; a += b; asm ("add %2, %1\n\t" /* t := t + b */ "cmovc %1, %0\n\t" /* if (carry) a := t */ :"+r" (a), "+&r" (t) :"r" (b) :"cc" ); return a; } #define addmod(a,b,n) _addmod(a,b,n) #elif BITS_PER_WORD == 64 && HAVE_UINT128 /* 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. */ #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). */ #undef MULMODS_ARE_FAST #define MULMODS_ARE_FAST 0 /* 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.73/ptypes.h0000644000076400007640000001667113355737466014454 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; #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 #ifdef STANDALONE #include #include #include #include typedef unsigned long UV; typedef signed long IV; typedef double NV; typedef size_t STRLEN; #define UV_MAX ULONG_MAX #define IV_MAX LONG_MAX #define NV_MAX DBL_MAX #define UVCONST(x) ((unsigned long)x##UL) #define U32_CONST(x) ((unsigned int)x##U) #define UVuf "lu" #define IVdf "ld" #define NVff "f" /* Technically this is sizeof(NV) but that's not valid for macros */ #define NVSIZE 8 #define croak(fmt,...) { printf(fmt,##__VA_ARGS__); exit(3); } #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 isDIGIT(x) isdigit(x) #if ULONG_MAX >> 31 == 1 #define BITS_PER_WORD 32 #elif ULONG_MAX >> 63 == 1 #define BITS_PER_WORD 64 #else #error Unsupported bits per word (must be 32 or 64) #endif #else #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 #endif /* End of Perl specific section */ /* Try to determine if we have 64-bit available via uint64_t */ #if defined(UINT64_MAX) || defined(_UINT64_T) || defined(__UINT64_TYPE__) #define HAVE_STD_U64 1 #elif defined(_MSC_VER) /* We set up the types earlier */ #define HAVE_STD_U64 1 #else #define HAVE_STD_U64 0 #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); } #define MPUverbose(level,fmt,...) \ if (_XS_get_verbose() >= level) { printf(fmt,##__VA_ARGS__); fflush(stdout); } /* 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) #if defined(__SIZEOF_INT128__) && !defined(__CUDACC__) #define HAVE_UINT128 1 typedef unsigned __int128 uint128_t; #elif (__GNUC__ >= 4) && (defined(__x86_64__) || defined(__powerpc64__)) #if __clang__ && (__clang_major__ > 4 || (__clang_major__ == 4 && __clang_minor__ >= 2)) #define HAVE_UINT128 1 typedef unsigned __int128 uint128_t; #elif __GNUC__ < 4 || (__GNUC__ == 4 && __GNUC_MINOR__ < 4) #define HAVE_UINT128 0 #elif __GNUC__ == 4 && __GNUC_MINOR__ >= 4 && __GNUC_MINOR__ < 6 #define HAVE_UINT128 1 typedef unsigned int uint128_t __attribute__ ((__mode__ (TI))); #else #define HAVE_UINT128 1 typedef unsigned __int128 uint128_t; #endif #else #define HAVE_UINT128 0 #endif /* Perl 5.23.0 added the very helpful definition. Without it, guess. */ #ifndef NVMANTBITS #if NVSIZE <= 8 #define NVMANTBITS ((NVSIZE <= 4) ? 24 : 53) #elif defined(USE_QUADMATH) #define NVMANTBITS 112 #elif defined(__LDBL_MANT_DIG__) #define NVMANTBITS __LDBL_MANT_DIG__ #else #define NVMANTBITS 64 #endif #endif #if defined(USE_QUADMATH) typedef __float128 LNV; #define LNV_ZERO 0.0Q #define LNV_ONE 1.0Q #define LNVCONST(x) ((__float128)x##Q) #define loglnv(x) logq(x) #define explnv(x) expq(x) #define sqrtlnv(x) sqrtq(x) #define fabslnv(x) fabsq(x) #define LNV_EPSILON FLT128_EPSILON #define LNV_IS_QUAD 1 #else typedef long double LNV; #define LNV_ZERO 0.0L #define LNV_ONE 1.0L #define LNVCONST(x) ((long double)x##L) #define loglnv(x) logl(x) #define explnv(x) expl(x) #define sqrtlnv(x) sqrtl(x) #define fabslnv(x) fabsl(x) #define LNV_EPSILON LDBL_EPSILON #define LNV_IS_QUAD 0 #endif #if defined(__GNUC__) || defined(__clang__) #define INLINE inline #elif defined(_MSC_VER) #define INLINE __inline #else #define INLINE #endif #if __BIG_ENDIAN__ || (defined(BYTEORDER) && (BYTEORDER == 0x4321 || BYTEORDER == 0x87654321)) # if (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) || __GNUC__ >= 5 || (__clang__ && __clang_major__ >= 4) # if BITS_PER_WORD == 64 # define LEUV(x) __builtin_bswap64(x) # else # define LEUV(x) __builtin_bswap32(x) # endif # else # if BITS_PER_WORD == 64 /* compare to 5 step interleave */ static UV LEUV(UV x) { UV v = ((x & UVCONST(0xFF00000000000000)) >> 56) | ((x & UVCONST(0x00FF000000000000)) >> 40) | ((x & UVCONST(0x0000FF0000000000)) >> 24) | ((x & UVCONST(0x000000FF00000000)) >> 8) | ((x & UVCONST(0x00000000FF000000)) << 8) | ((x & UVCONST(0x0000000000FF0000)) << 24) | ((x & UVCONST(0x000000000000FF00)) << 40) | ((x & UVCONST(0x00000000000000FF)) << 56); return v; } # else static UV LEUV(UV x) { UV v = ((x & 0xFF000000) >> 24) | ((x & 0x00FF0000) >> 8) | ((x & 0x0000FF00) << 8) | ((x & 0x000000FF) << 24); return v; } # endif # endif #else /* LE */ # define LEUV(x) (x) #endif #endif Math-Prime-Util-0.73/xt/0000755000076400007640000000000013373340013013351 5ustar danadanaMath-Prime-Util-0.73/xt/check-nth-bounds.pl0000644000076400007640000000220613204400603017035 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use v5.16; use ntheory ":all"; my $small_nth = 1e7; my $small_rnth = 1e6; my $rp_inc = 1e9; print "Verifying nth prime bounds up to $small_nth\n"; { my $n = 1; forprimes { my $p = $_; my($l,$u) = (nth_prime_lower($n),nth_prime_upper($n)); die "$n: $l $p $u" unless $l <= $p && $u >= $p; $n++; } $small_nth; } print "Verifying nth Ramanujan prime bounds to $small_rnth\n"; { my $r = ramanujan_primes($small_rnth); for (0 .. $#$r) { my $n = $_+1; my $rn = $r->[$_]; my($l,$u) = (nth_ramanujan_prime_lower($n),nth_ramanujan_prime_upper($n)); die "$n: $l $rn $u" unless $l <= $rn && $u >= $rn; } } print "Verifying nth Ramanujan prime bounds:\n"; { my $s = 0; my $n = 1; while ($s < 1e12) { my $r = ramanujan_primes($s, $s + $rp_inc - 1); for (0 .. $#$r) { my $rn = $r->[$_]; my($l,$u) = (nth_ramanujan_prime_lower($n),nth_ramanujan_prime_upper($n)); die "$n: $l $rn $u" unless $l <= $rn && $u >= $rn; #die "$n: $rn" unless $rn == nth_ramanujan_prime($n); $n++; } print " $s + $rp_inc\n"; $s += $rp_inc; } } Math-Prime-Util-0.73/xt/primecount-many.t0000644000076400007640000001640613204400603016667 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/; 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. # All these results were verified on with MPU's LMO (28 July 2014). # 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, # ); 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.73/xt/totient-range.pl0000755000076400007640000000132013204400603016460 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util qw/euler_phi vecsum urandomm/; 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"; print "Running non-stop random tests. Break when desired.\n"; while (1) { my $beg = urandomm($limit); my $end = urandomm($limit); ($beg,$end) = ($end,$beg) if $beg > $end; # Does range return the same values? my $sum1 = vecsum( @phi[ $beg .. $end ] ); my $sum2 = vecsum( euler_phi($beg,$end) ); warn "\nbeg $beg end $end sum $sum1 range sum $sum2\n" unless $sum1 == $sum2; print "."; } Math-Prime-Util-0.73/xt/test-pcbounds.pl0000755000076400007640000000611313204400603016477 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/prime_count prime_count_lower prime_count_upper LogarithmicIntegral RiemannR/; use Math::Prime::Util::PP; use Math::BigInt try=>"GMP,Pari"; use Math::BigFloat; $| = 1; # fast pipes my %pivals = ( 1 => 1, 2 => 2, 3 => 4, 4 => 6, 5 => 11, 6 => 18, 7 => 31, 8 => 54, 9 => 97, 10 => 172, 11 => 309, 12 => 564, 13 => 1028, 14 => 1900, 15 => 3512, 16 => 6542, 17 => 12251, 18 => 23000, 19 => 43390, 20 => 82025, 21 => 155611, 22 => 295947, 23 => 564163, 24 => 1077871, 25 => 2063689, 26 => 3957809, 27 => 7603553, 28 => 14630843, 29 => 28192750, 30 => 54400028, 31 => 105097565, 32 => 203280221, 33 => 393615806, 34 => 762939111, 35 => 1480206279, 36 => 2874398515, 37 => 5586502348, 38 => 10866266172, 39 => 21151907950, 40 => 41203088796, 41 => 80316571436, 42 => 156661034233, 43 => 305761713237, 44 => 597116381732, 45 => 1166746786182, 46 => 2280998753949, 47 => 4461632979717, 48 => 8731188863470, 49 => 17094432576778, 50 => 33483379603407, 51 => 65612899915304, 52 => 128625503610475, 53 => 252252704148404, 54 => 494890204904784, 55 => 971269945245201, 56 => 1906879381028850, 57 => 3745011184713964, 58 => 7357400267843990, 59 => 14458792895301660, 60 => 28423094496953330, 61 => 55890484045084135, 62 => 109932807585469973, 63 => 216289611853439384, 64 => 425656284035217743, 65 => 837903145466607212, 66 => 1649819700464785589, 67 => 3249254387052557215, 68 => 6400771597544937806, 69 => 12611864618760352880, 70 => 24855455363362685793, 71 => 48995571600129458363, 72 => 96601075195075186855, 73 => 190499823401327905601, 74 => 375744164937699609596, 75 => 741263521140740113483, 76 => 1462626667154509638735, 77 => 2886507381056867953916, 78 => 5697549648954257752872, 79 => 11248065615133675809379, 80 => 22209558889635384205844, 81 => 43860397052947409356492, 82 => 86631124695994360074872, 83 => 171136408646923240987028, 84 => 338124238545210097236684, 85 => 668150111666935905701562, 86 => 1320486952377516565496055, ); print "\n"; print "Lower / Upper bounds. Percentages.\n"; print "\n"; printf(" N %12s %12s %12s %12s\n", "lower", "upper", "PP lower", "PP upper"); printf("----- %12s %12s %12s %12s\n", '-'x12,'-'x12,'-'x12,'-'x12); foreach my $e (sort {$a<=>$b} keys %pivals) { my $n = Math::BigInt->new(2)**$e; my ($pin, $pcl, $pcu, $ppl, $ppu) = map { Math::BigFloat->new($_) } ($pivals{$e}, prime_count_lower($n), prime_count_upper($n), Math::Prime::Util::PP::prime_count_lower($n), Math::Prime::Util::PP::prime_count_upper($n), ); #printf "10^%2d %12d %12d\n", length($n)-1, $pin-$pcl, $pcu-$pin; printf "2^%2d %12.8f %12.8f %12.8f %12.8f\n", $e, 100*($pin-$pcl)/$pin, 100*($pcu-$pin)/$pin, 100*($pin-$ppl)/$pin, 100*($ppu-$pin)/$pin; } Math-Prime-Util-0.73/xt/legendre_phi.t0000644000076400007640000000114512532503145016167 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.73/xt/test-znlog.pl0000755000076400007640000000171013204400603016011 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util qw/random_nbit_prime znprimroot znlog powmod/; # This test uses znlog with prime modulus, similar to FLINT's tests. # Our znlog will handle non-primes, so another interesting test would # be using random integer p values. my $ebits = 63; print "1..",$ebits-3,"\n"; for my $bits (4 .. $ebits) { #Math::Prime::Util::prime_set_config(verbose=>1) if $bits > 50; my $ntests = ($bits < 30) ? 100 : ($bits < 40) ? 10 : ($bits < 45) ? 5 : 1; my $ok = "ok"; for my $tn (1 .. $ntests) { my $p = random_nbit_prime( $bits ); my $root = znprimroot($p); my $b = int(rand($p-1)) + 1; my $d = znlog($b, $root, $p); my $res = powmod($root, $d, $p); next if $res == $b; $ok = "not ok"; warn "FAIL $bits: $root ^ $d mod $p = $res, not $b\n"; print "PASS $bits: $root ^ $d mod $p = $res\n"; } print "$ok ",$bits-3," - znlog with $bits bits\n"; } Math-Prime-Util-0.73/xt/nthprime.t0000644000076400007640000000772112532503145015376 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.73/xt/pari-compare.pl0000755000076400007640000002661012776251142016307 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 = 80_000; print "Comparing for small inputs: 0 - $small\n"; foreach my $n (0 .. $small) { print '.' unless ($n+1) % int($small/80); 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); for my $k (2,3,9,10) { die "valuation($n,$k)" unless Math::Pari::valuation($n,$k) == valuation($n,$k); } 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); if ($n > 1) { for (1..10) { my $k; do { $k = int(rand(50)) } while !($k % $n); die "binomial($n,$k)" unless Math::Pari::binomial($n,$k) == binomial($n,$k); my $negn = - ($n >> 1); die "binomial($negn,$k)" unless Math::Pari::binomial($negn,$k) == binomial($negn,$k); } } { my $d = $n+3; my @gmpu = gcdext($n,$d); my $gpari = Math::Pari::bezout($n,$d); die "gcdext($n,$d)" unless $gmpu[0] == $gpari->[0] && $gmpu[1] == $gpari->[1] && $gmpu[2] == $gpari->[2]; } 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 $invmod = invmod($m, $n); if (defined $invmod) { die "invmod($m, $n)" unless Math::Pari::lift(PARI "Mod(1/$m,$n)") == $invmod; } else { eval { PARI "Mod(1/$m,$n)" }; die "invmod($m, $n) defined in Pari" unless $@ =~ /impossible inverse/ || ($m == 0 && $@ =~ /division by zero/); } } { 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) == $order } 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); for my $k (2,3,9,10) { die "valuation($n,$k)" unless Math::Pari::valuation($n,$k) == valuation($n,$k); } 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); if ($n > 2) { for (1..10) { my $k; do { $k = int(rand(10)) } while !($k % $n); die "binomial($n,$k)" unless Math::Pari::binomial($n,$k) == binomial($n,$k); my $negn = - ($n >> 1); die "binomial($negn,$k)" unless Math::Pari::binomial($negn,$k) == binomial($negn,$k); } } # 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 $invmod = invmod($m, $n); if (defined $invmod) { die "invmod($m, $n)" unless Math::Pari::lift(PARI "Mod(1/$m,$n)") == $invmod; } else { eval { PARI "Mod(1/$m,$n)" }; die "invmod($m, $n) defined in Pari" unless $@ =~ /impossible inverse/ || ($m == 0 && $@ =~ /division by zero/); } } { 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) == $order; } 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 @gmpu = gcdext($a,$b); my $gpari = Math::Pari::bezout($a,$b); die "gcdext($a,$b)" unless $gmpu[0] == $gpari->[0] && $gmpu[1] == $gpari->[1] && $gmpu[2] == $gpari->[2]; } } { 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.73/xt/test-ispower.pl0000755000076400007640000000153613204400603016356 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util qw/is_prime is_power/; use Math::GMPz; foreach my $e (5 .. 37) { next unless is_prime($e); print "$e "; for (3..1000000) { my $n = Math::GMPz->new($_) ** $e; last if $n > ~0; die "$n\n" unless is_power($n); foreach my $o (-10..10) { my $m = $n+$o; next if $m==$n; die "$m\n" if is_power($m) && int(sqrt($m))**2 != $m && $m!=2197; } } } print "\n"; my $int = 100000; foreach my $i (1 .. 80*$int) { print "." unless $i % $int; my @iroots = (0,0,map { int($i ** (1.0/$_) + 0.00001) ** $_ } 2 .. 12); my $r; foreach my $e (2 .. 12) { if (is_power($i,$e,\$r)) { die "1 $i $e $r" unless $iroots[$e] == $i && $r ** $e == $i; } else { die "0 $i $e" unless $iroots[$e] != $i; } } } print "\n"; Math-Prime-Util-0.73/xt/test-factor-mpxs.pl0000755000076400007640000000212513204400603017124 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util qw/factor urandomm/; 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; 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 + urandomm($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.73/xt/test-primes-script2.pl0000755000076400007640000000740612532503145017563 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.73/xt/moebius-mertens.pl0000755000076400007640000000154612776251142017047 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util qw/moebius mertens vecsum/; 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 = vecsum(@mu_range); my $mo_sum = vecsum(@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.73/xt/primes-edgecases.pl0000755000076400007640000001146113204400603017127 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) = @_; if (Math::Prime::Util::prime_get_config->{'xs'}) { return Math::Prime::Util::segment_primes($low,$high); # Private function } else { return primes($low,$high); } } 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.73/xt/twin_prime_count.t0000644000076400007640000000577312776251142017151 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/twin_prime_count/; # 2^n using primesieve (fast), double checked with Pari 2.7.0 (slow): # a(n)=my(s, p=2); forprime(q=3, 2^n, if(q-p==2, s++); p=q); s # for (i=1,35,print(2^i," ", a(i))) # 10^n from tables my %tpcvals = ( 1 => 0, 2 => 0, 4 => 1, 8 => 2, 16 => 3, 32 => 5, 64 => 7, 128 => 10, 256 => 17, 512 => 24, 1024 => 36, 2048 => 62, 4096 => 107, 8192 => 177, 16384 => 290, 32768 => 505, 65536 => 860, 131072 => 1526, 262144 => 2679, 524288 => 4750, 1048576 => 8535, 2097152 => 15500, 4194304 => 27995, 8388608 => 50638, 16777216 => 92246, 33554432 => 168617, 67108864 => 309561, 134217728 => 571313, 268435456 => 1056281, 536870912 => 1961080, 1073741824 => 3650557, 2147483648 => 6810670, 4294967296 => 12739574, 8589934592 => 23878645, 17179869184 => 44849427, 34359738368 => 84384508, 68719476736 => 159082253, # 137438953472 => 300424743, 10 => 2, 100 => 8, 1000 => 35, 10000 => 205, 100000 => 1224, 1000000 => 8169, 10000000 => 58980, 100000000 => 440312, 1000000000 => 3424506, 10000000000 => 27412679, 100000000000 => 224376048, 1000000000000 => 1870585220, 10000000000000 => 15834664872, 100000000000000 => 135780321665, 1000000000000000 => 1177209242304, 10000000000000000 => 10304195697298, 100000000000000000 => 90948839353159, 1000000000000000000 => 808675888577436, ); plan tests => scalar(keys %tpcvals); foreach my $n (sort {$a <=> $b} keys %tpcvals) { my $tpc = $tpcvals{$n}; is( twin_prime_count($n), $tpc, "Pi_2($n) = $tpc" ); } Math-Prime-Util-0.73/xt/rwh_primecount.py0000755000076400007640000000136512453427654017017 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.73/xt/test-factor-yafu.pl0000755000076400007640000000563113204400603017106 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/factor urandomm/; 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; { # 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 + urandomm($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.73/xt/lucasuv.pl0000644000076400007640000000056213204400603015366 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use ntheory ":all"; use Math::GMP; for my $n (8539783 .. 8539788) { for (1..2000) { my($u,$v) = lucas_sequence($n, 1, -1, $_); my $u1 = Math::GMP->new(lucasu(1,-1,$_)) % $n; my $v1 = Math::GMP->new(lucasv(1,-1,$_)) % $n; die "U $_ $n $u $u1" unless $u==$u1; die "V $_ $n $v $v1" unless $v==$v1; } } Math-Prime-Util-0.73/xt/test-pcapprox.pl0000755000076400007640000000534012532503145016527 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.73/xt/create-pc-tables.pl0000755000076400007640000000445313204400603017025 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use ntheory ":all"; use v5.20; my $s = 0; if(0) { $s+= make_table(1, 15, 0, 9); $s+= make_table(2, 30, 9, 39); $s+= make_table(3, 60, 39, 63); $s+= make_table(4, 300, 60, 120); $s+= make_table(5, 30000, 120,3000); } if(0) { $s+= make_table(1, 15, 0, 9); $s+= make_table(2, 30, 9, 39); $s+= make_table(3, 60, 39, 63); $s+= make_table(4, 60, 63, 90); $s+= make_table(5, 15000, 90,3000); } if(0) { $s+= make_table(1, 5, 0, 1.5); $s+= make_table(2, 15, 1.5, 12); $s+= make_table(3, 30, 12, 39); $s+= make_table(4, 30, 39, 66); $s+= make_table(5, 60, 66, 90); $s+= make_table(6, 30000, 90,3000); } if(1) { # k M M $s+= make_table(0, 3, 0, 0.30); $s+= make_table(1, 6, 0.30, 3.0 ); $s+= make_table(2, 15, 3.0, 15 ); $s+= make_table(3, 30, 15, 42 ); $s+= make_table(4, 30, 42, 69 ); $s+= make_table(5, 60, 69, 90 ); $s+= make_table(6, 30000, 90, 3000 ); } say "/* $s bytes */"; sub make_table { my($name, $stepk, $start, $stop) = @_; my $step = 1000 * $stepk; $start *= 1_000_000; $stop *= 1_000_000; die "start must be less than stop" unless $start < $stop; die "start must be divisible by step" unless ($start % $step) == 0; die "stop must be divisible by step" unless ($stop % $step) == 0; my $s = $start / $step; my $pc = prime_count($start); my $nsteps = ($stop - $start) / $step; if ($start == 0) { $s = 0; $pc = prime_count(5); } my @c; { my($npc,$spc) = ($pc); @c = map { ($spc,$npc) = ($npc, prime_count(($s+$_)*$step)); $npc-$spc; } 1 .. $nsteps; } my $min = vecmin(@c); @c = map { $_-$min } @c; my $max = vecmax(@c); say "#define NSTEP_STEP_$name $step"; say "#define NSTEP_START_$name $start"; say "#define NSTEP_COUNT_$name $pc"; say "#define NSTEP_BASE_$name $min"; my $type = ($max <= 255) ? "char" : ($max <= 65535) ? "short" : "int"; say "static const unsigned $type step_counts_${name}[] ="; say "{",join(",",@c),"};"; say "#define NSTEP_NUM_$name (sizeof(step_counts_$name)/sizeof(step_counts_${name}[0]))"; say ""; return scalar(@c) * (($max <= 255) ? 1 : ($max <= 65535) ? 2 : 4); } Math-Prime-Util-0.73/xt/pari-totient-moebius.pl0000755000076400007640000000212013204400603017757 0ustar danadanause warnings; $| = 1; # fast pipes use Math::Prime::Util qw/urandomm/; 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 + urandomm($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.73/xt/test-bpsw.pl0000755000076400007640000001143513204400603015640 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util qw/urandomm/; use Math::Primality; use Config; my $nlinear = 10000; my $nrandom = shift || 20000; my $randmax = ~0; 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 + urandomm($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 + urandomm($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 + urandomm($range); my $rand_base = 2 + urandomm($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/; require Math::Prime::Util::PP; 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.73/xt/test-nthapprox.pl0000755000076400007640000000306412532503145016717 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.73/xt/measure_zeta_accuracy.pl0000755000076400007640000000651113210572416020256 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 you need one of: - a recent Math::Prime::Util::GMP backend (late 2016) - a recent Math::BigInt (mid-2014) 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.73/xt/nth_twin_prime.t0000644000076400007640000000337713204400603016571 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/twin_prime_count nth_twin_prime/; # 2^n using primesieve (fast), double checked with Pari 2.7.0 (slow): # a(n)=my(s, p=2); forprime(q=3, 2^n, if(q-p==2, s++); p=q); s # for (i=1,35,print(2^i," ", a(i))) # 10^n from tables my %nthvals = ( # 0 => undef, 1 => 3, 2 => 5, 3 => 11, 5 => 29, 7 => 59, 8 => 71, 10 => 107, 17 => 239, 24 => 461, 35 => 881, 36 => 1019, 62 => 2027, 107 => 4091, 177 => 8087, 205 => 9929, 290 => 16361, 505 => 32717, 860 => 65519, 1224 => 99989, 1526 => 131009, 2679 => 262109, 4750 => 524219, 8169 => 999959, 8535 => 1048571, 15500 => 2097131, 27995 => 4193801, 50638 => 8388449, 58980 => 9999971, 92246 => 16777139, 168617 => 33554009, 309561 => 67108667, 440312 => 99999587, 571313 => 134217437, 1056281 => 268435007, 1961080 => 536870837, 3424506 => 999999191, 3650557 => 1073741717, 6810670 => 2147482949, 12739574 => 4294965839, 23878645 => 8589934289, 27412679 => 9999999701, 44849427 => 17179868807, 84384508 => 34359737297, 159082253 => 68719476389, 224376048 => 99999999761, 1870585220 => 999999999959, ); plan tests => scalar(keys %nthvals); foreach my $n (sort {$a <=> $b} keys %nthvals) { my $ntp = $nthvals{$n}; is( nth_twin_prime($n), $ntp, "nth_twin_prime($n) = $ntp" ); } Math-Prime-Util-0.73/xt/factor-holf.pl0000755000076400007640000000121212776251142016123 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/is_prime factor holf_factor/; my $hrounds = 512*1024*1024; for (2 .. 1e10) { my @fs; my $s_fact = join(".",sort {$a<=>$b} factor($_)); my @p_holf; push @fs, $_; while (@fs) { my $n = pop @fs; if (is_prime($n)) { push @p_holf, $n; } else { my @f = holf_factor($n,$hrounds); die "Could not factor $n\n" if scalar @f == 1; push @fs, @f; } } 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.73/xt/small-is-next-prev.pl0000755000076400007640000001336313204400603017361 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 $n == 0 || 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 $n==0 || 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 $n==0 || $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 $n==0 || $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 $n==0 || $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 $n==0 || $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 $n==0 || $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.73/xt/chinese.pl0000755000076400007640000000777112776251142015355 0ustar danadana#!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util qw/chinese lcm/; use Math::ModInt qw(mod); use Math::ModInt::ChineseRemainder qw(cr_combine); my $limit = shift || 10_000; my $printmod = int(($limit+77) / 78); print "Running $limit random tests with 2 small inputs...\n"; for my $n (1 .. $limit) { print '.' unless $n % $printmod; my (@rm) = map { my $m = 1+int(rand(2**16)); [int(rand($m)),$m] } 1..2; #print join(" ", map { "[$_->[0] $_->[1]]" } @rm), "\n"; my $mic = cr_combine( map { mod($_->[0],$_->[1]) } @rm ); if ($mic->is_undefined) { my $mpu_res = chinese(@rm); die "MIC: undef MPU: $mpu_res\n" if defined $mpu_res; next; } my $mic_res = $mic->residue; my $mic_mod = $mic->modulus; my $mpu_res = chinese(@rm); die "MIC: $mic_res $mic_mod MPU: undef\n" if !defined $mpu_res; my $mpu_mod = lcm(map { $_->[1] } @rm); die "MIC: $mic_res $mic_mod MPU: $mpu_res $mpu_mod" if $mpu_res != $mic_res || $mpu_mod != $mic_mod; } print "\nRunning $limit random tests with 2 large inputs...\n"; for my $n (1 .. $limit) { print '.' unless $n % $printmod; my (@rm) = map { my $m = 1+int(rand(2**32)); [int(rand($m)),$m] } 1..2; #print join(" ", map { "[$_->[0] $_->[1]]" } @rm), "\n"; my $mic = cr_combine( map { mod($_->[0],$_->[1]) } @rm ); if ($mic->is_undefined) { my $mpu_res = chinese(@rm); die "MIC: undef MPU: $mpu_res\n" if defined $mpu_res; next; } my $mic_res = $mic->residue; my $mic_mod = $mic->modulus; my $mpu_res = chinese(@rm); die "MIC: $mic_res $mic_mod MPU: undef\n" if !defined $mpu_res; my $mpu_mod = lcm(map { $_->[1] } @rm); die "MIC: $mic_res $mic_mod MPU: $mpu_res $mpu_mod" if $mpu_res != $mic_res || $mpu_mod != $mic_mod; } print "\nRunning $limit random tests with 4 small inputs...\n"; for my $n (1 .. $limit) { print '.' unless $n % $printmod; my (@rm) = map { my $m = 1+int(rand(2**16)); [int(rand($m)),$m] } 1..4; #print join(" ", map { "[$_->[0] $_->[1]]" } @rm), "\n"; my $mic = cr_combine( map { mod($_->[0],$_->[1]) } @rm ); if ($mic->is_undefined) { my $mpu_res = chinese(@rm); die "MIC: undef MPU: $mpu_res\n" if defined $mpu_res; next; } my $mic_res = $mic->residue; my $mic_mod = $mic->modulus; my $mpu_res = chinese(@rm); die "MIC: $mic_res $mic_mod MPU: undef\n" if !defined $mpu_res; my $mpu_mod = lcm(map { $_->[1] } @rm); die "MIC: $mic_res $mic_mod MPU: $mpu_res $mpu_mod" if $mpu_res != $mic_res || $mpu_mod != $mic_mod; } print "\nRunning $limit random tests with 3 large inputs...\n"; for my $n (1 .. $limit) { print '.' unless $n % $printmod; my (@rm) = map { my $m = 1+int(rand(2**40)); [int(rand($m)),$m] } 1..3; #print join(" ", map { "[$_->[0] $_->[1]]" } @rm), "\n"; my $mic = cr_combine( map { mod($_->[0],$_->[1]) } @rm ); if ($mic->is_undefined) { my $mpu_res = chinese(@rm); die "MIC: undef MPU: $mpu_res\n" if defined $mpu_res; next; } my $mic_res = $mic->residue; my $mic_mod = $mic->modulus; my $mpu_res = chinese(@rm); die "MIC: $mic_res $mic_mod MPU: undef\n" if !defined $mpu_res; my $mpu_mod = lcm(map { $_->[1] } @rm); die "MIC: $mic_res $mic_mod MPU: $mpu_res $mpu_mod" if $mpu_res != $mic_res || $mpu_mod != $mic_mod; } print "\nRunning $limit random tests with 13 large inputs...\n"; for my $n (1 .. $limit) { print '.' unless $n % $printmod; my (@rm) = map { my $m = 1+int(rand(2**31)); [int(rand($m)),$m] } 1..13; #print join(" ", map { "[$_->[0] $_->[1]]" } @rm), "\n"; my $mic = cr_combine( map { mod($_->[0],$_->[1]) } @rm ); if ($mic->is_undefined) { my $mpu_res = chinese(@rm); die "MIC: undef MPU: $mpu_res\n" if defined $mpu_res; next; } my $mic_res = $mic->residue; my $mic_mod = $mic->modulus; my $mpu_res = chinese(@rm); die "MIC: $mic_res $mic_mod MPU: undef\n" if !defined $mpu_res; my $mpu_mod = lcm(map { $_->[1] } @rm); die "MIC: $mic_res $mic_mod MPU: $mpu_res $mpu_mod" if $mpu_res != $mic_res || $mpu_mod != $mic_mod; } print "\nDone\n"; Math-Prime-Util-0.73/xt/rwh_primecount_numpy.py0000755000076400007640000000115012453427654020237 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.73/xt/primality-aks.pl0000755000076400007640000000144513204400603016476 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/is_aks_prime is_prime primes urandomm/; $| = 1; # fast pipes my $limit = shift || 2_000_000_000; my $nrand = 8000; my %isprime = map { $_ => 1 } @{primes(160_000)}; print "Testing AKS for all numbers from 1 to 160,000:\n"; foreach my $n (1 .. 160_000) { print "." unless $n % 2000; if ($isprime{$n}) { die "\n$n is prime\n" unless is_aks_prime($n); } else { die "\n$n is composite\n" if is_aks_prime($n); } } print "\n"; print "Testing $nrand random numbers from 1 to $limit:\n"; for (1 .. $nrand) { print "." unless $_ % 100; my $n = 1 + urandomm($limit); if (is_prime($n)) { die "\n$n is prime\n" unless is_aks_prime($n); } else { die "\n$n is composite\n" if is_aks_prime($n); } } print "\n"; Math-Prime-Util-0.73/xt/make-script-test-data.pl0000755000076400007640000001227413230421234020017 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", 1_000_000], [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", 100_000], [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.73/xt/primality-proofs.pl0000755000076400007640000000752713204400603017237 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"; #test_proofs(450, 550, 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 of this many bits: # 300bits 600bits which # 1sec 4sec mpu random_nbit_prime # 1sec 5sec mpu random_shawe_taylor_prime # 1sec 7sec mpu random_maurer_prime # 67sec 240sec pari # 150sec 488sec 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') { # Note: Pari 2.7 added randomprime which would work spectacularly. # But Math::Pari is the ancient version 2.1.5. # # We could use nextprime for ~4x speedup: # $n = Math::Pari::nextprime( ...makerandom... ); do { $n = Crypt::Random::makerandom(Size=>$bits,Strength=>0); } while !Math::Pari::isprime($n); } else { # Much faster than the others. $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.73/xt/make-chacha20-inner.pl0000644000076400007640000000252413204400603017301 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use v5.16; use ntheory; sub outqr { my($bits,$a,$b,$c,$d) = @_; ($a,$b,$c,$d) = map { length($_) == 1 ? "$_ " : $_ } ($a,$b,$c,$d); my $qr32 = <<'EOT'; $a+=$b; $d^=$a; $d=($d<<16)|(($d>>16)& 0xFFFF); $c+=$d; $b^=$c; $b=($b<<12)|(($b>>20)& 0xFFF); $a+=$b; $d^=$a; $d=($d<< 8)|(($d>>24)& 0xFF); $c+=$d; $b^=$c; $b=($b<< 7)|(($b>>25)& 0x7F); EOT my $qr64 = <<'EOT'; $a=($a+$b)&0xFFFFFFFF; $d^=$a; $d=(($d<<16)|($d>>16))&0xFFFFFFFF; $c=($c+$d)&0xFFFFFFFF; $b^=$c; $b=(($b<<12)|($b>>20))&0xFFFFFFFF; $a=($a+$b)&0xFFFFFFFF; $d^=$a; $d=(($d<< 8)|($d>>24))&0xFFFFFFFF; $c=($c+$d)&0xFFFFFFFF; $b^=$c; $b=(($b<< 7)|($b>>25))&0xFFFFFFFF; EOT my $qr = ($bits == 32) ? $qr32 : $qr64; $qr =~ s/\$a/\$x$a/g; $qr =~ s/\$b/\$x$b/g; $qr =~ s/\$c/\$x$c/g; $qr =~ s/\$d/\$x$d/g; $qr =~ s/^/ /mg; $qr =~ s/\n$//; say $qr; } say " use integer;"; say " if (BITS == 64) {"; outqr(64,0,4,8,12); outqr(64,1,5,9,13); outqr(64,2,6,10,14); outqr(64,3,7,11,15); outqr(64,0,5,10,15); outqr(64,1,6,11,12); outqr(64,2,7,8,13); outqr(64,3,4,9,14); say " } else { # 32-bit"; outqr(32,0,4,8,12); outqr(32,1,5,9,13); outqr(32,2,6,10,14); outqr(32,3,7,11,15); outqr(32,0,5,10,15); outqr(32,1,6,11,12); outqr(32,2,7,8,13); outqr(32,3,4,9,14); say " }"; Math-Prime-Util-0.73/xt/test-primes-script.pl0000755000076400007640000001006612453427654017511 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.73/xt/test-nextprime-yafu.pl0000755000076400007640000000457413204400603017650 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/next_prime urandomm/; 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 + urandomm($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.73/xt/make-perrin-data.pl0000644000076400007640000000316113204400603017023 0ustar danadana#!/usr/bin/env perl use warnings; use strict; use ntheory ":all"; use Math::GMPz; # https://oeis.org/A104217/b104217.txt my %mods; open(my $pfile, '<', 'b104217.txt') or die "Cannot open b104217.txt\n"; while (<$pfile>) { next unless /^(\d+)\s+(\d+)/; $mods{$1} = $2; } close($pfile) or die "Error on close\n"; my @maskdata; my @struct; my $offset = 0; for my $mod (sort {$a<=>$b} keys %mods) { last if $offset > 65535; my $period = $mods{$mod}; next if $mod < 2 || $period > 65535; #next unless is_prime($mod) || (is_power($mod,2) && is_prime(sqrtint($mod))); next unless is_prime($mod) || is_prime_power($mod) == 2; # Find the zeros my @P = (3,0,2); my @zeros; for (0 .. $period-1) { push @zeros, $_ if ($P[0] % $mod) == 0; @P = ($P[1], $P[2], ($P[0]+$P[1]) % $mod); } my $nzeros = scalar(@zeros); my $pwords = int(($period+31)/32); next unless $pwords < 5000; my @nums = (0) x $pwords; for (@zeros) { $nums[int($_/32)] |= 1 << ($_ % 32); } my $bytesperzero = $pwords*4 / $nzeros; my $expect = (1/$mod) * $nzeros; next unless $expect > 0.003; next unless $bytesperzero < 100; #print "mod $mod nzeros $nzeros bpz $bytesperzero exp $expect\n"; push @struct, " {$mod, $period, $offset}"; push @maskdata, @nums; $offset += scalar(@nums); } print "#define NPERRINDIV ", scalar(@struct), "\n"; print "/* ", 4*scalar(@maskdata), " mask bytes */\n"; print "static const uint32_t _perrinmask[] = {", join(",", map { ($_ > 2147483647) ? "${_}U" : $_ } @maskdata), "};\n"; print "static _perrin _perrindata[NPERRINDIV] = {\n", join(",\n", @struct), "\n};\n"; Math-Prime-Util-0.73/xt/test-primecount.pl0000755000076400007640000000214513210572416017061 0ustar danadana#!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/prime_count primes prime_precalc urandomm/; prime_precalc(1e8); $|=1; if (1) { print "Testing prime counts for (a,b) for a in {3..15}, b in units of 1000\n"; for my $bm (0 .. 1000) { my $b = 1000 * $bm + urandomm(1000); print "$b " unless $bm % 10; for my $a (3 .. 15) { my($pc1,$pc2) = (prime_count($a,$b), scalar(@{primes($a,$b)})); die "($a,$b) => $pc1 != $pc2\n" unless $pc1 == $pc2; } } print "\n"; } if (1) { print "Testing prime counts for (a,b) for random a,b in 1..1e6\n"; for my $c (1 .. 10000) { print "$c " unless $c % 1000; my $b = urandomm(1e6); my $a = urandomm($b); my($pc1,$pc2) = (prime_count($a,$b), scalar(@{primes($a,$b)})); die "($a,$b) => $pc1 != $pc2\n" unless $pc1 == $pc2; } print "\n"; } if (1) { print "Testing prime counts for (a,b) for all b <= 1000, a <= b\n"; for my $b (0 .. 1000) { print "$b " unless $b % 100; for my $a (0 .. $b) { my($pc1,$pc2) = (prime_count($a,$b), scalar(@{primes($a,$b)})); die "($a,$b) => $pc1 != $pc2\n" unless $pc1 == $pc2; } } print "\n"; } Math-Prime-Util-0.73/xt/primality-small.pl0000755000076400007640000000226512532503145017041 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.73/xt/primecount-approx.t0000644000076400007640000001443312776251142017251 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 %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, ); use Math::BigInt try=>"GMP,Pari"; plan tests => 3*scalar(keys %pivals); foreach my $n (sort {$a <=> $b} keys %pivals) { my $pin = $pivals{$n}; $n = Math::BigInt->new($n) if $n > ~0; # stringify to work around Math::BigInt::GMP's stupid bug cmp_ok( ''.prime_count_upper($n), '>=', $pin, "Pi($n) <= upper estimate" ); cmp_ok( ''.prime_count_lower($n), '<=', $pin, "Pi($n) >= lower estimate" ); # Result may be bigint, so turn into float for percentage comparison my $approx = 0.0 + (''.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.73/prime_count_tables.h0000644000076400007640000003535213210572416016761 0ustar danadana#ifndef MPU_PC_TABLES_H #define MPU_PC_TABLES_H #include "ptypes.h" /* These tables let us have fast answers up to 3000M for the cost of ~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 LMO/Lehmer is faster past 50M or so. */ #define NSTEP_STEP_0 3000 #define NSTEP_START_0 0 #define NSTEP_COUNT_0 3 #define NSTEP_BASE_0 219 static const unsigned char step_counts_0[] = {208,134,115,102,97,91,77,89,74,65,74,67,64,66,64,52,57,59,63,56,44,52,44,55,46,50,44,46,41,44,52,49,34,42,39,31,43,34,37,37,43,36,39,32,30,46,37,27,29,38,44,27,22,35,22,25,28,30,34,37,22,34,27,25,28,29,21,24,24,41,20,22,21,30,25,21,42,6,17,20,28,26,32,20,16,18,20,17,26,28,26,15,19,26,20,0,27,4,23,5}; #define NSTEP_NUM_0 (sizeof(step_counts_0)/sizeof(step_counts_0[0])) #define NSTEP_STEP_1 6000 #define NSTEP_START_1 300000 #define NSTEP_COUNT_1 25997 #define NSTEP_BASE_1 377 static const unsigned char step_counts_1[] = {115,82,116,101,108,92,93,98,95,90,84,73,95,86,87,103,77,75,81,102,86,87,97,97,64,82,62,85,96,89,63,98,88,72,80,71,101,83,72,69,69,81,68,71,73,84,83,93,59,75,78,75,90,59,56,78,49,75,69,67,81,61,61,85,78,65,55,86,76,47,81,70,69,55,49,73,70,70,72,60,70,63,77,55,65,61,65,84,65,47,61,59,61,57,82,56,67,61,57,53,54,87,42,66,66,54,58,48,54,45,68,64,41,50,51,53,66,70,63,56,66,45,57,51,60,35,51,48,54,63,54,51,71,50,69,68,41,45,66,47,41,57,56,79,44,52,72,60,60,45,28,45,69,36,50,33,48,53,41,71,55,61,34,52,63,31,49,43,50,43,57,43,45,61,20,60,44,45,41,71,42,41,60,56,31,33,35,61,51,58,40,47,54,50,43,24,66,42,63,28,72,53,42,30,42,28,47,38,43,56,36,37,45,30,42,33,38,62,23,48,42,52,50,28,37,54,27,57,40,56,32,31,44,50,42,32,40,39,27,42,30,63,40,9,42,43,49,37,38,49,33,53,26,41,56,41,12,56,35,54,50,41,34,38,41,40,29,35,52,35,36,58,23,51,35,43,32,20,22,25,43,41,50,35,55,43,36,30,52,27,30,26,35,44,41,25,25,39,36,23,48,37,36,24,49,18,43,42,31,59,24,24,47,18,38,34,14,46,30,16,30,45,35,27,36,27,51,39,56,25,13,34,28,42,35,18,13,43,23,23,36,15,33,39,40,15,43,34,30,41,25,9,52,31,22,29,22,28,48,33,36,17,22,20,47,17,32,35,33,23,48,40,9,25,32,31,33,23,28,49,43,27,35,14,18,47,12,28,51,11,46,30,38,15,32,17,28,33,30,39,29,25,39,33,8,15,28,33,14,25,39,27,23,20,20,29,31,30,68,26,37,13,55,29,23,26,12,35,22,0,29,26,15,27,39,11,35,22,18,43,1,36,0,38,35,18,33,28,22,31}; #define NSTEP_NUM_1 (sizeof(step_counts_1)/sizeof(step_counts_1[0])) #define NSTEP_STEP_2 15000 #define NSTEP_START_2 3000000 #define NSTEP_COUNT_2 216816 #define NSTEP_BASE_2 871 static const unsigned char step_counts_2[] = {143,107,131,112,148,155,116,149,128,120,134,132,154,156,139,152,106,140,130,112,135,133,117,84,143,139,144,119,133,152,92,103,110,103,111,103,104,147,105,129,168,138,100,98,129,131,143,122,140,112,94,118,103,127,150,110,124,107,102,149,105,137,122,105,106,92,102,116,129,155,94,130,118,121,82,88,117,135,114,115,123,112,101,109,115,75,120,115,88,102,98,114,105,91,147,129,130,115,120,105,98,97,83,113,113,108,110,121,92,113,83,122,109,112,99,118,85,114,85,96,106,95,117,98,113,119,131,91,106,110,114,128,104,87,91,102,93,100,107,100,89,97,121,80,105,70,115,99,101,127,95,95,94,101,85,102,97,93,126,79,84,101,92,110,87,86,92,79,90,86,79,104,101,88,86,91,77,81,87,123,93,99,92,88,76,73,93,91,82,101,76,85,128,100,122,98,85,78,77,86,109,112,54,98,72,82,105,90,74,94,93,95,59,112,61,84,94,98,107,111,74,113,80,78,58,63,90,86,66,71,108,69,86,90,93,80,83,90,113,75,101,75,76,55,96,58,97,101,98,81,99,71,54,89,92,84,95,119,88,75,72,79,92,91,101,67,75,79,108,107,54,86,81,109,65,29,96,84,61,80,77,78,86,65,95,88,73,75,76,55,88,90,59,64,83,84,90,49,89,58,63,60,94,100,47,70,99,76,82,78,72,74,88,64,96,43,71,48,96,52,103,47,102,74,85,89,43,87,81,77,59,75,70,74,60,43,85,90,51,55,55,106,47,82,60,101,51,93,76,74,48,75,71,71,74,65,101,48,69,66,68,59,40,78,59,84,72,85,92,50,77,98,62,86,65,76,64,75,49,78,79,78,68,63,91,78,60,37,70,64,46,73,64,50,90,80,68,32,72,92,15,55,65,52,71,85,71,35,49,91,42,91,60,60,94,73,62,65,66,66,71,46,61,87,55,65,44,69,36,74,39,65,68,65,56,58,65,60,100,70,46,73,47,75,75,58,36,46,86,72,46,42,73,70,58,61,26,73,50,61,37,61,66,45,58,27,48,66,73,73,75,48,67,54,58,53,73,48,50,25,53,72,52,62,82,43,46,64,59,49,63,46,82,55,76,64,54,76,48,73,72,22,58,70,64,55,43,41,80,71,36,91,73,64,65,41,52,25,55,47,56,39,85,56,49,45,83,31,68,81,54,33,62,33,44,51,73,63,58,69,69,3,53,60,76,63,61,36,43,60,51,21,85,20,66,47,58,34,48,50,39,68,37,74,68,25,64,22,71,82,50,54,49,69,97,8,70,41,27,73,40,38,54,59,31,77,60,43,35,32,67,60,33,52,54,52,88,46,46,34,43,43,44,63,52,38,29,57,40,82,20,37,55,38,61,56,33,53,38,73,77,32,16,74,83,36,52,73,39,47,58,39,38,10,80,9,62,25,46,50,57,56,40,38,39,55,50,71,52,57,47,67,31,34,62,57,47,55,16,40,30,33,30,48,45,8,72,63,10,50,15,47,3,62,31,57,35,27,58,65,47,48,24,35,48,49,38,69,28,35,72,37,31,38,36,50,16,28,48,42,24,43,36,33,44,71,33,63,38,27,53,80,26,45,49,16,70,28,35,64,38,31,53,48,44,61,63,52,30,33,14,22,13,52,34,38,33,23,78,29,59,47,41,28,33,23,11,59,31,48,50,51,45,42,18,61,77,37,56,57,9,43,44,25,27,48,41,12,42,42,39,60,35,40,9,41,16,46,64,22,39,45,30,49,70,32,44,22,39,48,36,23,33,11,34,34,63,0,26,40}; #define NSTEP_NUM_2 (sizeof(step_counts_2)/sizeof(step_counts_2[0])) #define NSTEP_STEP_3 30000 #define NSTEP_START_3 15000000 #define NSTEP_COUNT_3 970704 #define NSTEP_BASE_3 1648 static const unsigned char step_counts_3[] = {173,179,154,149,165,182,133,171,192,169,164,178,124,133,127,191,180,188,186,164,173,155,177,168,147,153,140,170,216,147,169,142,176,146,150,175,120,170,144,149,176,175,163,155,118,151,151,196,128,192,133,121,170,194,142,163,142,182,151,190,147,141,138,175,159,212,165,159,148,170,133,133,99,134,168,142,181,205,116,172,170,151,187,163,171,157,131,177,94,160,145,114,175,144,116,171,129,163,207,159,117,144,77,174,154,136,88,213,168,149,187,86,135,178,125,110,127,132,150,171,159,174,100,146,166,154,116,156,158,108,137,161,150,132,142,126,107,164,138,151,116,149,113,158,130,158,179,155,129,113,131,105,96,180,125,127,169,114,169,156,141,142,140,133,150,130,144,155,142,135,126,118,182,70,143,128,135,103,173,121,112,122,105,171,123,136,117,150,124,183,161,115,130,102,138,151,106,135,102,144,166,148,108,120,140,111,107,104,146,176,117,116,144,115,119,189,97,113,118,154,137,105,138,142,148,135,108,142,127,118,163,165,119,104,190,72,84,125,121,93,106,106,119,151,92,117,117,108,118,119,134,152,147,115,107,144,152,124,104,99,103,159,135,144,100,113,156,132,114,110,98,145,109,106,108,161,142,102,156,71,90,150,134,91,156,107,97,126,137,119,84,111,122,110,77,128,158,117,95,131,120,138,118,84,113,138,108,157,105,148,119,123,114,140,90,93,128,128,94,119,114,95,174,111,109,150,85,78,122,116,84,105,130,133,60,138,140,118,66,102,70,80,118,127,103,95,127,69,169,90,101,123,129,77,138,56,139,119,132,104,136,111,123,93,112,108,113,111,105,112,123,101,88,114,49,134,104,113,92,134,156,66,131,122,135,82,112,115,127,80,101,59,119,122,82,124,112,127,115,107,110,79,147,105,130,109,57,116,75,85,92,121,74,126,131,79,85,121,112,155,86,104,60,97,178,71,97,72,71,140,118,107,105,99,141,49,105,99,98,67,142,103,113,146,84,74,91,99,81,142,97,117,96,73,127,94,64,125,65,114,74,97,92,117,77,90,99,109,66,106,103,85,60,116,36,120,160,92,130,90,42,80,116,81,113,85,90,94,113,121,133,58,54,72,113,137,103,122,113,115,120,98,134,67,127,60,117,96,88,121,104,111,86,92,21,101,78,134,82,129,79,152,98,81,85,76,83,110,109,110,88,82,35,114,50,79,48,126,72,66,99,74,138,88,82,79,87,82,72,64,68,83,130,88,83,114,82,48,87,88,112,121,86,80,89,94,79,61,78,100,121,118,57,58,96,84,106,84,96,94,89,80,97,81,93,94,100,94,77,94,77,73,84,87,46,78,106,106,116,77,78,40,96,77,95,95,80,73,113,95,109,77,117,77,92,83,59,53,121,67,53,98,80,90,81,118,57,115,97,85,75,18,84,72,77,50,90,57,44,66,77,55,88,59,52,57,97,56,105,84,118,75,67,86,50,27,80,83,58,107,54,83,120,86,68,114,56,54,65,58,91,95,53,98,99,47,95,95,48,104,102,76,58,63,109,62,64,73,110,71,53,84,110,59,82,50,51,79,60,111,126,27,71,94,95,44,26,97,117,104,76,89,76,30,83,106,66,75,32,122,82,60,41,51,48,127,68,35,92,35,26,92,99,86,74,77,110,128,55,65,51,37,81,67,67,79,107,29,67,96,91,97,25,104,78,71,59,77,57,73,38,94,37,81,55,69,68,63,112,69,88,75,118,51,67,105,114,57,48,74,73,70,63,109,22,46,74,47,67,86,88,96,74,79,95,101,43,114,44,46,53,64,73,81,77,57,66,83,56,138,100,59,55,93,65,44,95,81,44,81,130,59,83,38,57,89,63,37,71,47,68,17,63,78,40,66,84,79,77,45,38,43,143,70,83,89,46,40,73,90,36,49,29,74,45,57,67,126,69,104,60,78,48,10,41,68,74,61,35,112,60,69,87,42,56,28,59,96,38,43,36,118,42,65,57,34,30,31,65,83,58,63,55,89,106,40,64,0,60,30}; #define NSTEP_NUM_3 (sizeof(step_counts_3)/sizeof(step_counts_3[0])) #define NSTEP_STEP_4 30000 #define NSTEP_START_4 42000000 #define NSTEP_COUNT_4 2547620 #define NSTEP_BASE_4 1598 static const unsigned char step_counts_4[] = {84,119,116,106,140,117,134,80,152,159,106,103,125,80,108,130,110,104,106,82,108,152,85,104,106,101,157,67,98,71,93,112,87,89,90,132,142,95,142,75,119,93,96,112,123,108,100,107,121,131,112,135,109,80,85,78,101,113,84,108,100,114,100,78,123,163,113,88,117,78,77,113,114,115,78,149,126,84,93,88,121,113,94,91,108,131,134,96,88,150,107,120,121,83,64,137,87,92,127,83,110,156,105,101,96,67,92,144,109,135,161,124,79,84,145,135,76,136,65,140,105,106,104,99,112,128,41,80,133,139,122,103,61,124,95,100,83,70,102,108,123,84,61,97,127,102,92,102,76,125,108,84,105,135,107,123,92,69,96,132,114,76,110,105,102,96,113,99,35,86,129,115,110,99,78,126,93,110,70,121,90,62,128,113,92,96,105,80,52,107,101,68,101,105,105,170,68,77,89,73,109,42,92,113,108,100,68,65,108,96,111,116,100,91,55,100,137,103,45,114,121,75,90,77,74,67,122,138,79,96,84,115,93,84,87,84,115,80,98,118,124,80,101,72,115,108,109,110,73,156,101,88,129,118,76,90,84,85,122,90,71,134,111,97,71,121,52,84,89,92,145,77,49,113,87,91,108,113,85,74,77,104,97,110,93,120,78,107,61,117,72,137,98,79,126,89,68,77,73,102,59,70,87,141,61,78,85,116,91,79,91,92,153,87,74,51,125,87,132,97,82,64,58,86,128,89,126,143,58,86,96,99,77,90,100,106,72,89,51,116,90,67,64,86,103,95,102,78,79,97,72,106,63,104,131,59,74,99,100,86,109,60,113,89,80,78,86,94,69,136,54,132,90,57,99,98,127,86,79,59,95,73,49,94,70,55,87,60,137,61,114,81,90,74,35,104,123,68,123,94,60,94,110,71,97,51,61,78,98,78,91,82,45,71,94,81,63,129,65,119,99,122,53,55,80,103,75,72,70,18,63,162,81,99,96,127,105,57,74,77,113,70,61,91,78,83,82,105,80,74,39,64,103,96,105,91,105,98,123,41,114,92,48,88,60,82,95,76,103,109,111,98,131,57,47,109,89,55,77,70,45,49,108,49,106,88,108,66,108,137,108,80,109,92,60,42,113,97,50,78,82,60,121,94,79,60,79,74,106,124,97,106,76,57,58,58,101,101,70,79,65,75,54,87,72,61,76,64,88,91,70,84,48,70,100,101,70,94,65,70,58,117,82,39,90,113,65,74,73,71,103,97,72,106,86,44,61,104,87,117,129,46,90,83,64,58,48,127,33,102,64,34,120,49,52,64,89,106,46,22,117,76,70,95,95,52,89,83,69,58,104,41,121,77,107,63,80,56,68,87,72,64,73,27,103,102,39,133,59,66,106,75,88,89,53,75,75,68,62,74,139,72,81,54,108,90,77,110,90,70,71,69,82,90,77,58,45,76,23,64,92,78,70,40,39,95,63,62,106,89,63,52,37,90,49,109,54,72,69,55,95,82,80,46,104,52,105,59,86,90,98,69,52,61,70,60,101,110,70,38,98,77,55,75,55,19,102,41,76,82,86,59,121,81,49,60,103,55,85,51,92,19,123,48,46,86,88,79,96,58,44,66,90,76,108,82,42,86,81,69,54,81,81,35,98,67,134,89,51,96,85,71,58,55,78,78,101,60,55,73,69,59,118,39,83,60,99,58,71,57,79,58,19,29,72,81,61,45,38,72,65,50,75,81,80,75,52,134,44,62,58,50,39,48,81,72,89,76,41,30,145,72,132,44,55,60,63,69,0,113,44,58,63,95,70,77,67,64,86,92,63,112,70,68,25,107,91,88,44,71,130,66,108,53,52,65,93,52,51,92,65,77,108,37,58,62,53,44,99,84,34,56,54,82,74,54,73,45,38,80,86,82,97,81,38,78,95,65,108,61,55,65,90,64,47,75,53,92,84,18,66,84,63,90,56,70,64,49,88,26,87,54,36,108,73,41,76,44,45,79,65,39,110,39,49,83,54,47,90,47,71,36,64,31,73,76,58,34,72,102}; #define NSTEP_NUM_4 (sizeof(step_counts_4)/sizeof(step_counts_4[0])) #define NSTEP_STEP_5 60000 #define NSTEP_START_5 69000000 #define NSTEP_COUNT_5 4062674 #define NSTEP_BASE_5 3184 static const unsigned char step_counts_5[] = {133,125,135,92,121,183,192,167,142,141,154,158,155,149,87,125,105,111,139,176,142,143,132,180,170,123,155,71,135,74,132,127,161,116,146,148,102,169,88,129,247,122,129,149,142,105,73,150,134,100,150,175,154,189,171,131,131,82,159,95,103,176,73,181,135,133,154,145,96,88,122,152,121,98,109,185,107,175,130,96,151,156,94,108,45,159,122,101,111,159,131,84,100,146,112,141,146,81,184,99,94,166,109,177,120,146,123,161,96,100,156,122,122,166,134,144,161,90,110,125,84,91,155,118,48,147,77,79,98,120,141,126,142,150,120,117,138,106,87,146,81,114,119,110,86,123,123,123,147,102,149,101,151,108,45,104,80,93,136,157,89,112,134,118,91,117,82,152,122,111,100,98,91,168,95,101,115,154,108,92,109,99,133,24,155,103,63,166,141,99,147,119,101,80,116,146,96,167,94,133,175,170,115,78,125,84,149,141,53,131,93,117,90,93,139,102,151,129,113,47,68,90,112,109,77,127,93,136,137,130,151,96,98,146,47,84,63,99,113,70,115,110,112,81,65,166,95,137,150,158,77,40,81,64,96,134,84,143,116,64,78,100,112,76,82,100,85,72,106,108,106,78,129,158,83,121,66,120,86,106,93,120,93,83,140,72,80,88,71,141,122,130,76,130,48,102,122,100,82,77,134,63,108,114,95,92,8,120,111,88,100,63,95,96,119,86,111,162,82,84,196,86,71,130,38,0,109,123,77,96,142,101,110,79,77,126,111,111,101,22,105,62,71,87,31,45,33,134,77,92}; #define NSTEP_NUM_5 (sizeof(step_counts_5)/sizeof(step_counts_5[0])) #define NSTEP_STEP_6 30000000 #define NSTEP_START_6 90000000 #define NSTEP_COUNT_6 5216954 #define NSTEP_BASE_6 1374445 static const unsigned int step_counts_6[] = {250249,228303,211544,196796,185473,175395,166496,158705,151368,145477,138824,134114,128941,123383,119684,115460,111972,108081,104496,101132,97856,94688,91850,90266,86778,84033,80882,79773,77438,74948,73167,70584,68840,67823,64066,63243,61158,59178,58193,56713,54713,53489,51746,50004,48701,47453,47183,45074,43201,41829,40383,40029,38091,37702,35704,35029,34402,32174,31418,30254,29375,28357,27770,27014,25527,24242,23523,22947,21580,20866,19636,19169,19257,17300,16505,15411,14800,13936,13112,12642,11840,11644,10910,9214,8585,7729,7683,6111,5495,5543,4736,3855,3588,2529,1837,1201,0}; #define NSTEP_NUM_6 (sizeof(step_counts_6)/sizeof(step_counts_6[0])) #define NSTEP_IF(name) \ (high < (NSTEP_START_##name + NSTEP_STEP_##name*(NSTEP_NUM_##name+1))) #define NSTEP_SEARCH(name) \ { \ UV i, maxi; \ low = NSTEP_START_##name; \ scount = NSTEP_COUNT_##name; \ maxi = (high-low)/NSTEP_STEP_##name; \ for (i = 0; i < maxi && i < NSTEP_NUM_##name; i++) { \ scount += NSTEP_BASE_##name + step_counts_##name[i]; \ low += NSTEP_STEP_##name; \ } \ } #define APPLY_TABLES \ if (low == 7 && high >= 3000) { \ UV scount = 0; \ if (NSTEP_IF(0)) { NSTEP_SEARCH(0); } \ else if (NSTEP_IF(1)) { NSTEP_SEARCH(1); } \ else if (NSTEP_IF(2)) { NSTEP_SEARCH(2); } \ else if (NSTEP_IF(3)) { NSTEP_SEARCH(3); } \ else if (NSTEP_IF(4)) { NSTEP_SEARCH(4); } \ else if (NSTEP_IF(5)) { NSTEP_SEARCH(5); } \ else { NSTEP_SEARCH(6); } \ count = count + scount - 3; /* step counts start at 2 */ \ } #endif Math-Prime-Util-0.73/sieve_cluster.c0000644000076400007640000002667013357250560015762 0ustar danadana#include #include #define FUNC_is_prime_in_sieve 1 #define FUNC_gcd_ui 1 #include "sieve.h" #include "ptypes.h" #include "util.h" #include "primality.h" #define NSMALLPRIMES 168 static const unsigned short sprimes[NSMALLPRIMES] = {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}; typedef struct { uint32_t nmax; uint32_t nsize; UV* list; } vlist; #define INIT_VLIST(v) \ v.nsize = 0; \ v.nmax = 100; \ New(0, v.list, v.nmax, UV); #define PUSH_VLIST(v, n) \ do { \ if (v.nsize >= v.nmax) \ Renew(v.list, v.nmax += 100, UV); \ v.list[v.nsize++] = n; \ } while (0) #define ADDVAL32(v, n, max, val) \ do { if (n >= max) Renew(v, max += 512, UV); v[n++] = val; } while (0) #define SWAPL32(l1, n1, m1, l2, n2, m2) \ { UV t_, *u_ = l1; l1 = l2; l2 = u_; \ t_ = n1; n1 = n2; n2 = t_; \ t_ = m1; m1 = m2; m2 = t_; } static int is_admissible(uint32_t nc, uint32_t* cl) { uint32_t i, j, c; char rset[sprimes[NSMALLPRIMES-1]]; if (nc > NSMALLPRIMES) return 1; /* TODO */ for (i = 0; i < nc; i++) { uint32_t p = sprimes[i]; memset(rset, 0, p); for (c = 0; c < nc; c++) rset[cl[c] % p] = 1; for (j = 0; j < p; j++) if (rset[j] == 0) break; if (j == p) /* All values were 1 */ return 0; } return 1; } /* Given p prime, is this a cluster? */ static int is_cluster(UV p, uint32_t nc, uint32_t* cl) { uint32_t c; for (c = 1; c < nc; c++) if (!is_prob_prime(p+cl[c])) break; return (c == nc); } /* This is fine for small ranges. Low overhead. */ UV* sieve_cluster_simple(UV beg, UV end, uint32_t nc, uint32_t* cl, UV* numret) { vlist retlist; INIT_VLIST(retlist); if (beg <= 2 && end >= 2 && is_cluster(2, nc, cl)) PUSH_VLIST(retlist, 2); if (beg <= 3 && end >= 3 && is_cluster(3, nc, cl)) PUSH_VLIST(retlist, 3); if (beg <= 5 && end >= 5 && is_cluster(5, nc, cl)) PUSH_VLIST(retlist, 5); if (beg < 7) beg = 7; /* If not admissible, then don't keep looking. */ if (!is_admissible(nc, cl) && end > sprimes[nc]) end = sprimes[nc]; if (beg <= end) { uint32_t c; unsigned char* segment; UV seg_base, seg_beg, seg_end; void* ctx = start_segment_primes(beg, end, &segment); while (next_segment_primes(ctx, &seg_base, &seg_beg, &seg_end)) { UV sp, last_sieve_cluster = (seg_end >= cl[nc-1]) ? seg_end-cl[nc-1] : 0; START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_base, seg_beg, seg_end ) if (p <= last_sieve_cluster) { sp = p - seg_base; for (c = 1; c < nc; c++) if (!is_prime_in_sieve(segment, sp+cl[c])) break; if (c == nc) PUSH_VLIST(retlist,p); } else { if (is_cluster(p, nc, cl)) PUSH_VLIST(retlist, p); } END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } *numret = retlist.nsize; return retlist.list; } #define addmodded(r,a,b,n) do { r = a + b; if (r >= n) r -= n; } while(0) UV* sieve_cluster(UV low, UV high, uint32_t nc, uint32_t* cl, UV* numret) { vlist retlist; UV i, ppr, nres, allocres; uint32_t const targres = 100000; UV *residues, *cres, num_mr = 0, num_lucas = 0; uint32_t pp_0, pp_1, pp_2, *resmod_0, *resmod_1, *resmod_2; uint32_t rem_0, rem_1, rem_2, remadd_0, remadd_1, remadd_2; uint32_t pi, startpi = 1, maxpi = 150; uint32_t lastspr = sprimes[maxpi-1]; uint32_t c, smallnc; char crem_0[43*47], crem_1[53*59], crem_2[61*67], **VPrem; if ((UV_MAX - cl[nc-1]) < high) return 0; /* Overflow */ if ( ((high-low) < 10000) || (nc == 3 && ((high>>31) >> 16) == 0) /* sieving large vals is slow */ || (nc == 2 && ((high>>31) >> 27) == 0) || (nc < 2) ) return sieve_cluster_simple(low, high, nc, cl, numret); if (!(low&1)) low++; if (!(high&1)) high--; INIT_VLIST(retlist); if (low < lastspr) { UV t, chigh = (high > lastspr) ? lastspr : high; UV* s = sieve_cluster_simple(low, chigh, nc, cl, &t); for (i = 0; i < t; i++) PUSH_VLIST(retlist, s[i]); Safefree(s); low = chigh + 2; } if (low > high) { *numret = retlist.nsize; return retlist.list; } if (low&1) low--; /* Determine the primorial size and acceptable residues */ New(0, residues, allocres = 1024, UV); { UV remr, *res2, allocres2, nres2, maxppr; /* Calculate residues for a small primorial */ for (pi = 2, ppr = 1, i = 0; i <= pi; i++) ppr *= sprimes[i]; remr = low % ppr; nres = 0; for (i = 1; i <= ppr; i += 2) { for (c = 0; c < nc; c++) { UV v = (remr + i + cl[c]) % ppr; if (gcd_ui(v, ppr) != 1) break; } if (c == nc) ADDVAL32(residues, nres, allocres, i); } /* Raise primorial size until we have plenty of residues */ New(0, res2, allocres2 = 1024, UV); maxppr = high - low; #if BITS_PER_WORD == 64 while (pi++ < 12) { #else while (pi++ < 8) { #endif uint32_t j, p = sprimes[pi]; UV r, newppr = ppr * p; if (nres == 0 || nres > targres/(p/2) || newppr > maxppr) break; MPUverbose(2, "cluster sieve found %"UVuf" residues mod %"UVuf"\n", nres, ppr); remr = low % newppr; nres2 = 0; for (i = 0; i < p; i++) { for (j = 0; j < nres; j++) { r = i*ppr + residues[j]; for (c = 0; c < nc; c++) { UV v = remr + r + cl[c]; if ((v % p) == 0) break; } if (c == nc) ADDVAL32(res2, nres2, allocres2, r); } } ppr = newppr; SWAPL32(residues, nres, allocres, res2, nres2, allocres2); } startpi = pi; Safefree(res2); } MPUverbose(1, "cluster sieve using %"UVuf" residues mod %"UVuf"\n", nres, ppr); /* Return if not admissible, maybe with a single small value */ if (nres == 0) { Safefree(residues); *numret = retlist.nsize; return retlist.list; } /* Pre-mod the residues with first two primes for fewer modulos every chunk */ { uint32_t p1 = sprimes[startpi+0], p2 = sprimes[startpi+1]; uint32_t p3 = sprimes[startpi+2], p4 = sprimes[startpi+3]; uint32_t p5 = sprimes[startpi+4], p6 = sprimes[startpi+5]; pp_0 = p1*p2; pp_1 = p3*p4; pp_2 = p5*p6; memset(crem_0, 1, pp_0); memset(crem_1, 1, pp_1); memset(crem_2, 1, pp_2); /* Mark remainders that indicate a composite for this residue. */ for (i = 0; i < p1; i++) { crem_0[i*p1]=0; crem_0[i*p2]=0; } for ( ; i < p2; i++) { crem_0[i*p1]=0; } for (i = 0; i < p3; i++) { crem_1[i*p3]=0; crem_1[i*p4]=0; } for ( ; i < p4; i++) { crem_1[i*p3]=0; } for (i = 0; i < p5; i++) { crem_2[i*p5]=0; crem_2[i*p6]=0; } for ( ; i < p6; i++) { crem_2[i*p5]=0; } for (c = 1; c < nc; c++) { uint32_t c1=cl[c], c2=cl[c], c3=cl[c], c4=cl[c], c5=cl[c], c6=cl[c]; if (c1 >= p1) c1 %= p1; if (c2 >= p2) c2 %= p2; for (i = 1; i <= p1; i++) { crem_0[i*p1-c1]=0; crem_0[i*p2-c2]=0; } for ( ; i <= p2; i++) { crem_0[i*p1-c1]=0; } if (c3 >= p3) c3 %= p3; if (c4 >= p4) c4 %= p4; for (i = 1; i <= p3; i++) { crem_1[i*p3-c3]=0; crem_1[i*p4-c4]=0; } for ( ; i <= p4; i++) { crem_1[i*p3-c3]=0; } if (c5 >= p5) c5 %= p5; if (c6 >= p6) c6 %= p6; for (i = 1; i <= p5; i++) { crem_2[i*p5-c5]=0; crem_2[i*p6-c6]=0; } for ( ; i <= p6; i++) { crem_2[i*p5-c5]=0; } } New(0, resmod_0, nres, uint32_t); New(0, resmod_1, nres, uint32_t); New(0, resmod_2, nres, uint32_t); for (i = 0; i < nres; i++) { resmod_0[i] = residues[i] % pp_0; resmod_1[i] = residues[i] % pp_1; resmod_2[i] = residues[i] % pp_2; } } /* Precalculate acceptable residues for more primes */ New(0, VPrem, maxpi, char*); memset(VPrem, 0, maxpi); for (pi = startpi+6; pi < maxpi; pi++) { uint32_t p = sprimes[pi]; New(0, VPrem[pi], p, char); memset(VPrem[pi], 1, p); } for (pi = startpi+6, smallnc = 0; pi < maxpi; pi++) { uint32_t p = sprimes[pi]; char* prem = VPrem[pi]; prem[0] = 0; while (smallnc < nc && cl[smallnc] < p) smallnc++; for (c = 1; c < smallnc; c++) prem[p-cl[c]] = 0; for ( ; c < nc; c++) prem[p-(cl[c]%p)] = 0; } New(0, cres, nres, UV); rem_0 = low % pp_0; remadd_0 = ppr % pp_0; rem_1 = low % pp_1; remadd_1 = ppr % pp_1; rem_2 = low % pp_2; remadd_2 = ppr % pp_2; /* Loop over their range in chunks of size 'ppr' */ while (low <= high) { uint32_t r, nr, remr, ncres; /* Reduce the allowed residues for this chunk using more primes */ { /* Start making a list of this chunk's residues using three pairs */ for (r = 0, ncres = 0; r < nres; r++) { addmodded(remr, rem_0, resmod_0[r], pp_0); if (crem_0[remr]) { addmodded(remr, rem_1, resmod_1[r], pp_1); if (crem_1[remr]) { addmodded(remr, rem_2, resmod_2[r], pp_2); if (crem_2[remr]) { cres[ncres++] = residues[r]; } } } } addmodded(rem_0, rem_0, remadd_0, pp_0); addmodded(rem_1, rem_1, remadd_1, pp_1); addmodded(rem_2, rem_2, remadd_2, pp_2); } /* Sieve through more primes one at a time, removing residues. */ for (pi = startpi+6; pi < maxpi && ncres > 0; pi++) { uint32_t p = sprimes[pi]; uint32_t rem = low % p; char* prem = VPrem[pi]; /* Check divisibility of each remaining residue with this p */ /* If we extended prem we could remove the add in the loop below */ if (startpi <= 9) { /* Residues are 32-bit */ for (r = 0, nr = 0; r < ncres; r++) { if (prem[ (rem+(uint32_t)cres[r]) % p ]) cres[nr++] = cres[r]; } } else { /* Residues are 64-bit */ for (r = 0, nr = 0; r < ncres; r++) { if (prem[ (rem+cres[r]) % p ]) cres[nr++] = cres[r]; } } ncres = nr; } MPUverbose(3, "cluster sieve range has %u residues left\n", ncres); /* Now check each of the remaining residues for inclusion */ for (r = 0; r < ncres; r++) { UV p = low + cres[r]; if (p > high) break; /* PRP test. Split to save time. */ for (c = 0; c < nc; c++) if (num_mr++,!is_euler_plumb_pseudoprime(p+cl[c])) break; if (c < nc) continue; for (c = 0; c < nc; c++) if (num_lucas++,!is_almost_extra_strong_lucas_pseudoprime(p+cl[c], 1)) break; if (c < nc) continue; PUSH_VLIST(retlist, p); } low += ppr; if (low < ppr) low = UV_MAX; } MPUverbose(1, "cluster sieve ran %"UVuf" MR and %"UVuf" Lucas tests\n", num_mr, num_lucas); for (pi = startpi+6; pi < maxpi; pi++) Safefree(VPrem[pi]); Safefree(VPrem); Safefree(resmod_0); Safefree(resmod_1); Safefree(resmod_2); Safefree(cres); Safefree(residues); *numret = retlist.nsize; return retlist.list; } Math-Prime-Util-0.73/Changes0000644000076400007640000020514413373337725014237 0ustar danadanaRevision history for Perl module Math::Prime::Util 0.73 2018-11-15 [ADDED] - inverse_totient(n) the image of euler_phi(n) [FIXES] - Try to work around 32-bit platforms in semiprime approximations. Cannot reproduce on any of my 32-bit test platforms. - Fix RT 127605, memory use in for... iterators. 0.72 2018-11-08 [ADDED] - nth_semiprime(n) the nth semiprime - nth_semiprime_approx(n) fast approximate nth semiprime - semiprime_count_approx(n) fast approximate semiprime count - semi_primes as primes but for semiprimes - forsetproduct {...} \@a,\@b,... Cartesian product of list refs [FIXES] - Some platforms are extremely slow for is_pillai. Speed up tests. - Ensure random_factored_integer factor list is sorted min->max. - forcomposites didn't check lastfor on every callback. - Sun's compilers, in a valid interpretation of the code, generated divide by zero code for pillai testing. [FUNCTIONALITY AND PERFORMANCE] - chebyshev_theta and chebyshev_psi redone and uses a table. Large inputs are significantly faster. - Convert some FP functions to use quadmath if possible. Without quadmath there should be no change. With quadmath functions like LogarithmicIntegral and LambertW will be slower but more accurate. - semiprime_count for non-trivial inputs uses a segmented sieve and precalculates primes for larger values so can run 2-3x faster. - forsemiprimes uses a sieve so large ranges are much faster. - ranged moebius more efficient for small intervals. - Thanks to GRAY for his module Set::Product which has clean and clever XS code, which I used to improve my code. - forfactored uses multicall. Up to 2x faster. - forperm, forcomb, forderange uses multicall. 2-3x faster. - Frobenius-Khashin algorithm changed from 2013 version to 2016/2018. 0.71 2018-08-28 [ADDED] - forfactored { ... } a,b loop n=a..b setting $_=n, @_=factor(n) - forsquarefree { ... } a,b as forfactored, but only square-free n - forsemiprimes { ... } a,b as forcomposites, but only semiprimes - random_factored_integer(n) random [1..n] w/ array ref of factors - semiprime_count([lo],hi) counts semiprimes in range [FIXES] - Monolithic sieves beyond 30*2^32 (~ 1.2 * 10^11) overflowed. - is_semiprime was wrong for five small values since 0.69. Fixed. [FUNCTIONALITY AND PERFORMANCE] - is_primitive_root much faster (doesn't need to calulate totient, and faster rejection when n has no primitive root). - znprimroot and znorder use Montgomery, 1.2x to 2x faster. - slightly faster sieve_range for native size inputs (use factor_one). - bin/primes.pl faster for palindromic primes and works for 10^17 [OTHER] - Added ability to use -DBENCH_SEG for benchmarking sieves using prime_count and ntheory::_segment_pi without table optimizations. - Reorg of main factor loop. Should be identical from external view. - Internal change to is_semiprime and is_catalan_pseudoprime. 0.70 2017-12-02 [FIXES] - prime_count(a,b) incorrect for a={3..7} and b < 66000000. First appeared in v0.65 (May 2017). Reported by Trizen. Fixed. - Also impacted were nth_ramanujan_prime and _lower/_upper for small input values. [FUNCTIONALITY AND PERFORMANCE] - Some utility functions used prime counts. Unlink for more isolation. - prime_count_approx uses full precision for bigint or string input. - LogarithmicIntegral and ExponentialIntegral will try to use our GMP backend if possible. - Work around old Math::BigInt::FastCalc (as_int() doesn't work right). - prime_memfree also calls GMP's memfree function. This will clear the cached constants (e.g. Pi, Euler). - Calling srand or csrand will also result in the GMP backend CSPRNG functions being called. This gives more consistent behavior. [OTHER] - Turned off threads testing unless release or extended testing is used. A few smokers seem to have threads lib that die before we event start. - Removed all Math::MPFR code and references. The latest GMP backend has everything we need. - The MPU_NO_XS and MPU_NO_GMP environment variables are documented. 0.69 2017-11-08 [ADDED] - is_totient(n) true if euler_phi(x) == n for some x [FUNCTIONALITY AND PERFORMANCE] - is_square_free uses abs(n), like Pari and moebius. - is_primitive_root could be wrong with even n on some platforms. - euler_phi and moebius with negative range inputs weren't consistent. - factorialmod given a large n and m where m was a composite with large square factors was incorrect. Fixed. - numtoperm will accept negative k values (k is always mod n!) - Split XS mapping of many primality tests. Makes more sense and improves performance for some calls. - Split final test in PP cluster sieve. - Support some new Math::Prime::Util::GMP functions from 0.47. - C spigot Pi is 30-60% faster on x86_64 by using 32-bit types. - Reworked some factoring code. - Remove ISAAC (Perl and C) since we use ChaCha. - Each thread allocs a new const array again instead of sharing. 0.68 2017-10-19 [API Changes] - forcomb with one argument iterates over the power set, so k=0..n instead of k=n. The previous behavior was undocumented. The new behavior matches Pari/GP (forsubset) and Perl6 (combinations). [ADDED] - factorialmod(n,m) n! mod m calculated efficiently - is_fundamental(d) true if d a fundamental discriminant [FUNCTIONALITY AND PERFORMANCE] - Unknown bigint classes no longer return two values after objectify. Thanks to Daniel Șuteu for finding this. - Using lastfor inside a formultiperm works correctly now. - randperm a little faster for k < n cases, and can handle big n values without running out of memory as long as k << n. E.g. 5000 random native ints without dups: @r = randperm(~0,5000); - forpart with primes pulls min/max values in for a small speedup. - forderange 10-20% faster. - hammingweight for bigints 3-8x faster. - Add Math::GMPq and Math::AnyNum as possible bigint classes. Inputs of these types will be relied on to stringify correctly, and if this results in an integer string, to intify correctly. This should give a large speedup for these types. - Factoring native integers is 1.2x - 2x faster. This is due to a number of changes. - Add Lehman factoring core. Since this is not exported or used by default, the API for factor_lehman may change. - All new Montgomery math. Uses mulredc asm from Ben Buhrow. Faster and smaller. Most primality and factoring code 10% faster. - Speedup for factoring by running more Pollard-Rho-Brent, revising SQUFOF, updating HOLF, updating recipe. 0.67 2017-09-23 [ADDED] - lastfor stops forprimes (etc.) iterations - is_square(n) returns 1 if n is a perfect square - is_polygonal(n,k) returns 1 if n is a k-gonal number [FUNCTIONALITY AND PERFORMANCE] - shuffle prototype is @ instead of ;@, so matches List::Util. - On Perl 5.8 and earlier we will call PP instead of trying direct-to-GMP. Works around a bug in XS trying to turn the result into an object where 5.8.7 and earlier gets lost. - We create more const integers, which speeds up common uses of permutations. - CSPRNG now stores context per-thread rather than using a single mutex-protected context. This speeds up anything using random numbers a fair amount, especially with threaded Perls. - With the above two optimizations, randperm(144) is 2.5x faster. - threading test has threaded srand/irand test added back in, showing context is per-thread. Each thread gets its own sequence and calls to srand/csrand and using randomness doesn't impact other threads. 0.66 2017-09-12 [ADDED] - random_semiprime random n-bit semiprime (even split) - random_unrestricted_semiprime random n-bit semiprime - forderange { ... } n derangements iterator - numtoperm(n,k) returns kth permutation of n elems - permtonum([...]) returns rank of permutation array ref - randperm(n[,k]) random permutation of n elements - shuffle(...) random permutation of an array [FUNCTIONALITY AND PERFORMANCE] - Rewrite sieve marking based on Kim Walisch's new simple mod-30 sieve. Similar in many ways to my old code, but this is simpler and faster. - is_pseudoprime, is_euler_pseudoprime, is_strong_pseudoprime changed to better handle the unusual case of base >= n. - Speedup for is_carmichael. - is_frobenius_underwood_pseudoprime checks for jacobi == 0. Faster. - Updated Montgomery inverse from Robert Gerbicz. - Tighter nth prime bounds for large inputs from Axler 2017-06. Redo Ramanujan bounds since they're based on nth prime bounds. - chinese objectifies result (i.e. big results are bigints). - Internal support for Baillie-Wagstaff (pg 1402) extra Lucas tests. - More standardized Lucas parameter selection. Like other tests and the 1980 paper, checks jacobi(D) in the loop, not gcd(D). - entropy_bytes, srand, and csrand moved to XS. - Add -secure import to disallow all manual seeding. 0.65 2017-05-03 [API Changes] - Config options irand and primeinc are deprecated. They will carp if set. [FUNCTIONALITY AND PERFORMANCE] - Add Math::BigInt::Lite to list of known bigint objects. - sum_primes fix for certain ranges with results near 2^64. - is_prime, next_prime, prev_prime do a lock-free check for a find-in-cache optimization. This is a big help on on some platforms with many threads. - C versions of LogarithmicIntegral and inverse_li rewritten. inverse_li honors the documentation promise within FP representation. Thanks to Kim Walisch for motivation and discussion. - Slightly faster XS nth_prime_approx. - PP nth_prime_approx uses inverse_li past 1e12, which should run at a reasonable speed now. - Adjusted crossover points for segment vs. LMO interval prime_count. - Slightly tighter prime_count_lower, nth_prime_upper, and Ramanujan bounds. 0.64 2017-04-17 [FUNCTIONALITY AND PERFORMANCE] - inverse_li switched to Halley instead of binary search. Faster. - Don't call pre-0.46 GMP backend directly for miller_rabin_random. 0.63 2017-04-16 [FUNCTIONALITY AND PERFORMANCE] - Moved miller_rabin_random to separate interface. Make catching of negative bases more explicit. 0.62 2017-04-16 [API Changes] - The 'irand' config option is removed, as we now use our own CSPRNG. It can be seeded with csrand() or srand(). The latter is not exported. - The 'primeinc' config option is deprecated and will go away soon. [ADDED] - irand() Returns uniform random 32-bit integer - irand64() Returns uniform random 64-bit integer - drand([fmax]) Returns uniform random NV (floating point) - urandomb(n) Returns uniform random integer less than 2^n - urandomm(n) Returns uniform random integer in [0, n-1] - random_bytes(nbytes) Return a string of CSPRNG bytes - csrand(data) Seed the CSPRNG - srand([UV]) Insecure seed for the CSPRNG (not exported) - entropy_bytes(nbytes) Returns data from our entropy source - :rand Exports srand, rand, irand, irand64 - nth_ramanujan_prime_upper(n) Upper limit of nth Ramanujan prime - nth_ramanujan_prime_lower(n) Lower limit of nth Ramanujan prime - nth_ramanujan_prime_approx(n) Approximate nth Ramanujan prime - ramanujan_prime_count_upper(n) Upper limit of Ramanujan prime count - ramanujan_prime_count_lower(n) Lower limit of Ramanujan prime count - ramanujan_prime_count_approx(n) Approximate Ramanujan prime count [FUNCTIONALITY AND PERFORMANCE] - vecsum is faster when returning a bigint from native inputs (we construct the 128-bit string in C, then call _to_bigint). - Add a simple Legendre prime sum using uint128_t, which means only for modern 64-bit compilers. It allows reasonably fast prime sums for larger inputs, e.g. 10^12 in 10 seconds. Kim Walisch's primesum is much more sophisticated and over 100x faster. - is_pillai about 10x faster for composites. - Much faster Ramanujan prime count and nth prime. These also now use vastly less memory even with large inputs. - small speed ups for cluster sieve. - faster PP is_semiprime. - Add prime option to forpart restrictions for all prime / non-prime. - is_primitive_root needs two args, as documented. - We do random seeding ourselves now, so remove dependency. - Random primes functions moved to XS / GMP, 3-10x faster. 0.61 2017-03-12 [ADDED] - is_semiprime(n) Returns 1 if n has exactly 2 prime factors - is_pillai(p) Returns 0 or v wherev v! % n == n-1 and n % v != 1 - inverse_li(n) Integer inverse of Logarithmic Integral [FUNCTIONALITY AND PERFORMANCE] - is_power(-1,k) now returns true for odd k. - RiemannZeta with GMP was not subtracting 1 from results > 9. - PP Bernoulli algorithm changed to Seidel from Brent-Harvey. 2x speedup. Math::BigNum is 10x faster, and our GMP code is 2000x faster. - LambertW changes in C and PP. Much better initial approximation, and switch iteration from Halley to Fritsch. 2 to 10x faster. - Try to use GMP LambertW for bignums if it is available. - Use Montgomery math in more places: = sqrtmod. 1.2-1.7x faster. = is_primitive_root. Up to 2x faster for some inputs. = p-1 factoring stage 1. - Tune AKS r/s selection above 32-bit. - primes.pl uses twin_primes function for ~3x speedup. - native chinese can handle some cases that used to overflow. Use Shell sort on moduli to prevent pathological-but-reasonable test case. - chinese directly to GMP - Switch to Bytes::Random::Secure::Tiny -- fewer dependencies. - PP nth_prime_approx has better MSE and uses inverse_li above 10^12. - All random prime functions will use GMP versions if possible and if a custom irand has not been configured. They are much faster than the PP versions at smaller bit sizes. - is_carmichael and is_pillai small speedups. 0.60 2016-10-09 [ADDED] - vecfirstidx { expr } @n returns first index with expr true [FUNCTIONALITY AND PERFORMANCE] - Expanded and modified prime count sparse tables. Prime counts from 30k to 90M are 1.2x to 2.5x faster. It has no appreciable effect on the speed of prime counts larger than this size. - fromdigits works with bigint first arg, no need to stringify. Slightly faster for bigints, but slower than desired. - Various speedups and changes for fromdigits, todigits, todigitstring. - vecprod in PP for negative high-bit would return double not bigint. - Lah numbers added as Stirling numbers of the third kind. They've been in the GMP code for almost 2 years now. Also for big results, directly call the GMP code and objectify the result. - Small performance change to AKS (r,s) selection tuning. - On x86_64, use Montgomery math for Pollard/Brent Rho. This speeds up factoring significantly for large native inputs (e.g. 10-20 digits). - Use new GMP zeta and riemannr functions if possible, making some of our operations much faster without Math::MPFR. - print_primes with large args will try GMP sieve for big speedup. E.g. use bigint; print_primes(2e19,2e19+1e7); goes from 37 minutes to 7 seconds. This also removes a mistaken blank line at the end for certain ranges. - PP primes tries to use GMP. Only for calls from other PP code. - Slightly more accuracy in native ExponentialIntegral. - Slightly more accuracy in twin_prime_count_approx. - nth_twin_prime_approx was incorrect over 1e10 and over 2e16 would infinite loop due to Perl double conversion. - nth_twin_prime_approx a little faster and more accurate. 0.59 2016-08-03 [ADDED] - is_euler_plumb_pseudoprime Plumb's Euler Criterion test. - is_prime_power Returns k if n=p^k for p a prime. - logint(n,b) Integer logarithm. Largest e s.t. b^e <= n. - rootint(n,k) Integer k-th root. - ramanujan_sum(k,n) Ramanujan's sum [FUNCTIONALITY AND PERFORMANCE] - Fixes for quadmath: + Fix "infinity" in t/11-primes.t. + Fix native Pi to use quads. + Trim some threading tests. - Fix fromdigits memory error with large string. - Remove 3 threading tests that were causing issues with Perl -DDEBUGGING. - foroddcomposites with some odd start values could index incorrectly. - is_primitive_root(1,0) returns 0 instead of fp exception. - mertens() uses a little less memory. - 2x speedup for znlog with bigint values. - is_pseudoprime() and is_euler_pseudoprime() use Montgomery math so are much faster. They seem to be ~5% faster than Miller-Rabin now. - is_catalan_pseudoprime 1.1x to 1.4x faster. - is_perrin_pseudoprime over 10x faster. Uses Adams/Shanks doubling and Montgomery math. Single core, odd composites: ~8M range/s. - Add restricted Perrin pseudoprimes using an optional argument. - Add bloom filters to reject non-perfect cubes, fifths, and sevenths. is_power about 2-3x faster for native inputs. - forcomposites / foroddcomposites about 1.2x faster past 64-bit. - exp_mangoldt rewritten to use is_prime_power. - Integer root code rewritten and now exported. - We've been hacking around the problem of older Perls autovivifying functions at compile time. This makes functions that don't exist return true when asked if they're defined, which causes us distress. Store the available GMP functions before loading the PP code. XS code knows MPU::GMP version and calls as appropriate. This works around the auto-vivication, and lets us choose to call the GMP function based on version instead of just existence. E.g. GMP's is_power was added in 0.19, but didn't support negative powers until 0.28. 0.58 2016-05-21 [API Changes] - prev_prime($n) where $n <= 2 now returns undef instead of 0. This may enable catching range errors, and is technically more correct. - nth_prime(0) now returns undef instead of 0. This should help catch cases where the base wasn't understood. The change is similar for all the nth_* functions (e.g. nth_twin_prime). - sumdigits(n,base) will interpret n as a number in the given base, rather than the Pari/GP method of converting decimal n to that base then summing. This allows sumdigits to easily sum hex strings. The old behavior is easily done with vecsum(todigits(n, base)). - binary() was not intended to be released (todigits and todigitstring are supersets), but the documentation got left in. Remove docs. [ADDED] - addmod(a, b, n) a + b mod n - mulmod(a, b, n) a * b mod n - divmod(a, b, n) a / b mod n - powmod(a, b, n) a ^ b mod n - sqrtmod(a, n) modular square root - is_euler_pseudoprime(n,a[...]) Euler test to given bases - is_primitive_root(r, n) is r a primitive root mod n - is_quasi_carmichael(n) is n a Quasi-Carmichael number - hclassno(n) Hurwitz class number H(n) * 12 - sieve_range(n, width, depth) sieve to given depth, return offsets [FUNCTIONALITY AND PERFORMANCE] - Fixed incorrect table entries for 2^16th Ramanujan prime count and nth_ramanujan_prime(23744). - foroddcomposites with certain arguments would start with 10 instead of 9. - lucasu and lucasv should return bigint types. - vecsum will handle 128-bit sums internally (performance increase). - Speedup is_carmichael. - Speedup znprimroot, 10% for small inputs, 10x for large composites. - Speedup znlog ~2x. It is now Rho racing an interleaved BSGS. - Change AKS to Bernstein 2003 theorem 4.1. 5-20x faster than Bornemann, 20000+x faster than V6. - sum_primes now uses tables for native sizes (performance increase). - ramanujan_tau uses Cohen's hclassno method instead of the sigma calculation. This is 3-4x faster than the GMP code for inputs > 300k, and much faster than the older PP code. - fromdigits much faster for large base-10 arrays. Timing is better than split plus join when output is a bigint. 0.57 2016-01-03 [ADDED] - formultiperm { ... } \@n loop over multiset permutations - todigits(n[,base[,len]]) convert n to digit array - todigitstring(n[,base[,len]]) convert n to string - fromdigits(\@d[,base]) convert digit array ref to number - fromdigits(str[,base]) convert string to number - ramanujan_prime_count counts Ramanujan primes in range - vecany { expr } @n true if any expr is true - vecall { expr } @n true if all expr are true - vecnone { expr } @n true if no expr are true - vecnotall { expr } @n true if not all expr are true - vecfirst { expr } @n returns first element with expr true [FUNCTIONALITY AND PERFORMANCE] - nth_ramanujan_prime(997) was wrong. Fixed. - Tighten Ramanujan prime bounds. Big speedups for large nth Rp. 0.56 2015-12-13 [ADDED] - is_carmichael(n) Returns 1 if n is a Carmichael number - forcomp { ... } n[,{...}] loop over compositions [FUNCTIONALITY AND PERFORMANCE] - Faster, nonrecursive divisors_from_factors routine. - gcdext(0,0) returns (0,0,0) to match GMP and Pari/GP. - Use better prime count lower/upper bounds from Büthe 2015. - forpart and forcomp both use lexicographic order (was anti-lexico). 0.55 2015-10-19 - Fixed test that was using a 64-bit number on 32-bit machines. [FUNCTIONALITY AND PERFORMANCE] - Speed up PP versions of sieve_prime_cluster, twin_primes, twin_prime_count, nth_twin_prime, primes. 0.54 2015-10-14 [ADDED] - sieve_prime_cluster(low,high[,...]) find prime clusters [Misc] - Certain small primes used to return false with Frobenius and AES Lucas tests when given extra arguments. Both are unusual cases never used by the main system. Fixed. 0.53 2015-09-05 [ADDED] - ramanujan_tau(n) Ramanujan's Tau function - sumdigits(n[,base]) sum digits of n [FUNCTIONALITY AND PERFORMANCE] - Don't use Math::MPFR unless underlying MPFR library is at least 3.x. - Use new Math::Prime::Util::GMP::sigma function for divisor_sum. - Use new Math::Prime::Util::GMP::sieve_twin_primes(a,b). 0.52 2015-08-09 [ADDED] - is_square_free(n) Check for repeated factors [FUNCTIONALITY AND PERFORMANCE] - print_primes with 2 args was sending to wrong fileno. - Double speed of sum_primes. - Rewrote some internal sieve-walking code, speeds up next_prime, forprimes, print_primes, and more. - Small speedup for forcomposites / foroddcomposites. - Small speedup for is_prime with composite 32+ bit inputs. - is_frobenius_khashin_pseudoprime now uses Montgomery math for speed. - PrimeArray now treats skipping forward by relatively small amounts as forward iteration. This makes it much more efficient for many cases, but does open up some pathological cases. - PrimeArray now allows exporting @primes (and a few others), which saves some typing. - PrimeArray now works for indices up to 2^32-1, after which it silently rolls over. Previously it worked to 2^31-1 then croaked. - PrimeIterator now uses small segments instead of always next_prime. A little more memory, but 2-4x faster. - factor, divisor, fordivisors and some others should better keep bigint types (e.g. Math::GMPz input yields Math::GMPz output). - Faster GCD on some platforms. - Peter Dettman supplied a patch for Shawe-Taylor prime generation to make it deterministically match reference implementations. Thanks! [Misc] - Check for old MPFR now using C library version, not module version. - prime_count_{lower,upper} now uses MPFR to give full precision. - Montgomery math and uint128_t enabled on Darwin/clang. 0.51 2015-06-21 [ADDED] - sum_primes(lo,hi) Summation of primes in range - print_primes(lo,hi[,fd]) Print primes to stdout or fd - is_catalan_pseudoprime(n) Catalan primality test - is_frobenius_khashin_pseudoprime(n) Khashin's 2013 Frobenius test [FUNCTIONALITY AND PERFORMANCE] - Slightly faster PP sieving using better code from Perlmonks. - Lucas sequence works with even valued n. - Used idea from Colin Wright to speed up is_perrin_pseudoprime 5x. We can check smaller congruent sequences for composites as a prefilter. - is_frobenius_pseudoprime no longer checks for perfect squares, and doesn't bail to BPSW if P,Q,D exceed n. This makes it produce some pseudoprimes it did not before (but ought to have). [Misc] - Work with old MPFR (some test failures in older Win32 systems). - Don't assert in global destructor if a MemFree object is destroyed. 0.50 2015-05-03 [ADDED] - harmfrac(n) (num,den) of Harmonic number - harmreal(n) Harmonic number as BigFloat - sqrtint(n) Integer square root of n - vecextract(\@arr, mask) Return elements from arr selected by mask - ramanujan_primes(lo,hi) Ramanujan primes R_n in [lo,hi] - nth_ramanujan_prime(n) the nth Ramanujan prime R_n - is_ramanujan_prime(n) 1 if n is a Ramanujan prime, 0 otherwise [FUNCTIONALITY AND PERFORMANCE] - Implement single-base hashed M-R for 32-bit inputs, inspired by Forišek and Jančina 2015 as well as last year's tests with 2-base (2^49) and 3-base (2^64) hashed solutions for MPU. Primality testing is 20-40% faster for this size. - Small speedups for znlog. - PP nth_prime on 32-bit fixed for values over 2^32. [Misc] - Changes to nth_prime_{lower,upper}. They use the Axler (2013) bounds, and the XS code will also use inverse prime count bounds for small values. This gives 2-10x tighter bounds. - Tighten prime count bounds using Axler, Kotnik, Büthe. Thanks to Charles R Greathouse IV for pointing me to these. 0.49 2014-11-30 - Make versions the same in all packages. 0.48 2014-11-28 [ADDED] - lucasu(P, Q, k) U_k for Lucas(P,Q) - lucasv(P, Q, k) V_k for Lucas(P,Q) [Misc] - Use Axler (2014) bounds for prime count where they improve on Dusart. 0.47 2014-11-18 [ADDED] - is_mersenne_prime(p) returns 1 iff 2^p-1 is prime [FUNCTIONALITY AND PERFORMANCE] - Standalone compilation (e.g. factoring without Perl installed) is easier. - For next_prime and prev_prime with bigints, stay in XS as long as possible to cut overhead. Up to 1.5x faster. - Factoring on 64-bit platforms is faster for 32-bit inputs. - AKS is faster for larger than half-word inputs, especially on 64-bit machines with gcc's 128-bit types. - is_provable_prime goes through XS first, so can run *much* faster for small inputs. [OTHER] - NetBSD improperly exports symbols in string.h, including popcount. Rename our internal function to work around it. - is_power now takes an optional scalar reference third argument which will be set to the root if found. It also works for negative n. - Changes to trim a little memory use. lucas_sequence goes from PP->[XS,GMP,PP] to XS[->PP[->GMP]]. ecm_factor is moved out of root. Moved some primality proving logic out of root. - primes.pl when given one argument will show primes up to that number. 0.46 2014-10-21 [API Changes] - is_pseudoprime has the same signature as is_strong_pseudoprime now. This means it requires one or more bases and has no default base. The documentation had never mentioned the default, so this should have little impact, and the common signature makes more sense. [ADDED] - hammingweight(n) Population count (count binary 1s) - vecreduce {...} @v Reduce/fold, exactly like List::Util::reduce [Misc] - Syntax fix from Salvatore. - vecmin / vecmax in XS, if overflows UV do via strings to avoid PP. - Add example for verifying prime gaps, similar to Nicely's cglp4. - divisor_sum wasn't running XS code for k=0. Refactor PP code, includes speedup when input is a non-Math::BigInt (e.g. Math::GMP). - Improve test coverage. [PP Updates] - Large speedup for divisors with bigints in 64-100 bit range. - Revamp RiemannZeta. Fixes some bignum output, but requires RT fixes. - Optimization for PP comparison to ~0. - PP factoring is faster, especially for small inputs. 0.45 2014-09-26 [ADDED] - forcomb { ... } n, k combinations iterator - forperm { ... } n permutations iterator - factorial(n) n! - is_bpsw_prime(n) primality test with no pretests, just ES BPSW - is_frobenius_pseudoprime Frobenius quadratic primality test - is_perrin_pseudoprime Perrin primality test (unrestricted) - vecmin(@list) minimum of list of integers - vecmax(@list) maximum of list of integers - vecprod(@list) product of list of integers - bernfrac(n) (num,den) of Bernoulli number - bernreal(n) Bernoulli number as BigFloat - stirling(n,m,[type]) Stirling numbers of first or second kind - LambertW(k) Solves for W in k = W*exp(W) - Pi([digits]) Pi as NV or with requested digits [FUNCTIONALITY AND PERFORMANCE] - znorder algorithm changed from Das to Cohen for ~1% speedup. - factoring sped up a bit for 15-19 digits. - speedup for divisor_sum with very large exponents. [OTHER] - Alias added for the module name "ntheory". The module has grown enough that it seems more appropriate. - Big build change: Try a GMP compilation and add Math::Prime::Util::GMP to dependency list if it succeeds. - Fixed a memory leak in segment_primes / segment_twin_primes introduced in previous release. Thanks Valgrind! 0.43 2014-08-16 [ADDED] - foroddcomposites like forcomposites, but skips even numbers - twin_primes as primes but for twin primes - config: use_primeinc allow the fast but bad PRIMEINC random prime method [REMOVED DEPRECATED NAMES] - all_factors replaced in 0.36 by divisors - miller_rabin replaced in 0.10 by is_strong_pseudoprime [FUNCTIONALITY AND PERFORMANCE] - Divisors sorted with qsort instead of Shell sort. No appreciable time difference, but slightly less code size. - Added Micali-Schnorr generator to examples/csrand.pl. Made a version of csrand that uses Math::GMP for faster operation. - Added synopsis release test. Thanks to Neil Bowers and Toby Inkster. - ranged euler_phi is more efficient when lo < 100. - factor for 49 to 64-bit numbers sped up slightly (a small p-1 is tried before SQUFOF for these sizes). - HOLF factoring sped up using premultiplier first. 0.42 2014-06-18 [ADDED] - gcdext(x,y) extended Euclidian algorithm - chinese([a,n],[a,n],...) Chinese Remainder [FUNCTIONALITY AND PERFORMANCE] - znlog is *much* faster. Added BSGS for XS and PP, Rho works better. - Another inverse improvement from W. Izykowski, doing 8 bits at a time. A further 1% to 15% speedup in primality testing. - A 35% reduction in overhead for forprimes with multicall. - prime segment sieving over large ranges will use larger segment sizes when given large bases. This uses some more memory, but is much faster. - An alternate method for calculating RiemannR used when appropriate. - RiemannZeta caps at 10M even with MPFR. This has over 300k leading 0s. - RiemannR will use the C code if not a BigFloat or without bignum loaded. The C code should only take a few microseconds for any value. - Refactor some PP code: {next,prev}_prime, chebyshev_{theta,psi}. In addition, PP sieving uses less memory. - Accelerate nth_twin_prime using the sparse twin_prime_count table. 0.41 2014-05-18 [ADDED] - valuation(n,k) how many times does k divide n? - invmod(a,n) inverse of a modulo n - forpart { ... } n[,{...}] loop over partitions (Pari 2.6.x) - vecsum(...) sum list of integers - binomial(n,k) binomial coefficient [FUNCTIONALITY AND PERFORMANCE] - Big speedup for primality testing in range ~2^25 to 2^64, which also affects functions like next_prime, prev_prime, etc. This is due to two changes in the Montgomery math section -- an improvement to mont_prod64 and using a new modular inverse from W. Izykowski based on Arazi (1994). - factoring small inputs (n < 20M) is ~10% faster, which speeds up some misc functions (e.g. euler_phi, divisor_sum) for small inputs. - Small improvement to twin_prime_count_approx and nth_twin_prime_approx. - Better AKS testing in xt/primality-aks.pl. - Loosen requirements of lucas_sequence. More useful for general seqs. Add tests for some common sequences. - forcomposites handles beg and end near ~0. 0.40 2014-04-21 [ADDED] - random_shawe_taylor_prime FIPS 186-4 random proven prime - random_shawe_taylor_prime_with_cert as above with certificate - twin_prime_count counts twin primes in range - twin_prime_count_approx fast approximation to Pi_2(n) - nth_twin_prime returns the nth twin prime - nth_twin_prime_approx estimates the nth twin prime [FUNCTIONALITY AND PERFORMANCE] - Update PP Frobenius-Underwood test. - Speed up exp_mangoldt. - nth_prime_approx uses inverse RiemannR in XS code for better accuracy. Cippola 1902 is still used for PP and large values, with a slightly more accurate third order correction. - Tighten nth_prime_lower and nth_prime_upper for very small values. - Fix legendre_phi when given tiny x and large a (odd test case). Some speedups for huge a, from R. Andrew Ohana. - Ranged totient is slightly faster with start of 0. - Fix random_prime with a bigint prime high value. 0.39 2014-03-01 - Changed logl to log in AKS. Critical for FreeBSD and NetBSD. - Make sure we don't use Math::BigInt::Pari in threading tests. threads + Math::Pari = segfault on UNIX and Windows. - Various minor changes trying to guess what ActiveState is doing. 0.38 2014-02-28 [ADDED] - is_power Returns max k if n=p^k. See Pari 2.4.x. [FUNCTIONALITY AND PERFORMANCE] - Factoring powers (and k*n^m for small k) is much faster. - Speed up znprimroot. - Add Bernstein+Voloch improvements to AKS. Much faster than the v6 implementation, though still terribly slow vs. BPSW or other proofs. [OTHER] - Added some Project Euler examples. - If using a threaded Perl without EXTENDED_TESTING, thread tests will print diagnostics instead of failing. This might help find issues with platforms that are currently failing with no indications, and allow installation for non-threaded use. 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.73/util.h0000644000076400007640000002624313373330217014060 0ustar danadana#ifndef MPU_UTIL_H #define MPU_UTIL_H #include "ptypes.h" extern int _numcmp(const void *a, const void *b); /* qsort numerical sorting */ 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); /* Disable all manual seeding */ extern int _XS_get_secure(void); extern void _XS_set_secure(void); extern int is_prime(UV x); extern UV next_prime(UV x); extern UV prev_prime(UV x); extern void print_primes(UV low, UV high, int fd); extern int powerof(UV n); extern int is_power(UV n, UV a); extern UV rootof(UV n, UV k); extern int primepower(UV n, UV* prime); extern UV valuation(UV n, UV k); extern UV logint(UV n, UV b); extern UV mpu_popcount_string(const char* ptr, uint32_t len); extern signed char* range_moebius(UV low, UV high); extern UV* range_totient(UV low, UV high); extern IV mertens(UV n); extern NV chebyshev_psi(UV n); extern NV chebyshev_theta(UV n); extern NV Ei(NV x); extern NV Li(NV x); extern long double ld_riemann_zeta(long double x); extern long double RiemannR(long double x); extern NV lambertw(NV k); extern UV inverse_li(UV x); extern UV inverse_R(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 factorial(UV n); extern UV binomial(UV n, UV k); extern IV gcdext(IV a, IV b, IV* u, IV* v, IV* s, IV* t); /* Ext Euclidean */ 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 int sqrtmod(UV* s, UV a, UV p); /* sqrt(a) mod p */ extern int sqrtmod_composite(UV* s, UV a,UV n);/* sqrt(a) mod n */ extern UV chinese(UV* a, UV* n, UV num, int *status); /* Chinese Remainder */ 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 int is_primitive_root(UV a, UV n, int nprime); extern UV factorialmod(UV n, UV m); #define is_square_free(n) (moebius(n) != 0) extern int is_fundamental(UV n, int neg); extern int is_totient(UV n); extern int is_semiprime(UV n); extern int is_carmichael(UV n); extern UV is_quasi_carmichael(UV n); /* Returns number of bases */ extern UV pillai_v(UV n); /* v: v! % n == n-1 && n % v != 1 */ extern UV inverse_totient_count(UV n); extern UV* inverse_totient_list(UV *ntotients, UV n); extern UV stirling3(UV n, UV m); extern IV stirling2(UV n, UV m); extern IV stirling1(UV n, UV m); extern IV hclassno(UV n); extern IV ramanujan_tau(UV n); extern char* pidigits(int digits); extern int strnum_minmax(int min, char* a, STRLEN alen, char* b, STRLEN blen); extern int from_digit_string(UV* n, const char* s, int base); extern int from_digit_to_UV(UV* rn, UV* r, int len, int base); extern int from_digit_to_str(char** rstr, UV* r, int len, int base); extern int to_digit_array(int* bits, UV n, int base, int length); extern int to_digit_string(char *s, UV n, int base, int length); extern int to_string_128(char s[40], IV hi, UV lo); extern int is_catalan_pseudoprime(UV n); extern UV polygonal_root(UV n, UV k, int* overflow); extern int num_to_perm(UV rank, int n, int *vec); extern int perm_to_num(int n, int *vec, UV *rank); extern void randperm(void* ctx, UV n, UV k, UV *S); extern UV random_factored_integer(void* ctx, UV n, int *nf, UV *factors); extern UV gcdz(UV x, UV y); #if defined(FUNC_isqrt) || defined(FUNC_is_perfect_square) #include 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 #if defined(FUNC_icbrt) || defined(FUNC_is_perfect_cube) 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_ipow) static UV ipow(UV n, UV k) { UV p = 1; while (k) { if (k & 1) p *= n; k >>= 1; if (k) n *= n; } return p; } #endif #if defined(FUNC_gcd_ui) || defined(FUNC_lcm_ui) /* If we have a very fast ctz, then use the fast FLINT version of gcd */ #if defined(__GNUC__) && (__GNUC__ >= 4 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) #define gcd_ui(x,y) gcdz(x,y) #else 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 #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) { /* Step 1, reduce to 18% of inputs */ uint32_t m = n & 127; if ((m*0x8bc40d7d) & (m*0xa1e2f5d1) & 0x14020a) return 0; /* Step 2, reduce to 7% of inputs (mod 99 reduces to 4% but slower) */ m = n %240; if ((m*0xfa445556) & (m*0x8021feb1) & 0x614aaa0f) return 0; /* m = n % 99; if ((m*0x5411171d) & (m*0xe41dd1c7) & 0x80028a80) return 0; */ /* Step 3, do the square root instead of any more rejections */ m = isqrt(n); return (UV)m*(UV)m == n; } #endif #ifdef FUNC_is_perfect_cube static int is_perfect_cube(UV n) { UV m; if ((n & 3) == 2) return 0; /* m = n & 511; if ((m*5016427) & (m*95638165) & 438) return 0; */ m = n % 117; if ((m*833230740) & (m*120676722) & 813764715) return 0; m = n % 133; if ((m*76846229) & (m*305817297) & 306336544) return 0; m = icbrt(n); return m*m*m == n; } #endif #ifdef FUNC_is_perfect_fifth static int is_perfect_fifth(UV n) { UV m; if ((n & 3) == 2) return 0; m = n % 88; if ((m*85413603) & (m*76260301) & 26476550) return 0; m = n % 31; if ((m*80682551) & (m*73523539) & 45414528) return 0; m = n % 41; if ((m*92806493) & (m*130690042) & 35668129) return 0; /* m = n % 25; if ((m*109794298) & (m*105535723) & 16097553) return 0; */ m = rootof(n, 5); return m*m*m*m*m == n; } #endif #ifdef FUNC_is_perfect_seventh static int is_perfect_seventh(UV n) { UV m; /* if ((n & 3) == 2) return 0; */ m = n & 511; if ((m*97259473) & (m*51311663) & 894) return 0; m = n % 49; if ((m*109645301) & (m*76482737) & 593520192) return 0; m = n % 71; if ((m*71818386) & (m*38821587) & 35299393) return 0; /* m = n % 43; if ((m*101368253) & (m*814158665) & 142131408) return 0; */ /* m = n % 29; if ((m*81935611) & (m*84736134) & 37831965) return 0; */ /* m = n % 116; if ((m*348163737) & (m*1539055705) & 2735997248) return 0; */ m = rootof(n, 7); return m*m*m*m*m*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__) && (__GNUC__ >= 4 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) #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 && !defined(__clang__) && !defined(_WIN32_WCE) #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 */ #ifdef FUNC_popcnt /* 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 manually written 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 #else static UV popcnt(UV b) { b -= (b >> 1) & 0x55555555; b = (b & 0x33333333) + ((b >> 2) & 0x33333333); b = (b + (b >> 4)) & 0x0f0f0f0f; return (b * 0x01010101) >> 24; } #endif #endif #endif Math-Prime-Util-0.73/primality.h0000644000076400007640000000252313335225513015110 0ustar danadana#ifndef MPU_PRIMALITY_H #define MPU_PRIMALITY_H #include "ptypes.h" extern int is_pseudoprime(UV const n, UV a); extern int is_euler_pseudoprime(UV const n, UV a); extern int is_euler_plumb_pseudoprime(UV const n); extern int 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 is_lucas_pseudoprime(UV n, int strength); extern int is_almost_extra_strong_lucas_pseudoprime(UV n, UV increment); extern int is_frobenius_pseudoprime(UV n, IV P, IV Q); extern int is_frobenius_underwood_pseudoprime(UV n); extern int is_frobenius_khashin_pseudoprime(UV n); extern int is_perrin_pseudoprime(UV n, int restricted); extern int is_mersenne_prime(UV p); extern int lucas_lehmer(UV p); extern int lucasu(IV* U, IV P, IV Q, UV k); extern int lucasv(IV* V, IV P, IV Q, UV k); #if defined(FUNC_is_strong_pseudoprime) static int is_strong_pseudoprime(UV n, UV base) { return miller_rabin(n, &base, 1); } #endif extern int BPSW(UV const n); extern int MR32(uint32_t n); /* General purpose primality test. Does small-prime divisibility. */ extern int is_prob_prime(UV n); /* General purpose primality test without small divisibility tests. */ #if BITS_PER_WORD == 32 #define is_def_prime(n) MR32(n) #else #define is_def_prime(n) ((n <= 4294967295U) ? MR32(n) : BPSW(n)) #endif #endif Math-Prime-Util-0.73/constants.h0000644000076400007640000000273113370623653015121 0ustar danadana#ifndef MPU_CONSTANTS_H #define MPU_CONSTANTS_H #include "ptypes.h" #if BITS_PER_WORD == 32 #define MPU_MAX_PRIME UVCONST(4294967291) #define MPU_MAX_PRIME_IDX UVCONST(203280221) #define MPU_MAX_TWIN_PRIME UVCONST(4294965839) #define MPU_MAX_TWIN_PRIME_IDX UVCONST(12739574) #define MPU_MAX_RMJN_PRIME UVCONST(4294967279) #define MPU_MAX_RMJN_PRIME_IDX UVCONST(98182656) #define MPU_MAX_SEMI_PRIME UVCONST(4294967294) #define MPU_MAX_SEMI_PRIME_IDX UVCONST(658662065) #else #define MPU_MAX_PRIME UVCONST(18446744073709551557) #define MPU_MAX_PRIME_IDX UVCONST(425656284035217743) #define MPU_MAX_TWIN_PRIME UVCONST(18446744073709550771) #define MPU_MAX_TWIN_PRIME_IDX UVCONST(12975810317986308) /* Approx */ #define MPU_MAX_RMJN_PRIME UVCONST(18446744073709550771) /* Not correct */ #define MPU_MAX_RMJN_PRIME_IDX UVCONST(12975810317986308) /* Not correct */ #define MPU_MAX_SEMI_PRIME UVCONST(18446744073709551601) #define MPU_MAX_SEMI_PRIME_IDX UVCONST(1701500000000000000) /* Approx */ #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) /* Where to start using LMO instead of segment sieve */ #define _MPU_LMO_CROSSOVER 66000000 #endif Math-Prime-Util-0.73/csprng.h0000644000076400007640000000223213204400603014355 0ustar danadana#ifndef MPU_CSPRNG_H #define MPU_CSPRNG_H #include "ptypes.h" /*****************************************************************************/ extern uint32_t csprng_context_size(void); /* Seed and init if needed */ extern void csprng_seed(void *ctx, uint32_t bytes, const unsigned char* data); /* Simple seed */ extern void csprng_srand(void *ctx, UV insecure_seed); /* Fill buffer with this many bytes of random data */ extern void csprng_rand_bytes(void *ctx, uint32_t bytes, unsigned char* data); extern uint32_t irand32(void *ctx); extern UV irand64(void *ctx); /*****************************************************************************/ extern int is_csprng_well_seeded(void *ctx); extern NV drand64(void *ctx); extern uint32_t urandomm32(void* ctx, uint32_t n); /* integer less than n */ extern UV urandomm64(void* ctx, UV n); extern UV urandomb(void* ctx, int nbits); /* integer with n bits */ /*****************************************************************************/ /* Very simple PRNG for other use. */ extern char* prng_new(uint32_t a, uint32_t b, uint32_t c, uint32_t d); extern uint32_t prng_next(char* rng); #endif Math-Prime-Util-0.73/factor.c0000644000076400007640000014746713373330217014370 0ustar danadana#include #include #include #include #define FUNC_isqrt 1 #define FUNC_icbrt 1 #define FUNC_gcd_ui 1 #define FUNC_is_perfect_square 1 #define FUNC_clz 1 #include "ptypes.h" #include "factor.h" #include "sieve.h" #include "util.h" #include "mulmod.h" #include "cache.h" #include "primality.h" #include "montmath.h" static int holf32(uint32_t n, UV *factors, uint32_t rounds); /* * 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])) static int _small_trial_factor(UV n, UV *factors, UV *newn, uint32_t *lastf) { int nfactors = 0; uint32_t 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) { uint32_t const lastsp = 83; uint32_t sp = 4; /* Trial division from 7 to 421. Use 32-bit if possible. */ if (n <= 4294967295U) { uint32_t un = n; while (sp < lastsp) { while ( (un%f) == 0 ) { factors[nfactors++] = f; un /= f; } f = primes_small[++sp]; if (f*f > un) break; } n = un; } else { while (sp < lastsp) { while ( (n%f) == 0 ) { factors[nfactors++] = f; n /= f; } f = primes_small[++sp]; if (f*f > n) break; } } /* If n is small and still composite, finish it here */ if (n < 2011*2011 && f*f <= n) { /* Trial division from 431 to 2003 */ uint32_t un = n; while (sp < NPRIMES_SMALL) { while ( (un%f) == 0 ) { factors[nfactors++] = f; un /= f; } f = primes_small[++sp]; if (f*f > un) break; } n = un; } } if (f*f > n && n != 1) { factors[nfactors++] = n; n = 1; } if (newn) *newn = n; if (lastf) *lastf = f; return nfactors; } static int _power_factor(UV n, UV *factors) { int nfactors, i, j, k = powerof(n); if (k > 1) { UV p = rootof(n, k); nfactors = factor(p, factors); for (i = nfactors; i >= 0; i--) for (j = 0; j < k; j++) factors[k*i+j] = factors[i]; return k*nfactors; } factors[0] = n; return 1; } /* Find one factor of an input n. */ int factor_one(UV n, UV *factors, int primality, int trial) { int nfactors; if (n < 4) { factors[0] = n; return (n == 1) ? 0 : 1; } /* TODO: deal with small n */ if (trial) { uint32_t sp, f; if (!(n&1)) { factors[0] = 2; factors[1] = n >> 1; return 2; } if (!(n%3)) { factors[0] = 3; factors[1] = n / 3; return 2; } if (!(n%5)) { factors[0] = 5; factors[1] = n / 5; return 2; } for (sp = 4; (f = primes_small[sp]) < 2011; sp++) { if ( (n % f) == 0 ) { factors[0] = f; factors[1] = n/f; return 2; } } if (n < f*f) { factors[0] = n; return 1; } } if (primality && is_prime(n)) { factors[0] = n; return 1; } #if 0 /* Simple solution, just fine on x86_64 */ nfactors = (n < 1073741824UL) ? holf32(n, factors, 1000000) : pbrent_factor(n, factors, 500000, 1); if (nfactors < 2) croak("factor_one failed on %lu\n", n); #endif { /* Adjust the number of rounds based on the number size and speed */ UV const nbits = BITS_PER_WORD - clz(n); #if USE_MONTMATH UV const br_rounds = 8000 + (9000 * ((nbits <= 45) ? 0 : (nbits-45))); UV const sq_rounds = 200000; #elif MULMODS_ARE_FAST UV const br_rounds = 500 + ( 200 * ((nbits <= 45) ? 0 : (nbits-45))); UV const sq_rounds = 100000; #else UV const br_rounds = (nbits >= 63) ? 120000 : (nbits >= 58) ? 500 : 0; UV const sq_rounds = 200000; #endif #if BITS_PER_WORD == 64 /* For small semiprimes the fastest solution is HOLF under 32, then * Lehman (no trial) under 38. However on random inputs, HOLF is * best only under 28-30 bits, and adding Lehman is always slower. */ if (nbits <= 30) { /* This should always succeed */ nfactors = holf32(n, factors, 1000000); if (nfactors > 1) return nfactors; } #endif /* Almost all inputs are factored here */ if (br_rounds > 0) { nfactors = pbrent_factor(n, factors, br_rounds, 1); if (nfactors > 1) return nfactors; } #if USE_MONTMATH nfactors = pbrent_factor(n, factors, 2*br_rounds, 3); if (nfactors > 1) return nfactors; #endif /* Random 64-bit inputs at this point: * About 3.1% are small enough that we did with HOLF. * montmath: 96.89% pbrent, 0.01% pbrent2 * fast: 73.43% pbrent, 21.97% squfof, 1.09% p-1, 0.49% prho, long * slow: 75.34% squfof, 19.47% pbrent, 0.20% p-1, 0.06% prho */ /* SQUFOF with these parameters gets 99.9% of everything left */ if (nbits <= 62) { nfactors = squfof_factor(n, factors, sq_rounds); if (nfactors > 1) return nfactors; } /* At this point we should only have 16+ digit semiprimes. */ nfactors = pminus1_factor(n, factors, 8000, 120000); if (nfactors > 1) return nfactors; /* Get the stragglers */ nfactors = prho_factor(n, factors, 120000); if (nfactors > 1) return nfactors; nfactors = pbrent_factor(n, factors, 500000, 5); if (nfactors > 1) return nfactors; nfactors = prho_factor(n, factors, 120000); if (nfactors > 1) return nfactors; croak("factor_one failed on %lu\n", n); } return nfactors; } /******************************************************************************/ /* Main factor loop */ /* */ /* Puts factors in factors[] and returns the number found. */ /******************************************************************************/ int factor(UV n, UV *factors) { UV tofac_stack[MPU_MAX_FACTORS+1]; int nsmallfactors, npowerfactors, nfactors, i, j, ntofac = 0; uint32_t f; nfactors = _small_trial_factor(n, factors, &n, &f); if (n == 1) return nfactors; #if BITS_PER_WORD == 64 /* For small values less than f^3, use simple factor to split semiprime */ if (n < 100000000 && n < f*f*f) { if (MR32(n)) factors[nfactors++] = n; else nfactors += holf32(n, factors+nfactors, 10000); return nfactors; } #endif nsmallfactors = nfactors; /* Perfect powers. Factor root only once. */ npowerfactors = _power_factor(n, factors+nsmallfactors); if (npowerfactors > 1) return nsmallfactors + npowerfactors; /* loop over each remaining factor, until ntofac == 0 */ do { while ( (n >= f*f) && (!is_def_prime(n)) ) { int split_success = factor_one(n, tofac_stack+ntofac, 0, 0) - 1; if (split_success != 1 || tofac_stack[ntofac] == 1 || tofac_stack[ntofac] == n) croak("internal: factor_one failed to factor %"UVuf"\n", n); ntofac++; /* Leave one on the to-be-factored stack */ n = tofac_stack[ntofac]; /* Set n to the other one */ } /* 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 fi = factors[i]; for (j = i; j > 0 && factors[j-1] > fi; j--) factors[j] = factors[j-1]; factors[j] = fi; } return nfactors; } int factor_exp(UV n, UV *factors, UV* exponents) { int i = 1, j = 1, nfactors; if (n == 1) return 0; nfactors = factor(n, factors); if (exponents == 0) { for (; i < nfactors; i++) if (factors[i] != factors[i-1]) factors[j++] = factors[i]; } else { exponents[0] = 1; for (; 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 f, UV last) { int sp, nfactors = 0; if (f < 2) f = 2; if (last == 0 || last*last > n) last = UV_MAX; if (n < 4 || last < f) { factors[0] = n; return (n == 1) ? 0 : 1; } /* possibly do uint32_t specific code here */ if (f < primes_small[NPRIMES_SMALL-1]) { while ( (n & 1) == 0 ) { factors[nfactors++] = 2; n >>= 1; } if (3<=last) while ( (n % 3) == 0 ) { factors[nfactors++] = 3; n /= 3; } if (5<=last) while ( (n % 5) == 0 ) { factors[nfactors++] = 5; n /= 5; } for (sp = 4; sp < (int)NPRIMES_SMALL; sp++) { f = primes_small[sp]; if (f*f > n || f > last) 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 <= last) { UV m, newlimit, limit = isqrt(n); if (limit > last) limit = last; 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 void _divisors_from_factors(UV nfactors, UV* fp, UV* fe, UV* res) { UV s, count = 1; res[0] = 1; for (s = 0; s < nfactors; s++) { UV i, j, scount = count, p = fp[s], e = fe[s], mult = 1; for (j = 0; j < e; j++) { mult *= p; for (i = 0; i < scount; i++) res[count++] = res[i] * mult; } } } UV* _divisor_list(UV n, UV *num_divisors) { UV factors[MPU_MAX_FACTORS+1]; UV exponents[MPU_MAX_FACTORS+1]; UV* divs; int i, 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); _divisors_from_factors(nfactors, factors, exponents, divs); /* Sort divisors (numeric ascending) */ qsort(divs, ndivisors, sizeof(UV), _numcmp); /* Return number of divisors and list */ *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[11] = #if BITS_PER_WORD == 64 {UVCONST(3000000000000000000),UVCONST(3000000000),2487240,64260,7026, 1622, 566, 256, 139, 85, 57}; #else {UVCONST(845404560), 52560, 1548, 252, 84, 41, 24, 16, 12, 10, 8}; #endif UV divisor_sum(UV n, UV k) { UV factors[MPU_MAX_FACTORS+1]; int nfac, i, j; UV product = 1; if (k > 11 || (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; } static int found_factor(UV n, UV f, UV* factors) { UV f2 = n/f; int i = f > f2; if (f == 1 || f2 == 1) { factors[0] = n; return 1; } factors[i] = f; factors[1-i] = f2; MPUassert( factors[0] * factors[1] == n , "incorrect factoring"); return 2; } /* Knuth volume 2, algorithm C. * Can't compete with HOLF, SQUFOF, pbrent, etc. */ 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; return found_factor(n, r, factors); } /* Hart's One Line Factorization. */ 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"); /* We skip the perfect-square test for s in the loop, so we * will never succeed if n is a perfect square. Test that now. */ if (is_perfect_square(n)) return found_factor(n, isqrt(n), factors); if (n <= (UV_MAX >> 6)) { /* Try with premultiplier first */ UV npre = n * ( (n <= (UV_MAX >> 13)) ? 720 : (n <= (UV_MAX >> 11)) ? 480 : (n <= (UV_MAX >> 10)) ? 360 : (n <= (UV_MAX >> 8)) ? 60 : 30 ); UV ni = npre; #if 0 /* Straightforward */ while (rounds--) { s = isqrt(ni) + 1; m = (s*s) - ni; if (is_perfect_square(m)) { f = gcd_ui(n, s - isqrt(m)); if (f > 1 && f < n) return found_factor(n, f, factors); } if (ni >= (ni+npre)) break; ni += npre; } #else /* More optimized */ while (rounds--) { s = 1 + (UV)sqrt((double)ni); m = (s*s) - ni; f = m & 127; if (!((f*0x8bc40d7d) & (f*0xa1e2f5d1) & 0x14020a)) { f = (UV)sqrt((double)m); if (m == f*f) { f = gcd_ui(n, s - f); if (f > 1 && f < n) return found_factor(n, f, factors); } } if (ni >= (ni+npre)) break; ni += npre; } #endif } 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.... */ return found_factor(n, f, factors); } } factors[0] = n; return 1; } static int holf32(uint32_t n, UV *factors, uint32_t rounds) { UV npre, ni; /* These should be 64-bit */ uint32_t s, m, f; if (n < 3) { factors[0] = n; return 1; } if (!(n&1)) { factors[0] = 2; factors[1] = n/2; return 2; } if (is_perfect_square(n)) { factors[0] = factors[1] = isqrt(n); return 2; } ni = npre = (UV) n * ((BITS_PER_WORD == 64) ? 5040 : 1); while (rounds--) { s = 1 + (uint32_t)sqrt((double)ni); m = ((UV)s*(UV)s) - ni; f = m & 127; if (!((f*0x8bc40d7d) & (f*0xa1e2f5d1) & 0x14020a)) { f = (uint32_t)sqrt((double)m); if (m == f*f) { f = gcd_ui(n, s - f); if (f > 1 && f < n) return found_factor(n, f, factors); } } if (ni >= (ni+npre)) break; /* We've overflowed */ ni += npre; } factors[0] = n; return 1; } #define ABSDIFF(x,y) (x>y) ? x-y : y-x #if USE_MONTMATH /* Pollard Rho with Brent's updates, using Montgomery reduction. */ int pbrent_factor(UV n, UV *factors, UV rounds, UV a) { UV const nbits = BITS_PER_WORD - clz(n); const UV inner = (nbits <= 31) ? 32 : (nbits <= 35) ? 64 : (nbits <= 40) ? 160 : (nbits <= 52) ? 256 : 320; UV f, m, r, rleft, Xi, Xm, Xs; int irounds, fails = 6; const uint64_t npi = mont_inverse(n), mont1 = mont_get1(n); MPUassert( (n >= 3) && ((n%2) != 0) , "bad n in pbrent_factor"); r = f = 1; Xi = Xm = Xs = mont1; a = mont_geta(a,n); while (rounds > 0) { rleft = (r > rounds) ? rounds : r; Xm = Xi; /* Do rleft rounds, inner at a time */ while (rleft > 0) { irounds = (rleft > (UV)inner) ? inner : rleft; rleft -= irounds; rounds -= irounds; Xs = Xi; if (n < (1ULL << 63)) { Xi = mont_mulmod63(Xi,Xi+a,n); m = ABSDIFF(Xi,Xm); while (--irounds > 0) { Xi = mont_mulmod63(Xi,Xi+a,n); f = ABSDIFF(Xi,Xm); m = mont_mulmod63(m, f, n); } } else if (a == mont1) { Xi = mont_mulmod64(Xi,Xi+a,n); m = ABSDIFF(Xi,Xm); while (--irounds > 0) { Xi = mont_mulmod64(Xi,Xi+a,n); f = ABSDIFF(Xi,Xm); m = mont_mulmod64(m, f, n); } } else { Xi = addmod(mont_mulmod64(Xi,Xi,n), a, n); m = ABSDIFF(Xi,Xm); while (--irounds > 0) { Xi = addmod(mont_mulmod64(Xi,Xi,n), a, n); f = ABSDIFF(Xi,Xm); m = mont_mulmod64(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; continue; } if (f == n) { /* back up, with safety */ Xi = Xs; do { if (n < (1ULL << 63) || a == mont1) Xi = mont_mulmod(Xi,Xi+a,n); else Xi = addmod(mont_mulmod(Xi,Xi,n),a,n); m = ABSDIFF(Xi,Xm); f = gcd_ui(m, n); } while (f == 1 && r-- != 0); } if (f == 0 || f == n) { if (fails-- <= 0) break; Xi = Xm = mont1; a = addmod(a, mont_geta(11,n), n); continue; } return found_factor(n, f, factors); } factors[0] = n; return 1; } #else /* Pollard Rho with Brent's updates. */ int pbrent_factor(UV n, UV *factors, UV rounds, UV a) { UV f, m, r, Xi, Xm; const UV inner = (n <= 4000000000UL) ? 32 : 160; int fails = 6; MPUassert( (n >= 3) && ((n%2) != 0) , "bad n in pbrent_factor"); r = f = Xi = Xm = 1; while (rounds > 0) { UV rleft = (r > rounds) ? rounds : r; UV saveXi = Xi; /* 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 = ABSDIFF(Xi,Xm); while (--dorounds > 0) { /* Now do inner-1=63 more iterations */ Xi = sqraddmod(Xi, a, n); f = ABSDIFF(Xi,Xm); 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( ABSDIFF(Xi,Xm), n); } while (f == 1 && r-- != 0); } if (f == 0 || f == n) { if (fails-- <= 0) break; Xm = addmod(Xm, 11, n); Xi = Xm; a++; continue; } return found_factor(n, f, factors); } factors[0] = n; return 1; } #endif /* 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; int fails = 3; 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 == 0 || f == n) { if (fails-- <= 0) break; U = addmod(U,2,n); V = U; a++; continue; } return found_factor(n, f, factors); } factors[0] = n; return 1; } /* Pollard's P-1 */ int pminus1_factor(UV n, UV *factors, UV B1, UV B2) { UV f, k, kmin; UV a = 2, q = 2; UV savea = 2, saveq = 2; UV j = 1; UV sqrtB1 = isqrt(B1); #if USE_MONTMATH const uint64_t npi = mont_inverse(n), mont1 = mont_get1(n); UV ma = mont_geta(a,n); #define PMINUS1_APPLY_POWER ma = mont_powmod(ma, k, n) #define PMINUS1_RECOVER_A a = mont_recover(ma,n) #else #define PMINUS1_APPLY_POWER a = powmod(a, k, n) #define PMINUS1_RECOVER_A #endif MPUassert( (n >= 3) && ((n%2) != 0) , "bad n in pminus1_factor"); if (B1 <= primes_small[NPRIMES_SMALL-2]) { UV i; for (i = 1; primes_small[i] <= B1; i++) { q = k = primes_small[i]; if (q <= sqrtB1) { k = q*q; kmin = B1/q; while (k <= kmin) k *= q; } PMINUS1_APPLY_POWER; if ( (j++ % 32) == 0) { PMINUS1_RECOVER_A; if (a == 0 || gcd_ui(a-1, n) != 1) break; savea = a; saveq = q; } } PMINUS1_RECOVER_A; } else { START_DO_FOR_EACH_PRIME(2, B1) { q = k = p; if (q <= sqrtB1) { k = q*q; kmin = B1/q; while (k <= kmin) k *= q; } PMINUS1_APPLY_POWER; if ( (j++ % 32) == 0) { PMINUS1_RECOVER_A; if (a == 0 || gcd_ui(a-1, n) != 1) break; savea = a; saveq = q; } } END_DO_FOR_EACH_PRIME PMINUS1_RECOVER_A; } 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) { k = p; 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); } return found_factor(n, f, factors); } /* 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 return found_factor(n, f, factors); } /* SQUFOF, based on Ben Buhrow's racing version. */ #if 1 /* limit to 62-bit inputs, use 32-bit types, faster */ #define SQUFOF_TYPE uint32_t #define SQUFOF_MAX (UV_MAX >> 2) #else /* All 64-bit inputs possible, though we severely limit multipliers */ #define SQUFOF_TYPE UV #define SQUFOF_MAX UV_MAX #endif typedef struct { int valid; SQUFOF_TYPE P; SQUFOF_TYPE bn; SQUFOF_TYPE Qn; SQUFOF_TYPE Q0; SQUFOF_TYPE b0; SQUFOF_TYPE it; SQUFOF_TYPE imax; SQUFOF_TYPE mult; } mult_t; /* N < 2^63 (or 2^31). Returns 0 or a factor */ static UV squfof_unit(UV n, mult_t* mult_save) { SQUFOF_TYPE imax,i,Q0,Qn,bn,b0,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 */ t2 = Qn & 127; if (!((t2*0x8bc40d7d) & (t2*0xa1e2f5d1) & 0x14020a)) { t1 = (uint32_t) sqrt(Qn); if (Qn == t1*t1) break; } /* Odd iteration. */ SQUARE_SEARCH_ITERATION; } S = t1; /* isqrt(Qn); */ mult_save->it = i; /* Reduce to G0 */ Ro = P + S*((b0 - P)/S); So = (n - (UV)Ro*(UV)Ro)/(UV)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) { mult_t mult_save[NSQUFOF_MULT]; UV i, nn64, sqrtnn64, mult, f64,rounds_done = 0; int mults_racing = NSQUFOF_MULT; /* Caller should have handled these trivial cases */ MPUassert( (n >= 3) && ((n%2) != 0) , "bad n in squfof_factor"); /* Too big */ if (n > SQUFOF_MAX) { factors[0] = n; return 1; } for (i = 0; i < NSQUFOF_MULT; i++) { mult_save[i].valid = -1; mult_save[i].it = 0; } /* Race each multiplier for a bit (20-20k rounds) */ while (mults_racing > 0 && rounds_done < rounds) { for (i = 0; i < NSQUFOF_MULT && rounds_done < rounds; i++) { if (mult_save[i].valid == 0) continue; mult = squfof_multipliers[i]; nn64 = n * mult; if (mult_save[i].valid == -1) { if ((SQUFOF_MAX / mult) < n) { mult_save[i].valid = 0; /* This multiplier would overflow 64-bit */ mults_racing--; continue; } sqrtnn64 = isqrt(nn64); mult_save[i].valid = 1; mult_save[i].Q0 = 1; mult_save[i].b0 = sqrtnn64; mult_save[i].P = sqrtnn64; mult_save[i].Qn = (SQUFOF_TYPE)(nn64 - sqrtnn64 * sqrtnn64); if (mult_save[i].Qn == 0) return found_factor(n, sqrtnn64, factors); mult_save[i].bn = (2 * sqrtnn64) / (UV)mult_save[i].Qn; mult_save[i].it = 0; mult_save[i].mult = mult; mult_save[i].imax = (UV) (sqrt(sqrtnn64) / 16); if (mult_save[i].imax < 20) mult_save[i].imax = 20; if (mult_save[i].imax > rounds) mult_save[i].imax = rounds; } if (mults_racing == 1) /* Do all rounds if only one multiplier left */ mult_save[i].imax = (rounds - rounds_done); f64 = squfof_unit(nn64, &mult_save[i]); if (f64 > 1) { UV f64red = f64 / gcd_ui(f64, mult); if (f64red > 1) { /* unsigned long totiter = 0; {int K; for (K = 0; K < NSQUFOF_MULT; K++) totiter += mult_save[K].it; } printf(" n %lu mult %lu it %lu (%lu)\n",n,mult,totiter,(UV)mult_save[i].it); */ return found_factor(n, f64red, factors); } /* Found trivial factor. Quit working with this multiplier. */ mult_save[i].valid = 0; } if (mult_save[i].valid == 0) mults_racing--; rounds_done += mult_save[i].imax; /* Assume we did all rounds */ } } /* No factors found */ factors[0] = n; return 1; } #define SQR_TAB_SIZE 512 static int sqr_tab_init = 0; static double sqr_tab[SQR_TAB_SIZE]; static void make_sqr_tab(void) { int i; for (i = 0; i < SQR_TAB_SIZE; i++) sqr_tab[i] = sqrt((double)i); sqr_tab_init = 1; } /* Lehman written and tuned by Warren D. Smith. * Revised by Ben Buhrow and Dana Jacobsen. */ int lehman_factor(UV n, UV *factors, int do_trial) { const double Tune = ((n >> 31) >> 5) ? 3.5 : 5.0; double x, sqrtn; UV a,c,kN,kN4,B2; uint32_t b,p,k,r,B,U,Bred,inc,ip=2; if (!(n&1)) return found_factor(n, 2, factors); B = Tune * (1+rootof(n,3)); if (do_trial) { uint32_t FirstCut = 0.1 * B; if (FirstCut < 84) FirstCut = 84; if (FirstCut > 65535) FirstCut = 65535; for (ip = 2; ip < NPRIMES_SMALL; ip++) { p = primes_small[ip]; if (p >= FirstCut) break; if (n % p == 0) return found_factor(n, p, factors); } } if (n >= UVCONST(8796393022207)) { factors[0] = n; return 1; } Bred = B / (Tune * Tune * Tune); B2 = B*B; kN = 0; if (!sqr_tab_init) make_sqr_tab(); sqrtn = sqrt(n); for (k = 1; k <= Bred; k++) { if (k&1) { inc = 4; r = (k+n) % 4; } else { inc = 2; r = 1; } kN += n; if (kN >= UVCONST(1152921504606846976)) { factors[0] = n; return 1; } kN4 = kN*4; x = (k < SQR_TAB_SIZE) ? sqrtn * sqr_tab[k] : sqrt((double)kN); a = x; if ((UV)a * (UV)a == kN) return found_factor(n, gcd_ui(a,n), factors); x *= 2; a = x + 0.9999999665; /* Magic constant */ b = a % inc; b = a + (inc+r-b) % inc; c = (UV)b*(UV)b - kN4; U = x + B2/(2*x); for (a = b; a <= U; c += inc*(a+a+inc), a += inc) { /* Check for perfect square */ b = c & 127; if (!((b*0x8bc40d7d) & (b*0xa1e2f5d1) & 0x14020a)) { b = (uint32_t) sqrt(c); if (c == b*b) { B2 = gcd_ui(a+b, n); return found_factor(n, B2, factors); } } } } if (do_trial) { if (B > 65535) B = 65535; /* trial divide from primes[ip] to B. We could: * 1) use table of 6542 shorts for the primes. * 2) use a wheel * 3) let trial_factor handle it */ if (ip >= NPRIMES_SMALL) ip = NPRIMES_SMALL-1; return trial_factor(n, factors, primes_small[ip], B); } factors[0] = n; return 1; } static const uint32_t _fr_chunk = 8192; static const uint32_t _fr_sieve_crossover = 10000000; /* About 10^14 */ static void _vec_factor(UV lo, UV hi, UV *nfactors, UV *farray, UV noffset, int square_free) { UV *N, j, n, sqrthi, sievelim; sqrthi = isqrt(hi); n = hi-lo+1; New(0, N, hi-lo+1, UV); for (j = 0; j < n; j++) { N[j] = 1; nfactors[j] = 0; } sievelim = (sqrthi < _fr_sieve_crossover) ? sqrthi : icbrt(hi); START_DO_FOR_EACH_PRIME(2, sievelim) { UV q, t, A; if (square_free == 0) { UV kmin = hi / p; for (q = p; q <= kmin; q *= p) { t = lo / q, A = t * q; if (A < lo) A += q; for (j = A-lo; j < n; j += q) { farray[ j*noffset + nfactors[j]++ ] = p; N[j] *= p; } } } else { q = p*p, t = lo / q, A = t * q; if (A < lo) A += q; for (j = A-lo; j < n; j += q) { N[j] = 0; nfactors[j] = 0; } q = p, t = lo / q, A = t * q; if (A < lo) A += q; for (j = A-lo; j < n; j += q) { if (N[j] > 0) { farray[ j*noffset + nfactors[j]++ ] = p; N[j] *= p; } } } } END_DO_FOR_EACH_PRIME if (sievelim == sqrthi) { /* Handle the unsieved results, which are prime */ for (j = 0; j < n; j++) { if (N[j] == 1) farray[ j*noffset + nfactors[j]++ ] = j+lo; else if (N[j] > 0 && N[j] != j+lo) farray[ j*noffset + nfactors[j]++ ] = (j+lo) / N[j]; } } else { /* Handle the unsieved results, which are prime or semi-prime */ for (j = 0; j < n; j++) { UV rem = j+lo; if (N[j] > 0 && N[j] != rem) { if (N[j] != 1) rem /= N[j]; if (square_free && is_perfect_square(rem)) { nfactors[j] = 0; } else { UV* f = farray + j*noffset + nfactors[j]; nfactors[j] += factor_one(rem, f, 1, 0); } } } } Safefree(N); } factor_range_context_t factor_range_init(UV lo, UV hi, int square_free) { factor_range_context_t ctx; ctx.lo = lo; ctx.hi = hi; ctx.n = lo-1; ctx.is_square_free = square_free ? 1 : 0; if (hi-lo+1 > 100) { /* Sieve in chunks */ if (square_free) ctx._noffset = (hi <= 42949672965UL) ? 10 : 15; else ctx._noffset = BITS_PER_WORD - clz(hi); ctx._coffset = _fr_chunk; New(0, ctx._nfactors, _fr_chunk, UV); New(0, ctx._farray, _fr_chunk * ctx._noffset, UV); { /* Prealloc all the sieving primes now. */ UV t = isqrt(hi); if (t >= _fr_sieve_crossover) t = icbrt(hi); get_prime_cache(t, 0); } } else { /* factor each number */ New(0, ctx.factors, square_free ? 15 : 63, UV); ctx._nfactors = 0; ctx._farray = ctx.factors; ctx._noffset = 0; } return ctx; } int factor_range_next(factor_range_context_t *ctx) { int j, nfactors; UV n; if (ctx->n >= ctx->hi) return -1; n = ++(ctx->n); if (ctx->_nfactors) { if (ctx->_coffset >= _fr_chunk) { UV clo = n; UV chi = n + _fr_chunk - 1; if (chi > ctx->hi) chi = ctx->hi; _vec_factor(clo, chi, ctx->_nfactors, ctx->_farray, ctx->_noffset, ctx->is_square_free); ctx->_coffset = 0; } nfactors = ctx->_nfactors[ctx->_coffset]; ctx->factors = ctx->_farray + ctx->_coffset * ctx->_noffset; ctx->_coffset++; } else { if (ctx->is_square_free && n >= 49 && (!(n% 4) || !(n% 9) || !(n%25) || !(n%49))) return 0; nfactors = factor(n, ctx->factors); if (ctx->is_square_free) { for (j = 1; j < nfactors; j++) if (ctx->factors[j] == ctx->factors[j-1]) break; if (j < nfactors) return 0; } } return nfactors; } void factor_range_destroy(factor_range_context_t *ctx) { if (ctx->_farray != 0) Safefree(ctx->_farray); if (ctx->_nfactors != 0) Safefree(ctx->_nfactors); ctx->_farray = ctx->_nfactors = ctx->factors = 0; } /******************************************************************************/ /* DLP */ /******************************************************************************/ static UV dlp_trial(UV a, UV g, UV p, UV maxrounds) { UV k, t; if (maxrounds > p) maxrounds = p; #if USE_MONTMATH if (p&1) { const uint64_t npi = mont_inverse(p), mont1 = mont_get1(p); g = mont_geta(g, p); a = mont_geta(a, p); for (t = g, k = 1; k < maxrounds; k++) { if (t == a) return k; t = mont_mulmod(t, g, p); if (t == g) break; /* Stop at cycle */ } } else #endif { for (t = g, k = 1; k < maxrounds; k++) { if (t == a) return k; t = mulmod(t, g, p); if (t == g) break; /* Stop at cycle */ } } return 0; } /******************************************************************************/ /* DLP - Pollard Rho */ /******************************************************************************/ /* Compare with Pomerance paper (dartmouth dtalk4): * Type I/II/III = our case 1, 0, 2. * x_i = u, a_i = v, b_i = w * * Also see Bai/Brent 2008 for many ideas to speed this up. * https://maths-people.anu.edu.au/~brent/pd/rpb231.pdf * E.g. Teske adding-walk, Brent's cycle algo, Teske modified cycle */ #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;\ } typedef struct prho_state_t { UV u; UV v; UV w; UV U; UV V; UV W; UV round; int failed; int verbose; } prho_state_t; static UV dlp_prho_uvw(UV a, UV g, UV p, UV n, UV rounds, prho_state_t *s) { UV i, k = 0; UV u=s->u, v=s->v, w=s->w; UV U=s->U, V=s->V, W=s->W; int const verbose = s->verbose; if (s->failed) return 0; if (s->round + rounds > n) rounds = n - s->round; for (i = 1; i <= rounds; 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, G, G2; r1 = submod(v, V, n); if (r1 == 0) { if (verbose) printf("DLP Rho failure, r=0\n"); s->failed = 1; k = 0; break; } r2 = submod(W, w, n); G = gcd_ui(r1,n); G2 = gcd_ui(G,r2); k = divmod(r2/G2, r1/G2, n/G2); if (G > 1) { if (powmod(g,k,p) == a) { if (verbose > 2) printf(" common GCD %"UVuf"\n", G2); } else { UV m, l = divmod(r2, r1, n/G); for (m = 0; m < G; m++) { k = addmod(l, mulmod(m,(n/G),n), n); if (powmod(g,k,p) == a) break; } if (m 2) printf(" GCD %"UVuf", found with m=%"UVuf"\n", G, m); } } 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); s->failed = 1; k = 0; } break; } } s->round += i-1; if (verbose && k) printf("DLP Rho solution found after %"UVuf" steps\n", s->round + 1); s->u = u; s->v = v; s->w = w; s->U = U; s->V = V; s->W = W; return k; } #if 0 static UV dlp_prho(UV a, UV g, UV p, UV n, UV maxrounds) { #ifdef DEBUG int const verbose = _XS_get_verbose() #else int const verbose = 0; #endif prho_state_t s = {1, 0, 0, 1, 0, 0, 0, 0, verbose}; return dlp_prho_uvw(a, g, p, n, maxrounds, &s); } #endif /******************************************************************************/ /* DLP - BSGS */ /******************************************************************************/ typedef struct bsgs_hash_t { UV M; /* The baby step index */ UV V; /* The powmod value */ struct bsgs_hash_t* next; } bsgs_hash_t; /****************************************/ /* Simple and limited pool allocation */ #define BSGS_ENTRIES_PER_PAGE 8000 typedef struct bsgs_page_top_t { struct bsgs_page_t* first; bsgs_hash_t** table; UV size; int nused; int npages; } bsgs_page_top_t; typedef struct bsgs_page_t { bsgs_hash_t entries[BSGS_ENTRIES_PER_PAGE]; struct bsgs_page_t* next; } bsgs_page_t; static bsgs_hash_t* get_entry(bsgs_page_top_t* top) { if (top->nused == 0 || top->nused >= BSGS_ENTRIES_PER_PAGE) { bsgs_page_t* newpage; Newz(0, newpage, 1, bsgs_page_t); newpage->next = top->first; top->first = newpage; top->nused = 0; top->npages++; } return top->first->entries + top->nused++; } static void destroy_pages(bsgs_page_top_t* top) { bsgs_page_t* head = top->first; while (head != 0) { bsgs_page_t* next = head->next; Safefree(head); head = next; } top->first = 0; } /****************************************/ static void bsgs_hash_put(bsgs_page_top_t* pagetop, UV v, UV i) { UV idx = v % pagetop->size; bsgs_hash_t** table = pagetop->table; bsgs_hash_t* entry = table[idx]; while (entry && entry->V != v) entry = entry->next; if (!entry) { entry = get_entry(pagetop); entry->M = i; entry->V = v; entry->next = table[idx]; table[idx] = entry; } } static UV bsgs_hash_get(bsgs_page_top_t* pagetop, UV v) { bsgs_hash_t* entry = pagetop->table[v % pagetop->size]; while (entry && entry->V != v) entry = entry->next; return (entry) ? entry->M : 0; } static UV bsgs_hash_put_get(bsgs_page_top_t* pagetop, UV v, UV i) { UV idx = v % pagetop->size; bsgs_hash_t** table = pagetop->table; bsgs_hash_t* entry = table[idx]; while (entry && entry->V != v) entry = entry->next; if (entry) return entry->M; entry = get_entry(pagetop); entry->M = i; entry->V = v; entry->next = table[idx]; table[idx] = entry; return 0; } static UV dlp_bsgs(UV a, UV g, UV p, UV n, UV maxent, int race_rho) { bsgs_page_top_t PAGES; UV i, m, maxm, hashmap_count; UV aa, S, gm, T, gs_i, bs_i; UV result = 0; #ifdef DEBUG int const verbose = _XS_get_verbose(); #else int const verbose = 0; #endif prho_state_t rho_state = {1, 0, 0, 1, 0, 0, 0, 0, verbose}; if (n <= 2) return 0; /* Shouldn't be here with gorder this low */ if (race_rho) { result = dlp_prho_uvw(a, g, p, n, 10000, &rho_state); if (result) { if (verbose) printf("rho found solution in BSGS step 0\n"); return result; } } if (a == 0) return 0; /* We don't handle this case */ maxm = isqrt(n); m = (maxent > maxm) ? maxm : maxent; hashmap_count = (m < 65537) ? 65537 : (m > 40000000) ? 40000003 : next_prime(m); /* Ave depth around 2 */ /* Create table. Size: 8*hashmap_count bytes. */ PAGES.size = hashmap_count; PAGES.first = 0; PAGES.nused = 0; PAGES.npages = 0; Newz(0, PAGES.table, hashmap_count, bsgs_hash_t*); aa = mulmod(a,a,p); S = a; gm = powmod(g, m, p); T = gm; gs_i = 0; bs_i = 0; bsgs_hash_put(&PAGES, S, 0); /* First baby step */ S = mulmod(S, g, p); /* Interleaved Baby Step Giant Step */ for (i = 1; i <= m; i++) { gs_i = bsgs_hash_put_get(&PAGES, S, i); if (gs_i) { bs_i = i; break; } S = mulmod(S, g, p); if (S == aa) { /* We discovered the solution! */ if (verbose) printf(" dlp bsgs: solution at BS step %"UVuf"\n", i+1); result = i+1; break; } bs_i = bsgs_hash_put_get(&PAGES, T, i); if (bs_i) { gs_i = i; break; } T = mulmod(T, gm, p); if (race_rho && (i % 2048) == 0) { result = dlp_prho_uvw(a, g, p, n, 100000, &rho_state); if (result) { if (verbose) printf("rho found solution in BSGS step %"UVuf"\n", i); break; } } } if (!result) { /* Extend Giant Step search */ if (!(gs_i || bs_i)) { UV b = (p+m-1)/m; if (m < maxm && b > 8*m) b = 8*m; for (i = m+1; i < b; i++) { bs_i = bsgs_hash_get(&PAGES, T); if (bs_i) { gs_i = i; break; } T = mulmod(T, gm, p); if (race_rho && (i % 2048) == 0) { result = dlp_prho_uvw(a, g, p, n, 100000, &rho_state); if (result) { if (verbose) printf("rho found solution in BSGS step %"UVuf"\n", i); break; } } } } if (gs_i || bs_i) { result = submod(mulmod(gs_i, m, p), bs_i, p); } } if (verbose) printf(" dlp bsgs using %d pages (%.1fMB+%.1fMB) for hash\n", PAGES.npages, ((double)PAGES.npages * sizeof(bsgs_page_t)) / (1024*1024), ((double)hashmap_count * sizeof(bsgs_hash_t*)) / (1024*1024)); destroy_pages(&PAGES); Safefree(PAGES.table); if (result != 0 && powmod(g,result,p) != a) { if (verbose) printf("Incorrect DLP BSGS solution: %"UVuf"\n", result); result = 0; } if (race_rho && result == 0) { result = dlp_prho_uvw(a, g, p, n, 2000000000U, &rho_state); } return result; } /* Find smallest k where a = g^k mod p */ #define DLP_TRIAL_NUM 10000 static UV znlog_solve(UV a, UV g, UV p, UV n) { UV k, sqrtn; const int verbose = _XS_get_verbose(); if (a >= p) a %= p; if (g >= p) g %= p; if (a == 1 || g == 0 || p <= 2) return 0; if (verbose > 1 && n != p-1) printf(" g=%"UVuf" p=%"UVuf", order %"UVuf"\n", g, p, n); /* printf(" solving znlog(%"UVuf",%"UVuf",%"UVuf") n=%"UVuf"\n", a, g, p, n); */ if (n == 0 || n <= DLP_TRIAL_NUM) { k = dlp_trial(a, g, p, DLP_TRIAL_NUM); if (verbose) printf(" dlp trial 10k %s\n", (k!=0 || p <= DLP_TRIAL_NUM) ? "success" : "failure"); if (k != 0 || (n > 0 && n <= DLP_TRIAL_NUM)) return k; } { /* Existence checks */ UV aorder, gorder = n; if (gorder != 0 && powmod(a, gorder, p) != 1) return 0; aorder = znorder(a,p); if (aorder == 0 && gorder != 0) return 0; if (aorder != 0 && gorder % aorder != 0) return 0; } sqrtn = (n == 0) ? 0 : isqrt(n); if (n == 0) n = p-1; { UV maxent = (sqrtn > 0) ? sqrtn+1 : 100000; k = dlp_bsgs(a, g, p, n, maxent/2, /* race rho */ 1); if (verbose) printf(" dlp bsgs %"UVuf"k %s\n", maxent/1000, k!=0 ? "success" : "failure"); if (k != 0) return k; if (sqrtn > 0 && sqrtn < maxent) return 0; } if (verbose) printf(" dlp doing exhaustive trial\n"); k = dlp_trial(a, g, p, p); return k; } /* Silver-Pohlig-Hellman */ static UV znlog_ph(UV a, UV g, UV p, UV p1) { UV fac[MPU_MAX_FACTORS+1]; UV exp[MPU_MAX_FACTORS+1]; int i, nfactors; UV x, j; if (p1 == 0) return 0; /* TODO: Should we plow on with p1=p-1? */ nfactors = factor_exp(p1, fac, exp); if (nfactors == 1) return znlog_solve(a, g, p, p1); for (i = 0; i < nfactors; i++) { UV pi, delta, gamma; pi = fac[i]; for (j = 1; j < exp[i]; j++) pi *= fac[i]; delta = powmod(a,p1/pi,p); gamma = powmod(g,p1/pi,p); /* printf(" solving znlog(%"UVuf",%"UVuf",%"UVuf")\n", delta, gamma, p); */ fac[i] = znlog_solve( delta, gamma, p, znorder(gamma,p) ); exp[i] = pi; } x = chinese(fac, exp, nfactors, &i); if (i == 1 && powmod(g, x, p) == a) return x; return 0; } /* Find smallest k where a = g^k mod p */ UV znlog(UV a, UV g, UV p) { UV k, gorder, aorder; const int verbose = _XS_get_verbose(); if (a >= p) a %= p; if (g >= p) g %= p; if (a == 1 || g == 0 || p <= 2) return 0; /* TODO: We call znorder with the same p many times. We should have a * method for znorder given {phi,nfactors,fac,exp} */ gorder = znorder(g,p); if (gorder != 0 && powmod(a, gorder, p) != 1) return 0; aorder = znorder(a,p); if (aorder == 0 && gorder != 0) return 0; if (aorder != 0 && gorder % aorder != 0) return 0; /* TODO: Come up with a better solution for a=0 */ if (a == 0 || p < DLP_TRIAL_NUM || (gorder > 0 && gorder < DLP_TRIAL_NUM)) { if (verbose > 1) printf(" dlp trial znlog(%"UVuf",%"UVuf",%"UVuf")\n",a,g,p); k = dlp_trial(a, g, p, p); return k; } if (!is_prob_prime(gorder)) { k = znlog_ph(a, g, p, gorder); if (verbose) printf(" dlp PH %s\n", k!=0 ? "success" : "failure"); if (k != 0) return k; } return znlog_solve(a, g, p, gorder); } /* Compile with: * gcc -O3 -fomit-frame-pointer -march=native -Wall -DSTANDALONE -DFACTOR_STANDALONE factor.c util.c primality.c cache.c sieve.c chacha.c csprng.c prime_nth_count.c lmo.c -lm */ #ifdef FACTOR_STANDALONE #include int main(int argc, char *argv[]) { UV n; UV factors[MPU_MAX_FACTORS+1]; int nfactors, i, a; if (argc <= 1) { char line[1024]; while (1) { if (!fgets(line,sizeof(line),stdin)) break; n = strtoull(line, 0, 10); nfactors = factor(n, factors); if (nfactors == 1) { printf("%"UVuf": %"UVuf"\n",n,n); } else if (nfactors == 2) { printf("%"UVuf": %"UVuf" %"UVuf"\n",n,factors[0],factors[1]); } else if (nfactors == 3) { printf("%"UVuf": %"UVuf" %"UVuf" %"UVuf"\n",n,factors[0],factors[1],factors[2]); } else { printf("%"UVuf": %"UVuf" %"UVuf" %"UVuf" %"UVuf"",n,factors[0],factors[1],factors[2],factors[3]); for (i = 4; i < nfactors; i++) printf(" %"UVuf"", factors[i]); printf("\n"); } } exit(0); } for (a = 1; a < argc; a++) { n = strtoul(argv[a], 0, 10); if (n == ULONG_MAX && errno == ERANGE) { printf("Argument larger than ULONG_MAX\n"); return(-1); } nfactors = factor(n, factors); printf("%"UVuf":", n); for (i = 0; i < nfactors; i++) printf(" %"UVuf"", factors[i]); printf("\n"); } return(0); } #endif Math-Prime-Util-0.73/lehmer.c0000644000076400007640000006763313352074136014364 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 >= UVCONST(18446744065119617025)) 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 >= UVCONST(18446724184312856125)) 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 segment_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" #include "prime_nth_count.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 segment_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 != segment_prime_count(2, n)) croak("wrong count for %lu: %lu vs. %lu\n", n, i-1, segment_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 meissel_prime_count(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 + segment_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 legendre_prime_count(UV n) { UV a, phina; if (n < SIEVE_LIMIT) return segment_prime_count(2, n); a = legendre_prime_count(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 meissel_prime_count(UV n) { UV a, b, sum; if (n < SIEVE_LIMIT) return segment_prime_count(2, n); a = meissel_prime_count(icbrt(n)); /* a = Pi(floor(n^1/3)) [max 192725] */ b = meissel_prime_count(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 lehmer_prime_count(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 segment_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 segment_prime_count(2,n); } if (verbose > 0) printf("lehmer %lu stage 1: calculate a,b,c \n", n); TIMING_START; z = isqrt(n); a = lehmer_prime_count(isqrt(z)); /* a = Pi(floor(n^1/4)) [max 6542] */ b = lehmer_prime_count(z); /* b = Pi(floor(n^1/2)) [max 203280221] */ c = lehmer_prime_count(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 + segment_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 LMOS_prime_count(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 segment_prime_count(2, n); n13 = icbrt(n); /* n13 = floor(n^1/3) [max 2642245] */ a = lehmer_prime_count(n13); /* a = Pi(floor(n^1/3)) [max 192725] */ b = lehmer_prime_count(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 = lehmer_prime_count(n); } else if (!strcasecmp(method, "meissel")) { pi = meissel_prime_count(n); } else if (!strcasecmp(method, "legendre")) { pi = legendre_prime_count(n); } else if (!strcasecmp(method, "lmo")) { pi = LMOS_prime_count(n); } else if (!strcasecmp(method, "sieve")) { pi = segment_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 LMOS_prime_count(UV n) { if (n!=0) croak("Not compiled with Lehmer support"); return 0;} UV lehmer_prime_count(UV n) { if (n!=0) croak("Not compiled with Lehmer support"); return 0;} UV meissel_prime_count(UV n) { if (n!=0) croak("Not compiled with Lehmer support"); return 0;} UV legendre_prime_count(UV n) { if (n!=0) croak("Not compiled with Lehmer support"); return 0;} #endif Math-Prime-Util-0.73/lehmer.h0000644000076400007640000000033113204400603014333 0ustar danadana#ifndef MPU_LEHMER_H #define MPU_LEHMER_H #include "ptypes.h" extern UV legendre_prime_count(UV n); extern UV meissel_prime_count(UV n); extern UV lehmer_prime_count(UV n); extern UV LMOS_prime_count(UV n); #endif Math-Prime-Util-0.73/sieve_cluster.h0000644000076400007640000000037713204400603015745 0ustar danadana#ifndef MPU_SIEVE_CLUSTER_H #define MPU_SIEVE_CLUSTER_H #include "ptypes.h" extern UV* sieve_cluster_simple(UV beg, UV end, uint32_t nc, uint32_t* cl, UV* numret); extern UV* sieve_cluster(UV beg, UV end, uint32_t nc, uint32_t* cl, UV* numret); #endif Math-Prime-Util-0.73/multicall.h0000644000076400007640000001076612453427654015106 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 Math-Prime-Util-0.73/semi_primes.h0000644000076400007640000000045313355737466015433 0ustar danadana#ifndef MPU_SEMI_PRIMES_H #define MPU_SEMI_PRIMES_H #include "ptypes.h" extern UV nth_semiprime(UV n); extern UV nth_semiprime_approx(UV n); extern UV semiprime_count(UV low, UV high); extern UV semiprime_count_approx(UV n); extern UV range_semiprime_sieve(UV** semis, UV lo, UV hi); #endif

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_euler_plumb_pseudoprime Takes a positive number C as input and returns 1 if C passes Colin Plumb's Euler Criterion primality test. Pseudoprimes to this test are a subset of the base 2 Fermat and Euler tests, but a superset of the base 2 strong pseudoprime (Miller-Rabin) test. The main reason for this test is that is a bit more efficient than other probable prime tests. =head2 is_perrin_pseudoprime Takes a positive number C as input and returns 1 if C divides C where C is the Perrin number of C. The Perrin sequence is defined by C with C. While pseudoprimes are relatively rare (the first two are 271441 and 904631), infinitely many exist. They have significant overlap with the base-2 pseudoprimes and strong pseudoprimes, making the test inferior to the Lucas or Frobenius tests for combined testing. The pseudoprime sequence is L. The implementation uses modular pre-filters, Montgomery math, and the Adams/Shanks doubling method. This is significantly more efficient than other known implementations. An optional second argument C indicates whether to run additional tests. With C, C is also verified, creating the "minimal restricted" test. With C, the full signature is also tested using the Adams and Shanks (1982) rules (without the quadratic form test). With C, the full signature is testing using the Grantham (2000) test, which additionally does not allow pseudoprimes to be divisible by 2 or 23. The minimal restricted pseudoprime sequence is L. =head2 is_catalan_pseudoprime Takes a positive number C as input and returns 1 if C<-1^((n-1/2)) C_((n-1/2)> is congruent to 2 mod C, where C is the nth Catalan number. The nth Catalan number is equal to C. All odd primes satisfy this condition, and only three known composites. The pseudoprime sequence is L. There is no known efficient method to perform the Catalan primality test, so it is a curiosity rather than a practical test. The implementation uses a method from Charles Greathouse IV (2015) and results from Aebi and Cairns (2008) to produce results many orders of magnitude faster than other known implementations, but it is still vastly slower than other compositeness tests. =head2 is_frobenius_pseudoprime Takes a positive number C as input, and two optional parameters C and C, and returns 1 if the C is a Frobenius probable prime with respect to the polynomial C. Without the parameters, C and C is the least positive odd number such that C<(a^2-4b|n) = -1>. This selection has no pseudoprimes below C<2^64> and none known. In any case, the discriminant C must not be a perfect square. Some authors use the Fibonacci polynomial C corresponding to C<(1,-1)> as the default method for a Frobenius probable prime test. This creates a weaker test than most other parameter choices (e.g. over twenty times more pseudoprimes than C<(3,-5)>), so is not used as the default here. With the C<(1,-1)> parameters the pseudoprime sequence is L. The Frobenius test is a stronger test than the Lucas test. Any Frobenius C<(a,b)> pseudoprime is also a Lucas C<(a,b)> pseudoprime but the converse is not true, as any Frobenius C<(a,b)> pseudoprime is also a Fermat pseudoprime to the base C<|b|>. We can see that with the default parameters this is similar to, but somewhat weaker than, the BPSW test used by this module (which uses the strong and extra-strong versions of the probable prime and Lucas tests respectively). Also see the more efficient L and L which have no known counterexamples and run quite a bit faster. =head2 is_frobenius_underwood_pseudoprime Takes a positive number as input, and returns 1 if the input passes the efficient Frobenius test of Paul Underwood. This selects a parameter C as the least non-negative integer such that C<(a^2-4|n)=-1>, then verifies that C<(x+2)^(n+1) = 2a + 5 mod (x^2-ax+1,n)>. This combines a Fermat and Lucas test with a cost of only slightly more than 2 strong pseudoprime tests. This makes it similar to, but faster than, a regular Frobenius test. There are no known pseudoprimes to this test and extensive computation has shown no counterexamples under C<2^50>. This test also has no overlap with the BPSW test, making it a very effective method for adding additional certainty. Performance at 1e12 is about 60% slower than BPSW. =head2 is_frobenius_khashin_pseudoprime Takes a positive number as input, and returns 1 if the input passes the Frobenius test of Sergey Khashin. This ensures C is not a perfect square, selects the parameter C as the smallest odd prime such that C<(c|n)=-1>, then verifies that C<(1+D)^n = (1-D) mod n> where C. There are no known pseudoprimes to this test and Khashin (2018) shows there are no counterexamples under C<2^64>. Performance at 1e12 is about 40% slower than BPSW. =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 non-negative 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. This implementation uses theorem 4.1 from Bernstein (2003). It runs substantially faster than the original, v6 revised paper with Lenstra improvements, or the late 2002 improvements of Voloch and Bornemann. The GMP implementation uses a binary segmentation method for modular polynomial multiplication (see Bernstein's 2007 Quartic paper), which reduces to a single scalar multiplication, at which GMP excels. Because of this, the GMP implementation is likely to be faster once the input is larger than C<2^33>. =head2 is_mersenne_prime say "2^607-1 (M607) is a Mersenne prime" if is_mersenne_prime(607); Takes a non-negative number C