Math-Prime-Util-0.74/000755 000765 000024 00000000000 15154713772 014404 5ustar00danastaff000000 000000 Math-Prime-Util-0.74/XS.xs000644 000765 000024 00000656426 15154713505 015327 0ustar00danastaff000000 000000 #define PERL_NO_GET_CONTEXT 1 /* Define at top for more efficiency. */ #if defined(__clang__) && defined(__clang_major__) && __clang_major__ > 11 #pragma clang diagnostic ignored "-Wcompound-token-split-by-macro" #endif #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 "sort.h" #include "primality.h" #include "lucas_seq.h" #include "factor.h" #include "totients.h" #include "lehmer.h" #include "lmo.h" #include "legendre_phi.h" #include "aks.h" #include "constants.h" #include "mulmod.h" #include "entropy.h" #include "csprng.h" #include "random_prime.h" #include "perfect_powers.h" #include "prime_powers.h" #include "ramanujan_primes.h" #include "semi_primes.h" #include "twin_primes.h" #include "almost_primes.h" #include "omega_primes.h" #include "prime_counts.h" #include "prime_sums.h" #include "congruent_numbers.h" #include "powerfree.h" #include "powerful.h" #include "lucky_numbers.h" #include "goldbach.h" #include "rootmod.h" #include "rational.h" #include "real.h" #include "ds_iset.h" /* Used for sumset, setbinop, is_sidon_set, vecuniq */ #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 #ifdef USE_QUADMATH #define STRTONV(t) strtoflt128(t,NULL) #elif defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) #define STRTONV(t) strtold(t,NULL) #else #define STRTONV(t) strtod(t,NULL) #endif #if PERL_VERSION_LT(5,7,0) && 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_VERSION_LT(5,14,0) && 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_VERSION_GE(5,9,4) || PERL_VERSION_EQ(5,8,9) #define SVf_MAGTEST SVf_ROK #else #define SVf_MAGTEST SVf_AMAGIC #define GV_NOTQUAL 0 #endif #define SVNUMTEST(n) \ ((SvFLAGS(n) & (SVf_IOK | SVf_MAGTEST | SVs_GMG )) == SVf_IOK) /* multicall compatibility stuff */ #if PERL_VERSION_LT(5,7,0) || !defined(dMULTICALL) # define USE_MULTICALL 0 /* Too much trouble to work around it */ #else # define USE_MULTICALL 1 #endif #if PERL_VERSION_LT(5,13,9) # define FIX_MULTICALL_REFCOUNT \ if (CvDEPTH(multicall_cv) > 1) SvREFCNT_inc(multicall_cv); #else # define FIX_MULTICALL_REFCOUNT #endif /* Perl globals we use for setting a and b inside the called block */ #define plAgv PL_firstgv #define plBgv PL_secondgv #ifndef CvISXSUB # define CvISXSUB(cv) CvXSUB(cv) #endif /* Not right, but close. We don't use it ourselves, but core macros do. */ #if !defined cxinc && PERL_VERSION_GE(5,8,1) && PERL_VERSION_LT(5,11,0) # define cxinc() Perl_cxinc(aTHX) #endif #if PERL_VERSION_LT(5,17,7) # define SvREFCNT_dec_NN(sv) SvREFCNT_dec(sv) #endif #if PERL_VERSION_LT(5,20,0) # define EXTEND_TYPE int #else # define EXTEND_TYPE SSize_t #endif #define MAX_EXTEND ((Size_t)((EXTEND_TYPE)-1)) /******************************************************************************/ /******************************************************************************/ /* Information about the GMP back end. * * This is not ideal in a couple ways. * * - The return type info would be useful for non-GMP functions also. The * thought was to use this to automatically apply objectify. The PP * backend should take care of the result itself. * * - The versioning is limited. Having more fine grain info, e.g. the GMP * module provides semantics 20210808 of modint, while we need 20250212. * * No matter what we do it's going to be tricky with things like adding * support for negative inputs, while positive ones remain unchanged. */ typedef enum { R_VOID, R_BOOL, R_NATIVE, R_BIGINT, R_OTHER, } gmp_return_type_t; typedef struct { const char *name; uint32_t version; uint16_t nretvals; gmp_return_type_t rettype; } gmp_info_t; static const gmp_info_t gmp_info[] = { { "sqrtint", 40, 1, R_BIGINT }, { "addint", 52, 1, R_BIGINT }, { "subint", 52, 1, R_BIGINT }, { "mulint", 52, 1, R_BIGINT }, { "divint", 52, 1, R_BIGINT }, { "modint", 52, 1, R_BIGINT }, { "powint", 52, 1, R_BIGINT }, { "absint", 52, 1, R_BIGINT }, { "negint", 52, 1, R_BIGINT }, { "cdivint", 53, 1, R_BIGINT }, { "add1int", 53, 1, R_BIGINT }, { "sub1int", 53, 1, R_BIGINT }, { "lshiftint", 53, 1, R_BIGINT }, { "rshiftint", 53, 1, R_BIGINT }, { "rashiftint", 53, 1, R_BIGINT }, { "logint", 47, 1, R_BIGINT }, /* no root return */ { "rootint", 40, 1, R_BIGINT }, /* no root return */ { "invmod", 20, 1, R_BIGINT }, { "znorder", 22, 1, R_BIGINT }, { "zinprimroot", 22, 1, R_BIGINT }, { "addmod", 53, 1, R_BIGINT }, /* 36 with n > 0 */ { "submod", 53, 1, R_BIGINT }, { "mulmod", 53, 1, R_BIGINT }, /* 36 with n > 0 */ { "powmod", 53, 1, R_BIGINT }, /* 36 with n > 0 */ { "divmod", 53, 1, R_BIGINT }, /* 36 with n > 0 */ { "muladdmod", 53, 1, R_BIGINT }, { "mulsubmod", 53, 1, R_BIGINT }, { "factorialmod", 53, 1, R_BIGINT }, /* 47 with m > 0 */ { "binomialmod", 53, 1, R_BIGINT }, { "sqrtmod", 53, 1, R_BIGINT }, /* 53 for composites */ { "divrem", 52, 2, R_BIGINT }, { "tdivrem", 52, 2, R_BIGINT }, { "fdivrem", 53, 2, R_BIGINT }, { "cdivrem", 53, 2, R_BIGINT }, { "is_primitive_root", 36, 1, R_BOOL }, { "is_semiprime", 42, 1, R_BOOL }, { "is_square", 47, 1, R_BOOL }, { "is_carmichael", 47, 1, R_BOOL }, { "is_perfect_power", 47, 1, R_BOOL }, { "is_fundamental", 47, 1, R_BOOL }, { "is_totient", 47, 1, R_BOOL }, { "is_lucky", 48, 1, R_BOOL }, { "is_practical", 53, 1, R_BOOL }, { "is_perfect_number", 53, 1, R_BOOL }, { "is_square_free", 53, 1, R_BOOL }, { "is_powerfree", 53, 1, R_BOOL }, { "is_smooth", 53, 1, R_BOOL }, { "is_rough", 53, 1, R_BOOL }, { "is_almost_prime", 53, 1, R_BOOL }, { "is_divisible", 53, 1, R_BOOL }, { "is_congruent", 53, 1, R_BOOL }, { "is_powerful", 53, 1, R_BOOL }, { "is_qr", 53, 1, R_BOOL }, { "is_prime", 1, 1, R_BOOL }, { "is_prob_prime", 1, 1, R_BOOL }, { "is_provable_prime", 4, 1, R_BOOL }, { "is_bpsw_prime", 17, 1, R_BOOL }, { "is_aks_prime", 16, 1, R_BOOL }, { "is_mersenne_prime", 28, 1, R_BOOL }, { "is_gaussian_prime", 52, 1, R_BOOL }, { "is_pseudoprime", 53, 1, R_BOOL }, /* v0.41 with bases */ { "is_euler_pseudoprime", 53, 1, R_BOOL }, /* v0.41 with bases */ { "is_strong_pseudoprime", 53, 1, R_BOOL }, /* v0.41 with bases */ { "is_euler_plumb_pseudoprime", 39, 1, R_BOOL }, { "is_perrin_pseudoprime", 40, 1, R_BOOL }, { "is_lucas_pseudoprime", 1, 1, R_BOOL }, { "is_strong_lucas_pseudoprime", 1, 1, R_BOOL }, { "is_extra_strong_lucas_pseudoprime", 1, 1, R_BOOL }, { "is_almost_extra_strong_lucas_pseudoprime", 13, 1, R_BOOL }, { "is_frobenius_pseudoprime", 24, 1, R_BOOL }, { "is_frobenius_underwood_pseudoprime", 13, 1, R_BOOL }, { "is_frobenius_khashin_pseudoprime", 30, 1, R_BOOL }, { "miller_rabin_random", 46, 1, R_BOOL }, { "next_prime", 1, 1, R_BIGINT }, { "prev_prime", 1, 1, R_BIGINT }, { "kronecker", 17, 1, R_NATIVE }, { "valuation", 20, 1, R_NATIVE }, { "liouville", 22, 1, R_NATIVE }, { "hammingweight", 47, 1, R_NATIVE }, { "moebius", 49, 1, R_NATIVE }, /* v0.22 with non-neg */ { "prime_omega", 53, 1, R_NATIVE }, { "prime_bigomega", 53, 1, R_NATIVE }, { "consecutive_integer_lcm", 4, 1, R_BIGINT }, { "partitions", 16, 1, R_BIGINT }, { "gcd", 17, 1, R_BIGINT }, { "lcm", 17, 1, R_BIGINT }, { "exp_mangoldt", 19, 1, R_BIGINT }, { "jordan_totient", 22, 1, R_BIGINT }, { "carmichael_lambda", 22, 1, R_BIGINT }, { "binomial", 22, 1, R_BIGINT }, { "stirling", 26, 1, R_BIGINT }, { "lucasu", 29, 1, R_BIGINT }, { "lucasv", 29, 1, R_BIGINT }, { "chinese", 32, 1, R_BIGINT }, { "ramanujan_tau", 53, 1, R_BIGINT }, /* v0.53 much faster */ { "gcdext", 35, 3, R_BIGINT }, { "primorial", 37, 1, R_BIGINT }, { "pn_primorial", 37, 1, R_BIGINT }, { "permtonum", 47, 1, R_BIGINT }, { "subfactorial", 51, 1, R_BIGINT }, { "falling_factorial", 51, 1, R_BIGINT }, { "rising_factorial", 51, 1, R_BIGINT }, { "lucasumod", 53, 1, R_BIGINT }, { "lucasvmod", 53, 1, R_BIGINT }, { "lucasuv", 53, 2, R_BIGINT }, { "lucasuvmod", 53, 2, R_BIGINT }, { "pisano_period", 53, 1, R_BIGINT }, { "powersum", 53, 1, R_BIGINT }, { "fromdigits", 53, 1, R_BIGINT }, { "urandomb", 43, 1, R_BIGINT }, { "urandomm", 44, 1, R_BIGINT }, { "random_nbit_prime", 42, 1, R_BIGINT }, { "random_ndigit_prime", 42, 1, R_BIGINT }, { "random_strong_prime", 43, 1, R_BIGINT }, { "random_maurer_prime", 43, 1, R_BIGINT }, {"random_shawe_taylor_prime", 43, 1, R_BIGINT }, { "random_prime", 44, 1, R_BIGINT }, { "random_safe_prime", 52, 1, R_BIGINT }, { "sieve_range", 36, 0xFF, R_BIGINT }, /* needs objectify */ { "sieve_prime_cluster", 34, 0xFF, R_BIGINT }, /* needs objectify */ { "divisors", 53, 0xFF, R_BIGINT }, /* needs objectify */ { "numtoperm", 47, 0xFF, R_NATIVE }, { "todigits", 41, 0xFF, R_NATIVE }, { "powerful_count", 53, 1, R_BIGINT }, { "powerfree_count", 53, 1, R_BIGINT }, { "prime_power_count", 53, 1, R_BIGINT }, { "perfect_power_count", 53, 1, R_BIGINT }, { "nth_powerfree", 53, 1, R_BIGINT }, { "nth_perfect_power", 53, 1, R_BIGINT }, { "nth_perfect_power_approx", 53, 1, R_BIGINT }, { "next_perfect_power", 53, 1, R_BIGINT }, { "prev_perfect_power", 53, 1, R_BIGINT }, { "is_power", 42, 1, R_NATIVE }, /* no root return */ { "is_prime_power", 40, 1, R_NATIVE }, /* no root return */ { "is_polygonal", 47, 1, R_BOOL }, /* no root return */ { "bernfrac", 24, 2, R_BIGINT }, { "harmfrac", 30, 2, R_BIGINT }, /* if the input is already a bigint type, we want to use that */ /* { "factorial", 24, 1, R_BIGINT }, */ #if 0 /* need to objectify a return list */ { "factor", 41, 0xFF, R_BIGINT }, #endif #if 0 /* objectify list, and the API isn't identical */ { "trial_factor", 47, 0xFF, R_BIGINT }, { "holf_factor", 47, 0xFF, R_BIGINT }, { "squfof_factor", 47, 0xFF, R_BIGINT }, { "phro_factor", 47, 0xFF, R_BIGINT }, { "pplus1_factor", 47, 0xFF, R_BIGINT }, { "pbrent_factor", 47, 0xFF, R_BIGINT }, { "pminus1_factor", 47, 0xFF, R_BIGINT }, { "ecm_factor", 47, 0xFF, R_BIGINT }, { "cheb_factor", 53, 0xFF, R_BIGINT }, #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"; */ static const char ivmin_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"; */ static const char ivmin_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; /* Track nesting level of for loops */ char forexit; /* Boolean whether we should exit early */ } 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") || /* BigFloat not here, force to PP */ 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/-1 if it is good to process by XS. * TODO: it would be useful to know the sign even if returning 0 for bigint. */ static int _validate_int(pTHX_ SV* n, int negok) { const char* mustbe = (negok) ? "must be an integer" : "must be a non-negative integer"; 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 "' %s", n, mustbe); } if (sv_isobject(n)) { isbignum = _is_sv_bigint(aTHX_ n); if (!isbignum) return 0; } if (!SvOK(n)) croak("Parameter must be defined"); if (SvGAMAGIC(n) && !isbignum) ptr = SvPV(n, len); else ptr = SvPV_nomg(n, len); if (len == 0 || ptr == 0) croak("Parameter %s", mustbe); if (ptr[0] == '-' && negok) { isneg = 1; ptr++; len--; /* Read negative sign */ } else if (ptr[0] == '+') { ptr++; len--; /* Allow a single plus sign */ } /* Empty string or non-numeric */ if (len == 0 || !isDIGIT(ptr[0])) croak("Parameter '%" SVf "' %s", n, mustbe); /* Leading zeros and if left with only zero */ while (len > 0 && *ptr == '0') /* Strip all leading zeros */ { ptr++; len--; } if (len == 0) /* 0 or -0 */ return 1; /* We're going to look more carefully at the string to ensure it's a number */ if (isneg) { ret = -1; maxlen = ivmax_maxlen; maxstr = ivmin_str; } else { ret = 1; maxlen = uvmax_maxlen; maxstr = uvmax_str; } for (i = 0; i < len; i++) /* Ensure all characters are digits */ if (!isDIGIT(ptr[i])) croak("Parameter '%" SVf "' %s", n, mustbe); if (len > maxlen) return 0; /* Obvious bigint */ if (len < maxlen) return ret; /* Valid small integer */ for (i = 0; i < maxlen; i++) /* Check if in range */ if (ptr[i] != maxstr[i]) return ptr[i] < maxstr[i] ? ret : 0; return ret; /* value = UV_MAX/UV_MIN. That's ok */ } #define IFLAG_ANY 0x00000000U #define IFLAG_POS 0x00000001U /* Must be non-negative */ #define IFLAG_NONZERO 0x00000002U /* Must not be zero */ #define IFLAG_ABS 0x00000004U /* Absolute value returned */ #define IFLAG_IV 0x00000008U /* Value returned as IV */ static int _validate_and_set(UV* val, pTHX_ SV* svn, uint32_t mask) { int status; if (svn == 0) croak("Parameter must be defined"); /* Streamline the typical path of input being a native integer. */ if (SVNUMTEST(svn)) { IV n = SvIVX(svn); if (n >= 0) { if (n == 0 && (mask & IFLAG_NONZERO)) croak("Parameter '%" SVf "' must be a positive integer", svn); *val = (UV)n; return 1; } if (SvIsUV(svn)) { if (mask & IFLAG_IV) return 0; *val = (UV)n; return 1; } if (mask & IFLAG_ABS) { *val = (UV)(-n); return 1; } if (mask & IFLAG_POS) croak("Parameter '%" SVf "' must be a non-negative integer", svn); *val = n; return -1; } status = _validate_int( aTHX_ svn, !(mask & IFLAG_POS) ); if (status == 1) { UV n = my_svuv(svn); if (n == 0 && (mask & IFLAG_NONZERO)) croak("Parameter '%" SVf "' must be a positive integer", svn); if (n > (UV)IV_MAX && (mask & IFLAG_IV)) return 0; *val = n; } else if (status == -1) { IV n = my_sviv(svn); if (mask & IFLAG_ABS) { *val = (UV)(-n); status = 1; } else { *val = (UV)n; } } return status; } /******************************************************************************/ #if 1 /* This is NEGATE_2UV(iv) from handy.h */ #define neg_iv(n) ((UV)-((n)+1) + 1U) #else static UV neg_iv(UV n) { if ((IV)n == IV_MIN) return (UV_MAX >> 1) + 1; else return (UV) (-(IV)n); } #endif /* Given 'a' and astatus (-1 means 'a' is an IV), properly mod with n */ static void _mod_with(UV *a, int astatus, UV n) { if (n == 0) return; if (astatus != -1) { *a %= n; } else { UV r = neg_iv(*a) % n; *a = (r == 0) ? 0 : n-r; } } /******************************************************************************/ #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); } static NOINLINE const char* _subname(pTHX_ const CV *cv) { return GvNAME(CvGV(cv)); } #define SUBNAME _subname(aTHX_ cv) /* -1 if not found, array entry if found */ static int find_gmp_info(const char *name) { const int ngmpinfo = sizeof(gmp_info)/sizeof(gmp_info[0]); int i; /* Stupid linear scan */ for (i = 0; i < ngmpinfo; i++) if (strcmp(gmp_info[i].name, name) == 0) return i; return -1; } static NOINLINE void dispatch_external(pTHX_ const CV* thiscv, I32 context, int nitems, bool gmp_is_ok) { const char *name = GvNAME(CvGV(thiscv)); const int ginfoi = find_gmp_info(name); I32 callflags = VCALL_PP; uint32_t ver = 0; bool usegmp = ginfoi >= 0 && gmp_is_ok; if (usegmp) { ver = gmp_info[ginfoi].version; callflags |= VCALL_GMP; } _vcallsubn(aTHX_ context, callflags, name, nitems, ver); /* TODO: _vcallsubn returns the number of values we got back. Use this * together with the gmp_info type to decide what to objectify. * We're missing the input sv that gives us the desired return class. */ } #define DISPATCHPP() dispatch_external(aTHX_ cv, GIMME_V, items, TRUE) #define DISPATCHPP_GMPONLYIF(expr) \ dispatch_external(aTHX_ cv, GIMME_V, items, !!(expr)) #define DISPATCH_VOIDPP() \ (void)_vcallsubn(aTHX_ G_VOID|G_DISCARD, VCALL_PP, SUBNAME, items, 0) #define CALLROOTSUB(fn) \ (void)_vcallsubn(aTHX_ GIMME_V, VCALL_ROOT, fn, items, 0) #define CALLROOTSUB_ONE_SCALAR(fn) \ (void)_vcallsubn(aTHX_ G_SCALAR, VCALL_ROOT, fn, 1, 0) #define CALLROOTSUB_VOID(fn) \ (void)_vcallsubn(aTHX_ G_VOID|G_DISCARD, VCALL_ROOT, fn, items, 0) #define OBJECTIFY_STACK(n) \ do { \ uint32_t i_, nargs_ = n; \ for (i_ = 0; i_ < nargs_; i_++) \ if (SvOK(ST(i_)) && !sv_isobject(ST(i_)) && !SVNUMTEST(ST(i_))) \ break; \ if (i_ < nargs_) \ _vcallsubn(aTHX_ G_ARRAY,VCALL_ROOT,"_maybe_bigint_allargs",nargs_,0); \ } while (0) /* Returns 0 if we see no reason to wrap this sub inside it's own scope. Returns 1 if we need to because of locals created. Returns 1 if it's too complicated (long, infinite loop, deep branches) */ static bool cv_needs_scope(pTHX_ const CV *cv) { OP *o = CvSTART(cv); size_t nops = 0; OP *branches[8]; int nbranch = 0; for (; nops < 500; o = o->op_next) { if (!o) { if (nbranch > 0) { o = branches[--nbranch]; continue; } break; } /* printf(" %s\n",PL_op_name[o->op_type]); */ nops++; switch (o->op_type) { case OP_PADSV: case OP_PADAV: case OP_PADHV: case OP_ANONCODE: #if PERL_VERSION_GE(5,17,6) case OP_PADRANGE: #endif #if PERL_VERSION_GE(5,27,6) case OP_MULTICONCAT: /* This could hide a PADSV -- we don't know */ #endif #if PERL_VERSION_GE(5,37,3) case OP_PADSV_STORE: #endif return 1; case OP_AND: case OP_OR: case OP_COND_EXPR: case OP_ANDASSIGN: case OP_ORASSIGN: #if PERL_VERSION_GE(5,9,0) case OP_DOR: case OP_DORASSIGN: #endif if (nbranch >= 8) return 1; /* Too deep */ branches[nbranch++] = cLOGOPx(o)->op_other; break; case OP_LEAVESUB: if (nbranch > 0) { o = branches[--nbranch]; continue; } break; } } if (nops >= 500) return 1; return 0; } #define DECL_MULTICALL_SCOPE(cv) bool addscope = cv_needs_scope(aTHX_ cv) #define SCOPED_MULTICALL \ do { if(addscope) {ENTER;} MULTICALL; if(addscope) {LEAVE;} } while(0) /******************************************************************************/ #define SETSUBREF(cv, block) \ do { \ GV *gv_; \ HV *stash_; \ cv = sv_2cv(block, &stash_, &gv_, 0); \ if (cv == Nullcv) croak("%s: Not a subroutine reference", SUBNAME); \ } while (0) /* 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_new(result) */ dSP; (void)POPs; ENTER; PUSHMARK(SP); XPUSHs(sv_2mortal(newSVpv(iname, 0))); XPUSHs(output); PUTBACK; call_method("new", G_SCALAR); LEAVE; } } } static SV* call_sv_to_func(pTHX_ SV* r, const char* name) { dSP; ENTER; PUSHMARK(SP); XPUSHs(r); PUTBACK; call_pv(name, G_SCALAR); SPAGAIN; r = POPs; PUTBACK; LEAVE; return r; } static SV* sv_to_bigint(pTHX_ SV* r) { return call_sv_to_func(aTHX_ r, "Math::Prime::Util::_to_bigint"); } static SV* sv_to_bigint_abs(pTHX_ SV* r) { return call_sv_to_func(aTHX_ r, "Math::Prime::Util::_to_bigint_abs"); } static SV* sv_to_bigint_nonneg(pTHX_ SV* r) { return call_sv_to_func(aTHX_ r, "Math::Prime::Util::_to_bigint_nonneg"); } #define NEWSVINT(sign,v) (((sign) > 0) ? newSVuv(v) : newSViv(v)) #define SETSVINT(sv,setpos,posv,negv) \ do { if (setpos) sv_setuv(sv,posv); \ else sv_setiv(sv,negv); } while(0) #if 1 #define FASTSETSVINT(sv,setpos,val) \ do { \ const UV val_ = val; \ if ((setpos) && (UV)(val_) > (UV)IV_MAX) { \ if (SvTYPE(sv) != SVt_IV) sv_setuv(sv,val_); \ else { SvUV_set(sv,val_); SvIsUV_on(sv); } \ } else { \ if (SvTYPE(sv) != SVt_IV) sv_setiv(sv,(IV)val_); \ else { SvIV_set(sv,(IV)val_); SvIsUV_off(sv); } \ } \ } while(0) #else #define FASTSETSVINT(sv,setpos,val) SETSVINT(sv,setpos,val,(IV)val) #endif #define RETURN_128(hi,lo) \ do { char str_[40]; \ uint32_t slen_ = to_string_128(str_, hi, lo); \ ST(0) = sv_to_bigint( aTHX_ sv_2mortal(newSVpv(str_,slen_)) ); \ XSRETURN(1); } while(0) #define CREATE_RETURN_AV(av) \ do { \ av = newAV(); \ { \ SV * retsv = sv_2mortal(newRV_noinc( (SV*) av )); \ PUSHs(retsv); \ PUTBACK; \ SP = NULL; /* never use SP again, poison */ \ } \ } while(0) #define PUSH_2ELEM_AREF(p, q) \ do { \ AV* av_ = newAV(); \ av_push(av_, newSVuv(p)); \ av_push(av_, newSVuv(q)); \ PUSHs(sv_2mortal(newRV_noinc((SV*) av_))); \ } while (0) #define RETURN_LIST_VALS(in_alen,arr,sign) /* Return array values */ \ { \ size_t k_, alen_ = in_alen; \ if (GIMME_V == G_SCALAR) { \ Safefree(arr); \ XSRETURN_UV(alen_); \ } \ EXTEND(SP,(EXTEND_TYPE)alen_); \ for (k_ = 0; k_ < alen_; k_++) \ ST(k_) = sv_2mortal(NEWSVINT(sign,arr[k_])); \ Safefree(arr); \ XSRETURN(alen_); \ } #define RETURN_LIST_REF(in_alen,arr,sign) /* Return array values as ref */ \ { \ size_t k_, alen_ = in_alen; \ AV* av_ = newAV(); \ av_extend(av_, (SSize_t)alen_-1); \ SV **ar_ = AvARRAY(av_); \ for (k_ = 0; k_ < alen_; k_++) \ ar_[k_] = NEWSVINT(sign,arr[k_]); \ AvFILLp(av_) = (SSize_t)alen_-1; \ Safefree(arr); \ ST(0) = sv_2mortal(newRV_noinc((SV*) av_)); \ XSRETURN(1); \ } #define RETURN_EMPTY_LIST_REF() \ { \ AV* av_ = newAV(); \ ST(0) = sv_2mortal(newRV_noinc((SV*) av_)); \ XSRETURN(1); \ } /******************************************************************************/ #define IARR_TYPE_ANY 0x00 #define IARR_TYPE_NEG 0x01 #define IARR_TYPE_POS 0x02 #define IARR_TYPE_BAD 0x03 /* BAD always bad, ANY with ANY/POS/NEG, POS and NEG only with ANY and self. */ #define CAN_COMBINE_IARR_TYPES(t1,t2) ( ((t1) | (t2)) != IARR_TYPE_BAD ) /* Convert to 0/1/-1 status */ #define IARR_TYPE_TO_STATUS(t) \ (((t) == IARR_TYPE_BAD) ? 0 : ((t) == IARR_TYPE_NEG) ? -1 : 1) #define STATUS_TO_IARR_TYPE(s,n) \ (((s) == 0) ? IARR_TYPE_BAD : ((s) == -1) ? IARR_TYPE_NEG : ((n) > (UV)IV_MAX) ? IARR_TYPE_POS : IARR_TYPE_ANY) /* Compare using first argument non-zero to indicate UV, otherwise IV */ #define SIGNED_CMP_LE(pos,x,y) ((pos) ? (x <= y) : ((IV)x <= (IV)y)) #define SIGNED_CMP_LT(pos,x,y) ((pos) ? (x < y) : ((IV)x < (IV)y)) #define SIGNED_CMP_GT(pos,x,y) ((pos) ? (x > y) : ((IV)x > (IV)y)) /* Given values and a sign indicating IV or UV, returns -1 (<), 0 (eq), 1 (>) */ static int _sign_cmp(int xsign, UV x, int ysign, UV y) { /* Convert sign to -1 (neg), 0 (small pos), 1 (big pos) */ if (x <= (UV)IV_MAX) xsign = 0; if (y <= (UV)IV_MAX) ysign = 0; if (xsign == ysign && x == y) return 0; /* neg < small pos < big pos */ if (xsign != ysign) return (xsign < ysign) ? -1 : 1; /* Numerical comparison as IV or UV */ return ((xsign == -1 && (IV)x < (IV)y) || (xsign != -1 && x < y)) ? -1 : 1; } /******************************************************************************/ #define CHECK_ARRAYREF1(sv,name) \ do { \ if ( !SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV ) \ croak("%s: expected array reference", name); \ } while (0) #define CHECK_ARRAYREF(sv) CHECK_ARRAYREF1(sv,SUBNAME) #define CHECK_AV_NOT_READONLY1(av,name) \ do { \ if (SvREADONLY(av)) \ croak("%s: array reference is readonly", name); \ } while (0) #define CHECK_AV_NOT_READONLY(av) CHECK_AV_NOT_READONLY1(av, SUBNAME) #define DECL_ARREF(name) \ AV * avp_ ## name; \ SV ** svarr_ ## name; \ Size_t len_ ## name #define AR_READ 0 #define AR_WRITE 1 #define USE_ARREF(name, sv, subname, will_modify) \ do { \ CHECK_ARRAYREF1(sv, subname); \ avp_ ## name = (AV*) SvRV(sv); \ len_ ## name = av_count(avp_ ## name); \ if (will_modify) \ CHECK_AV_NOT_READONLY1(avp_ ## name, subname); \ if (SvMAGICAL(avp_ ## name) || (will_modify && !AvREAL(avp_ ## name) && AvREIFY(avp_ ## name))) \ svarr_ ## name = 0; \ else \ svarr_ ## name = AvARRAY(avp_ ## name); \ } while(0) static SV* _fetch_arref(pTHX_ AV* av, SV** svarr, size_t i) { if (svarr == 0) { SV **svp = av_fetch(av, i, 0); return svp ? *svp : &PL_sv_undef; } return svarr[i]; } #define FETCH_ARREF(name,i) _fetch_arref(aTHX_ avp_ ## name, svarr_ ## name, i) #define STORE_ARREF(name, i, sv) \ do { (use_direct_ ## name ? (svarr_ ## name)[i] = sv : av_store(avp_ ## name, i, sv)) } while(0) #define DEBUG_PRINT_ARRAY(name,av) \ { Size_t j_; SV** arr_ = AvARRAY(av); printf("%s: [",name); for(j_=0; j_ (UV)IV_MAX) itype |= IARR_TYPE_POS; \ if (istatus == 0 || itype == IARR_TYPE_BAD) break; \ dst = n; \ } static int arrayref_to_int_array(pTHX_ size_t *retlen, UV** ret, bool want_sort, SV* sva, const char* fstr) { Size_t len, i; int itype = IARR_TYPE_ANY; UV *r; DECL_ARREF(avp); USE_ARREF(avp, sva, fstr, AR_READ); len = len_avp; *retlen = len; if (len == 0) { *ret = 0; return itype; } New(0, r, len, UV); for (i = 0; i < len; i++) { SV *iv = FETCH_ARREF(avp,i); if (iv == 0) continue; if (SVNUMTEST(iv)) { IV n = SvIVX(iv); if (n < 0) { if (SvIsUV(iv)) itype |= IARR_TYPE_POS; else itype |= IARR_TYPE_NEG; if (itype == IARR_TYPE_BAD) break; } r[i] = (UV)n; } else { READ_UV_IARR(r[i], iv, itype); } } if (i < len) { Safefree(r); *ret = 0; return IARR_TYPE_BAD; } *ret = r; if (want_sort) { if (itype == IARR_TYPE_NEG) { for (i = 1; i < len; i++) if ( (IV)r[i] <= (IV)r[i-1] ) break; } else { for (i = 1; i < len; i++) if (r[i] <= r[i-1]) break; } if (i < len) sort_dedup_uv_array(r, itype == IARR_TYPE_NEG, retlen); } return itype; } /* Check whether an SV is a non-magical arrayref whose elements are all native * non-negative integers in strictly increasing order (i.e. sorted and unique). * On success returns the AvARRAY pointer and sets *lenp; otherwise NULL. * Used by the set-op fast path to skip intermediate UV array allocation. */ static SV** _check_sorted_nonneg_arrayref(pTHX_ SV *sv, size_t *lenp) { AV *av; SV **arr; size_t len, i; if (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV) return NULL; av = (AV*)SvRV(sv); if (SvMAGICAL(av)) return NULL; arr = AvARRAY(av); len = av_count(av); for (i = 0; i < len; i++) { SV *elem = arr[i]; if (!SVNUMTEST(elem) || (!SvIsUV(elem) && SvIVX(elem) < 0)) return NULL; if (i > 0 && SvUVX(elem) <= SvUVX(arr[i-1])) return NULL; } *lenp = len; return arr; } static int array_to_int_array(pTHX_ size_t *retlen, UV** ret, bool want_sort, SV** svbase, size_t len) { size_t i; int itype = IARR_TYPE_ANY; UV *r; *retlen = len; if (len == 0) { *ret = 0; return itype; } New(0, r, len, UV); for (i = 0; i < len; i++) { SV *iv = svbase[i]; if (SVNUMTEST(iv)) { IV n = SvIVX(iv); if (n < 0) { if (SvIsUV(iv)) itype |= IARR_TYPE_POS; else itype |= IARR_TYPE_NEG; if (itype == IARR_TYPE_BAD) break; } r[i] = (UV)n; } else { READ_UV_IARR(r[i], iv, itype); } } if (i < len) { Safefree(r); *ret = 0; return IARR_TYPE_BAD; } *ret = r; if (want_sort) { if (itype == IARR_TYPE_NEG) { for (i = 1; i < len; i++) if ( (IV)r[i] <= (IV)r[i-1] ) break; } else { for (i = 1; i < len; i++) if (r[i] <= r[i-1]) break; } if (i < len) sort_dedup_uv_array(r, itype == IARR_TYPE_NEG, retlen); } return itype; } static int arrayref_to_digit_array(pTHX_ UV** ret, AV* av, int base) { SSize_t len, i; UV *r, carry = 0; if (SvTYPE((SV*)av) != SVt_PVAV) croak("fromdigits first argument must be a string or array reference"); len = av_count(av); New(0, r, len, UV); for (i = len-1; i >= 0; i--) { SV** psvd = av_fetch(av, i, 0); if (_validate_and_set(r+i, aTHX_ *psvd, IFLAG_ANY) != 1) break; r[i] += 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 (UV)IV_MAX) return IARR_TYPE_POS; return IARR_TYPE_ANY; } /* For simplicity, throw out NEG+POS to avoid UV+IV */ if (typea == IARR_TYPE_POS || typeb == IARR_TYPE_POS) return IARR_TYPE_BAD; /* NEG+NEG NEG+ANY ANY+NEG */ if ((IV)amax > 0 && (IV)bmax > 0 && amax + bmax > (UV)IV_MAX) return IARR_TYPE_BAD; /* overflow */ if ((IV)amin < 0 && (IV)bmin < 0 && (UV)(-(IV)amin) + (UV)(-(IV)bmin) > (UV)IV_MAX) return IARR_TYPE_BAD; /* underflow */ if (((IV)amin > 0 || (IV)bmin > 0) && (IV)(amin+bmin) >= 0) return IARR_TYPE_ANY; /* Result is all positive */ return IARR_TYPE_NEG; } /******************************************************************************/ #define MPU_SC_SIZE 257 /* Choose 131, 257, 521, 1031, 2053 */ typedef struct { /* lo in 0, hi in 1, cached values in rest */ UV value[2+MPU_SC_SIZE]; size_t index[2+MPU_SC_SIZE]; signed char status[2+MPU_SC_SIZE]; } set_data_t; static void _sc_clear_cache(set_data_t *cache) { memset(cache->status, 0, sizeof(signed char) * (2+MPU_SC_SIZE)); } #define _SC_GET_VALUE(statvar, var, arr, i) \ statvar = _validate_and_set(&var, aTHX_ arr[i], IFLAG_ANY); \ if (statvar == 0) return -1; #define SC_SET_MID_VALUE(statvar, var, arr, i, cache) \ do { \ if (cache == 0) { \ _SC_GET_VALUE(statvar, var, arr, i) \ } else { \ unsigned int imod_ = 2 + ((i) % MPU_SC_SIZE); \ if (cache->status[imod_] != 0 && cache->index[imod_] == i) { \ statvar = cache->status[imod_]; \ var = cache->value[imod_]; \ } else { \ _SC_GET_VALUE(statvar, var, arr, i) \ cache->status[imod_] = statvar; \ cache->value[imod_] = var; \ cache->index[imod_] = i; \ } \ } \ } while (0) static int _sc_set_lohi(pTHX_ SV** avarr, set_data_t *cache, int loindex, int hiindex, int *lostatus, int *histatus, UV *loval, UV *hival) { if (cache && cache->status[0] != 0) { *lostatus = cache->status[0]; *loval = cache->value[0]; } else { _SC_GET_VALUE(*lostatus, *loval, avarr, loindex); if (cache) { cache->status[0] = *lostatus; cache->value[0] = *loval; } } if (cache && cache->status[1] != 0) { *histatus = cache->status[1]; *hival = cache->value[1]; } else { _SC_GET_VALUE(*histatus, *hival, avarr, hiindex); if (cache) { cache->status[1] = *histatus; cache->value[1] = *hival; } } return 1; } /* index of val in a set (array ref of sorted unique integers) * -1 bigint * n nth-position (0 .. count-1) * eq will be set to 1 if the element in that position is the input value. */ static int index_for_set(pTHX_ AV* av, set_data_t *cache, int sign, UV val, int *eq) { Size_t len; int lo, hi, lostatus, histatus, midstatus, cmp; UV rlo, rhi, rmid; SV** arr; if (sign != 1 && sign != -1) return -1; len = av_count(av); if (len == 0) { *eq = 0; return 0; } arr = AvARRAY(av); lo = 0; hi = len-1; if (_sc_set_lohi(aTHX_ arr, cache, lo, hi, &lostatus, &histatus, &rlo, &rhi) < 0) return -1; cmp = _sign_cmp(sign, val, lostatus, rlo); if (cmp <= 0) { *eq = cmp==0; return lo; } /* val > rlo */ cmp = _sign_cmp(sign, val, histatus, rhi); if (cmp >= 0) { *eq = cmp==0; return hi + (cmp>0); } /* val < rhi */ while (hi-lo > 1) { int mid = lo + ((hi-lo) >> 1); SC_SET_MID_VALUE(midstatus, rmid, arr, (size_t)mid, cache); cmp = _sign_cmp(midstatus, rmid, sign, val); if (cmp == 0) { *eq = 1; return mid; } if (cmp < 0) { lo = mid; rlo = rmid; lostatus = midstatus; } else { hi = mid; rhi = rmid; histatus = midstatus; } } if (sign == histatus && rhi == val) *eq = 1; else if (_sign_cmp(sign,val, histatus,rhi) > 0) croak("internal index error"); return hi; } /* Find index to insert in a set (array ref of sorted unique integers) * -1 bigint * 0 already in set * n should be in n-th position (1 means should be first element) */ static int insert_index_in_set(pTHX_ AV* av, set_data_t *cache, int sign, UV val) { int eq = 0; int index = index_for_set(aTHX_ av, cache, sign, val, &eq); return (index < 0) ? index : eq ? 0 : index+1; } /* Find index of element in a set (array ref of sorted unique integers) * -1 bigint * 0 not in set * n in n-th position (1 means first element) */ static int index_in_set(pTHX_ AV* av, set_data_t *cache, int sign, UV val) { int eq = 0; int index = index_for_set(aTHX_ av, cache, sign, val, &eq); return (index < 0) ? index : eq ? index+1 : 0; } /* See if an element is in a set (array ref of sorted unique integers) */ /* -1 = bigint, 0 = not found, 1 = found */ static int is_in_set(pTHX_ AV* av, set_data_t *cache, int sign, UV val) { int eq = 0; int index = index_for_set(aTHX_ av, cache, sign, val, &eq); return (index < 0) ? index : eq ? 1 : 0; } /* 1 if deleted, 0 if not deleted, -1 if need to punt to PP */ static int del_from_set(pTHX_ AV* ava, int bstatus, UV b) { int index = index_in_set(aTHX_ ava, 0, bstatus, b); if (index <= 0) return index; { SV **arr = AvARRAY(ava); SV *savep = arr[index-1]; Size_t pos = index, alen = av_count(ava); if (pos > alen/2) { if (pos < alen) { memmove(arr+pos-1, arr+pos, sizeof(SV*) * (alen-pos)); arr[alen-1] = savep; } SvREFCNT_dec_NN(av_pop(ava)); } else { if (pos > 1) { memmove(arr+1, arr+0, sizeof(SV*) * (pos-1)); arr[0] = savep; } SvREFCNT_dec_NN(av_shift(ava)); } } return 1; } /* 1 if inserted, 0 if not inserted, -1 if need to punt to PP */ static int ins_into_set(pTHX_ AV* ava, int bstatus, UV b) { int index = insert_index_in_set(aTHX_ ava, 0, bstatus, b); if (index <= 0) return index; { SV *newb, **arr; SV* newsvb = NEWSVINT(bstatus, b); Size_t alen = av_count(ava); if ((Size_t)index > alen/2) { av_push(ava, newsvb); if ((Size_t)index <= alen) { arr = AvARRAY(ava); newb = arr[alen]; memmove(arr+index, arr+index-1, sizeof(SV*) * (alen-(index-1))); arr[index-1] = newb; } } else { av_unshift(ava, 1); av_store(ava, 0, newsvb); if (index > 1) { arr = AvARRAY(ava); newb = arr[0]; memmove(arr+0, arr+1, sizeof(SV*) * index); arr[index-1] = newb; } } } return 1; } /******************************************************************************/ static int _compare_array_refs(pTHX_ SV* a, SV* b) { AV *ava, *avb; SSize_t i, alen, blen; if ( ((!SvROK(a)) || (SvTYPE(SvRV(a)) != SVt_PVAV)) || ((!SvROK(b)) || (SvTYPE(SvRV(b)) != SVt_PVAV)) ) return -1; ava = (AV*) SvRV(a); avb = (AV*) SvRV(b); alen = av_len(ava); blen = av_len(avb); if (alen != blen) return 0; for (i = 0; i <= alen; i++) { SV** iva = av_fetch(ava, i, 0); SV** ivb = av_fetch(avb, i, 0); SV *sva, *svb; int res; if (!iva || !ivb) return -1; sva = *iva; svb = *ivb; if (!SvOK(sva) && !SvOK(svb)) /* Two undefs are fine. */ continue; if (!SvOK(sva) || !SvOK(svb)) /* One undef isn't ok. */ return 0; /* Hashes, I/O, etc. are not ok. */ if (SvTYPE(sva) >= SVt_PVAV || SvTYPE(svb) >= SVt_PVAV) return -1; /* One of them is a non-object reference */ if ( (SvROK(sva) && !sv_isobject(sva)) || (SvROK(svb) && !sv_isobject(svb)) ) { /* Always error if either one is not an array reference. */ if ( (SvROK(sva) && SvTYPE(SvRV(sva)) != SVt_PVAV) || (SvROK(svb) && SvTYPE(SvRV(svb)) != SVt_PVAV) ) return -1; /* One reference, one non-reference = not equal */ if (SvROK(sva) != SvROK(svb)) return 0; /* Now we know both are array references. Compare. */ res = _compare_array_refs(aTHX_ sva, svb); if (res == 1) continue; return res; } /* Common case: two simple integers */ if ( SVNUMTEST(sva) && SVNUMTEST(svb) && (SvTYPE(sva) == SVt_IV || SvTYPE(sva) == SVt_PVIV) && (SvTYPE(svb) == SVt_IV || SvTYPE(svb) == SVt_PVIV) ) { UV va = my_svuv(sva), vb = my_svuv(svb); if (va != vb) return 0; continue; } /* This function is more useful if we allow more than strictly integers */ { /* Compare the string representation */ STRLEN alen, blen; const char* stra = SvPV(sva, alen); const char* strb = SvPV(svb, blen); if (alen != blen || strcmp(stra,strb) != 0) return 0; } } return 1; } static void csprng_init_seed(void* ctx) { unsigned char* data; New(0, data, 64, unsigned char); get_entropy_bytes(64, data); csprng_seed(ctx, 64, data); Safefree(data); } static void _comb_init(UV* cm, UV k, int derangement) { UV i; cm[0] = UV_MAX; for (i = 0; i < k; i++) cm[i] = k-i; if (derangement && k >= 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; HV * stash = gv_stashpv("Math::Prime::Util", TRUE); newCONSTSUB(stash, "_XS_prime_maxbits", newSViv(BITS_PER_WORD)); newCONSTSUB(stash, "_ivsize", newSViv(IVSIZE)); newCONSTSUB(stash, "_uvsize", newSViv(UVSIZE)); newCONSTSUB(stash, "_uvbits", newSViv(UVSIZE * 8)); newCONSTSUB(stash, "_nvsize", newSViv(NVSIZE)); newCONSTSUB(stash, "_nvmantbits", newSViv(NVMANTBITS)); newCONSTSUB(stash, "_nvmantdigits", newSViv((IV)((NVMANTBITS+1) / 3.322))); { 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) CALLROOTSUB("_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) CALLROOTSUB("_srand_p"); RETVAL = seedval; OUTPUT: RETVAL UV irand() ALIAS: irand64 = 1 PREINIT: dMY_CXT; CODE: #if BITS_PER_WORD == 32 /* TODO: what should irand64 on 32-bit perl do? */ RETVAL = irand32(MY_CXT.randcxt); #else RETVAL = ix == 0 ? irand32(MY_CXT.randcxt) : irand64(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 bool _validate_integer(SV* svn) ALIAS: _validate_integer_nonneg = 1 _validate_integer_positive = 2 _validate_integer_abs = 3 PREINIT: uint32_t mask; int status; UV n; CODE: /* Flag: 0 neg ok, 1 neg err, 2 zero or neg err, 3 abs */ switch (ix) { case 0: mask = IFLAG_ANY; break; case 1: mask = IFLAG_POS; break; case 2: mask = IFLAG_POS | IFLAG_NONZERO; break; case 3: mask = IFLAG_ABS; break; default: croak("_validate_integer unknown flag value"); } status = _validate_and_set(&n, aTHX_ svn, mask); if (status != 0) { SETSVINT(svn, status == 1, n, (IV)n); #if PERL_VERSION_LT(5,8,0) && BITS_PER_WORD == 64 if (status == 1 && n > 562949953421312UL) sv_setpvf(svn, "%"UVuf, n); if (status == -1 && (IV)n < -562949953421312) sv_setpvf(svn, "%"IVdf, n); #endif } else { /* Status 0 = bigint */ if (mask & IFLAG_ABS) { /* TODO: if given a positive bigint, no need for this */ sv_setsv(svn, sv_to_bigint_abs(aTHX_ svn)); } else if (mask & IFLAG_POS) { if (!_is_sv_bigint(aTHX_ svn)) sv_setsv(svn, sv_to_bigint_nonneg(aTHX_ svn)); } else { if (!_is_sv_bigint(aTHX_ svn)) sv_setsv(svn, sv_to_bigint(aTHX_ svn)); } } RETVAL = TRUE; 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) DISPATCH_VOIDPP(); XSRETURN(0); 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>0; } break; } return; /* skip implicit PUTBACK */ void prime_count(IN SV* svlo, IN SV* svhi = 0) ALIAS: semiprime_count = 1 twin_prime_count = 2 ramanujan_prime_count = 3 perfect_power_count = 4 prime_power_count = 5 lucky_count = 6 PREINIT: UV lo = 0, hi, count = 0; PPCODE: if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_POS)) || (items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) { if (lo <= hi) { switch (ix) { case 0: count = prime_count_range(lo, hi); break; case 1: count = semiprime_count_range(lo, hi); break; case 2: count = twin_prime_count_range(lo, hi); break; case 3: count = ramanujan_prime_count_range(lo, hi); break; case 4: count = perfect_power_count_range(lo, hi); break; case 5: count = prime_power_count_range(lo, hi); break; case 6: count = lucky_count_range(lo, hi); break; } } XSRETURN_UV(count); } DISPATCHPP(); XSRETURN(1); void prime_count_upper(IN SV* svn) ALIAS: prime_count_lower = 1 prime_count_approx = 2 prime_power_count_upper = 3 prime_power_count_lower = 4 prime_power_count_approx = 5 perfect_power_count_upper = 6 perfect_power_count_lower = 7 perfect_power_count_approx = 8 ramanujan_prime_count_upper = 9 ramanujan_prime_count_lower = 10 ramanujan_prime_count_approx = 11 twin_prime_count_approx = 12 semiprime_count_approx = 13 lucky_count_upper = 14 lucky_count_lower = 15 lucky_count_approx = 16 PREINIT: UV n, ret; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) { switch (ix) { case 0: ret = prime_count_upper(n); break; case 1: ret = prime_count_lower(n); break; case 2: ret = prime_count_approx(n); break; case 3: ret = prime_power_count_upper(n); break; case 4: ret = prime_power_count_lower(n); break; case 5: ret = prime_power_count_approx(n); break; case 6: ret = perfect_power_count_upper(n); break; case 7: ret = perfect_power_count_lower(n); break; case 8: ret = perfect_power_count_approx(n); break; case 9: ret = ramanujan_prime_count_upper(n); break; case 10: ret = ramanujan_prime_count_lower(n); break; case 11: ret = ramanujan_prime_count_approx(n); break; case 12: ret = twin_prime_count_approx(n); break; case 13: ret = semiprime_count_approx(n); break; case 14: ret = lucky_count_upper(n); break; case 15: ret = lucky_count_lower(n); break; case 16: default: ret = lucky_count_approx(n); break; } XSRETURN_UV(ret); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void sum_primes(IN SV* svlo, IN SV* svhi = 0) PREINIT: UV lo = 2, hi; PPCODE: if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_POS)) || (items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) { UV count = 0; int retok = 1; /* 32/64-bit, Legendre or table-accelerated sieving. */ retok = sum_primes(lo, hi, &count); /* If that didn't work, try the 128-bit version if supported. */ if (retok == 0 && HAVE_SUM_PRIMES128) { UV hicount, lo_hic, lo_loc; retok = sum_primes128(hi, &hicount, &count); if (retok == 1 && lo > 2) { retok = sum_primes128(lo-1, &lo_hic, &lo_loc); hicount -= lo_hic; if (count < lo_loc) hicount--; count -= lo_loc; } if (retok == 1 && hicount > 0) RETURN_128(hicount, count); } if (retok == 1) XSRETURN_UV(count); } DISPATCHPP(); XSRETURN(1); void random_prime(IN SV* svlo, IN SV* svhi = 0) PREINIT: UV lo = 2, hi, ret; dMY_CXT; PPCODE: if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_POS)) || (items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) { ret = random_prime(MY_CXT.randcxt,lo,hi); if (ret) XSRETURN_UV(ret); else XSRETURN_UNDEF; } DISPATCHPP(); objectify_result(aTHX_ svlo, ST(0)); XSRETURN(1); void print_primes(IN SV* svlo, IN SV* svhi = 0, IN int infd = -1) PREINIT: UV lo = 2, hi; PPCODE: if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_POS)) || (items >= 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) { if (lo <= hi) { int fd = (infd == -1) ? fileno(stdout) : infd; print_primes(lo, hi, fd); } } else { DISPATCH_VOIDPP(); } return; 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 PREINIT: AV* av; PPCODE: CREATE_RETURN_AV(av); if ((low <= 2) && (high >= 2)) av_push(av, newSVuv( 2 )); if ((low <= 3) && (high >= 3)) av_push(av, newSVuv( 3 )); if ((low <= 5) && (high >= 5)) av_push(av, newSVuv( 5 )); if (low < 7) low = 7; if (low <= high) { if (ix == 0) { /* Sieve with primary cache */ START_DO_FOR_EACH_PRIME(low, high) { av_push(av,newSVuv(p)); } END_DO_FOR_EACH_PRIME } else if (ix == 1) { /* Trial */ for (low = next_prime(low-1); low <= high && low != 0; low = next_prime(low) ) { av_push(av,newSVuv(low)); } } else if (ix == 2) { /* Erat with private memory */ unsigned char* sieve = sieve_erat30(high); START_DO_FOR_EACH_SIEVE_PRIME( sieve, 0, low, high ) { av_push(av,newSVuv(p)); } END_DO_FOR_EACH_SIEVE_PRIME Safefree(sieve); } else if (ix == 3) { /* Segment */ unsigned char* segment; UV seg_base, seg_low, seg_high; void* ctx = start_segment_primes(low, high, &segment); while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_base, seg_low, seg_high ) av_push(av,newSVuv( p )); END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } } return; /* skip implicit PUTBACK */ void primes(IN SV* svlo, IN SV* svhi = 0) PREINIT: AV* av; UV lo = 0, hi, i; PPCODE: if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_POS)) || (items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) { CREATE_RETURN_AV(av); if ((lo <= 2) && (hi >= 2)) av_push(av, newSVuv( 2 )); if ((lo <= 3) && (hi >= 3)) av_push(av, newSVuv( 3 )); if ((lo <= 5) && (hi >= 5)) av_push(av, newSVuv( 5 )); if (lo < 7) lo = 7; if (lo <= hi) { if ( hi-lo <= 10 || (hi > 100000000UL && hi-lo <= 330) || (hi > 4000000000UL && hi-lo <= 1500) ) { for (i = !(lo&1); i <= hi-lo; i += 2) if (is_prime(lo+i)) av_push(av,newSVuv(lo+i)); } else if (hi < (65536*30) || hi <= get_prime_cache(0,0)) { START_DO_FOR_EACH_PRIME(lo, hi) { av_push(av,newSVuv(p)); } END_DO_FOR_EACH_PRIME } else { unsigned char* segment; UV seg_base, seg_low, seg_high; void* ctx = start_segment_primes(lo, hi, &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) av_push(av,newSVuv( p )); END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } } } else { DISPATCHPP(); } return; void almost_primes(IN UV k, IN SV* svlo, IN SV* svhi = 0) ALIAS: omega_primes = 1 PREINIT: AV* av; UV lo = 1, hi, i, n, *S; PPCODE: if ((items == 2 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_POS)) || (items >= 3 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) { CREATE_RETURN_AV(av); S = 0; if (ix == 0) n = generate_almost_primes(&S, k, lo, hi); else n = range_omega_prime_sieve(&S, k, lo, hi); for (i = 0; i < n; i++) av_push(av, newSVuv(S[i])); if (S != 0) Safefree(S); } else { DISPATCHPP(); } return; void prime_powers(IN SV* svlo, IN SV* svhi = 0) ALIAS: twin_primes = 1 semi_primes = 2 ramanujan_primes = 3 PREINIT: AV* av; UV lo = 0, hi, i, num, *L; PPCODE: if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_POS)) || (items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) { CREATE_RETURN_AV(av); if (ix == 0) { /* Prime power */ if ((lo <= 2) && (hi >= 2)) av_push(av, newSVuv( 2 )); if ((lo <= 3) && (hi >= 3)) av_push(av, newSVuv( 3 )); if ((lo <= 4) && (hi >= 4)) av_push(av, newSVuv( 4 )); if ((lo <= 5) && (hi >= 5)) av_push(av, newSVuv( 5 )); } else if (ix == 1) { /* Twin */ if ((lo <= 3) && (hi >= 3)) av_push(av, newSVuv( 3 )); if ((lo <= 5) && (hi >= 5)) av_push(av, newSVuv( 5 )); } else if (ix == 2) { /* Semi */ if ((lo <= 4) && (hi >= 4)) av_push(av, newSVuv( 4 )); if ((lo <= 6) && (hi >= 6)) av_push(av, newSVuv( 6 )); } else if (ix == 3) { /* Ramanujan */ if ((lo <= 2) && (hi >= 2)) av_push(av, newSVuv( 2 )); } if (lo < 7) lo = 7; if (lo <= hi) { switch (ix) { case 0: num = prime_power_sieve(&L,lo,hi); break; case 1: num = range_twin_prime_sieve(&L,lo,hi); break; case 2: num = range_semiprime_sieve(&L,lo,hi); break; case 3: num = range_ramanujan_prime_sieve(&L,lo,hi); break; default: num = 0; L = 0; break; } for (i = 0; i < num; i++) av_push(av,newSVuv(L[i])); Safefree(L); } } else { DISPATCHPP(); } return; void lucky_numbers(IN SV* svlo, IN SV* svhi = 0) PREINIT: AV* av; UV lo = 0, hi, i, nlucky = 0; PPCODE: if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_POS)) || (items == 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) { CREATE_RETURN_AV(av); if (lo == 0 && hi <= UVCONST(4000000000)) { uint32_t* lucky = lucky_sieve32(&nlucky, hi); for (i = 0; i < nlucky; i++) av_push(av,newSVuv(lucky[i])); Safefree(lucky); } else { UV* lucky = lucky_sieve_range(&nlucky, lo, hi); for (i = 0; i < nlucky; i++) av_push(av,newSVuv(lucky[i])); Safefree(lucky); } } else { DISPATCHPP(); } return; void minimal_goldbach_pair(IN SV* svn) ALIAS: goldbach_pair_count = 1 PREINIT: UV n, res; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) { if (ix == 0) { res = minimal_goldbach_pair(n); if (res == 0) XSRETURN_UNDEF; } else { res = goldbach_pair_count(n); } XSRETURN_UV(res); } DISPATCHPP(); XSRETURN(1); void goldbach_pairs(IN SV* svn) PREINIT: size_t npairs, i; UV n, *L; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS) == 1) { if (GIMME_V != G_ARRAY) XSRETURN_UV(goldbach_pair_count(n)); L = goldbach_pairs(&npairs, n); if (L == 0) XSRETURN_EMPTY; EXTEND(SP, (EXTEND_TYPE)npairs); for (i = 0; i < npairs; i++) PUSHs(sv_2mortal(newSVuv(L[i]))); Safefree(L); } else { DISPATCHPP(); return; } void powerful_numbers(IN SV* svlo, IN SV* svhi = 0, IN UV k = 2) PREINIT: AV* av; UV lo = 1, hi, i, npowerful, *powerful; PPCODE: if ((items == 1 && _validate_and_set(&hi, aTHX_ svlo, IFLAG_POS)) || (items >= 2 && _validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS))) { CREATE_RETURN_AV(av); powerful = powerful_numbers_range(&npowerful, lo, hi, k); for (i = 0; i < npowerful; i++) av_push(av,newSVuv(powerful[i])); Safefree(powerful); } else { DISPATCHPP(); } return; void sieve_range(IN SV* svn, IN UV width, IN UV depth) PREINIT: int status; UV i, n; PPCODE: /* Return index of every n unless it is a composite with factor > depth */ status = _validate_and_set(&n, aTHX_ svn, IFLAG_POS); if (status == 1) { if ((n+width) < n) { status = 0; /* range will overflow */ } else { /* TODO: actually sieve */ for (i = (n<2)?2-n:0; i < width; i++) if (is_rough(n+i, (depth+1) >= (n+i) ? n+i : depth+1)) XPUSHs(sv_2mortal(newSVuv( i ))); } } if (status != 1) { DISPATCHPP(); return; } void sieve_prime_cluster(IN SV* svlo, IN SV* svhi, ...) PREINIT: uint32_t nc, cl[100]; UV i, lo, hi, cval, nprimes, *list; int 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_and_set(&cval, aTHX_ ST(1+i), IFLAG_POS)) croak("sieve_prime_cluster: cluster values must be standard integers"); 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; } done = 0; if (_validate_and_set(&lo, aTHX_ svlo, IFLAG_POS) && _validate_and_set(&hi, aTHX_ svhi, IFLAG_POS)) { list = sieve_cluster(lo, hi, nc, cl, &nprimes); if (list != 0) { done = 1; EXTEND(SP, (EXTEND_TYPE)nprimes); for (i = 0; i < nprimes; i++) PUSHs(sv_2mortal(newSVuv( list[i] ))); Safefree(list); } } if (!done) { DISPATCHPP(); return; } void is_pseudoprime(IN SV* svn, ...) ALIAS: is_euler_pseudoprime = 1 is_strong_pseudoprime = 2 PREINIT: int i, status, ret = 0; UV n, base; PPCODE: status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); if (status == 1) { if (n < 3) { ret = (n == 2); } else if (ix == 2 && !(n&1)) { ret = 0; } else if (items == 1) { ret = (ix == 0) ? is_pseudoprime(n, 2) : (ix == 1) ? is_euler_pseudoprime(n, 2) : is_strong_pseudoprime(n, 2); } else { for (i = 1, ret = 1; i < items && ret == 1; i++) { status = _validate_and_set(&base, aTHX_ ST(i), IFLAG_POS); if (status != 1) break; ret = (ix == 0) ? is_pseudoprime(n, base) : (ix == 1) ? is_euler_pseudoprime(n, base) : is_strong_pseudoprime(n, base); } } } if (status != 0) RETURN_NPARITY(ret); DISPATCHPP(); XSRETURN(1); 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_semiprime = 13 is_chen_prime = 14 is_mersenne_prime = 15 PREINIT: int status, ret; UV n; PPCODE: ret = 0; status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); if (status == 1) { switch (ix) { case 0: ret = 2*is_prime(n); break; case 1: ret = 2*is_prob_prime(n); break; case 2: ret = 2*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_semiprime(n); break; case 14: ret = is_chen_prime(n); break; case 15: ret = is_mersenne_prime(n); if (ret == -1) status = 0; break; default: break; } } if (status != 0) RETURN_NPARITY(ret); DISPATCHPP(); XSRETURN(1); void is_perrin_pseudoprime(IN SV* svn, IN UV k = 0) ALIAS: is_almost_extra_strong_lucas_pseudoprime = 1 is_delicate_prime = 2 PREINIT: int status, ret; UV n; PPCODE: /* k is a UV, so always positive. */ /* ix = 0 k = 0 - 3 n below 2 returns 0 for all k * ix = 1 k = 0 - 256 n below 2 returns 0 for all k * ix = 2 k = 0 - 2^32 n below 2 returns 0 for all k */ status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); ret = 0; if (status == 1) { switch (ix) { case 0: if (items == 1) k = 0; ret = is_perrin_pseudoprime(n, k); break; case 1: if (items == 1) k = 1; ret = is_almost_extra_strong_lucas_pseudoprime(n, k); break; case 2: if (items == 1) k = 10; ret = is_delicate_prime(n, k); if (ret < 0) status = 0; break; default: break; } } if (status != 0) RETURN_NPARITY(ret); DISPATCHPP(); XSRETURN(1); void is_frobenius_pseudoprime(IN SV* svn, IN IV P = 0, IN IV Q = 0) PREINIT: int status; UV n; PPCODE: status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); if (status != 0) RETURN_NPARITY((status == 1) ? is_frobenius_pseudoprime(n, P, Q) : 0); DISPATCHPP(); XSRETURN(1); void miller_rabin_random(IN SV* svn, IN IV bases = 1, IN char* seed = 0) PREINIT: int status; UV n; dMY_CXT; PPCODE: if (bases < 0) croak("miller_rabin_random: expected positive number of bases"); status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); if (status == -1) RETURN_NPARITY(0); if (seed == 0 && status == 1) RETURN_NPARITY( is_mr_random(MY_CXT.randcxt, n, bases) ); DISPATCHPP(); XSRETURN(1); void is_gaussian_prime(IN SV* sva, IN SV* svb) PREINIT: UV a, b; PPCODE: if (_validate_and_set(&a, aTHX_ sva, IFLAG_ABS) && _validate_and_set(&b, aTHX_ svb, IFLAG_ABS)) { if (a == 0) RETURN_NPARITY( ((b % 4) == 3) ? 2*is_prime(b) : 0 ); if (b == 0) RETURN_NPARITY( ((a % 4) == 3) ? 2*is_prime(a) : 0 ); if (a < HALF_WORD && b < HALF_WORD) { UV aa = a*a, bb = b*b; if (UV_MAX-aa >= bb) RETURN_NPARITY( 2*is_prime(aa+bb) ); } } DISPATCHPP(); XSRETURN(1); 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); if (items > 1 && (status = _validate_and_set(&ret, aTHX_ ST(0), IFLAG_ANY))) { sign = status; for (i = 1; i < items; i++) { status = _validate_and_set(&n, aTHX_ ST(i), IFLAG_ANY); if (status == 0) break; 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_and_set(&n, aTHX_ ST(i), IFLAG_ANY); if (status == 0) break; if (status == 1) hi += (n > (UV_MAX - lo)); else 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_and_set(&n, aTHX_ ST(i), IFLAG_ANY); if (status == 0) break; 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(neg_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 = 1; nullv = 0; } for (i = 0; i < items && ret != nullv && status != 0; i++) { status = _validate_and_set(&n, aTHX_ ST(i), IFLAG_ABS); if (status == 0) break; 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); } DISPATCHPP(); if (ix == 0 || ix == 1) objectify_result(aTHX_ 0, ST(0)); XSRETURN(1); void vecextract(IN SV* x, IN SV* svm) PREINIT: AV* av; UV mask, i = 0; PPCODE: CHECK_ARRAYREF(x); av = (AV*) SvRV(x); if (SvROK(svm) && SvTYPE(SvRV(svm)) == SVt_PVAV) { SSize_t j, index; DECL_ARREF(mav); USE_ARREF(mav, svm, SUBNAME, AR_READ); for (j = 0; (Size_t)j < len_mav; j++) { SV* v = FETCH_ARREF(mav, j); if (_validate_and_set(&mask, aTHX_ v, IFLAG_IV) == 0) croak("vecextract invalid index"); index = (SSize_t)mask; { SV **v = av_fetch(av, index, 0); if (v) XPUSHs(*v); } } } else if (_validate_and_set(&mask, aTHX_ svm, IFLAG_POS)) { while (mask) { if (mask & 1) { SV** v = av_fetch(av, i, 0); if (v) XPUSHs(*v); } i++; mask >>= 1; } } else { DISPATCHPP(); return; } void vecequal(IN SV* a, IN SV* b) PREINIT: int res; PPCODE: res = _compare_array_refs(aTHX_ a, b); if (res == -1) croak("vecequal: expected scalar or array reference"); RETURN_NPARITY(res); XSRETURN(1); void vecmex(...) ALIAS: vecpmex = 1 PROTOTYPE: @ PREINIT: char *setv; int i, status = 1; UV min, n; uint32_t mask; PPCODE: if (ix == 0) { min = 0; mask = IFLAG_POS; } else { min = 1; mask = IFLAG_POS | IFLAG_NONZERO; } if (items == 0) XSRETURN_UV(min); Newz(0, setv, items, char); for (i = 0; i < items; i++) { status = _validate_and_set(&n, aTHX_ ST(i), mask); /* Ignore any bigint */ if (status == 1 && n-min < (UV)items) setv[n-min] = 1; } for (i = 0; i < items; i++) if (setv[i] == 0) break; Safefree(setv); XSRETURN_UV(i+min); void frobenius_number(...) PROTOTYPE: @ PREINIT: int i, found1 = 0; UV fn, n, *A; PPCODE: if (items == 0) XSRETURN_UNDEF; Newz(0, A, items, UV); for (i = 0; i < items; i++) { if (!_validate_and_set(&n, aTHX_ ST(i), IFLAG_POS | IFLAG_NONZERO)) break; if (n == 1) { found1 = 1; break; } A[i] = n; } if (i == items) { fn = frobenius_number(A, i); Safefree(A); if (fn == 0) XSRETURN_UNDEF; if (fn != UV_MAX) XSRETURN_UV(fn); } else { Safefree(A); if (found1) XSRETURN_IV(-1); } DISPATCHPP(); XSRETURN(1); void chinese(...) ALIAS: chinese2 = 1 PROTOTYPE: @ PREINIT: int i, status, astatus, nstatus; UV ret, lcm, *an; SV **psva, **psvn; SV *svfirstmod; PPCODE: status = 1; New(0, an, 2*items, UV); ret = 0; svfirstmod = 0; for (i = 0; i < items; i++) { AV* av; CHECK_ARRAYREF(ST(i)); av = (AV*) SvRV(ST(i)); if (av_count(av) != 2) croak("%s: expected 2-element array reference",SUBNAME); psva = av_fetch(av, 0, 0); psvn = av_fetch(av, 1, 0); if (psva == 0 || psvn == 0) { status = 0; break; } if (i == 0) svfirstmod = *psvn; astatus = _validate_and_set(an+i, aTHX_ *psva, IFLAG_ANY); nstatus = _validate_and_set(an+i+items, aTHX_ *psvn, IFLAG_ABS); if (astatus == 0 || nstatus == 0) { status = 0; break; } if (an[i+items] == 0) { XPUSHs(&PL_sv_undef); if (ix == 1) XPUSHs(&PL_sv_undef); XSRETURN(1 + ix); } _mod_with(an+i, astatus, an[i+items]); } if (status) status = chinese(&ret, &lcm, an, an+items, items); Safefree(an); if (status) { if (ix == 0) { if (status < 0) XSRETURN_UNDEF; else XSRETURN_UV(ret); } else { if (status < 0) { XPUSHs(&PL_sv_undef); XPUSHs(&PL_sv_undef); } else { XPUSHs(sv_2mortal(newSVuv( ret ))); XPUSHs(sv_2mortal(newSVuv( lcm ))); } XSRETURN(2); } } DISPATCHPP(); if (ix == 0) objectify_result(aTHX_ svfirstmod, ST(0)); XSRETURN(1 + ix); void cornacchia(IN SV* svd, IN SV* svn) PREINIT: UV d, n, x, y; PPCODE: if (_validate_and_set(&d, aTHX_ svd, IFLAG_POS) && _validate_and_set(&n, aTHX_ svn, IFLAG_POS) ) { if (!cornacchia(&x, &y, d, n)) XSRETURN_UNDEF; PUSHs(sv_2mortal(newSVuv( x ))); PUSHs(sv_2mortal(newSVuv( y ))); } else { DISPATCHPP(); return; /* Can return undef or two values */ } void lucas_sequence(...) PREINIT: UV U, V, Qk, n, P, Q, k; PPCODE: if (items != 4) croak("lucas_sequence: n, P, Q, k"); if (_validate_and_set(&n, aTHX_ ST(0), IFLAG_POS | IFLAG_NONZERO) && _validate_and_set(&P, aTHX_ ST(1), IFLAG_ANY | IFLAG_IV) && _validate_and_set(&Q, aTHX_ ST(2), IFLAG_ANY | IFLAG_IV) && _validate_and_set(&k, aTHX_ ST(3), IFLAG_POS)) { lucas_seq(&U, &V, &Qk, n, (IV)P, (IV)Q, k); PUSHs(sv_2mortal(newSVuv( U ))); /* 4 args in, 3 out, no EXTEND needed */ PUSHs(sv_2mortal(newSVuv( V ))); PUSHs(sv_2mortal(newSVuv( Qk ))); } else { DISPATCHPP(); OBJECTIFY_STACK(3); XSRETURN(3); } void lucasuvmod(IN SV* svp, IN SV* svq, IN SV* svk, IN SV* svn) ALIAS: lucasumod = 1 lucasvmod = 2 PREINIT: int pstatus, qstatus; UV P, Q, k, n, U, V; PPCODE: pstatus = _validate_and_set(&P, aTHX_ svp, IFLAG_ANY); qstatus = _validate_and_set(&Q, aTHX_ svq, IFLAG_ANY); if ((pstatus != 0) && (qstatus != 0) && _validate_and_set(&k, aTHX_ svk, IFLAG_POS) && _validate_and_set(&n, aTHX_ svn, IFLAG_ABS) ) { if (n == 0) XSRETURN_UNDEF; P = (pstatus == 1) ? P % n : ivmod((IV)P,n); Q = (qstatus == 1) ? Q % n : ivmod((IV)Q,n); switch (ix) { case 0: lucasuvmod(&U, &V, P, Q, k, n); PUSHs(sv_2mortal(newSVuv( U ))); PUSHs(sv_2mortal(newSVuv( V ))); break; case 1: XSRETURN_UV(lucasumod(P, Q, k, n)); break; case 2: default: XSRETURN_UV(lucasvmod(P, Q, k, n)); break; } } else { DISPATCHPP(); OBJECTIFY_STACK(ix==0 ? 2 : 1); XSRETURN(ix==0 ? 2 : 1); } void lucasuv(IN SV* svp, IN SV* svq, IN SV* svk) ALIAS: lucasu = 1 lucasv = 2 PREINIT: UV k; IV P, Q, U, V; PPCODE: if (_validate_and_set((UV*)&P, aTHX_ svp, IFLAG_IV) && _validate_and_set((UV*)&Q, aTHX_ svq, IFLAG_IV) && _validate_and_set(&k, aTHX_ svk, IFLAG_POS) && lucasuv(&U, &V, P, Q, k)) { if (ix == 1) XSRETURN_IV(U); /* U = lucasu(P,Q,k) */ if (ix == 2) XSRETURN_IV(V); /* V = lucasv(P,Q,k) */ PUSHs(sv_2mortal(newSViv( U ))); /* (U,V) = lucasuv(P,Q,k) */ PUSHs(sv_2mortal(newSViv( V ))); } else { DISPATCHPP(); OBJECTIFY_STACK(ix==0 ? 2 : 1); XSRETURN(ix==0 ? 2 : 1); } void is_sum_of_squares(IN SV* svn, IN UV k = 2) PREINIT: int status, ret; UV n; PPCODE: status = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS); if (status != 0) { switch (k) { case 0: ret = (n==0); break; case 1: ret = is_power(n,2); break; case 2: ret = is_sum_of_two_squares(n); break; case 3: ret = is_sum_of_three_squares(n); break; default: ret = 1; break; } RETURN_NPARITY(ret); } DISPATCHPP(); XSRETURN(1); void is_square(IN SV* svn) ALIAS: is_carmichael = 1 is_quasi_carmichael = 2 is_perfect_power = 3 is_fundamental = 4 is_lucky = 5 is_practical = 6 is_perfect_number = 7 is_cyclic = 8 is_totient = 9 PREINIT: int status, ret; UV n; PPCODE: ret = 0; status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); if (status == 1) { switch (ix) { case 0: ret = is_power(n,2); break; case 1: ret = is_carmichael(n); break; case 2: ret = is_quasi_carmichael(n); break; case 3: ret = is_perfect_power(n); break; case 4: ret = is_fundamental(n,0); break; case 5: ret = is_lucky(n); break; case 6: ret = is_practical(n); break; case 7: ret = is_perfect_number(n); break; case 8: ret = is_cyclic(n); break; case 9: default:ret = is_totient(n); break; } } else if (status == -1) { switch (ix) { case 3: ret = is_perfect_power_neg(neg_iv(n)); break; case 4: ret = is_fundamental(neg_iv(n),1); break; default:break; } } if (status != 0) RETURN_NPARITY(ret); DISPATCHPP(); XSRETURN(1); void squarefree_kernel(IN SV* svn) PREINIT: int status; UV n; PPCODE: status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); if (status == -1) XSRETURN_IV( neg_iv(squarefree_kernel(neg_iv(n))) ); if (status == 1) XSRETURN_UV( squarefree_kernel(n) ); DISPATCHPP(); XSRETURN(1); void is_powerfree(IN SV* svn, IN int k = 2) ALIAS: powerfree_sum = 1 powerfree_part = 2 powerfree_part_sum = 3 PREINIT: int status; UV n, res; PPCODE: status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); if (status == -1) { n = neg_iv(n); if (ix == 2) XSRETURN_IV( neg_iv(powerfree_part(n,k)) ); } if (status != 0) { switch (ix) { case 0: res = is_powerfree(n,k); break; case 1: res = powerfree_sum(n,k); break; case 2: res = powerfree_part(n,k); break; case 3: default: res = powerfree_part_sum(n,k); break; } if (ix == 0) RETURN_NPARITY(res); if (res != 0 || n == 0) XSRETURN_UV(res); /* res is 0 and n > 0, so we overflowed. Fall through to PP. */ } DISPATCHPP(); XSRETURN(1); void powerfree_count(IN SV* svn, IN int k = 2) ALIAS: nth_powerfree = 1 PREINIT: int status; UV n, res; PPCODE: status = _validate_and_set(&n, aTHX_ svn, (ix==0) ? IFLAG_ANY : IFLAG_POS); if (status != 0) { if (status == -1) XSRETURN_UV(0); if (ix == 0) { res = powerfree_count(n,k); XSRETURN_UV(res); } else { if (n == 0 || k < 2) XSRETURN_UNDEF; res = nth_powerfree(n,k); if (res != 0) XSRETURN_UV(res); /* if res = 0, overflow */ } } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void is_power(IN SV* svn, IN UV k = 0, IN SV* svroot = 0) PREINIT: int status, ret; UV n; uint32_t root; PPCODE: status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); if (status != 0) { if (k != 0) { if (status == -1) { if (k % 2 == 0) RETURN_NPARITY(0); /* negative n even k return 0 */ n = neg_iv(n); } ret = is_power_ret(n, k, &root); } else { /* k = 0 */ if (status == -1) n = neg_iv(n); /* Following Pari/GP: ispower(0) = ispower(1) = ispower(-1) = 0 */ ret = (n <= 1) ? 0 : powerof_ret(n, &root); if (status == -1 && ret > 0 && ret % 2 == 0) { uint32_t v = valuation(ret,2); ret >>= v; if (ret == 1) ret = 0; if (ret) root = ipow(root,1U << v); } } if (ret && svroot != 0) { if (!SvROK(svroot)) croak("is_power: third argument not a scalar reference"); SETSVINT(SvRV(svroot), status == 1, root, -(IV)root); } RETURN_NPARITY(ret); } DISPATCHPP_GMPONLYIF(svroot == 0); XSRETURN(1); void is_prime_power(IN SV* svn, IN SV* svroot = 0) PREINIT: int status, ret; UV n, root; PPCODE: status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); if (status != 0) { ret = (status == 1) ? prime_power(n, &root) : 0; 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); } DISPATCHPP_GMPONLYIF(svroot == 0); XSRETURN(1); void is_polygonal(IN SV* svn, IN UV k, IN SV* svroot = 0) PREINIT: UV n; int status; PPCODE: if (svroot != 0 && !SvROK(svroot)) croak("is_polygonal: third argument not a scalar reference"); if (k < 3) croak("is_polygonal: k must be >= 3"); status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); if (status == -1) RETURN_NPARITY(0); if (status == 1) { bool overflow = 0; UV root = polygonal_root(n, k, &overflow); UV result = (n == 0) || root; if (!overflow) { if (result && svroot != 0) sv_setuv(SvRV(svroot), root); RETURN_NPARITY(result); } } DISPATCHPP_GMPONLYIF(svroot == 0); XSRETURN(1); void inverse_li(IN SV* svn) PREINIT: UV n; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) { if (n < MPU_MAX_PRIME_IDX) /* Fall through to Perl if out of range. */ XSRETURN_UV(inverse_li(n)); } DISPATCHPP(); XSRETURN(1); NV inverse_li_nv(IN NV x) CODE: RETVAL = ld_inverse_li(x); OUTPUT: RETVAL void nth_prime(IN SV* svn) ALIAS: nth_prime_upper = 1 nth_prime_lower = 2 nth_prime_approx = 3 PREINIT: UV n, ret; PPCODE: if ( _validate_and_set(&n, aTHX_ svn, IFLAG_POS) && n <= MPU_MAX_PRIME_IDX ) { if (n == 0) XSRETURN_UNDEF; switch (ix) { case 0: ret = nth_prime(n); break; case 1: ret = nth_prime_upper(n); break; case 2: ret = nth_prime_lower(n); break; case 3: default: ret = nth_prime_approx(n); break; } XSRETURN_UV(ret); } DISPATCHPP(); XSRETURN(1); void nth_prime_power(IN SV* svn) ALIAS: nth_prime_power_upper = 1 nth_prime_power_lower = 2 nth_prime_power_approx = 3 PREINIT: UV n, ret; PPCODE: if ( _validate_and_set(&n, aTHX_ svn, IFLAG_POS) && n <= MPU_MAX_PRIME_IDX ) { if (n == 0) XSRETURN_UNDEF; switch (ix) { case 0: ret = nth_prime_power(n); break; case 1: ret = nth_prime_power_upper(n); break; case 2: ret = nth_prime_power_lower(n); break; case 3: default: ret = nth_prime_power_approx(n); break; } XSRETURN_UV(ret); } DISPATCHPP(); XSRETURN(1); void nth_perfect_power(IN SV* svn) ALIAS: nth_perfect_power_upper = 1 nth_perfect_power_lower = 2 nth_perfect_power_approx = 3 PREINIT: UV n, ret; PPCODE: if ( _validate_and_set(&n, aTHX_ svn, IFLAG_POS) && n <= MPU_MAX_PERFECT_POW_IDX ) { if (n == 0) XSRETURN_UNDEF; switch (ix) { case 0: ret = nth_perfect_power(n); break; case 1: ret = nth_perfect_power_upper(n); break; case 2: ret = nth_perfect_power_lower(n); break; case 3: default: ret = nth_perfect_power_approx(n); break; } XSRETURN_UV(ret); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void nth_ramanujan_prime(IN SV* svn) ALIAS: nth_ramanujan_prime_upper = 1 nth_ramanujan_prime_lower = 2 nth_ramanujan_prime_approx = 3 PREINIT: UV n, ret; PPCODE: if ( _validate_and_set(&n, aTHX_ svn, IFLAG_POS) && n <= MPU_MAX_RMJN_PRIME_IDX ) { if (n == 0) XSRETURN_UNDEF; switch (ix) { case 0: ret = nth_ramanujan_prime(n); break; case 1: ret = nth_ramanujan_prime_upper(n); break; case 2: ret = nth_ramanujan_prime_lower(n); break; case 3: default: ret = nth_ramanujan_prime_approx(n); break; } XSRETURN_UV(ret); } DISPATCHPP(); XSRETURN(1); void nth_twin_prime(IN SV* svn) ALIAS: nth_twin_prime_approx = 1 PREINIT: UV n, ret; PPCODE: if ( _validate_and_set(&n, aTHX_ svn, IFLAG_POS) && n <= MPU_MAX_TWIN_PRIME_IDX ) { if (n == 0) XSRETURN_UNDEF; switch (ix) { case 0: ret = nth_twin_prime(n); break; case 1: default: ret = nth_twin_prime_approx(n); break; } XSRETURN_UV(ret); } DISPATCHPP(); XSRETURN(1); void nth_semiprime(IN SV* svn) ALIAS: nth_semiprime_approx = 1 PREINIT: UV n, ret; PPCODE: if ( _validate_and_set(&n, aTHX_ svn, IFLAG_POS) && n <= MPU_MAX_SEMI_PRIME_IDX ) { if (n == 0) XSRETURN_UNDEF; switch (ix) { case 0: ret = nth_semiprime(n); break; case 1: default: ret = nth_semiprime_approx(n); break; } XSRETURN_UV(ret); } DISPATCHPP(); XSRETURN(1); void nth_lucky(IN SV* svn) ALIAS: nth_lucky_upper = 1 nth_lucky_lower = 2 nth_lucky_approx = 3 PREINIT: UV n, ret; PPCODE: if ( _validate_and_set(&n, aTHX_ svn, IFLAG_POS) && n <= MPU_MAX_LUCKY_IDX ) { if (n == 0) XSRETURN_UNDEF; switch (ix) { case 0: ret = nth_lucky(n); break; case 1: ret = nth_lucky_upper(n); break; case 2: ret = nth_lucky_lower(n); break; case 3: default: ret = nth_lucky_approx(n); break; } XSRETURN_UV(ret); } DISPATCHPP(); XSRETURN(1); void next_prime(IN SV* svn) ALIAS: prev_prime = 1 PREINIT: UV n, ret; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS) && !(ix == 0 && n >= MPU_MAX_PRIME)) { ret = 0; switch (ix) { case 0: ret = next_prime(n); break; case 1: ret = prev_prime(n); break; default: break; } if (ret == 0) XSRETURN_UNDEF; XSRETURN_UV(ret); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void next_prime_power(IN SV* svn) ALIAS: prev_prime_power = 1 PREINIT: UV n, ret; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_ABS) && !(ix == 0 && n >= MPU_MAX_PRIME)) { ret = 0; switch (ix) { case 0: ret = next_prime_power(n); break; case 1: ret = prev_prime_power(n); break; default: break; } if (ret == 0) XSRETURN_UNDEF; XSRETURN_UV(ret); } DISPATCHPP(); XSRETURN(1); void next_perfect_power(IN SV* svn) PREINIT: UV n; int status; PPCODE: status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); if (status == 1) { n = next_perfect_power(n); if (n != 0) XSRETURN_UV(n); } else if (status == -1) { /* next perfect power: negative n */ n = next_perfect_power_neg(neg_iv(n)); XSRETURN_IV(neg_iv(n)); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void prev_perfect_power(IN SV* svn) PREINIT: UV n; int status; PPCODE: status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); if (status == 1) { if (n == 0) XSRETURN_IV(-1); n = prev_perfect_power(n); XSRETURN_UV(n); } else if (status == -1) { /* prev perfect power: negative n */ n = prev_perfect_power_neg(neg_iv(n)); if (n > 0 && n <= (UV)IV_MAX) XSRETURN_IV(neg_iv(n)); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void next_chen_prime(IN SV* svn) PREINIT: UV n, ret; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) { ret = next_chen_prime(n); if (ret != 0) XSRETURN_UV(ret); } DISPATCHPP(); XSRETURN(1); void urandomb(IN UV bits) ALIAS: random_ndigit_prime = 1 random_semiprime = 2 random_unrestricted_semiprime = 3 random_safe_prime = 4 random_nbit_prime = 5 random_shawe_taylor_prime = 6 random_maurer_prime = 7 random_proven_prime = 8 random_strong_prime = 9 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: minarg = 3; break; case 5: case 6: case 7: case 8: minarg = 2; break; case 9: minarg = 128; break; default: minarg = 0; break; } if (minarg > 0 && bits < minarg) croak("%s: input '%d' must be >= %d", SUBNAME, (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: res = random_safe_prime(cs,bits); break; case 5: case 6: case 7: case 8: case 9: default: res = random_nbit_prime(cs,bits); break; } if (res || ix == 0) XSRETURN_UV(res); } DISPATCHPP_GMPONLYIF(ix != 1 || bits != uvmax_maxlen); objectify_result(aTHX_ 0, ST(0)); XSRETURN(1); void urandomm(IN SV* svn) PREINIT: UV n, ret; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) { dMY_CXT; ret = urandomm64(MY_CXT.randcxt, n); XSRETURN_UV(ret); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void pisano_period(IN SV* svn) ALIAS: partitions = 1 consecutive_integer_lcm = 2 PREINIT: UV n, r = 0; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) { switch (ix) { case 0: r = pisano_period(n); break; case 1: r = npartitions(n); break; case 2: r = consecutive_integer_lcm(n); break; default: break; } /* Returns 0 if n=0 or result overflows */ if (r != 0 || n == 0) XSRETURN_UV(r); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void random_factored_integer(IN SV* svn) PREINIT: UV n; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS | IFLAG_NONZERO)) { dMY_CXT; int f, nf, flip; UV r, F[MPU_MAX_FACTORS+1]; AV* av = newAV(); 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 { DISPATCHPP(); XSRETURN(1); } void contfrac(IN SV* svnum, IN SV* svden) PREINIT: UV num, den; int nstatus; PPCODE: nstatus = _validate_and_set(&num, aTHX_ svnum, IFLAG_ANY); /* TODO: handle negative numerator */ if (nstatus == 1 && _validate_and_set(&den, aTHX_ svden, IFLAG_POS | IFLAG_NONZERO)) { UV *cf, rem; int i, steps = contfrac(&cf, &rem, num, den); EXTEND(SP, (EXTEND_TYPE)steps); for (i = 0; i < steps; i++) PUSHs(sv_2mortal(newSVuv( cf[i] ))); Safefree(cf); } else { DISPATCHPP(); return; } void from_contfrac(...) PROTOTYPE: @ PREINIT: size_t i; UV n, cfA0, cfA1, cfB0, cfB1, cfAn, cfBn; int nstatus, overflow; PPCODE: nstatus = 1; overflow = 0; cfA0 = 1; cfA1 = 0; cfB0 = 0; cfB1 = 1; if (items > 0) { nstatus = _validate_and_set(&n, aTHX_ ST(0), IFLAG_ANY); /* TODO: handle negative n */ cfA1 = n; for (i = 1; nstatus == 1 && i < (size_t) items; i++) { if (!_validate_and_set(&n, aTHX_ ST(i), IFLAG_POS | IFLAG_NONZERO)) break; /* check each step for overflow */ overflow = (UV_MAX/n < cfA1) || (UV_MAX/n < cfB1); if (overflow) break; cfAn = n * cfA1; cfBn = n * cfB1; overflow = (UV_MAX-cfAn < cfA0) || (UV_MAX-cfBn < cfB0); if (overflow) break; cfAn = cfAn + cfA0; cfBn = cfBn + cfB0; cfA0 = cfA1; cfA1 = cfAn; cfB0 = cfB1; cfB1 = cfBn; } if (i < (size_t) items) /* Covers overflow */ nstatus = 0; } if (nstatus == 1) { XPUSHs(sv_2mortal(newSVuv( cfA1 ))); XPUSHs(sv_2mortal(newSVuv( cfB1 ))); } else { DISPATCHPP(); } XSRETURN(2); void next_calkin_wilf(IN SV* svnum, IN SV* svden) ALIAS: next_stern_brocot = 1 PREINIT: UV num, den; int status; PPCODE: if (_validate_and_set(&num, aTHX_ svnum, IFLAG_POS | IFLAG_NONZERO) && _validate_and_set(&den, aTHX_ svden, IFLAG_POS | IFLAG_NONZERO)) { switch (ix) { case 0: status = next_calkin_wilf(&num, &den); break; case 1: status = next_stern_brocot(&num, &den); break; default: status = 0; break; } if (status) { XPUSHs(sv_2mortal(newSVuv( num ))); XPUSHs(sv_2mortal(newSVuv( den ))); XSRETURN(2); } } DISPATCHPP(); XSRETURN(2); void calkin_wilf_n(IN SV* svnum, IN SV* svden) ALIAS: stern_brocot_n = 1 PREINIT: UV num, den, n; PPCODE: if (_validate_and_set(&num, aTHX_ svnum, IFLAG_POS | IFLAG_NONZERO) && _validate_and_set(&den, aTHX_ svden, IFLAG_POS | IFLAG_NONZERO)) { switch (ix) { case 0: n = calkin_wilf_n(num, den); break; case 1: n = stern_brocot_n(num, den); break; default: n = 0; break; } if (n) XSRETURN_UV(n); } DISPATCHPP(); XSRETURN(1); void nth_calkin_wilf(IN SV* svn) ALIAS: nth_stern_brocot = 1 PREINIT: UV n, num, den; int status; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS | IFLAG_NONZERO)) { switch (ix) { case 0: status = nth_calkin_wilf(&num, &den, n); break; case 1: status = nth_stern_brocot(&num, &den, n); break; default: status = 0; break; } if (status) { XPUSHs(sv_2mortal(newSVuv( num ))); XPUSHs(sv_2mortal(newSVuv( den ))); XSRETURN(2); } } DISPATCHPP(); XSRETURN(2); void nth_stern_diatomic(IN SV* svn) PREINIT: UV n; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) XSRETURN_UV(nth_stern_diatomic(n)); DISPATCHPP(); XSRETURN(1); void farey(IN SV* svn, IN SV* svk = 0) PREINIT: UV n, k; int wantsingle, kresult; PPCODE: wantsingle = svk != 0; if (wantsingle) { if (!_validate_and_set(&k, aTHX_ svk, IFLAG_POS)) k = UV_MAX; } if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS | IFLAG_NONZERO)) { if (!wantsingle && GIMME_V != G_ARRAY) XSRETURN_UV(farey_length(n)); if (n <= UVCONST(4294967295)) { if (wantsingle) { uint32_t p, q; kresult = kth_farey(n, k, &p, &q); if (kresult == 0) XSRETURN_UNDEF; if (kresult == 1) { PUSH_2ELEM_AREF(p, q); XSRETURN(1); } } else { uint32_t *num, *den; UV i, len = farey_array(n, &num, &den); if (len > 0) { EXTEND(SP, (EXTEND_TYPE)len); for (i = 0; i < len; i++) PUSH_2ELEM_AREF(num[i], den[i]); Safefree(num); Safefree(den); XSRETURN(len); } } } } DISPATCHPP(); return; void next_farey(IN SV* svn, IN SV* svfrac) ALIAS: farey_rank = 1 PREINIT: SV **psvp, **psvq; AV* av; UV n, p64, q64; uint32_t p, q; int status; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS | IFLAG_NONZERO) && n <= UVCONST(4294967295)) { CHECK_ARRAYREF(svfrac); av = (AV*) SvRV(svfrac); if (av_count(av) != 2) croak("%s: expected 2-element array reference", SUBNAME); psvp = av_fetch(av, 0, 0); psvq = av_fetch(av, 1, 0); status = 1; if (psvp == 0 || psvq == 0) status = 0; if (status != 0) status = _validate_and_set(&p64, aTHX_ *psvp, IFLAG_POS); if (status != 0) status = _validate_and_set(&q64, aTHX_ *psvq, IFLAG_POS | IFLAG_NONZERO); if (status != 0 && p64 >= q64) { if (ix == 0) XSRETURN_UNDEF; else XSRETURN_UV(farey_length(n) - (p64 == q64)); } if (status != 0) { p = p64; q = q64; if (p != p64 || q != q64) status = 0; /* We only do 32-bit here */ } if (status != 0) { if (ix == 1) XSRETURN_UV(farey_rank(n, p, q)); else { if (next_farey(n, &p, &q)) { PUSH_2ELEM_AREF(p, q); XSRETURN(1); } /* Possibly drop through */ } } } DISPATCHPP(); XSRETURN(1); void Pi(IN UV digits = 0) PREINIT: #ifdef USE_QUADMATH const UV mantsize = FLT128_DIG; const NV pival = 3.141592653589793238462643383279502884197169Q; #elif defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) const UV mantsize = LDBL_DIG; const NV pival = 3.141592653589793238462643383279502884197169L; #else 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 { DISPATCHPP(); XSRETURN(1); } void bernfrac(IN SV* svn) ALIAS: harmfrac = 1 PREINIT: UV n; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS) != 0) { if (ix == 0) { IV num; UV den; if (bernfrac(&num, &den, n)) { XPUSHs(sv_2mortal(newSViv( num ))); XPUSHs(sv_2mortal(newSVuv( den ))); XSRETURN(2); } } else { UV num, den; if (harmfrac(&num, &den, n)) { XPUSHs(sv_2mortal(newSVuv( num ))); XPUSHs(sv_2mortal(newSVuv( den ))); XSRETURN(2); } } } DISPATCHPP(); OBJECTIFY_STACK(2); XSRETURN(2); 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 inverse_totient(IN SV* svn) PREINIT: U32 gimme_v; int status; UV i, n, ntotients; PPCODE: gimme_v = GIMME_V; status = _validate_and_set(&n, aTHX_ svn, IFLAG_POS); if (status == 1) { if (gimme_v == G_SCALAR) { XSRETURN_UV( inverse_totient_count(n) ); } else if (gimme_v == G_ARRAY) { UV* tots = inverse_totient_list(&ntotients, n); if (ntotients != UV_MAX) { EXTEND(SP, (EXTEND_TYPE)ntotients); for (i = 0; i < ntotients; i++) PUSHs(sv_2mortal(newSVuv( tots[i] ))); Safefree(tots); XSRETURN(ntotients); } } } DISPATCHPP(); return; void factor(IN SV* svn) ALIAS: factor_exp = 1 PREINIT: UV n; uint32_t i; U32 gimme_v; int status; PPCODE: gimme_v = GIMME_V; status = _validate_and_set(&n, aTHX_ svn, IFLAG_POS); if (status == 1) { if (ix == 0) { UV factors[MPU_MAX_FACTORS]; uint32_t nfactors = factor(n, factors); if (gimme_v == G_SCALAR) XSRETURN_UV(nfactors); EXTEND(SP, (EXTEND_TYPE)nfactors); for (i = 0; i < nfactors; i++) PUSHs(sv_2mortal(newSVuv( factors[i] ))); } else { factored_t nf = factorint(n); if (gimme_v == G_SCALAR) XSRETURN_UV(nf.nfactors); EXTEND(SP, (EXTEND_TYPE)nf.nfactors); for (i = 0; i < nf.nfactors; i++) PUSH_2ELEM_AREF( nf.f[i], nf.e[i] ); } } else { DISPATCHPP(); return; } void divisors(IN SV* svn, IN SV* svk = 0) PREINIT: int status; UV n, k, i, ndivisors, *divs; PPCODE: status = _validate_and_set(&n, aTHX_ svn, IFLAG_POS); k = n; if (status == 1 && svk != 0) { status = _validate_and_set(&k, aTHX_ svk, IFLAG_POS); if (k > n) k = n; } if (status != 1) { DISPATCHPP(); return; } if (GIMME_V == G_VOID) { /* Nothing */ } else if (GIMME_V == G_SCALAR && k >= n) { ndivisors = divisor_sum(n, 0); PUSHs(sv_2mortal(newSVuv( ndivisors ))); } else { divs = divisor_list(n, &ndivisors, k); if (GIMME_V == G_SCALAR) { PUSHs(sv_2mortal(newSVuv( ndivisors ))); } else { EXTEND(SP, (EXTEND_TYPE)ndivisors); for (i = 0; i < ndivisors; i++) PUSHs(sv_2mortal(newSVuv( divs[i] ))); } Safefree(divs); } void trial_factor(IN SV* svn, ...) ALIAS: fermat_factor = 1 holf_factor = 2 squfof_factor = 3 lehman_factor = 4 prho_factor = 5 cheb_factor = 6 pplus1_factor = 7 pbrent_factor = 8 pminus1_factor = 9 ecm_factor = 10 PREINIT: UV n, arg1, arg2; static const UV default_arg1[] = {0, 64000000, 8000000, 4000000, 1, 4000000, 0, 200, 4000000, 1000000}; /* Trial, Fermat, Holf, SQUFOF, Lmn, PRHO, Cheb, P+1, Brent, P-1 */ PPCODE: if (!_validate_and_set(&n, aTHX_ svn, IFLAG_POS) || ix == 10) { DISPATCHPP(); return; } if (n == 0) XSRETURN_UV(0); /* Must read arguments before pushing anything */ arg1 = (items >= 2) ? my_svuv(ST(1)) : default_arg1[ix]; arg2 = (items >= 3) ? my_svuv(ST(2)) : 0; /* Small factors */ while ( (n% 2) == 0 ) { n /= 2; XPUSHs(sv_2mortal(newSVuv( 2 ))); } while ( (n% 3) == 0 ) { n /= 3; XPUSHs(sv_2mortal(newSVuv( 3 ))); } while ( (n% 5) == 0 ) { n /= 5; XPUSHs(sv_2mortal(newSVuv( 5 ))); } if (n == 1) { /* done */ } else if (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 = cheb_factor (n, factors, arg1, arg2); break; case 7: nfactors = pplus1_factor (n, factors, arg1); break; case 8: if (items < 3) arg2 = 1; nfactors = pbrent_factor (n, factors, arg1, arg2); break; case 9: default: if (items < 3) arg2 = 10*arg1; nfactors = pminus1_factor(n, factors, arg1, arg2); break; } EXTEND(SP, (EXTEND_TYPE)nfactors); for (i = 0; i < nfactors; i++) PUSHs(sv_2mortal(newSVuv( factors[i] ))); } void divisor_sum(IN SV* svn, ...) PREINIT: UV n, k, sigma; PPCODE: if (items == 1) { if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) { sigma = divisor_sum(n, 1); if (n <= 1 || sigma != 0) XSRETURN_UV(sigma); } } else { SV* svk = ST(1); if ( (!SvROK(svk) || (SvROK(svk) && SvTYPE(SvRV(svk)) != SVt_PVCV)) && _validate_and_set(&n, aTHX_ svn, IFLAG_POS) && _validate_and_set(&k, aTHX_ svk, IFLAG_POS) ) { sigma = divisor_sum(n, k); if (n <= 1 || sigma != 0) XSRETURN_UV(sigma); } } DISPATCHPP(); XSRETURN(1); void jordan_totient(IN SV* sva, IN SV* svn) ALIAS: powersum = 1 ramanujan_sum = 2 legendre_phi = 3 smooth_count = 4 rough_count = 5 PREINIT: int astatus, nstatus; UV a, n, ret; PPCODE: astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_POS); nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_POS); if (astatus != 0 && nstatus != 0) { switch (ix) { case 0: ret = jordan_totient(a, n); if (ret == 0 && n > 1) goto overflow; break; case 1: ret = powersum(a, n); if (ret == 0 && a > 0) goto overflow; break; case 2: 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 3: ret = legendre_phi(a, n); break; case 4: ret = debruijn_psi(a, n); break; case 5: default: ret = buchstab_phi(a, n); break; } XSRETURN_UV(ret); } overflow: DISPATCHPP(); objectify_result(aTHX_ sva, ST(0)); XSRETURN(1); void almost_prime_count(IN SV* svk, IN SV* svn) ALIAS: almost_prime_count_approx = 1 almost_prime_count_lower = 2 almost_prime_count_upper = 3 omega_prime_count = 4 PREINIT: UV k, n, ret; PPCODE: if (_validate_and_set(&k, aTHX_ svk, IFLAG_ABS) && _validate_and_set(&n, aTHX_ svn, IFLAG_ABS) && k < BITS_PER_WORD) { ret = 0; switch (ix) { case 0: ret = almost_prime_count(k, n); break; case 1: ret = almost_prime_count_approx(k, n); break; case 2: ret = almost_prime_count_lower(k, n); break; case 3: ret = almost_prime_count_upper(k, n); break; case 4: ret = omega_prime_count(k, n); break; default: break; } XSRETURN_UV(ret); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void nth_almost_prime(IN SV* svk, IN SV* svn) ALIAS: nth_almost_prime_approx = 1 nth_almost_prime_lower = 2 nth_almost_prime_upper = 3 PREINIT: UV k, n, max; PPCODE: if (_validate_and_set(&k, aTHX_ svk, IFLAG_ABS) && _validate_and_set(&n, aTHX_ svn, IFLAG_ABS) && k < BITS_PER_WORD) { UV ret = 0; if (n == 0 || (k == 0 && n > 1)) XSRETURN_UNDEF; max = max_almost_prime_count(k); if (max > 0 && n <= max) { switch (ix) { case 0: ret = nth_almost_prime(k, n); break; case 1: ret = nth_almost_prime_approx(k, n); break; case 2: ret = nth_almost_prime_lower(k, n); break; case 3: ret = nth_almost_prime_upper(k, n); break; } if (ret != 0) XSRETURN_UV(ret); } } DISPATCHPP(); XSRETURN(1); void nth_omega_prime(IN SV* svk, IN SV* svn) PREINIT: UV k, n, max, ret; PPCODE: if (_validate_and_set(&k, aTHX_ svk, IFLAG_ABS) && _validate_and_set(&n, aTHX_ svn, IFLAG_ABS) && k < 16) { if (n == 0 || (k == 0 && n > 1)) XSRETURN_UNDEF; max = max_omega_prime_count(k); if (max > 0 && n <= max) { ret = nth_omega_prime(k, n); XSRETURN_UV(ret); } } DISPATCHPP(); XSRETURN(1); void powmod(IN SV* sva, IN SV* svg, IN SV* svn) ALIAS: rootmod = 1 PREINIT: int astatus, gstatus, nstatus, retundef; UV a, g, n, ret; PPCODE: astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY); gstatus = _validate_and_set(&g, aTHX_ svg, IFLAG_ANY); nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS); if (astatus != 0 && gstatus != 0 && nstatus != 0) { if (n == 0) XSRETURN_UNDEF; if (n == 1) XSRETURN_UV(0); _mod_with(&a, astatus, n); retundef = ret = 0; if (ix == 0) { retundef = !prep_pow_inv(&a,&g,gstatus,n); if (!retundef) ret = powmod(a, g, n); } else { retundef = !(prep_pow_inv(&a,&g,gstatus,n) && rootmod(&ret,a,g,n)); } if (retundef) XSRETURN_UNDEF; XSRETURN_UV(ret); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void addmod(IN SV* sva, IN SV* svb, IN SV* svn) ALIAS: submod = 1 mulmod = 2 divmod = 3 znlog = 4 PREINIT: int astatus, bstatus, nstatus, retundef; UV a, b, n, ret; PPCODE: astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY); bstatus = _validate_and_set(&b, aTHX_ svb, IFLAG_ANY); nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS); if (astatus != 0 && bstatus != 0 && nstatus != 0) { if (n == 0) XSRETURN_UNDEF; if (n == 1) XSRETURN_UV(0); _mod_with(&a, astatus, n); _mod_with(&b, bstatus, n); retundef = ret = 0; switch (ix) { case 0: ret = addmod(a, b, n); break; case 1: ret = submod(a, b, n); break; case 2: ret = mulmod(a, b, n); break; case 3: b = modinverse(b, n); if (b == 0) retundef = 1; else ret = mulmod(a, b, n); break; case 4: ret = znlog(a, b, n); if (ret == 0 && (b == 0 || a != 1)) retundef = 1; break; default: break; } if (retundef) XSRETURN_UNDEF; XSRETURN_UV(ret); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void muladdmod(IN SV* sva, IN SV* svb, IN SV* svc, IN SV* svn) ALIAS: mulsubmod = 1 PREINIT: int astatus, bstatus, cstatus, nstatus; UV a, b, c, n, ret; PPCODE: astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY); bstatus = _validate_and_set(&b, aTHX_ svb, IFLAG_ANY); cstatus = _validate_and_set(&c, aTHX_ svc, IFLAG_ANY); nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS); if (astatus != 0 && bstatus != 0 && cstatus != 0 && nstatus != 0) { if (n == 0) XSRETURN_UNDEF; if (n == 1) XSRETURN_UV(0); _mod_with(&a, astatus, n); _mod_with(&b, bstatus, n); _mod_with(&c, cstatus, n); ret = (ix==0) ? muladdmod(a,b,c,n) : mulsubmod(a,b,c,n); XSRETURN_UV(ret); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void binomialmod(IN SV* svn, IN SV* svk, IN SV* svm) PREINIT: int nstatus, kstatus, mstatus; UV ret, n, k, m; PPCODE: nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_ANY); mstatus = _validate_and_set(&m, aTHX_ svm, IFLAG_ABS); if (nstatus != 0 && kstatus != 0 && mstatus != 0) { if (m == 0) XSRETURN_UNDEF; if (m == 1) XSRETURN_UV(0); if ( (nstatus == 1 && (kstatus == -1 || k > n)) || (nstatus ==-1 && (kstatus == -1 && k > n)) ) XSRETURN_UV(0); if (kstatus == -1) k = n - k; if (nstatus == -1) n = neg_iv(n) + k - 1; if (binomialmod(&ret, n, k, m)) { if ((nstatus == -1) && (k & 1) && ret != 0) ret = m-ret; XSRETURN_UV(ret); } } DISPATCHPP(); XSRETURN(1); void factorialmod(IN SV* sva, IN SV* svn) PREINIT: int astatus, nstatus; UV a, n; PPCODE: astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_POS); nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS); if (astatus != 0 && nstatus != 0) { if (n == 0) XSRETURN_UNDEF; if (n == 1) XSRETURN_UV(0); XSRETURN_UV( factorialmod(a, n) ); } DISPATCHPP_GMPONLYIF(astatus == 1); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void invmod(IN SV* sva, IN SV* svn) ALIAS: znorder = 1 sqrtmod = 2 negmod = 3 PREINIT: int astatus, nstatus; UV a, n, r, retok; PPCODE: astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY); nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS); if (astatus != 0 && nstatus != 0) { if (n == 0) XSRETURN_UNDEF; if (n == 1) XSRETURN_UV((ix==1) ? 1 : 0); /* znorder different */ _mod_with(&a, astatus, n); retok = r = 0; switch (ix) { case 0: retok = r = modinverse(a, n); break; case 1: retok = r = znorder(a, n); break; case 2: retok = sqrtmod(&r, a, n); break; case 3: default: retok = 1; r = negmod(a, n); break; } if (retok == 0) XSRETURN_UNDEF; XSRETURN_UV(r); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void allsqrtmod(IN SV* sva, IN SV* svn) PREINIT: int astatus, nstatus; UV a, n, i, numr, *roots; PPCODE: astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY); nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS); if (astatus != 0 && nstatus != 0) { if (n == 0) XSRETURN_EMPTY; _mod_with(&a, astatus, n); roots = allsqrtmod(&numr, a, n); if (roots != 0) { if (GIMME_V != G_ARRAY) { PUSHs(sv_2mortal(newSVuv(numr))); } else { EXTEND(SP, (EXTEND_TYPE)numr); for (i = 0; i < numr; i++) PUSHs(sv_2mortal(newSVuv(roots[i]))); } Safefree(roots); } } else { DISPATCHPP(); return; } void allrootmod(IN SV* sva, IN SV* svg, IN SV* svn) PREINIT: int astatus, gstatus, nstatus; UV a, g, n, i, numr, *roots; PPCODE: astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY); gstatus = _validate_and_set(&g, aTHX_ svg, IFLAG_ANY); nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS); if (astatus != 0 && gstatus != 0 && nstatus != 0) { if (n == 0) XSRETURN_EMPTY; _mod_with(&a, astatus, n); if (!prep_pow_inv(&a,&g,gstatus,n)) XSRETURN_EMPTY; roots = allrootmod(&numr, a, g, n); if (roots != 0) { if (GIMME_V != G_ARRAY) { PUSHs(sv_2mortal(newSVuv(numr))); } else { EXTEND(SP, (EXTEND_TYPE)numr); for (i = 0; i < numr; i++) PUSHs(sv_2mortal(newSVuv(roots[i]))); } Safefree(roots); } } else { DISPATCHPP(); return; } void is_primitive_root(IN SV* sva, IN SV* svn) PREINIT: int astatus, nstatus; UV a, n; PPCODE: astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY); nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS); if (astatus != 0 && nstatus != 0) { if (n == 0) XSRETURN_UNDEF; _mod_with(&a, astatus, n); RETURN_NPARITY( is_primitive_root(a,n,0) ); } DISPATCHPP(); XSRETURN(1); void qnr(IN SV* svn) ALIAS: znprimroot = 1 PREINIT: UV n, r; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_ABS)) { if (n == 0) XSRETURN_UNDEF; if (ix == 0) { r = qnr(n); } else { r = znprimroot(n); if (r == 0 && n != 1) XSRETURN_UNDEF; } if (r < 100) RETURN_NPARITY(r); else XSRETURN_UV(r); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void is_smooth(IN SV* svn, IN SV* svk) ALIAS: is_rough = 1 PREINIT: UV n, k; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_ABS) && _validate_and_set(&k, aTHX_ svk, IFLAG_POS)) { RETURN_NPARITY( (ix == 0) ? is_smooth(n,k) : is_rough(n,k) ); } DISPATCHPP(); XSRETURN(1); void is_omega_prime(IN SV* svk, IN SV* svn) ALIAS: is_almost_prime = 1 PREINIT: UV n, k; int nstatus, kstatus; PPCODE: kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_POS); nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); if (kstatus != 0 && nstatus != 0) { int res = (nstatus != 1) ? 0 : (ix == 0) ? is_omega_prime(k, n) : is_almost_prime(k, n); RETURN_NPARITY(res); } DISPATCHPP(); XSRETURN(1); void is_divisible(IN SV* svn, IN SV* svd, ...) PREINIT: UV n, d, ret; size_t i; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_ABS) && _validate_and_set(&d, aTHX_ svd, IFLAG_ABS)) { int status = 1; ret = d==0 ? (n==0) : n % d == 0; for (i = 2; i < (size_t)items && !ret; i++) { if ((status = _validate_and_set(&d, aTHX_ ST(i), IFLAG_ABS)) != 1) break; ret = d==0 ? (n==0) : n % d == 0; } if (status == 1) RETURN_NPARITY(ret); } DISPATCHPP(); XSRETURN(1); void is_congruent(IN SV* svn, IN SV* svc, IN SV* svd) PREINIT: UV n, c, d; int nstatus, cstatus, dstatus; PPCODE: nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); cstatus = _validate_and_set(&c, aTHX_ svc, IFLAG_ANY); dstatus = _validate_and_set(&d, aTHX_ svd, IFLAG_ABS); if (nstatus != 0 && cstatus != 0 && dstatus != 0) { if (d != 0) { _mod_with(&n, nstatus, d); _mod_with(&c, cstatus, d); } RETURN_NPARITY( n == c ); } DISPATCHPP(); XSRETURN(1); void valuation(IN SV* svn, IN SV* svk) PREINIT: UV n, k; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_ABS) && _validate_and_set(&k, aTHX_ svk, IFLAG_POS)) { if (k <= 1) croak("valuation: k must be > 1"); if (n == 0) XSRETURN_UNDEF; RETURN_NPARITY(valuation(n, k)); } DISPATCHPP(); XSRETURN(1); void is_powerful(IN SV* svn, IN SV* svk = 0); ALIAS: powerful_count = 1 sumpowerful = 2 nth_powerful = 3 PREINIT: int nstatus; UV n, ret, k = 2; PPCODE: nstatus = _validate_and_set(&n, aTHX_ svn, (ix < 3) ? IFLAG_ANY: IFLAG_POS); if (nstatus != 0 && (!svk || _validate_and_set(&k, aTHX_ svk, IFLAG_POS))) { if (nstatus == -1) RETURN_NPARITY(0); if (ix == 0) RETURN_NPARITY( is_powerful(n, k) ); if (ix == 1) XSRETURN_UV( powerful_count(n, k) ); if (ix == 2) { if (n == 0) XSRETURN_UV(0); ret = sumpowerful(n, k); } else { if (n == 0) XSRETURN_UNDEF; ret = nth_powerful(n, k); } /* ret=0: nth_powerful / sumpowerful result > UV_MAX, so go to PP/GMP */ if (ret > 0) XSRETURN_UV(ret); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void kronecker(IN SV* sva, IN SV* svb) PREINIT: int astatus, bstatus; UV a, b; PPCODE: astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY); bstatus = _validate_and_set(&b, aTHX_ svb, IFLAG_ANY); if (astatus != 0 && bstatus != 0) { int k; if (bstatus == 1) k = (astatus==1) ? kronecker_uu(a,b) : kronecker_su((IV)a,b); else k = (astatus==1) ? kronecker_uu(a,neg_iv(b)) : -kronecker_su((IV)a,neg_iv(b)); RETURN_NPARITY( k ); } DISPATCHPP(); XSRETURN(1); void is_qr(IN SV* sva, IN SV* svn) PREINIT: int astatus, nstatus; UV a, n; PPCODE: astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY); nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS); if (astatus != 0 && nstatus != 0) { if (n == 0) XSRETURN_UNDEF; if (n == 1) RETURN_NPARITY(1); _mod_with(&a, astatus, n); RETURN_NPARITY( is_qr(a,n) ); } DISPATCHPP(); XSRETURN(1); void addint(IN SV* sva, IN SV* svb) ALIAS: subint = 1 mulint = 2 divint = 3 modint = 4 cdivint = 5 powint = 7 PREINIT: int astatus, bstatus, overflow, postneg, nix, smask; UV a, b, t, ret; PPCODE: astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY); bstatus = _validate_and_set(&b, aTHX_ svb, (ix == 7) ? IFLAG_POS : IFLAG_ANY); if (astatus != 0 && bstatus != 0) { /* We will try to do everything with non-negative integers, with overflow * detection. This means some pre-processing and post-processing for * negative inputs. */ nix = ix; /* So we can modify */ ret = overflow = postneg = 0; smask = ((astatus == -1) << 1) + (bstatus == -1); /* smask=0: +a +b smask=1: +a -b smask=2: -a +b smask=3: -a -b */ if (b == 0 && (ix==3 || ix==4 || ix==5)) croak("%s: divide by zero", SUBNAME); if (smask != 0) { /* Manipulate so all arguments are positive */ if (smask & 2) a = neg_iv(a); if (smask & 1) b = neg_iv(b); if (ix == 0) { switch (smask) { case 1: nix=1; break; /* a - |b| */ case 2: nix=1; t=a; a=b; b=t; break; /* b - |a| */ case 3: postneg=1; break; /* -(|a| + |b|) */ default: break; } } else if (ix == 1) { switch (smask) { case 1: nix=0; break; /* a + |b| */ case 2: nix=0; postneg=1; break; /* -(|a| + b) */ case 3: t=a; a=b; b=t; break; /* |b| - |a| */ default: break; } } else if (ix == 2) { switch (smask) { case 1: case 2: postneg = 1; break; default: break; } } else if (ix == 3) { switch (smask) { case 1: case 2: postneg = 1; nix = 5; break; default: break; } } else if (ix == 4) { switch (smask) { case 1: nix = 6; postneg = 1; break; case 2: nix = 6; break; case 3: postneg = 1; break; default: break; } } else if (ix == 5) { switch (smask) { case 1: case 2: postneg = 1; nix = 3; break; default: break; } } else if (ix == 6) { /* ix = 6 is cmodint */ } else if (ix == 7) { /* bstatus is never -1 for powint */ postneg = (b & 1); } } switch (nix) { case 0: ret = a + b; /* addint */ overflow = UV_MAX-a < b; break; case 1: ret = a - b; /* subint */ if (b > a && (IV)ret < 0) XSRETURN_IV((IV)ret); overflow = (b > a); break; case 2: ret = a * b; /* mulint */ overflow = a > 0 && UV_MAX/a < b; break; case 3: ret = a / b; break; /* divint */ case 4: ret = a % b; break; /* modint */ case 5: ret = a / b + (a % b != 0); /* cdivint */ break; case 6: ret = (a%b) ? b-(a%b) : 0; /* cmodint */ break; case 7: default: ret = ipowsafe(a, b); overflow = (a > 1 && ret == UV_MAX); break; } if (!overflow) { if (!postneg) XSRETURN_UV(ret); if (ret <= (UV)IV_MAX) XSRETURN_IV(neg_iv(ret)); } } DISPATCHPP(); objectify_result(aTHX_ sva, ST(0)); XSRETURN(1); void add1int(IN SV* svn) ALIAS: sub1int = 1 PREINIT: int status; UV n; PPCODE: status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); if (status == 1) { if (ix == 1 && n == 0) XSRETURN_IV(-1); if (ix == 1 || (ix == 0 && n < UV_MAX)) XSRETURN_UV( (ix==0) ? n+1 : n-1 ); } else if (status == -1) { if (ix == 0 || (ix == 1 && (IV)n > IV_MIN)) XSRETURN_IV( (ix==0) ? (IV)n+1 : (IV)n-1 ); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void absint(IN SV* svn) ALIAS: negint = 1 PREINIT: UV n; PPCODE: if (ix == 0) { if (_validate_and_set(&n, aTHX_ svn, IFLAG_ABS)) XSRETURN_UV(n); } else { int status = _validate_and_set(&n, aTHX_ svn, IFLAG_IV); if (status == -1) XSRETURN_UV(neg_iv(n)); else if (status == 1) XSRETURN_IV(neg_iv(n)); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void signint(IN SV* svn) ALIAS: is_odd = 1 is_even = 2 PREINIT: int status, sign, isodd; UV n; const char* s; STRLEN len; PPCODE: status = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); if (status == 0) { /* Look at the string input */ s = SvPV(svn, len); if (len == 0 || s == 0) croak("%s: invalid non-empty input", SUBNAME); sign = (s[0] == '-') ? -1 : (s[0] == '0') ? 0 : 1; isodd = (s[len-1] == '1' || s[len-1] == '3' || s[len-1] == '5' || s[len-1] == '7' || s[len-1] == '9'); } else { sign = (status == -1) ? -1 : (n == 0) ? 0 : 1; isodd = n & 1; } RETURN_NPARITY( (ix==0) ? sign : (ix==1) ? isodd : !isodd ); void cmpint(IN SV* sva, IN SV* svb) PREINIT: int astatus, bstatus, ret = 0; UV a, b; PPCODE: astatus = _validate_and_set(&a, aTHX_ sva, IFLAG_ANY); bstatus = _validate_and_set(&b, aTHX_ svb, IFLAG_ANY); if (astatus != 0 && bstatus != 0) { if (astatus > bstatus) ret = 1; else if (astatus < bstatus) ret = -1; else if (a == b) ret = 0; else ret = ((astatus == 1 && a > b) || (astatus == -1 && (IV)a > (IV)b)) ? 1 : -1; } else { STRLEN alen, blen; char *aptr, *bptr; aptr = SvPV(sva, alen); bptr = SvPV(svb, blen); ret = strnum_cmp(aptr, alen, bptr, blen); } RETURN_NPARITY(ret); void logint(IN SV* svn, IN UV k, IN SV* svret = 0) ALIAS: rootint = 1 PREINIT: UV n, root; PPCODE: if (ix == 0 && k <= 1) croak("logint: base must be > 1"); if (ix == 1 && k <= 0) croak("rootint: k must be > 0"); if (svret != 0 && !SvROK(svret)) croak("%s: third argument not a scalar reference",SUBNAME); if (_validate_and_set(&n, aTHX_ svn, ix == 0 ? IFLAG_POS | IFLAG_NONZERO : IFLAG_POS)) { root = (ix == 0) ? logint(n, k) : rootint(n, k); if (svret) sv_setuv(SvRV(svret), ix == 0 ? ipow(k,root) : ipow(root,k)); XSRETURN_UV(root); } DISPATCHPP_GMPONLYIF(svret == 0); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void divrem(IN SV* sva, IN SV* svb) ALIAS: fdivrem = 1 cdivrem = 2 tdivrem = 3 PREINIT: int astatus, bstatus; UV D, d; IV iD, id; PPCODE: astatus = _validate_and_set(&D, aTHX_ sva, IFLAG_ANY); bstatus = _validate_and_set(&d, aTHX_ svb, IFLAG_ANY); if (astatus != 0 && bstatus != 0 && d == 0) croak("%s: divide by zero", SUBNAME); if (astatus == 1 && bstatus == 1 && (ix != 2 || D % d == 0)) { XPUSHs(sv_2mortal(newSVuv( D / d ))); XPUSHs(sv_2mortal(newSVuv( D % d ))); XSRETURN(2); } else if (ix == 2 && astatus == 1 && bstatus == 1 && d <= (UV)IV_MAX) { /* Exact division was handled above */ XPUSHs(sv_2mortal(newSVuv( D/d + 1 ))); XPUSHs(sv_2mortal(newSViv( ((IV)D%d) - d ))); XSRETURN(2); } else if (astatus != 0 && bstatus != 0 && _validate_and_set((UV*)&iD, aTHX_ sva, IFLAG_IV) != 0 && _validate_and_set((UV*)&id, aTHX_ svb, IFLAG_IV) != 0) { /* Both values fit in an IV */ IV q, r; switch (ix) { case 0: edivrem(&q, &r, iD, id); break; case 1: fdivrem(&q, &r, iD, id); break; case 2: cdivrem(&q, &r, iD, id); break; case 3: default: tdivrem(&q, &r, D, d); break; } XPUSHs(sv_2mortal(newSViv( q ))); XPUSHs(sv_2mortal(newSViv( r ))); XSRETURN(2); } DISPATCHPP(); OBJECTIFY_STACK(2); XSRETURN(2); void lshiftint(IN SV* svn, IN SV* svk = 0) ALIAS: rshiftint = 1 rashiftint = 2 PREINIT: int nstatus, kstatus, nix; UV n, k, nk; PPCODE: nix = ix; if (items == 1) { kstatus = 1; k = 1; } else { kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_ANY); if (kstatus == -1) { k = neg_iv(k); nix = !ix; /* 0 => 1, 1 => 0, 2 => 0 */ } } if (kstatus != 0) { nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); if (k == 0) XSRETURN(1); if (nstatus != 0 && nix > 0 && k >= BITS_PER_WORD) /* Big right shift */ XSRETURN_IV(nstatus == -1 && nix==2 ? -1 : 0); if (nstatus == 1 && k < BITS_PER_WORD) { if (nix > 0) XSRETURN_UV(n >> k); /* Right shift */ if ( ((n << k) >> k) == n) XSRETURN_UV(n << k); /* Left shift */ /* Fall through -- left shift needs more bits */ } else if (nstatus == -1 && nix > 0 && k < BITS_PER_WORD) { n = neg_iv(n); nk = n >> k; XSRETURN_IV( nix == 1 ? -nk : (nk<> (k+1) == n) XSRETURN_IV(-nk); /* Fall through -- left shift needs more bits */ } } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void gcdext(IN SV* sva, IN SV* svb) PREINIT: IV u, v, d, a, b; PPCODE: if (_validate_and_set((UV*)&a, aTHX_ sva, IFLAG_IV) && _validate_and_set((UV*)&b, aTHX_ svb, IFLAG_IV)) { d = gcdext(a, b, &u, &v, 0, 0); XPUSHs(sv_2mortal(newSViv( u ))); XPUSHs(sv_2mortal(newSViv( v ))); XPUSHs(sv_2mortal(newSViv( d ))); } else { DISPATCHPP(); OBJECTIFY_STACK(3); XSRETURN(3); } 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); } DISPATCHPP(); objectify_result(aTHX_ 0, ST(0)); XSRETURN(1); 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 = !SvROK(x) ? SvNV(x) : STRTONV(SvPV_nolen(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,0); 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: UV lo, hi; int lostatus, histatus; uint32_t mask; PPCODE: mask = (ix == 1 && items == 1) ? IFLAG_ABS : IFLAG_ANY; lostatus = _validate_and_set(&lo, aTHX_ svlo, mask); if (svhi == 0 && lostatus != 0) { if (ix == 0) XSRETURN_UV( (lostatus == -1) ? 0 : totient(lo) ); else RETURN_NPARITY( moebius(lo) ); } histatus = (svhi == 0) ? 0 : _validate_and_set(&hi, aTHX_ svhi, IFLAG_ANY); /* - If range is larger than MAX_EXTEND, reduce it to fit. * Arguably we should croak as invalid input. * - If range includes UV_MAX, pull it off and handle separately. * This makes count never underflow (e.g. lo=0,hi=max, hi-lo+1 => 0) * It also simplifies loop overflow logic in the range function. */ if (lostatus == 1 && histatus == 1) { UV i, count; int appendmax = (hi == UV_MAX); if (lo > hi) XSRETURN(0); if (appendmax) hi--; if ((hi-lo+1) > MAX_EXTEND) hi = lo + MAX_EXTEND - 1; count = hi-lo+1; if (count > 0) { EXTEND(SP, (EXTEND_TYPE)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); } } if (appendmax) { EXTEND(SP, 1); if (ix == 0) { PUSHs(sv_2mortal(newSVuv(totient(UV_MAX)))); } else { dMY_CXT; PUSH_NPARITY(-1); /* moebius of 2^32-1, 2^64-1, 2^128-1 => -1 */ } } } else { DISPATCHPP(); return; } void sqrtint(IN SV* svn) ALIAS: carmichael_lambda = 1 exp_mangoldt = 2 PREINIT: UV n, r; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) { r = 0; switch (ix) { case 0: r = isqrt(n); break; case 1: r = carmichael_lambda(n); break; case 2: r = exp_mangoldt(n); break; default: break; } XSRETURN_UV(r); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void prime_omega(IN SV* svn) ALIAS: prime_bigomega = 1 hammingweight = 2 is_square_free = 3 PREINIT: UV n, ret; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_ABS)) { ret = 0; switch (ix) { case 0: ret = prime_omega(n); break; case 1: ret = prime_bigomega(n); break; case 2: ret = popcnt(n); break; case 3: ret = is_square_free(n); break; default: break; } RETURN_NPARITY(ret); } if (ix == 2 && _XS_get_callgmp() < 47) { char* ptr; STRLEN len; ptr = SvPV(svn, len); XSRETURN_UV(mpu_popcount_string(ptr, len)); } DISPATCHPP(); XSRETURN(1); void factorial(IN SV* svn) ALIAS: subfactorial = 1 fubini = 2 primorial = 3 pn_primorial = 4 sumtotient = 5 PREINIT: UV n, r; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) { r = 0; switch(ix) { case 0: r = factorial(n); break; case 1: r = subfactorial(n); break; case 2: r = fubini(n); break; case 3: r = primorial(n); break; case 4: r = pn_primorial(n); break; case 5: r = sumtotient(n); break; default: break; } if (n == 0 || r > 0) XSRETURN_UV(r); if (ix == 5) { /* Probably an overflow, try 128-bit. */ UV hicount, count; int retok = sumtotient128(n, &hicount, &count); if (retok == 1 && hicount > 0) RETURN_128(hicount, count); if (retok == 1) XSRETURN_UV(count); } } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void binomial(IN SV* svn, IN SV* svk) PREINIT: int nstatus, kstatus; UV n, k, ret; PPCODE: nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY); kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_ANY); if (nstatus != 0 && kstatus != 0) { if ( (nstatus == 1 && (kstatus == -1 || k > n)) || (nstatus ==-1 && (kstatus == -1 && k > n)) ) XSRETURN_UV(0); if (kstatus == -1) k = n - k; /* n<0,k<=n: (-1)^(n-k) * binomial(-k-1,n-k) */ if (nstatus == -1) { ret = binomial( neg_iv(n)+k-1, k ); if (ret > 0 && ret <= (UV)IV_MAX) XSRETURN_IV( (IV)ret * ((k&1) ? -1 : 1) ); } else if (nstatus == 1) { ret = binomial(n, k); if (ret != 0) XSRETURN_UV(ret); } } DISPATCHPP_GMPONLYIF(nstatus == 1 && kstatus != 0); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void falling_factorial(IN SV* svn, IN SV* svk) ALIAS: rising_factorial = 1 PREINIT: int nstatus, kstatus; UV n, k; PPCODE: nstatus = _validate_and_set(&n, aTHX_ svn, IFLAG_ANY | IFLAG_IV); kstatus = _validate_and_set(&k, aTHX_ svk, IFLAG_POS); if (nstatus == 1 && kstatus == 1) { UV ret = (ix==0) ? falling_factorial(n,k) : rising_factorial(n,k); if (ret != UV_MAX) XSRETURN_UV(ret); } else if (nstatus == -1 && kstatus == 1) { IV in = (IV)n; IV ret = (ix==0) ? falling_factorial_s(in,k) : rising_factorial_s(in,k); if (ret != IV_MAX) XSRETURN_IV(ret); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); void mertens(IN SV* svn) ALIAS: liouville = 1 sumliouville = 2 is_pillai = 3 is_congruent_number = 4 hclassno = 5 ramanujan_tau = 6 PREINIT: UV n; int status; PPCODE: status = _validate_and_set(&n, aTHX_ svn, (ix < 5) ? IFLAG_POS : IFLAG_ANY); if (status == -1) XSRETURN_IV(0); if (status == 1) { IV r = 0; switch(ix) { case 0: r = mertens(n); break; case 1: r = liouville(n); break; case 2: r = sumliouville(n); break; case 3: r = pillai_v(n); break; case 4: r = is_congruent_number(n); break; case 5: r = hclassno(n); break; case 6: r = ramanujan_tau(n); if (r == 0 && n != 0) status = 0; break; default: break; } if (status != 0) RETURN_NPARITY(r); } DISPATCHPP(); objectify_result(aTHX_ svn, ST(0)); XSRETURN(1); int _is_congruent_number_filter(IN UV n) CODE: RETVAL = is_congruent_number_filter(n); OUTPUT: RETVAL bool _is_congruent_number_tunnell(IN UV n) CODE: RETVAL = is_congruent_number_tunnell(n); OUTPUT: RETVAL void chebyshev_theta(IN SV* svn) ALIAS: chebyshev_psi = 1 PREINIT: UV n; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) { NV r = (ix==0) ? chebyshev_theta(n) : chebyshev_psi(n); XSRETURN_NV(r); } DISPATCHPP(); /* Result is FP */ XSRETURN(1); #define RETURN_SET_REF(s) /* Return sorted set values */ \ { \ UV *sdata; \ unsigned long slen = iset_size(s); \ int sign = iset_sign(s); \ New(0, sdata, slen, UV); \ iset_allvals(s, sdata); \ iset_destroy(&s); \ RETURN_LIST_REF( slen, sdata, sign ); \ } #define RETURN_EMPTY_SET_REF() RETURN_EMPTY_LIST_REF() void sumset(IN SV* sva, IN SV* svb = 0) PROTOTYPE: $;$ PREINIT: int atype, btype, stype, sign; UV *ra, *rb; size_t alen, blen, i, j; iset_t s; PPCODE: atype = arrayref_to_int_array(aTHX_ &alen, &ra, 1, sva, "sumset arg 1"); if (svb == 0 || atype == IARR_TYPE_BAD) { rb = ra; blen = alen; btype = atype; } else { btype = arrayref_to_int_array(aTHX_ &blen, &rb, 1, svb, "sumset arg 2"); } if (alen == 0 || blen == 0) { if (rb != ra) Safefree(rb); Safefree(ra); RETURN_EMPTY_SET_REF(); } if (atype == IARR_TYPE_BAD || btype == IARR_TYPE_BAD) stype = IARR_TYPE_BAD; else stype = type_of_sumset(atype, btype, ra[0],ra[alen-1], rb[0],rb[blen-1]); if (stype == IARR_TYPE_BAD) { if (rb != ra) Safefree(rb); Safefree(ra); DISPATCHPP(); XSRETURN(1); } sign = IARR_TYPE_TO_STATUS(stype); /* Sumset */ s = iset_create( 10UL * (alen+blen) ); for (i = 0; i < alen; i++) for (j = 0; j < blen; j++) iset_add(&s, ra[i]+rb[j], sign); if (rb != ra) Safefree(rb); Safefree(ra); RETURN_SET_REF(s); void setbinop(IN SV* block, IN SV* sva, IN SV* svb = 0) PROTOTYPE: &$;$ PREINIT: int atype, btype; UV *ra, *rb; Size_t alen, blen; CODE: /* Must be CODE and not PPCODE */ #if PERL_VERSION_GE(5,10,1) atype = arrayref_to_int_array(aTHX_ &alen, &ra, 1, sva, "setbinop arg 1"); if (svb == 0 || atype == IARR_TYPE_BAD) { rb = ra; blen = alen; btype = atype; } else { btype = arrayref_to_int_array(aTHX_ &blen, &rb, 1, svb, "setbinop arg 2"); } if (alen == 0 || blen == 0) { if (rb != ra) Safefree(rb); Safefree(ra); RETURN_EMPTY_SET_REF(); } if (atype != IARR_TYPE_BAD && btype != IARR_TYPE_BAD) { iset_t s; Size_t i, j; GV *agv, *bgv; SV *asv, *bsv; UV ret; CV *subcv; int status = 0; SETSUBREF(subcv, block); agv = gv_fetchpv("a", GV_ADD, SVt_PV); bgv = gv_fetchpv("b", GV_ADD, SVt_PV); SAVESPTR(GvSV(agv)); SAVESPTR(GvSV(bgv)); asv = NEWSVINT(0,0); bsv = NEWSVINT(0,0); GvSV(agv) = asv; GvSV(bgv) = bsv; s = iset_create( 4UL * ((size_t)alen + (size_t)blen + 2) ); #ifdef dMULTICALL if (!CvISXSUB(subcv)) { dMULTICALL; I32 gimme = G_SCALAR; DECL_MULTICALL_SCOPE(subcv); PUSH_MULTICALL(subcv); for (i = 0; i < alen; i++) { for (j = 0; j < blen; j++) { FASTSETSVINT(asv, atype == IARR_TYPE_POS, ra[i]); FASTSETSVINT(bsv, btype == IARR_TYPE_POS, rb[j]); SCOPED_MULTICALL; status = _validate_and_set(&ret, aTHX_ *PL_stack_sp, IFLAG_ANY); if (status != 0) iset_add(&s, ret, status); if (status == 0 || iset_is_invalid(s)) break; } if (j < blen) break; } FIX_MULTICALL_REFCOUNT; POP_MULTICALL; } else #endif { for (i = 0; i < alen; i++) { for (j = 0; j < blen; j++) { dSP; FASTSETSVINT(asv, atype == IARR_TYPE_POS, ra[i]); FASTSETSVINT(bsv, btype == IARR_TYPE_POS, rb[j]); PUSHMARK(SP); call_sv((SV*)subcv, G_SCALAR); status = _validate_and_set(&ret, aTHX_ *PL_stack_sp, IFLAG_ANY); if (status != 0) iset_add(&s, ret, status); if (status == 0 || iset_is_invalid(s)) break; } if (j < blen) break; } } /* asv and bsv are going to be freed with agv and bgv. */ if (status != 0 && !iset_is_invalid(s)) { if (rb != ra) Safefree(rb); Safefree(ra); RETURN_SET_REF(s); } iset_destroy(&s); } if (rb != ra) Safefree(rb); Safefree(ra); #endif DISPATCHPP(); XSRETURN(1); void setunion(IN SV* sva, IN SV* svb) PROTOTYPE: $$ ALIAS: setintersect = 1 setminus = 2 setdelta = 3 PREINIT: int atype, btype; UV *ra, *rb; size_t alen, blen; PPCODE: /* Fast path: both inputs are arrayrefs of native non-negative sorted * unique integers. Merge SV* directly with SvREFCNT_inc, skipping * intermediate UV array allocations and per-element newSVuv calls. */ { size_t fa, fb; SV **aa = _check_sorted_nonneg_arrayref(aTHX_ sva, &fa); SV **bb = aa ? _check_sorted_nonneg_arrayref(aTHX_ svb, &fb) : NULL; if (aa && bb) { int inc_eq = (ix == 0 || ix == 1); /* union, intersect */ int inc_lt = (ix != 1); /* union, minus, delta */ int inc_gt = (ix == 0 || ix == 3); /* union, delta */ size_t maxlen = (ix == 1) ? (fa < fb ? fa : fb) : fa + fb; AV *res = newAV(); size_t rlen = 0, ia = 0, ib = 0; av_extend(res, (SSize_t)maxlen - 1); SV **ar = AvARRAY(res); while (ia < fa && ib < fb) { UV va = SvUVX(aa[ia]), vb = SvUVX(bb[ib]); if (va==vb) {if (inc_eq) ar[rlen++]=SvREFCNT_inc(aa[ia]); ia++; ib++;} else if (va< vb) {if (inc_lt) ar[rlen++]=SvREFCNT_inc(aa[ia]); ia++;} else {if (inc_gt) ar[rlen++]=SvREFCNT_inc(bb[ib]); ib++;} } if (inc_lt) while (ia < fa) ar[rlen++] = SvREFCNT_inc(aa[ia++]); if (inc_gt) while (ib < fb) ar[rlen++] = SvREFCNT_inc(bb[ib++]); AvFILLp(res) = (SSize_t)rlen - 1; ST(0) = sv_2mortal(newRV_noinc((SV*)res)); XSRETURN(1); } } /* Get the integers and ensure they are sorted unique integers first. */ atype = arrayref_to_int_array(aTHX_ &alen, &ra, 1, sva, SUBNAME); btype = arrayref_to_int_array(aTHX_ &blen, &rb, 1, svb, SUBNAME); if (CAN_COMBINE_IARR_TYPES(atype,btype)) { UV *r = 0; size_t rlen = 0, ia = 0, ib = 0; int pcmp = (atype == IARR_TYPE_NEG || btype == IARR_TYPE_NEG) ? 0 : 1; if (ix == 0) { /* union */ New(0, r, alen + blen, UV); while (ia < alen && ib < blen) { if (ra[ia] == rb[ib]) { r[rlen++] = ra[ia]; ia++; ib++; } else { if (SIGNED_CMP_LT(pcmp, ra[ia], rb[ib])) r[rlen++] = ra[ia++]; else r[rlen++] = rb[ib++]; } } if (ia < alen) { Copy(ra+ia, r+rlen, alen-ia, UV); rlen += alen-ia; } if (ib < blen) { Copy(rb+ib, r+rlen, blen-ib, UV); rlen += blen-ib; } } else if (ix == 1) { /* intersect */ New(0, r, (alen < blen) ? alen : blen, UV); while (ia < alen && ib < blen) { if (ra[ia] == rb[ib]) { r[rlen++] = ra[ia]; ia++; ib++; } else { if (SIGNED_CMP_LT(pcmp, ra[ia], rb[ib])) ia++; else ib++; } } } else if (ix == 2) { /* minus (difference) */ New(0, r, alen, UV); while (ia < alen && ib < blen) { if (ra[ia] == rb[ib]) { ia++; ib++; } else { if (SIGNED_CMP_LT(pcmp, ra[ia], rb[ib])) r[rlen++] = ra[ia++]; else ib++; } } if (ia < alen) { Copy(ra+ia, r+rlen, alen-ia, UV); rlen += alen-ia; } } else if (ix == 3) { /* delta (symmetric difference) */ New(0, r, alen + blen, UV); while (ia < alen && ib < blen) { if (ra[ia] == rb[ib]) { ia++; ib++; } else { if (SIGNED_CMP_LT(pcmp, ra[ia], rb[ib])) r[rlen++] = ra[ia++]; else r[rlen++] = rb[ib++]; } } if (ia < alen) { Copy(ra+ia, r+rlen, alen-ia, UV); rlen += alen-ia; } if (ib < blen) { Copy(rb+ib, r+rlen, blen-ib, UV); rlen += blen-ib; } } Safefree(ra); Safefree(rb); RETURN_LIST_REF(rlen, r, pcmp); } /* if (atype != IARR_TYPE_BAD && btype != IARR_TYPE_BAD) { .. isets .. } */ Safefree(ra); Safefree(rb); DISPATCHPP(); XSRETURN(1); void set_is_disjoint(IN SV* sva, IN SV* svb) PROTOTYPE: $$ ALIAS: set_is_equal = 1 set_is_subset = 2 set_is_proper_subset = 3 set_is_superset = 4 set_is_proper_superset = 5 set_is_proper_intersection = 6 PREINIT: int atype, btype, ret; UV *ra, *rb; size_t alen, blen, inalen, inblen; PPCODE: /* If one set is much smaller than the other, it would be faster using * is_in_set(). We'll keep things simple and slurp in both sets. */ /* THIS ASSUMES THE INPUT LISTS HAVE NO DUPLICATES */ inalen = inblen = 0; if (SvROK(sva) && SvTYPE(SvRV(sva)) == SVt_PVAV && SvROK(svb) && SvTYPE(SvRV(svb)) == SVt_PVAV) { /* Shortcut on length if we can to skip intersection. */ inalen = av_count((AV*) SvRV(sva)); inblen = av_count((AV*) SvRV(svb)); if ( (ix == 1 && inalen != inblen) || (ix == 2 && inalen < inblen) || (ix == 3 && inalen <= inblen) || (ix == 4 && inalen > inblen) || (ix == 5 && inalen >= inblen) ) RETURN_NPARITY(0); } /* Get the integers as sorted arrays of IV or UV */ atype = arrayref_to_int_array(aTHX_ &alen, &ra, 1, sva, SUBNAME); btype = arrayref_to_int_array(aTHX_ &blen, &rb, 1, svb, SUBNAME); if (CAN_COMBINE_IARR_TYPES(atype,btype)) { size_t rlen = 0, ia = 0, ib = 0; int pcmp = (atype == IARR_TYPE_NEG || btype == IARR_TYPE_NEG) ? 0 : 1; while (ia < alen && ib < blen) { if (ra[ia] == rb[ib]) { rlen++; ia++; ib++; } else { if (SIGNED_CMP_LT(pcmp, ra[ia], rb[ib])) ia++; else ib++; } } Safefree(ra); Safefree(rb); ret = 0; switch (ix) { case 0: if (rlen == 0) ret = 1; break; case 1: if (alen == blen && rlen == blen) ret = 1; break; case 2: if (alen >= blen && rlen == blen) ret = 1; break; case 3: if (alen > blen && rlen == blen) ret = 1; break; case 4: if (alen <= blen && rlen == alen) ret = 1; break; case 5: if (alen < blen && rlen == alen) ret = 1; break; case 6: default:if (rlen > 0 && rlen < alen && rlen < blen) ret = 1; break; } RETURN_NPARITY(ret); } Safefree(ra); Safefree(rb); DISPATCHPP(); XSRETURN(1); void setcontains(IN SV* sva, ...) ALIAS: setcontainsany = 1 PROTOTYPE: $@ PREINIT: UV b; AV *ava; int bstatus, subset, findall; Size_t alen, blen, i; DECL_ARREF(arb); PPCODE: CHECK_ARRAYREF(sva); /* First argument is a set as array ref */ ava = (AV*) SvRV(sva); alen = av_count(ava); if (items < 2) RETURN_NPARITY(1); if (SvMAGICAL(ava) || !AvREAL(ava)) { /* Punt these to Perl */ DISPATCHPP(); XSRETURN(1); } findall = ix == 0 ? 1 : 0; if (items == 2 && SvROK(ST(1)) && SvTYPE(SvRV(ST(1))) == SVt_PVAV) { set_data_t svcache; USE_ARREF(arb, ST(1), SUBNAME, AR_READ); /* If setcontainsany and B is bigger than A, swap them for performance. */ if (ix == 1 && len_arb > alen && svarr_arb != 0) { ava = avp_arb; alen = len_arb; USE_ARREF(arb, ST(0), SUBNAME, AR_READ); } blen = len_arb; subset = ix == 0 && blen > alen ? 0 : findall; _sc_clear_cache(&svcache); /* setcontains: if we find anything that is NOT in SETA, return 0 * setcontainsany: if we find anything that IS in SETA, return 1 */ for (i = 0; i < blen && subset == findall; i++) { bstatus = _validate_and_set(&b, aTHX_ FETCH_ARREF(arb,i), IFLAG_ANY); subset = is_in_set(aTHX_ ava, &svcache, bstatus, b); } } else { UV *rb; int btype = array_to_int_array(aTHX_ &blen, &rb, 1, &ST(1), items-1); bstatus = IARR_TYPE_TO_STATUS(btype); subset = bstatus == 0 ? -1 : ix == 0 && blen > alen ? 0 : findall; if (blen <= 4) { for (i = 0; i < blen && subset == findall; i++) subset = is_in_set(aTHX_ ava, 0, bstatus, rb[i]); } else { set_data_t svcache; _sc_clear_cache(&svcache); for (i = 0; i < blen && subset == findall; i++) subset = is_in_set(aTHX_ ava, &svcache, bstatus, rb[i]); } Safefree(rb); } if (subset != -1) RETURN_NPARITY(subset); DISPATCHPP(); XSRETURN(1); void setinsert(IN SV* sva, ...) PROTOTYPE: $@ PREINIT: AV *ava; Size_t alen, blen, i; UV *rb; int btype, bstatus; PPCODE: CHECK_ARRAYREF(sva); /* First argument is a set as array ref */ ava = (AV*) SvRV(sva); alen = av_count(ava); if (items < 2) RETURN_NPARITY(0); CHECK_AV_NOT_READONLY(ava); /* We intend to modify it */ if (SvMAGICAL(ava) || !AvREAL(ava)) { /* Punt these to Perl */ DISPATCHPP(); XSRETURN(1); } if (SvROK(ST(1)) && SvTYPE(SvRV(ST(1))) == SVt_PVAV) { if (items != 2) croak("setinsert: expected integer list or single array reference"); btype = arrayref_to_int_array(aTHX_ &blen, &rb, 1, ST(1), "setinsert"); } else { btype = array_to_int_array(aTHX_ &blen, &rb, 1, &ST(1), items-1); } bstatus = IARR_TYPE_TO_STATUS(btype); if (bstatus != 0 && blen <= 4) { int res = 0; size_t nins = 0; for (i = 0; res >= 0 && i < blen; i++) { res = ins_into_set(aTHX_ ava, bstatus, rb[i]); nins += (res > 0); } if (res >= 0) { Safefree(rb); RETURN_NPARITY(nins); } } else if (bstatus != 0) { size_t nbeg, nmid, nend, nmidcheck; int alostatus, ahistatus; UV alo, ahi; set_data_t svcache; /* 1. ava is empty. push everything and we're done. */ if (alen == 0) { av_extend(ava, blen); for (i = 0; i < blen; i++) av_push(ava, NEWSVINT(bstatus, rb[i])); Safefree(rb); RETURN_NPARITY(blen); } _sc_clear_cache(&svcache); /* Get hi and lo values of set. */ if (_sc_set_lohi(aTHX_ AvARRAY(ava), &svcache, 0, alen-1, &alostatus, &ahistatus, &alo, &ahi) >= 0) { if (_sign_cmp(alostatus,alo,ahistatus,ahi) > 0) croak("%s: expected numerically ascending sorted input", SUBNAME); /* Both lo/hi are not bigint, so there are no bigints in the set. */ nbeg = nend = nmid = 0; /* 1. Find out how many elements go in front. */ while (nbeg < blen && _sign_cmp(bstatus,rb[nbeg],alostatus,alo) < 0) nbeg++; /* 2. Find out how many elements go at the end. */ while (nend < blen-nbeg && _sign_cmp(bstatus,rb[blen-1-nend],ahistatus,ahi) > 0) nend++; /* 3. In-place insert everything in the middle. */ nmidcheck = blen - nbeg - nend; if (nmidcheck > 0) { size_t *insert_idx; SV **insert_sv; New(0, insert_idx, nmidcheck, size_t); New(0, insert_sv, nmidcheck, SV*); for (i = nbeg; bstatus != 0 && i < blen-nend; i++) { int index = insert_index_in_set(aTHX_ ava,&svcache,bstatus,rb[i]); if (index < 0) croak("%s: expected sorted input, found bigint value in interior", SUBNAME); if (index > 0) { insert_sv[nmid] = NEWSVINT(bstatus,rb[i]);/* Value to insert */ insert_idx[nmid] = index-1; /* Where to insert */ nmid++; } } av_extend(ava, alen + nmid + nbeg + nend); if (nmid > 0) { SV** arr; unsigned long index_lastorig = alen-1; unsigned long index_moveto = index_lastorig + nmid; /* Push new values on end so Perl calculates array correctly. */ for (i = 0; i < nmid; i++) av_push(ava, insert_sv[i]); arr = AvARRAY(ava); /* SV* pointer manipulation to insert new values in place. */ for (i = 0; i < nmid; i++) { size_t j = nmid-1-i; size_t idx = insert_idx[j]; size_t nmove = index_lastorig - idx + 1; if (nmove > 0) { size_t moveto = index_moveto - nmove + 1; memmove(arr+moveto, arr+idx, sizeof(SV*) * nmove); index_lastorig -= nmove; index_moveto -= nmove; } arr[index_moveto--] = insert_sv[j]; } } Safefree(insert_sv); Safefree(insert_idx); } /* 4. Insert at front */ if (nbeg > 0) { av_unshift(ava, nbeg); for (i = 0; i < nbeg; i++) av_store(ava, i, NEWSVINT(bstatus, rb[i])); } /* 5. Push onto back */ if (nend > 0) { for (i = 0; i < nend; i++) av_push(ava, NEWSVINT(bstatus, rb[blen-nend+i])); } Safefree(rb); RETURN_NPARITY(nbeg+nmid+nend); } } Safefree(rb); DISPATCHPP(); XSRETURN(1); void setremove(IN SV* sva, ...) PROTOTYPE: $@ PREINIT: AV *ava; Size_t alen, blen, i; UV *rb; int btype, bstatus; PPCODE: CHECK_ARRAYREF(sva); /* First argument is a set as array ref */ ava = (AV*) SvRV(sva); alen = av_count(ava); if (alen == 0 || items < 2) RETURN_NPARITY(0); CHECK_AV_NOT_READONLY(ava); /* We intend to modify it */ if (SvMAGICAL(ava) || !AvREAL(ava)) { /* Punt these to Perl */ DISPATCHPP(); XSRETURN(1); } if (SvROK(ST(1)) && SvTYPE(SvRV(ST(1))) == SVt_PVAV) { if (items != 2) croak("setremove: expected integer list or single array reference"); btype = arrayref_to_int_array(aTHX_ &blen, &rb, 1, ST(1), "setremove"); } else { btype = array_to_int_array(aTHX_ &blen, &rb, 1, &ST(1), items-1); } if (btype != IARR_TYPE_BAD) { bstatus = IARR_TYPE_TO_STATUS(btype); if (blen <= 5 || alen <= 20) { /* SIMPLE DELETE LOOP */ int res = 0; size_t ndel = 0; for (i = 0; res >= 0 && i < blen; i++) { res = del_from_set(aTHX_ ava, bstatus, rb[i]); if (res > 0) ndel++; } if (res >= 0) { Safefree(rb); RETURN_NPARITY(ndel); } } else if (blen < 500 || (blen*100) < alen) { /* ONE PASS DELETE */ Size_t *del_idx, ndel = 0; set_data_t svcache; _sc_clear_cache(&svcache); /* Create index list to remove */ New(0, del_idx, blen, Size_t); for (i = 0; i < blen; i++) { int index = index_in_set(aTHX_ ava, &svcache, bstatus, rb[i]); if (index < 0) croak("%s: expected sorted input, found bigint value in interior", SUBNAME); if (index > 0) del_idx[ndel++] = index-1; } Safefree(rb); if (ndel > 0) { SV **arr = AvARRAY(ava); size_t to = del_idx[0]; for (i = 0; i < ndel; i++) { size_t idx = del_idx[i]; size_t beg = idx+1; size_t len = (i+1) >= ndel ? alen-beg : del_idx[i+1]-beg; SvREFCNT_dec_NN(arr[idx]); if (len > 0) { memmove(arr+to, arr+beg, sizeof(SV*) * len); to += len; } } Zero(arr + alen - ndel, ndel, SV*); av_fill(ava, alen-ndel-1); } Safefree(del_idx); RETURN_NPARITY(ndel); } else { /* CLEAR AND GREP */ int atype, astatus, del_complete = 0; UV *ra = 0; atype = arrayref_to_int_array(aTHX_ &alen, &ra, 1, sva, SUBNAME); if (CAN_COMBINE_IARR_TYPES(atype,btype)) { size_t ia = 0, ib = 0; int pcmp = (atype == IARR_TYPE_NEG || btype == IARR_TYPE_NEG) ? 0 : 1; astatus = IARR_TYPE_TO_STATUS(atype); av_clear(ava); while (ia < alen && ib < blen) { if (ra[ia] == rb[ib]) { ia++; ib++; } else { if (SIGNED_CMP_LT(pcmp, ra[ia], rb[ib])) av_push(ava, NEWSVINT(astatus, ra[ia++])); else ib++; } } while (ia < alen) av_push(ava, NEWSVINT(astatus, ra[ia++])); del_complete = 1; } Safefree(ra); Safefree(rb); if (del_complete) RETURN_NPARITY(alen - av_count(ava)); } } DISPATCHPP(); XSRETURN(1); void setinvert(IN SV* sva, ...) PROTOTYPE: $@ PREINIT: AV *ava; Size_t alen, blen, i; UV *rb; int btype, bstatus; PPCODE: CHECK_ARRAYREF(sva); ava = (AV*) SvRV(sva); alen = av_count(ava); if (items < 2) RETURN_NPARITY(0); CHECK_AV_NOT_READONLY(ava); if (SvMAGICAL(ava) || !AvREAL(ava)) { DISPATCHPP(); XSRETURN(1); } if (SvROK(ST(1)) && SvTYPE(SvRV(ST(1))) == SVt_PVAV) { if (items != 2) croak("setinvert: expected integer list or single array reference"); btype = arrayref_to_int_array(aTHX_ &blen, &rb, 1, ST(1), "setinvert"); } else { btype = array_to_int_array(aTHX_ &blen, &rb, 1, &ST(1), items-1); } if (btype != IARR_TYPE_BAD) { if (blen == 0) { Safefree(rb); RETURN_NPARITY(0); } bstatus = IARR_TYPE_TO_STATUS(btype); if (blen <= 4 || alen <= 20) { /* SIMPLE TOGGLE LOOP */ IV ndelta = 0; int res = 0; for (i = 0; res >= 0 && i < blen; i++) { res = del_from_set(aTHX_ ava, bstatus, rb[i]); if (res > 0) { ndelta--; } /* found and removed */ else if (res == 0) { /* not found, insert */ res = ins_into_set(aTHX_ ava, bstatus, rb[i]); if (res > 0) ndelta++; } } if (res >= 0) { Safefree(rb); ST(0) = sv_2mortal(newSViv(ndelta)); XSRETURN(1); } } else { /* MERGE-STYLE SYMMETRIC DIFFERENCE */ int atype, astatus, done = 0; UV *ra = 0; Size_t old_alen = alen; atype = arrayref_to_int_array(aTHX_ &alen, &ra, 1, sva, SUBNAME); if (CAN_COMBINE_IARR_TYPES(atype, btype)) { size_t ia = 0, ib = 0; int pcmp = (atype == IARR_TYPE_NEG || btype == IARR_TYPE_NEG) ? 0 : 1; astatus = IARR_TYPE_TO_STATUS(atype); av_clear(ava); while (ia < alen && ib < blen) { if (ra[ia] == rb[ib]) { ia++; ib++; } else if (SIGNED_CMP_LT(pcmp, ra[ia], rb[ib])) av_push(ava, NEWSVINT(astatus, ra[ia++])); else av_push(ava, NEWSVINT(bstatus, rb[ib++])); } while (ia < alen) av_push(ava, NEWSVINT(astatus, ra[ia++])); while (ib < blen) av_push(ava, NEWSVINT(bstatus, rb[ib++])); done = 1; } Safefree(ra); if (done) { Safefree(rb); ST(0) = sv_2mortal(newSViv((IV)av_count(ava) - (IV)old_alen)); XSRETURN(1); } } } Safefree(rb); DISPATCHPP(); XSRETURN(1); void is_sidon_set(IN SV* sva) PROTOTYPE: $ PREINIT: int itype, is_sidon; size_t len, i, j; UV *data; iset_t s; PPCODE: itype = arrayref_to_int_array(aTHX_ &len, &data, 1, sva,"is_sidon_set"); if (itype == IARR_TYPE_NEG) { /* All elements must be non-negative. */ Safefree(data); RETURN_NPARITY(0); } /* If any bigints or we cannot add the values in 64-bits, call PP. */ if (itype == IARR_TYPE_BAD || itype == IARR_TYPE_POS) { Safefree(data); DISPATCHPP(); XSRETURN(1); } /* Check if the set is a Sidon set. */ is_sidon = 1; s = iset_create( 20UL * len ); for (i = 0; i < len && is_sidon; i++) for (j = i; j < len; j++) if (!iset_add(&s, data[i] + data[j], 1)) { is_sidon = 0; break; } Safefree(data); iset_destroy(&s); RETURN_NPARITY(is_sidon); void is_sumfree_set(IN SV* sva) PROTOTYPE: $ PREINIT: UV *data; size_t len, i, j; int itype; bool is_sumfree; PPCODE: itype = arrayref_to_int_array(aTHX_ &len, &data,1,sva,"is_sumfree_set"); if (itype != IARR_TYPE_BAD && len <= 1) { /* Degenerate cases: len 0 or 1 */ is_sumfree = len == 0 || data[0] != 0; Safefree(data); RETURN_NPARITY(is_sumfree); } /* Check for IV overflow on sum */ if (itype == IARR_TYPE_NEG) { IV min = data[0], max = data[len-1]; /* Array is sorted */ if (min < IV_MIN/2 || max > IV_MAX/2) itype = IARR_TYPE_BAD; } is_sumfree = 1; if (itype == IARR_TYPE_ANY) { for (i = 0; i < len && is_sumfree; i++) for (j = i; j < len; j++) if (is_in_sorted_uv_array(data[i]+data[j], data, len)) { is_sumfree = 0; break; } } else if (itype == IARR_TYPE_NEG) { for (i = 0; i < len && is_sumfree; i++) for (j = i; j < len; j++) if (is_in_sorted_iv_array((IV)data[i]+(IV)data[j], (IV*)data, len)) { is_sumfree = 0; break; } } Safefree(data); if (itype == IARR_TYPE_ANY || itype == IARR_TYPE_NEG) RETURN_NPARITY(is_sumfree); /* We're here because one of: * 1) itype is TYPE_BAD because there were bigints. * 2) itype is TYPE_BAD because summed IVs would overflow. * 3) itype is TYPE_POS. * At least one element is >= 2^63, so we would overflow on sum. */ DISPATCHPP(); XSRETURN(1); void toset(...) PROTOTYPE: @ PREINIT: int type; size_t len; UV *L; PPCODE: if (items == 0) RETURN_EMPTY_SET_REF(); type = array_to_int_array(aTHX_ &len, &L, 1, &ST(0), items); if (type != IARR_TYPE_BAD) RETURN_LIST_REF(len, L, type != IARR_TYPE_NEG); Safefree(L); DISPATCHPP(); XSRETURN(1); void vecsort(...) PROTOTYPE: @ PREINIT: int type; size_t len; UV *L; PPCODE: if (items == 0) XSRETURN_EMPTY; if (SvROK(ST(0)) && SvTYPE(SvRV(ST(0))) == SVt_PVAV) { if (items != 1) croak("vecsort: expected integer list or single array reference"); type = arrayref_to_int_array(aTHX_ &len, &L, 0, ST(0), "vecsort"); } else { type = array_to_int_array(aTHX_ &len, &L, 0, &ST(0), items); } if (GIMME_V != G_ARRAY) /* In scalar context, return number of elements */ XSRETURN_UV(len); if (type == IARR_TYPE_ANY || type == IARR_TYPE_POS) { sort_uv_array(L, len); } else if (type == IARR_TYPE_NEG) { sort_iv_array((IV*)L, len); } else { Safefree(L); DISPATCHPP(); return; } RETURN_LIST_VALS( len, L, (type != IARR_TYPE_NEG) ); void vecsorti(IN SV* sva) PROTOTYPE: $ PREINIT: int type; size_t i, len; UV *L; SV **arr; AV *ava; PPCODE: CHECK_ARRAYREF(sva); ava = (AV*) SvRV(sva); CHECK_AV_NOT_READONLY(ava); /* We intend to modify it */ if (SvMAGICAL(ava) || !AvREAL(ava)) { /* Punt these to Perl */ DISPATCHPP(); XSRETURN(1); } type = arrayref_to_int_array(aTHX_ &len, &L, 0, sva, "vecsorti"); /* If we really wanted to optimize small values, the reading function * could create a mask like: * mask |= (istatus == 1) ? n : (n ^ (n<<1)); * then we know if the input is 8-bit, 16-bit, 32-bit, etc. */ if (type == IARR_TYPE_ANY || type == IARR_TYPE_POS) { sort_uv_array(L, len); } else if (type == IARR_TYPE_NEG) { sort_iv_array((IV*)L, len); } else { Safefree(L); DISPATCHPP(); XSRETURN(1); } arr = AvARRAY(ava); for (i = 0; i < len; i++) FASTSETSVINT(arr[i], type == IARR_TYPE_POS, L[i]); Safefree(L); XSRETURN(1); 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_and_set(&k, aTHX_ svk, IFLAG_ABS) == 1) { if (num_to_perm(k, n, S)) { dMY_CXT; EXTEND(SP, (EXTEND_TYPE)n); for (i = 0; i < (int)n; i++) PUSH_NPARITY( S[i] ); XSRETURN(n); } } DISPATCHPP(); XSRETURN(1); void permtonum(IN SV* svp) PREINIT: UV val, num; Size_t i, plen; DECL_ARREF(avp); PPCODE: USE_ARREF(avp, svp, SUBNAME, AR_READ); plen = len_avp; if (plen <= 20) { int V[21], A[21] = {0}; for (i = 0; i < plen; i++) { SV *iv = FETCH_ARREF(avp,i); if (_validate_and_set(&val, aTHX_ iv, IFLAG_POS) != 1) break; if (val >= plen || A[val] != 0) break; A[val] = i+1; V[i] = val; } if (i >= plen && perm_to_num(plen, V, &num)) XSRETURN_UV(num); } DISPATCHPP(); objectify_result(aTHX_ svp, 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, (EXTEND_TYPE)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: SSize_t i, j; void* randcxt; dMY_CXT; PPCODE: if (items == 0) XSRETURN_EMPTY; for (i = 0, randcxt = MY_CXT.randcxt; i < items-1; i++) { j = urandomm64(randcxt, items-i); { SV* t = ST(i); ST(i) = ST(i+j); ST(i+j) = t; } } XSRETURN(items); void vecsample(IN SV* svk, ...) PROTOTYPE: $@ PREINIT: void *randcxt; UV k; Size_t nitems, i; dMY_CXT; PPCODE: if (items == 1) XSRETURN_EMPTY; randcxt = MY_CXT.randcxt; /* * Fisher-Yates shuffle with first 'k' selections returned. * * There is only one algorithm here, no shortcuts other than * detecting an empty list. * * With a list input, the input is on the stack ST(1),ST(2),... * We move the last item to ST(0) then shuffle 'k' iterations. * * With an array reference input, we cannot modify the input at all. * We create an index array and shuffle using that. Remembering to * act like the last item is at the front so we match the list results. * We optimize by pushing each selection onto the return stack as * we find it rather than pushing them all at the end with another loop. */ if (items > 2 || !SvROK(ST(1)) || SvTYPE(SvRV(ST(1))) != SVt_PVAV) { /* Standard form, where we are given an array of items */ nitems = items-1; if (_validate_and_set(&k, aTHX_ svk, IFLAG_POS) == 0 || k > nitems) k = nitems; ST(0) = ST(items-1); /* Move last value to the first stack entry. */ for (i = 0; i < k; i++) { uint32_t j = urandomm32(randcxt, nitems-i); { SV* t = ST(i); ST(i) = ST(i+j); ST(i+j) = t; } } } else { /* We are given a single array reference. Select from it. */ DECL_ARREF(avp); USE_ARREF(avp, ST(1), SUBNAME, AR_READ); nitems = len_avp; if (_validate_and_set(&k, aTHX_ svk, IFLAG_POS) == 0 || k > nitems) k = nitems; if (k == 0) XSRETURN_EMPTY; if (nitems < 65536) { uint16_t *I; New(0, I, nitems, uint16_t); I[0] = nitems-1; for (i = 1; i < nitems; i++) I[i] = i-1; EXTEND(SP, (EXTEND_TYPE)k); for (i = 0; i < k; i++) { uint32_t j = urandomm32(randcxt, nitems-i); uint16_t t = I[i+j]; I[i+j] = I[i]; PUSHs(FETCH_ARREF(avp,t)); } Safefree(I); } else { size_t *I; New(0, I, nitems, size_t); I[0] = nitems-1; for (i = 1; i < nitems; i++) I[i] = i-1; EXTEND(SP, (EXTEND_TYPE)k); for (i = 0; i < k; i++) { size_t j = urandomm64(randcxt, nitems-i); size_t t = I[i+j]; I[i+j] = I[i]; PUSHs(FETCH_ARREF(avp,t)); } Safefree(I); } } XSRETURN(k); void is_happy(SV* svn, UV base = 10, UV k = 2) PREINIT: UV n, sum; int h, status; PPCODE: if (base < 2 || base > 36) croak("is_happy: invalid base %"UVuf, base); if (k > 10) croak("is_happy: invalid exponent %"UVuf, k); status = _validate_and_set(&n, aTHX_ svn, IFLAG_POS); if (status == 0 && base == 10) { /* String op to reduce into range. */ STRLEN i, len; const char* s = SvPV(svn, len); if (len <= UV_MAX/ipow(9,k)) { for (sum = 0, i = 0; i < len; i++) sum += ipow(s[i]-'0',k); h = happy_height(sum, base, k); RETURN_NPARITY( (h>0) ? h+1 : 0); } } if (status != 0) RETURN_NPARITY(happy_height(n, base, k)); DISPATCHPP(); XSRETURN(1); 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("%s: invalid base: %d", SUBNAME, base); status = 0; if (ix == 0 || ix == 1) { status = _validate_and_set(&n, aTHX_ svn, IFLAG_ABS); } /* 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, (EXTEND_TYPE)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, (EXTEND_TYPE)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_digit_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); } } DISPATCHPP(); if (ix == 2) objectify_result(aTHX_ 0, ST(0)); return; void tozeckendorf(SV* svn) PREINIT: UV n; PPCODE: if (_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) { char *str = to_zeckendorf(n); XPUSHs(sv_2mortal(newSVpv(str, 0))); Safefree(str); XSRETURN(1); } DISPATCHPP(); XSRETURN(1); void fromzeckendorf(IN char* str) PREINIT: int status; PPCODE: status = validate_zeckendorf(str); if (status == 0) croak("fromzeckendorf: expected binary string"); if (status == -1) croak("fromzeckendorf: expected binary string in canonical Zeckendorf form"); if (status == 1) XSRETURN_UV(from_zeckendorf(str)); DISPATCHPP(); XSRETURN(1); 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: SV* svarg; CV *subcv; unsigned char* segment; UV beg, end, seg_base, seg_low, seg_high; DECL_FORCOUNT; dMY_CXT; PPCODE: SETSUBREF(subcv, block); if (!_validate_and_set(&beg, aTHX_ svbeg, IFLAG_POS) || (svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_POS))) { DISPATCH_VOIDPP(); XSRETURN(0); } if (!svend) { end = beg; beg = 2; } START_FORCOUNT; SAVESPTR(GvSV(PL_defgv)); svarg = newSVuv(beg); GvSV(PL_defgv) = svarg; /* Handle early part */ #if USE_MULTICALL if (!CvISXSUB(subcv) && beg <= end) { dMULTICALL; I32 gimme = G_VOID; DECL_MULTICALL_SCOPE(subcv); PUSH_MULTICALL(subcv); if (beg < 6) { beg = (beg <= 2) ? 2 : (beg <= 3) ? 3 : 5; for ( ; beg < 6 && beg <= end; beg += 1+(beg>2) ) { CHECK_FORCOUNT; sv_setuv(svarg, beg); SCOPED_MULTICALL; } } if (beg <= end) { 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); SCOPED_MULTICALL; } } 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); } SCOPED_MULTICALL; END_DO_FOR_EACH_SIEVE_PRIME CHECK_FORCOUNT; } end_segment_primes(ctx); } } FIX_MULTICALL_REFCOUNT; POP_MULTICALL; } else #endif { if (beg < 6) { beg = (beg <= 2) ? 2 : (beg <= 3) ? 3 : 5; for ( ; beg < 6 && beg <= end; beg += 1+(beg>2) ) { sv_setuv(svarg, beg); PUSHMARK(SP); PUTBACK; call_sv((SV*)subcv, G_VOID|G_DISCARD); SPAGAIN; CHECK_FORCOUNT; } } 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); PUTBACK; call_sv((SV*)subcv, G_VOID|G_DISCARD); SPAGAIN; 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; SV* svarg; /* We use svarg to prevent clobbering $_ outside the block */ CV *subcv; DECL_FORCOUNT; dMY_CXT; PPCODE: SETSUBREF(subcv, block); if (!_validate_and_set(&beg, aTHX_ svbeg, IFLAG_POS) || (svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_POS))) { DISPATCH_VOIDPP(); XSRETURN(0); } if (!svend) { end = beg; beg = ix ? 4 : 9; } START_FORCOUNT; SAVESPTR(GvSV(PL_defgv)); svarg = newSVuv(0); GvSV(PL_defgv) = svarg; #if USE_MULTICALL if (!CvISXSUB(subcv) && 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; DECL_MULTICALL_SCOPE(subcv); PUSH_MULTICALL(subcv); 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); SCOPED_MULTICALL; } 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); SCOPED_MULTICALL; 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); } SCOPED_MULTICALL; } 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); SCOPED_MULTICALL; } } 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); PUTBACK; call_sv((SV*)subcv, G_VOID|G_DISCARD); SPAGAIN; CHECK_FORCOUNT; } } } SvREFCNT_dec(svarg); END_FORCOUNT; void forsemiprimes (SV* block, IN SV* svbeg, IN SV* svend = 0) PROTOTYPE: &$;$ PREINIT: UV beg, end; SV* svarg; /* We use svarg to prevent clobbering $_ outside the block */ CV *subcv; DECL_FORCOUNT; dMY_CXT; PPCODE: SETSUBREF(subcv, block); if (!_validate_and_set(&beg, aTHX_ svbeg, IFLAG_POS) || (svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_POS))) { DISPATCH_VOIDPP(); XSRETURN(0); } if (!svend) { end = beg; beg = 4; } 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(subcv) && end >= beg) { UV c, seg_beg, seg_end, *S, count; dMULTICALL; I32 gimme = G_VOID; DECL_MULTICALL_SCOPE(subcv); PUSH_MULTICALL(subcv); 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 ) { for (c = beg; c <= end && c >= beg; c++) { if (is_semiprime(c)) { sv_setuv(svarg, c); SCOPED_MULTICALL; } 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]); SCOPED_MULTICALL; 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); PUTBACK; call_sv((SV*)subcv, G_VOID|G_DISCARD); SPAGAIN; CHECK_FORCOUNT; } } } SvREFCNT_dec(svarg); END_FORCOUNT; void foralmostprimes (SV* block, IN UV k, IN SV* svbeg, IN SV* svend = 0) PROTOTYPE: &$$;$ PREINIT: UV c, beg, end, shiftres; SV* svarg; /* We use svarg to prevent clobbering $_ outside the block */ CV *subcv; DECL_FORCOUNT; dMY_CXT; PPCODE: SETSUBREF(subcv, block); if (!_validate_and_set(&beg, aTHX_ svbeg, IFLAG_POS) || (svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_POS))) { DISPATCH_VOIDPP(); XSRETURN(0); } if (!svend) { end = beg; beg = 1; } /* If k is over 63 but the beg/end points are UVs, then we're empty. */ if (k == 0 || k >= BITS_PER_WORD) XSRETURN(0); if (beg < (UVCONST(1) << k)) beg = UVCONST(1) << k; if (end > max_nth_almost_prime(k)) end = max_nth_almost_prime(k); if (beg > end) XSRETURN(0); /* We might be able to reduce the k value. */ shiftres = 0; if (k > MPU_MAX_POW3) shiftres = k - MPU_MAX_POW3; while ((k-shiftres) > 1 && (end >> shiftres) < ipow(3, k - shiftres)) shiftres++; beg = (beg >> shiftres) + (((beg >> shiftres) << shiftres) < beg); end = end >> shiftres; k -= shiftres; /* k <= 40 (64-bit) or 20 (32-bit). */ START_FORCOUNT; SAVESPTR(GvSV(PL_defgv)); svarg = newSVuv(0); GvSV(PL_defgv) = svarg; #if USE_MULTICALL if (!CvISXSUB(subcv) && end >= beg) { UV seg_beg, seg_end, *S, count, k3 = ipow(3,k); dMULTICALL; I32 gimme = G_VOID; DECL_MULTICALL_SCOPE(subcv); PUSH_MULTICALL(subcv); while (beg <= end) { /* TODO: Tuning this better would be nice */ UV ssize = 65536 * 256; seg_beg = beg; seg_end = end; if (k > 12) ssize *= 16; if (k > 18 || seg_beg > 9*k3) ssize *= 4; if (k > 24 || seg_beg > 81*k3) ssize *= 3; if ((seg_end - seg_beg) > ssize) seg_end = seg_beg + ssize - 1; count = generate_almost_primes(&S, k, seg_beg, seg_end); for (c = 0; c < count; c++) { sv_setuv(svarg, S[c] << shiftres); SCOPED_MULTICALL; CHECK_FORCOUNT; } Safefree(S); if (seg_end == UV_MAX) break; beg = seg_end+1; CHECK_FORCOUNT; } FIX_MULTICALL_REFCOUNT; POP_MULTICALL; } else #endif if (beg <= end) { for (c = beg; c <= end && c >= beg; c++) { if (is_almost_prime(k,c)) { sv_setuv(svarg, c << shiftres); PUSHMARK(SP); PUTBACK; call_sv((SV*)subcv, G_VOID|G_DISCARD); SPAGAIN; CHECK_FORCOUNT; } } } SvREFCNT_dec(svarg); END_FORCOUNT; void fordivisors (SV* block, IN SV* svn) PROTOTYPE: &$ PREINIT: UV i, n, ndivisors; UV *divs; SV* svarg; /* We use svarg to prevent clobbering $_ outside the block */ CV *subcv; DECL_FORCOUNT; dMY_CXT; PPCODE: SETSUBREF(subcv, block); if (!_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) { DISPATCH_VOIDPP(); XSRETURN(0); } divs = divisor_list(n, &ndivisors, UV_MAX); START_FORCOUNT; SAVESPTR(GvSV(PL_defgv)); svarg = newSVuv(0); GvSV(PL_defgv) = svarg; #if USE_MULTICALL if (!CvISXSUB(subcv)) { dMULTICALL; I32 gimme = G_VOID; DECL_MULTICALL_SCOPE(subcv); PUSH_MULTICALL(subcv); for (i = 0; i < ndivisors; i++) { sv_setuv(svarg, divs[i]); SCOPED_MULTICALL; CHECK_FORCOUNT; } FIX_MULTICALL_REFCOUNT; POP_MULTICALL; } else #endif { for (i = 0; i < ndivisors; i++) { sv_setuv(svarg, divs[i]); PUSHMARK(SP); PUTBACK; call_sv((SV*)subcv, G_VOID|G_DISCARD); SPAGAIN; 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; CV *subcv; SV** svals; DECL_FORCOUNT; dMY_CXT; PPCODE: SETSUBREF(subcv, block); if (!_validate_and_set(&n, aTHX_ svn, IFLAG_POS)) { DISPATCH_VOIDPP(); XSRETURN(0); } if (n > (UV_MAX-2)) croak("%s: argument overflow", SUBNAME); 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("%s: expected hash reference", SUBNAME); 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 = 1; /* -1, 0, or 1 */ } if (primeq == 1) { 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) { /* Nothing */ PUSHMARK(SP); PUTBACK; call_sv((SV*)subcv, 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, (EXTEND_TYPE)k+1); for (i = 0; i <= k; i++) { PUSHs(svals[a[i]]); } PUTBACK; call_sv((SV*)subcv, 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; CV *subcv; SV** svals; UV* cm; DECL_FORCOUNT; dMY_CXT; PPCODE: SETSUBREF(subcv, block); if (ix > 0 && svk != 0) croak("%s: too many arguments", SUBNAME); if (!_validate_and_set(&n, aTHX_ svn, IFLAG_POS) || (svk && !_validate_and_set(&k, aTHX_ svk, IFLAG_POS))) { DISPATCH_VOIDPP(); XSRETURN(0); } if (svk == 0) { begk = (ix == 0) ? 0 : n; endk = n; } else { begk = endk = k; if (begk > n) XSRETURN(0); } 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(subcv)) { dMULTICALL; I32 gimme = G_VOID; DECL_MULTICALL_SCOPE(subcv); AV *av = save_ary(PL_defgv); AvREAL_off(av); PUSH_MULTICALL(subcv); 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 ]; SCOPED_MULTICALL; } 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, (EXTEND_TYPE)k); for (i = 0; i < k; i++) { PUSHs(svals[ cm[k-i-1]-1 ]); } PUTBACK; call_sv((SV*)subcv, 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: SSize_t narrays, i, j, *arlen, *arcnt; SV ***arsvs; CV *subcv; DECL_FORCOUNT; dMY_CXT; PPCODE: SETSUBREF(subcv, block); narrays = items-1; if (narrays < 1) XSRETURN(0); for (i = 1; i <= narrays; i++) { SvGETMAGIC(ST(i)); CHECK_ARRAYREF(ST(i)); if (av_count((AV *)SvRV(ST(i))) == 0) XSRETURN(0); } Newz(0, arcnt, narrays, SSize_t); New(0, arlen, narrays, SSize_t); New(0, arsvs, narrays, SV**); /* Make local copies of the SV pointers. Allows magic/tied inputs. */ for (i = 0; i < narrays; i++) { DECL_ARREF(inav); USE_ARREF(inav, ST(i+1), SUBNAME, AR_READ); arlen[i] = len_inav; New(0, arsvs[i], len_inav, SV*); for (j = 0; j < (SSize_t)len_inav; j++) { SV* v = FETCH_ARREF(inav,j); arsvs[i][j] = v ? v : &PL_sv_undef; } } START_FORCOUNT; #if USE_MULTICALL if (!CvISXSUB(subcv)) { dMULTICALL; SV **arr; I32 gimme = G_VOID; DECL_MULTICALL_SCOPE(subcv); AV *av = save_ary(PL_defgv); AvREAL_off(av); PUSH_MULTICALL(subcv); do { av_fill(av, narrays-1); arr = AvARRAY(av); for (i = narrays-1; i >= 0; i--) /* Faster to fill backwards */ arr[i] = arsvs[i][arcnt[i]]; SCOPED_MULTICALL; CHECK_FORCOUNT; for (i = narrays-1; i >= 0; i--) { if (++arcnt[i] >= arlen[i]) arcnt[i] = 0; else break; } } while (i >= 0); FIX_MULTICALL_REFCOUNT; POP_MULTICALL; } else #endif do { PUSHMARK(SP); EXTEND(SP, (EXTEND_TYPE)narrays); for (i = 0; i < narrays; i++) { PUSHs(arsvs[i][arcnt[i]]); } PUTBACK; call_sv((SV*)subcv, G_VOID|G_DISCARD); SPAGAIN; CHECK_FORCOUNT; for (i = narrays-1; i >= 0; i--) { if (++arcnt[i] >= arlen[i]) arcnt[i] = 0; else break; } } while (i >= 0); for (i = 0; i < narrays; i++) Safefree(arsvs[i]); Safefree(arsvs); 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; SV* svarg; /* We use svarg to prevent clobbering $_ outside the block */ CV *subcv; SV* svals[64]; DECL_FORCOUNT; dMY_CXT; PPCODE: SETSUBREF(subcv, block); if (!_validate_and_set(&beg, aTHX_ svbeg, IFLAG_POS) || (svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_POS))) { DISPATCH_VOIDPP(); XSRETURN(0); } if (!svend) { end = beg; beg = 1; } if (beg < 1) beg = 1; if (beg > end) XSRETURN(0); 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]); } START_FORCOUNT; SAVESPTR(GvSV(PL_defgv)); svarg = newSVuv(0); GvSV(PL_defgv) = svarg; if (beg <= 1) { sv_setuv(svarg, 1); PUSHMARK(SP); PUTBACK; call_sv((SV*)subcv, G_VOID|G_DISCARD); SPAGAIN; beg = 2; } fctx = factor_range_init(beg, end, ix); #if USE_MULTICALL if (!CvISXSUB(subcv)) { dMULTICALL; I32 gimme = G_VOID; DECL_MULTICALL_SCOPE(subcv); AV *av = save_ary(PL_defgv); AvREAL_off(av); PUSH_MULTICALL(subcv); 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; } SCOPED_MULTICALL; } } 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, (EXTEND_TYPE)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*)subcv, G_VOID|G_DISCARD); SPAGAIN; } } factor_range_destroy(&fctx); SvREFCNT_dec(svarg); for (i = 0; i < maxfactors; i++) SvREFCNT_dec(svals[i]); END_FORCOUNT; void forsquarefreeint(SV* block, IN SV* svbeg, IN SV* svend = 0) PROTOTYPE: &$;$ PREINIT: UV beg, end, i; unsigned char* isf; SV* svarg; /* We use svarg to prevent clobbering $_ outside the block */ CV *subcv; DECL_FORCOUNT; dMY_CXT; PPCODE: SETSUBREF(subcv, block); if (!_validate_and_set(&beg, aTHX_ svbeg, IFLAG_POS) || (svend && !_validate_and_set(&end, aTHX_ svend, IFLAG_POS))) { DISPATCH_VOIDPP(); XSRETURN(0); } if (!svend) { end = beg; beg = 1; } if (beg < 1) beg = 1; if (beg > end) XSRETURN(0); START_FORCOUNT; SAVESPTR(GvSV(PL_defgv)); svarg = newSVuv(0); GvSV(PL_defgv) = svarg; if (beg <= 1) { sv_setuv(svarg, 1); PUSHMARK(SP); PUTBACK; call_sv((SV*)subcv, G_VOID|G_DISCARD); SPAGAIN; beg = 2; } while (beg <= end) { UV seglo = beg, seghi = end; if (seghi-seglo > (65536*256)) seghi = seglo + 65536*256 - 1; isf = range_issquarefree(seglo, seghi); #if USE_MULTICALL if (!CvISXSUB(subcv)) { dMULTICALL; I32 gimme = G_VOID; DECL_MULTICALL_SCOPE(subcv); PUSH_MULTICALL(subcv); for (i = 0; i < seghi-seglo+1; i++) { CHECK_FORCOUNT; if (isf[i]) { sv_setuv(svarg, seglo+i); SCOPED_MULTICALL; } } FIX_MULTICALL_REFCOUNT; POP_MULTICALL; } else #endif for (i = 0; i < seghi-seglo+1; i++) { CHECK_FORCOUNT; if (isf[i]) { sv_setuv(svarg, seglo+i); PUSHMARK(SP); PUTBACK; call_sv((SV*)subcv, G_VOID|G_DISCARD); SPAGAIN; } } Safefree(isf); if (seghi == UV_MAX) break; beg = seghi+1; CHECK_FORCOUNT; } SvREFCNT_dec(svarg); END_FORCOUNT; void vecreduce(SV* block, ...) PROTOTYPE: &@ CODE: { /* This is basically reduce from List::Util. Try to maintain compat. */ SV *ret = sv_newmortal(); SSize_t i; GV *agv,*bgv; SV **args = &PL_stack_base[ax]; CV *subcv; SETSUBREF(subcv, block); 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(subcv)) { dMULTICALL; I32 gimme = G_SCALAR; DECL_MULTICALL_SCOPE(subcv); PUSH_MULTICALL(subcv); for (i = 2; i < items; i++) { GvSV(bgv) = args[i]; SCOPED_MULTICALL; 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*)subcv, G_SCALAR); SvSetMagicSV(ret, *PL_stack_sp); } } ST(0) = ret; XSRETURN(1); } void vecslide(SV* block, ...) PROTOTYPE: &@ CODE: { /* Similar to slide from List::MoreUtils. */ SSize_t i; SV **args = &PL_stack_base[ax]; CV *subcv; SV **retsvarr; /* Store results */ SETSUBREF(subcv, block); if (items <= 2) XSRETURN_EMPTY; New(0, retsvarr, items-2, SV*); SAVEGENERICSV(plAgv); SAVEGENERICSV(plBgv); plAgv = MUTABLE_GV(SvREFCNT_inc(gv_fetchpvs("a",GV_ADD|GV_NOTQUAL,SVt_PV))); plBgv = MUTABLE_GV(SvREFCNT_inc(gv_fetchpvs("b",GV_ADD|GV_NOTQUAL,SVt_PV))); save_gp(plAgv, 0); save_gp(plBgv, 0); GvINTRO_off(plAgv); GvINTRO_off(plBgv); SAVEGENERICSV(GvSV(plAgv)); SvREFCNT_inc(GvSV(plAgv)); SAVEGENERICSV(GvSV(plBgv)); SvREFCNT_inc(GvSV(plBgv)); #ifdef dMULTICALL if (!CvISXSUB(subcv)) { dMULTICALL; I32 gimme = G_SCALAR; DECL_MULTICALL_SCOPE(subcv); PUSH_MULTICALL(subcv); for (i = 1; i < items-1; i++) { SV *olda = GvSV(plAgv), *oldb = GvSV(plBgv); GvSV(plAgv) = SvREFCNT_inc_simple_NN(args[i]); GvSV(plBgv) = SvREFCNT_inc_simple_NN(args[i+1]); SvREFCNT_dec(olda); SvREFCNT_dec(oldb); SCOPED_MULTICALL; retsvarr[i-1] = newSVsv(*PL_stack_sp); } FIX_MULTICALL_REFCOUNT; POP_MULTICALL; } else #endif { for (i = 1; i < items-1; i++) { SV *olda, *oldb; dSP; olda = GvSV(plAgv); oldb = GvSV(plBgv); GvSV(plAgv) = SvREFCNT_inc_simple_NN(args[i]); GvSV(plBgv) = SvREFCNT_inc_simple_NN(args[i+1]); SvREFCNT_dec(olda); SvREFCNT_dec(oldb); PUSHMARK(SP); call_sv((SV*)subcv, G_SCALAR); retsvarr[i-1] = newSVsv(*PL_stack_sp); } } for (i = 0; i < items-2; i++) { ST(i) = sv_2mortal(retsvarr[i]); retsvarr[i]=0; } Safefree(retsvarr); XSRETURN(items-2); } 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 */ SSize_t index; SV **args = &PL_stack_base[ax]; CV *subcv; SETSUBREF(subcv, block); SAVESPTR(GvSV(PL_defgv)); #ifdef dMULTICALL if (!CvISXSUB(subcv)) { dMULTICALL; I32 gimme = G_SCALAR; DECL_MULTICALL_SCOPE(subcv); PUSH_MULTICALL(subcv); for (index = 1; index < items; index++) { GvSV(PL_defgv) = args[index]; SCOPED_MULTICALL; 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*)subcv, 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; } void vecuniq(...) PROTOTYPE: @ PREINIT: iset_t s; int status, retvals; SSize_t j; UV n; unsigned long sz, nret; PPCODE: retvals = (GIMME_V != G_SCALAR && GIMME_V != G_VOID); s = iset_create((size_t)items); for (status = 1, nret = 0, j = 0; j < items; j++) { status = _validate_and_set(&n, aTHX_ ST(j), IFLAG_ANY); if (status == 0) break; if (iset_add(&s, n, status) == 0) continue; if (iset_sign(s) == 0) { status = 0; break; } if (retvals) { PUSHs(sv_2mortal(NEWSVINT(status,n))); nret++; } } sz = iset_size(s); iset_destroy(&s); if (status != 0 && retvals) { if (nret != sz)croak("vecuniq: iset %lu items, pushed %lu items",sz,nret); XSRETURN(nret); } else if (status != 0) { ST(0) = sv_2mortal(newSVuv(sz)); XSRETURN(1); } else { /* This is 100% from List::MoreUtils::XS by Parseval and Rehsack */ I32 i; IV count = 0, seen_undef = 0; HV *hv = newHV(); SV **args = &PL_stack_base[ax]; SV *tmp = sv_newmortal(); sv_2mortal(newRV_noinc((SV*)hv)); if (GIMME_V == G_SCALAR) { /* don't build return list if not needed */ for (i = 0; i < items; i++) { SvGETMAGIC(args[i]); if (SvOK(args[i])) { sv_setsv_nomg(tmp, args[i]); if (!hv_exists_ent(hv, tmp, 0)) { ++count; hv_store_ent(hv, tmp, &PL_sv_yes, 0); } } else if (0 == seen_undef++) ++count; } ST(0) = sv_2mortal(newSVuv(count)); XSRETURN(1); } /* list context: populate SP with mortal copies */ for (i = 0; i < items; i++) { SvGETMAGIC(args[i]); if (SvOK(args[i])) { SvSetSV_nosteal(tmp, args[i]); if (!hv_exists_ent(hv, tmp, 0)) { args[count++] = args[i]; hv_store_ent(hv, tmp, &PL_sv_yes, 0); } } else if (0 == seen_undef++) args[count++] = args[i]; } XSRETURN(count); } void vecfreq(...) PROTOTYPE: @ PREINIT: int itype; size_t len, i, retlen; UV *L, count; PPCODE: if (items == 0) { if (GIMME_V == G_SCALAR) XSRETURN_UV(0); else XSRETURN_EMPTY; } /* Try to read native integers. Bail to PP if something else. */ len = (size_t) items; New(0, L, len, UV); itype = IARR_TYPE_ANY; for (i = 0; i < len && itype != IARR_TYPE_BAD && SVNUMTEST(ST(i)); i++) { IV n = SvIVX(ST(i)); if (n < 0) { if (SvIsUV(ST(i))) itype |= IARR_TYPE_POS; else itype |= IARR_TYPE_NEG; } L[i] = n; } if (i < len || itype == IARR_TYPE_BAD) { Safefree(L); DISPATCHPP(); return; } if (itype == IARR_TYPE_NEG) sort_iv_array((IV*)L, len); else sort_uv_array(L, len); /* 2. Walk the sorted integers */ if (GIMME_V == G_SCALAR) { count = 0; for (i = 1; i < len; i++) if (L[i] != L[i-1]) count++; ST(0) = sv_2mortal(newSVuv(count+1)); retlen = 1; } else { int sign = itype == IARR_TYPE_NEG ? -1 : 1; EXTEND(SP, (EXTEND_TYPE)len*2); retlen = 0; count = 1; for (i = 1; i < len; i++) { if (L[i] == L[i-1]) { count++; continue; } PUSHs(sv_2mortal(NEWSVINT(sign,L[i-1]))); /* key */ PUSHs(sv_2mortal(newSVuv(count))); /* val */ retlen += 2; count = 1; } PUSHs(sv_2mortal(NEWSVINT(sign,L[i-1]))); /* key */ PUSHs(sv_2mortal(newSVuv(count))); /* val */ retlen += 2; } Safefree(L); XSRETURN(retlen); void vecsingleton(...) PROTOTYPE: @ PREINIT: int itype; size_t len, i, retlen, count; UV *L; iset_t seen, dups; PPCODE: if (items == 0) { if (GIMME_V == G_SCALAR) XSRETURN_UV(0); else XSRETURN_EMPTY; } /* Try to read native integers. Bail to PP if something else. */ len = (size_t) items; New(0, L, len, UV); seen = iset_create(len); dups = iset_create(len>>1); itype = IARR_TYPE_ANY; for (i = 0; i < len && itype != IARR_TYPE_BAD && SVNUMTEST(ST(i)); i++) { IV n = SvIVX(ST(i)); int sign = 1; if (n < 0) { if (SvIsUV(ST(i))) itype |= IARR_TYPE_POS; else { itype |= IARR_TYPE_NEG; sign = -1; } } L[i] = n; if (!iset_add(&seen, n, sign)) iset_add(&dups, n, sign); } if (iset_is_invalid(seen)) itype = IARR_TYPE_BAD; /* Poison the type */ iset_destroy(&seen); if (i < len || itype == IARR_TYPE_BAD) { iset_destroy(&dups); Safefree(L); DISPATCHPP(); return; } if (GIMME_V != G_ARRAY) { for (i = 0, count = 0; i < len; i++) if (!iset_contains(dups, L[i])) count++; ST(0) = sv_2mortal(newSVuv(count)); retlen = 1; } else { for (i = 0, retlen = 0; i < len; i++) if (!iset_contains(dups, L[i])) ST(retlen++) = ST(i); } iset_destroy(&dups); Safefree(L); XSRETURN(retlen); Math-Prime-Util-0.74/powerful.c000644 000765 000024 00000023253 15151334266 016412 0ustar00danastaff000000 000000 #include #include #include #include "ptypes.h" #define FUNC_isqrt 1 #define FUNC_ctz 1 #define FUNC_gcd_ui 1 #define FUNC_ipow 1 #include "util.h" #include "sort.h" #include "sieve.h" #include "cache.h" #include "constants.h" #include "inverse_interpolate.h" #include "factor.h" bool is_powerful(UV n, UV k) { UV pk; int res; if (n <= 1) return (n==1); if (k <= 1) return 1; if (!(n&1)) { /* Check and remove all multiples of 2 */ if (n & ((UVCONST(1) << k)-1)) return 0; n >>= ctz(n); if (n == 1) return 1; } if (k > MPU_MAX_POW3) return 0; /* if (k > logint(n,3)) return 0; */ /* Quick checks */ if (k == 2) { if ( (!(n % 3) && (n % 9)) || (!(n % 5) && (n % 25)) || (!(n % 7) && (n % 49)) || (!(n % 11) && (n % 121)) || (!(n % 13) && (n % 169)) ) return 0; } else if (k == 3) { if ( (!(n % 3) && (n % 27)) || (!(n % 5) && (n % 125)) || (!(n % 7) && (n % 343)) || (!(n % 11) && (n % 1331)) ) return 0; } else { if ( (!(n % 3) && (n % 81)) || (!(n % 5) && (n % 625)) || (!(n % 7) && (n % 2401)) || (!(n % 11) && (n % 14641)) ) return 0; } #if 0 /* Full factoring. Very simple and reasonably efficient. */ { factored_t nf = factorint(n); uint32_t i; for (i = 0; i < nf.nfactors; i++) if (nf.k[i] < k) return 0; return 1; } #endif /* Rather than full factoring, we'll use trial division. For k=2, we * only need to check up to the fourth root of n, and k=3 to the sixth. * Even for k=2 this is faster than full factoring on average. */ /* At every checkpoint (new prime p) for k=2 either: * 1) N < p^4 and N=1, p^2, q^2, p^3, or q^3. (q>p). Return 1. * 2) N < p^4 otherwise, N cannot be powerful. Return 0; * 3) N = p^4 is_square caught this and returned 1. * So the next possibility is p^2 * q^2 where q = next_prime(p). * Check n < p^4 before each new prime, and condition 1 after modifying n. */ if (n == 1 || powerof(n) >= k) return 1; #define LCHECK_POWERFUL(n, p, k) \ pk = ipow(p,k); \ if (n < pk*pk) { res = 0; break; } \ if (!(n%p)) { \ if (n%pk) { res = 0; break; } \ for (n /= pk; (n%p) == 0; n /= p) ; \ if (n == 1 || powerof(n) >= k) { res = 1; break; } \ } #define CHECK_POWERFUL(n, p, k) \ do { LCHECK_POWERFUL(n, p, k); } while (0); \ if (res != -1) return res; res = -1; CHECK_POWERFUL(n, 3, k); if (k >= 14 || n < ipow( 5,2*k)) return 0; CHECK_POWERFUL(n, 5, k); if (k >= 12 || n < ipow( 7,2*k)) return 0; CHECK_POWERFUL(n, 7, k); if (k >= 10 || n < ipow(11,2*k)) return 0; START_DO_FOR_EACH_PRIME(11, rootint(n,2*k)) { LCHECK_POWERFUL(n, p, k); } END_DO_FOR_EACH_PRIME return (res == 1); } static UV _pcr(UV n, UV k, unsigned char* isf, UV m, UV r) { UV i, sum = 0, lim = rootint(n/m, r); if (r <= k) return lim; if (r-1 == k) { for (i = 1; i <= lim; i++) if (isf[i] && gcd_ui(m,i) == 1) sum += rootint(n/(m*ipow(i,r)),k); } else { for (i = 1; i <= lim; i++) if (isf[i] && gcd_ui(m,i) == 1) sum += _pcr(n, k, isf, m * ipow(i,r), r-1); } return sum; } UV powerful_count(UV n, UV k) { UV i, r, lim, sum = 0; unsigned char *isf; if (k <= 1 || n <= 1) return n; if (k >= BITS_PER_WORD) return 1; lim = rootint(n, k+1); isf = range_issquarefree(0, lim); /* in util.c */ if (k == 2) { for (i = 1; i <= lim; i++) if (isf[i]) sum += isqrt(n/(i*i*i)); } else { /* sum = _pcr(n, k, isf, 1, 2*k-1); */ r = 2*k-1; lim = rootint(n, r); for (i = 1; i <= lim; i++) if (isf[i]) sum += _pcr(n, k, isf, ipow(i,r), r-1); } Safefree(isf); return sum; } /* We want: * k=0 turned into k=2 in XS (0 here ok) * n=0 undef in XS (0 here ok) * k=1 => n * n=1 => 1 * n=2 => 1<= BITS_PER_WORD) return 0; if (k == 1 || n <= 1) return n; max = (k <= 10) ? maxpow[k] : powerful_count(UV_MAX,k); if (n > max) return 0; if (n <= 20 && k >= mink[n]) return UVCONST(1) << (k+(n-2)); /* Now k >= 2, n >= 4 */ nc = pow(n, 2) / pow(2.1732543125195541, 2); if (k == 2) { /* From Mincu and Panaitopol 2009 */ npow = pow(n, 5.0/3.0); dlo = nc + 0.3 * npow; dhi = nc + 0.5 * npow; lo = (UV) dlo; hi = (n < 170) ? 8575 : (dhi >= UV_MAX) ? UV_MAX : 1 + (UV) dhi; } else if (k == 3) { /* Splitting the range is hacky but overall this isn't bad */ if (n < 84000) { nest = .06003 * pow(n, 2.865); dlo = 0.96 * (nc + nest); dhi = 1.08 * (nc + nest); } else { nest = .02209 * pow(n, 2.955); dlo = 0.987 * (nc + nest); dhi = 1.020 * (nc + nest); } lo = (UV) dlo; if (n < 900) dhi *= 1.3; if (n < 160) dhi = 1.3 * dhi + 600; hi = (dhi >= UV_MAX) ? UV_MAX : 1 + (UV) dhi; } else if (k <= 10) { /* Slopppy but better than linear. 4 <= k <= 10. */ if (n < 200) { npow = pow(n, 3.031 + 0.460*(k-4)); nest = (.5462 / pow(1.15, k-4)) * npow; dlo = 0.51 * (nc + nest); dhi = 1.86 * (nc + nest); } else { npow = pow(n, 3.690 + 0.665*(k-4)); nest = (.01275 / pow(4.11, k-4)) * npow; dlo = 0.70 * (nc + nest); dhi = 4.3 * (nc + nest); } lo = (UV) dlo; hi = (dhi >= UV_MAX) ? UV_MAX : 1 + (UV) dhi; } else { lo = (UVCONST(1) << (k+1))+1; hi = UV_MAX; /* Linear from min to max rather than a nice power fit as above */ if (n < max) hi = lo + (((double)n / (double)max) * (UV_MAX-lo) + 1); /* Alternately hi=0 which makes interpolation routine handle it. */ } return inverse_interpolate_k(lo, hi, n, k, &powerful_count, 0); } static UV _sumpowerful(UV m, UV r, UV n, UV k, unsigned char* isf) { UV i, rootdiv, sum; if (r < k) return m; rootdiv = rootint(n/m, r); if (r == k) return m * powersum(rootdiv, r); for (sum = 0, i = 1; i <= rootdiv; i++) if (isf[i] && gcd_ui(i,m) == 1) sum += _sumpowerful(m * ipow(i,r), r-1, n, k, isf); return sum; } UV sumpowerful(UV n, UV k) { UV lim, sum; unsigned char *isf; #if BITS_PER_WORD == 64 static UV const maxpow[41] = {0,6074000999,8676161894447,263030040471727, 1856371767674975,6768543273131775,17199267839999999,35098120384607510, 62985599999999999,104857599999999999,157641800537109374,246512345193381887, 312499999999999999,406381963906121727,499999999999999999,592297667290202111, 701982420492091391,935976560656121855,1184595334580404223,1350851717672992088, 1579460446107205631,2105947261476274175,2369190669160808447, 4052555153018976266,4738381338321616895,7450580596923828124, 7450580596923828124,7450580596923828124, UVCONST(9223372036854775807),UVCONST(9223372036854775807), UVCONST(9223372036854775807),UVCONST(9223372036854775807), UVCONST(9223372036854775807),UVCONST(9223372036854775807), UVCONST(9223372036854775807),UVCONST(9223372036854775807), UVCONST(9223372036854775807),UVCONST(9223372036854775807), UVCONST(9223372036854775807),UVCONST(9223372036854775807), UVCONST(12157665459056928800)}; if (k == 0 || n == 0) return 0; if (k >= 64) return 1; if (k < 41 && n > maxpow[k]) return 0; #else static UV const maxpow[21] = {0,92681,3367224,18224999,48599999,102036671,161243135,244140624,362797055,536870911,725594111,1088391167,1220703124,1220703124,2147483647,2147483647,2147483647,2147483647,2147483647,2147483647,3486784400U}; if (k == 0 || n == 0) return 0; if (k >= 32) return 1; if (k < 21 && n > maxpow[k]) return 0; #endif if (k == 1) return (n+1)/2 * (n|1); lim = rootint(n, k+1); isf = range_issquarefree(0, lim); sum = _sumpowerful(1, 2*k-1, n, k, isf); Safefree(isf); return sum; } static void _pcg(UV lo, UV hi, UV k, UV m, UV r, UV *pn, UV *npn) { UV v, *pnptr = pn + *npn, beg = 1, end = rootint(hi/m,r); if (r > k) { for (v = beg; v <= end; v++) { if (gcd_ui(m,v) == 1 && is_square_free(v)) _pcg(lo, hi, k, m*ipow(v,r), r-1, pn, npn); } } else { if (lo > m) { UV lom = (lo/m)+!!(lo%m); /* ceildiv(lo,m) */ beg = rootint(lom, r); if (ipow(beg,r) != lom) beg++; } for (v = beg; v <= end; v++) *pnptr++ = m * ipow(v,r); *npn += end-beg+1; } } UV* powerful_numbers_range(UV* npowerful, UV lo, UV hi, UV k) { UV *pn, npn, i; /* For small ranges it is faster to test each number vs generate. */ UV const single_thresh = ( (lo < 500000U) ? 30 : (lo < 400000000U) ? 160 : 600 ) * ((k <= 2) ? 1 : 4); /* Like powerful_count, we ignore 0. */ if (lo < 1) lo = 1; if (hi < lo) { pn = 0; npn = 0; } else if (k <= 1) { npn = hi-lo+1; New(0, pn, npn, UV); for (i = lo; i <= hi; i++) pn[i-lo] = i; } else if ((lo+single_thresh) > hi || lo > (UV_MAX-single_thresh)) { New(0, pn, hi-lo+1, UV); for (i = lo, npn = 0; i <= hi && i != 0; i++) if (is_powerful(i,k)) pn[npn++] = i; } else { npn = powerful_count(hi,k) - ((lo <= 1) ? 0 : powerful_count(lo-1,k)); New(0, pn, npn, UV); i = 0; _pcg(lo, hi, k, 1, 2*k-1, pn, &i); MPUassert(i == npn, "Number of powerful numbers generated != count"); sort_uv_array(pn, npn); } *npowerful = npn; return pn; } Math-Prime-Util-0.74/primality.h000644 000765 000024 00000002455 15154713505 016567 0ustar00danastaff000000 000000 #ifndef MPU_PRIMALITY_H #define MPU_PRIMALITY_H #include "ptypes.h" extern bool is_pseudoprime(UV const n, UV a) ISCONSTFUNC; extern bool is_euler_pseudoprime(UV const n, UV a) ISCONSTFUNC; extern bool is_strong_pseudoprime(UV const n, UV a) ISCONSTFUNC; extern bool is_euler_plumb_pseudoprime(UV const n) ISCONSTFUNC; extern bool is_lucas_pseudoprime(UV n, int strength) ISCONSTFUNC; extern bool is_almost_extra_strong_lucas_pseudoprime(UV n, UV increment) ISCONSTFUNC; extern bool is_frobenius_pseudoprime(UV n, IV P, IV Q); extern bool is_frobenius_underwood_pseudoprime(UV n); extern bool is_frobenius_khashin_pseudoprime(UV n) ISCONSTFUNC; extern bool is_perrin_pseudoprime(UV n, uint32_t restricted); extern bool miller_rabin(UV const n, const UV *bases, int nbases); /* 2^p-1: 0 composite, 1 prime, -1 don't know */ extern int is_mersenne_prime(UV p) ISCONSTFUNC; extern bool lucas_lehmer(UV p); extern bool BPSW(UV const n) ISCONSTFUNC; extern bool MR32(uint32_t n) ISCONSTFUNC; /* General purpose primality test. Does small-prime divisibility. */ extern bool is_prob_prime(UV n) ISCONSTFUNC; /* 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.74/ptypes.h000644 000765 000024 00000020435 15152202475 016074 0ustar00danastaff000000 000000 #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 #include #define TRUE true #define FALSE false 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 #if defined(__clang__) && defined(__clang_major__) && __clang_major__ > 11 #pragma clang diagnostic ignored "-Wcompound-token-split-by-macro" #endif #include "EXTERN.h" #include "perl.h" /* From perl.h, wrapped in PERL_CORE */ #ifndef U32_CONST # if INTSIZE >= 4 # define U32_CONST(x) ((U32TYPE)x##U) # else # define U32_CONST(x) ((U32TYPE)x##UL) # endif #endif /* From perl.h, wrapped in PERL_CORE */ #ifndef U64_CONST # ifdef HAS_QUAD # if INTSIZE >= 8 # define U64_CONST(x) ((U64TYPE)x##U) # elif LONGSIZE >= 8 # define U64_CONST(x) ((U64TYPE)x##UL) # elif QUADKIND == QUAD_IS_LONG_LONG # define U64_CONST(x) ((U64TYPE)x##ULL) # else /* best guess we can make */ # define U64_CONST(x) ((U64TYPE)x##UL) # endif # endif #endif /* See: * http://www.nntp.perl.org/group/perl.perl5.porters/2013/09/msg207524.html * for some discussion. */ #ifdef HAS_QUAD #define BITS_PER_WORD 64 #define UVCONST(x) U64_CONST(x) #else #define BITS_PER_WORD 32 #define UVCONST(x) U32_CONST(x) #endif #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_UINT64 1 #elif defined(_MSC_VER) /* We set up the types earlier */ #define HAVE_UINT64 1 #else #define HAVE_UINT64 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 #elif defined(__BITINT_MAXWIDTH__) && __BITINT_MAXWIDTH__ >= 128 /* Should have included and already */ #define HAVE_UINT128 1 typedef unsigned _BitInt(128) uint128_t; #else #define HAVE_UINT128 0 #endif /* Perl 5.23.0 added the very helpful definition. Without it, guess. */ /* Perl core standardized on not counting the implicit bit */ #ifndef NVMANTBITS #if NVSIZE <= 8 #define NVMANTBITS (NVSIZE <= 2 ? 10 : NVSIZE <= 4 ? 23 : 52) #elif defined(USE_QUADMATH) #define NVMANTBITS 112 #elif defined(__LDBL_MANT_DIG__) #define NVMANTBITS __LDBL_MANT_DIG__ #elif NVSIZE == 16 #define NVMANTBITS 112 #elif NVSIZE == 32 #define NVMANTBITS 236 #else #error Unknown NVSIZE, cannot guess at mantissa bits #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__)) && __STDC_VERSION__ >= 199901L #define INLINE inline #elif defined(_MSC_VER) #define INLINE __inline #else #define INLINE #endif #if (defined(__GNUC__) || defined(__clang__)) && !defined(__INTEL_COMPILER) #define ISCONSTFUNC __attribute__((const)) #define NOINLINE __attribute__((noinline)) #else #define ISCONSTFUNC #define NOINLINE #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.74/semi_primes.c000644 000765 000024 00000042514 15151337507 017065 0ustar00danastaff000000 000000 #include #include #include #include "ptypes.h" #include "constants.h" #define FUNC_isqrt 1 #include "cache.h" #include "sieve.h" #include "util.h" #include "prime_counts.h" #include "inverse_interpolate.h" #include "semi_primes.h" #define SP_SIEVE_THRESH 100 /* When to sieve vs. iterate */ /******************************************************************************/ /* SEMI PRIMES */ /******************************************************************************/ #if 0 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}; #else static const unsigned short _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, 259,262,265,267,274,278,287,289,291,295,298,299,301,302,303,305,309,314, 319,321,323,326,327,329,334,335,339,341,346,355,358,361,362,365,371,377, 381,382,386,391,393,394,395,398,403,407,411,413,415,417,422,427,437,445, 446,447,451,453,454,458,466,469,471,473,478,481,482,485,489,493,497,501, 502,505,511,514,515,517,519,526,527,529,533,535,537,538,542,543,545,551, 553,554,559,562,565,566,573,579,581,583,586,589,591,597,611,614,622,623}; #endif #define NSEMIPRIMELIST (sizeof(_semiprimelist)/sizeof(_semiprimelist[0])) #if 1 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; } 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 = 0, *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 += prime_count(n/2) - pc++; if (sqrtn >= 3) sum += prime_count(n/3) - pc++; if (sqrtn >= 5) sum += 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 = prime_count(xbeg); xsize = range_prime_sieve(&xarr, xbeg, xend); xend = xarr[xsize-1]; } cnt = xoff + _bs_count(np, xarr, xsize-1); } else { cnt = 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; } #else /* This is much cleaner, but ends up being a little slower. */ #include "prime_count_cache.h" #define CACHED_PC(cache,n) prime_count_cache_lookup(cache,n) UV semiprime_count(UV n) { UV sum = 0, sqrtn = prev_prime(isqrt(n)+1), pc_sqrtn; void *cache = prime_count_cache_create( (UV)pow(n,0.70) ); if (sqrtn >= 2) sum += CACHED_PC(cache,n/2); if (sqrtn >= 3) sum += CACHED_PC(cache,n/3); if (sqrtn >= 5) sum += CACHED_PC(cache,n/5); if (sqrtn >= 7) { unsigned char* segment; UV seg_base, seg_low, seg_high; 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 ) sum += CACHED_PC(cache, n/p); END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } pc_sqrtn = CACHED_PC(cache, sqrtn); sum -= (pc_sqrtn * pc_sqrtn - pc_sqrtn) / 2; prime_count_cache_destroy(cache); return sum; } #endif /* TODO: This overflows, see p=3037000507,lo=10739422018595509581. * p2 = 9223372079518257049 => 9223372079518257049 + 9223372079518257049 * Also with lo=18446744073709551215,hi=18446744073709551515. * Using P_GT_LO_0 might help, but the biggest issue is 2*p*p overflows. */ #define MARKSEMI(p,arr,lo,hi) \ do { UV i_, p2=(p)*(p); \ for (i_=P_GT_LO(p2, p, lo); i_ >= lo && i_ <= hi; i_ += p) arr[i_-lo]++; \ for (i_=P_GT_LO(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); } xsize = range_prime_sieve(&pr, 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) { sort_uv_array(S, count); *semis = S; } return count; } #endif UV semiprime_count_range(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 / ((UV)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) { UV i; if (n <= _semiprimelist[NSEMIPRIMELIST-1]) { for (i = 0; i < NSEMIPRIMELIST-1 && n >= _semiprimelist[i+1]; i++) ; return i; } else { /* Crisan and Erban (2020) https://arxiv.org/abs/2006.16491 */ UV L, res; double logn = log(n), loglogn = log(logn); double series = 0, den = 1, mc; static const double C[19] = { 0.26149721284764278375L, -2.0710850628855780875L, -7.6972777412176108802L, -35.345660320564161516L, -206.71503925406509339L, -1511.1997871316530251L, -13546.323682845914021L, -146229.10675883565523L, -1867579.6280076650637L, -27733045.258413542557L, -470983423.57703294361L, /* * Values for C_11+ are not exact, but that's ok here. * \p 80 * zetald(n) = { zeta'(n) / zeta(n) } * zetalim(n) = { derivnum(s = 1-1e-40, zetald(s) + 1/(s-1), n-1) } * B(n,x=100) = { if(n==0,return(0.2614972128476427837554268386086958590516)); (-1)^n * (sum(i=2, x, moebius(i) * i^(n-1) * derivnum(X=i,zetald(X),n-1)) + zetalim(n)) } * BN = vector(20,n,B(n-1,500)); * C(n) = { n!*(sum(i=0,n,BN[i+1]/i!) - sum(i=1,n,1/i)) } */ -9011500983.75L, -191744069149.4L, -4487573459710.5L, -114472069580579.8L, -3158610502077135.6L, -93682567786528911.9L, -2970838770257639695.3L, -100274471240063911725.1L }; /* ~ C_18 */ /* We will use C[0] to C[L-1]. Hence L must be 19 or less. */ static const double CROSS[15] = { 632, 9385, 136411, 4610076, 66358000, 440590000, 2557200000.0, 53032001000.0, 1151076796431.0L, 20416501389724.0L, 165815501587300.0L, /* Below this L = 13, Above this L = 14 */ 953038830319448.0L, /* Cross from L = 14 to 15 */ 20019396133340433.0L, /* Cross from L = 15 to 16 */ 192558867109258424.0L, /* Cross from L = 16 to 17 */ 1757883874953032448.0L }; /* Cross from L = 17 to 18 */ static const double mincount[16] = { 82, 195, 2485, 31446, 906319, 11741185, 72840337, 398702652, 7538564737.0L, 150382042176.0L, 2482510001499.0L, 19204997230933.0L, 106211451717048.0L, 2094735089989940.0L, 19282342825922188.0L, 168996486318315136.0L }; /* Pick truncation point, note L can be one higher than the value below*/ for (L = 3; L <= 17 && (double)n >= CROSS[L-3]; L++) ; /* Calculate truncated asymptotic value */ for (i = 1; i <= L; i++) { series += factorial(i-1) * (loglogn / den); series += C[i-1] / den; den *= logn; } res = (UV) ( (n / logn) * series + 0.5L ); /* Check for overflow */ if (res >= MPU_MAX_SEMI_PRIME_IDX) return MPU_MAX_SEMI_PRIME_IDX; /* Ensure monotonic using simple clamping */ mc = mincount[L-3]; /* mc = (L == 3) ? 82 : semiprime_count_approx(CROSS[L-4]-1); */ if ((double)res < mc) return mc; return res; } } UV nth_semiprime_approx(UV n) { double logn,log2n,log3n,log4n, err_lo, err_md, err_hi, err_factor, est; UV lo, hi; if (n < NSEMIPRIMELIST) return _semiprimelist[n]; if (n >= MPU_MAX_SEMI_PRIME_IDX) return n == MPU_MAX_SEMI_PRIME_IDX ? MPU_MAX_SEMI_PRIME : 0; /* Piecewise with blending. Hacky and maybe overkill. It makes a good * estimator by itself, but our count approximation is even better, so we * use this as an excellent initial estimate, then use inverse binary * search to lower the error another order of magnitude. * * 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 = err_factor * n * logn / log2n; if (est >= MPU_MAX_SEMI_PRIME) return MPU_MAX_SEMI_PRIME; /* Use inverse interpolation to improve the result. */ lo = 0.979 * est - 5; hi = 1.03 * est; return inverse_interpolate(lo, hi, n, &semiprime_count_approx, 0); } 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]; if (n >= MPU_MAX_SEMI_PRIME_IDX) return n == MPU_MAX_SEMI_PRIME_IDX ? MPU_MAX_SEMI_PRIME : 0; 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.74/bench/000755 000765 000024 00000000000 15154713771 015462 5ustar00danastaff000000 000000 Math-Prime-Util-0.74/ds_pagelist32.h000644 000765 000024 00000017266 15145577415 017236 0ustar00danastaff000000 000000 #ifndef MPU_DS_PAGELIST32_H #define MPU_DS_PAGELIST32_H #include "ptypes.h" /******************************************************************************/ /* PAGELIST DATA STRUCTURE */ /******************************************************************************/ /* * This is a form of unrolled skip list. However, for the sake of vastly * improved cache hits to find the right page, we use two arrays rather * than a linked list. */ #ifndef PLTYPE #define PLTYPE uint32_t #endif #define PLDEBUG 0 #define PAGESIZE 256 #define ELEV 4 #define ESHIFT 5 #define DELFACTOR 0.66 /* 1.0 means always merge */ #define NEPG(n,i) (((n) + (1UL<<((i)*ESHIFT)) - 1) >> ((i)*ESHIFT)) #define ADDSIZE(pl, p, n) \ { int _i; \ for (_i = 0; _i < ELEV; _i++) \ { pl->pgsize[_i][(p) >> (_i*ESHIFT)] += n; } } typedef struct pagelist32_t { uint32_t pagesize; PLTYPE nelems; PLTYPE npages_allocated[ELEV]; PLTYPE npages[ELEV]; PLTYPE *pgsize[ELEV]; PLTYPE **pgdata; } pagelist32_t; static pagelist32_t* pagelist32_create(uint32_t n) { pagelist32_t *pl; int i; New(0, pl, 1, pagelist32_t); pl->pagesize = PAGESIZE; pl->nelems = 0; for (i = 0; i < ELEV; i++) { pl->npages[i] = 1; pl->npages_allocated[i] = (i == 0) ? (1UL << ESHIFT) : 1; Newz(0, pl->pgsize[i], pl->npages_allocated[i], PLTYPE); } New(0, pl->pgdata, pl->npages_allocated[0], PLTYPE *); New(0, pl->pgdata[0], pl->pagesize, PLTYPE); return pl; } static void pagelist32_destroy(pagelist32_t *pl) { PLTYPE p; int i; for (p = 0; p < pl->npages[0]; p++) Safefree(pl->pgdata[p]); Safefree(pl->pgdata); for (i = 0; i < ELEV; i++) { Safefree(pl->pgsize[i]); pl->npages[i] = pl->npages_allocated[i] = 0; } pl->nelems = 0; } #if PLDEBUG #define CHECKPL(pl, msg) _pagelist32_check_epg(pl, msg) static void _pagelist32_check_epg(pagelist32_t *pl, const char* msg) { PLTYPE p, npages0 = pl->npages[0], *pgsz0 = pl->pgsize[0], sum[ELEV] = {0}; int i; for (i = 0; i < ELEV; i++) if (pl->npages[i] > pl->npages_allocated[i]) croak("level %u more pages in use than allocated\n", i); for (i = 1; i < ELEV; i++) if ( NEPG(npages0,i) > pl->npages[i] ) croak("%s: level %u not enough pages nepg\n",msg,i); for (i = 1; i < ELEV; i++) if ( ((npages0-1) >> (i*ESHIFT)) >= pl->npages[i] ) croak("%s: level %u not enough pages\n",msg,i); for (p = 0; p < npages0; p++) { for (i = 1; i < ELEV; i++) { PLTYPE pagesper = 1UL << (i*ESHIFT); sum[i] += pgsz0[p]; if (p == npages0-1 || (p % pagesper) == (pagesper-1)) { PLTYPE ep = p >> (i*ESHIFT); if (sum[i] != pl->pgsize[i][ep]) croak("%s: bad epg: sum %u pgsize[%u][%u] %u\n", msg, sum[i], i, ep, pl->pgsize[i][ep]); sum[i] = 0; } } } } #else #define CHECKPL(pl, msg) #endif #if 0 static void _pagelist32_remake_epg(pagelist32_t *pl) { PLTYPE i, p, npages0 = pl->npages[0], *pgsz0 = pl->pgsize[0]; for (i = 1; i < ELEV; i++) { PLTYPE* pgszi = pl->pgsize[i]; memset( pgszi, 0, pl->npages[i] * sizeof(PLTYPE) ); for (p = 0; p < npages0; p++) pgszi[ p >> (i*ESHIFT) ] += pgsz0[p]; } CHECKPL(pl, "remake"); } #endif static PLTYPE _pagelist32_find_page(pagelist32_t *pl, PLTYPE *n) { PLTYPE p; int i; if (*n >= pl->nelems) croak("pagelist32 index out of range"); CHECKPL(pl, "find page"); for (i = ELEV-1, p = 0; i >= 0; i--) { PLTYPE npagesi = pl->npages[i], *pgszi = pl->pgsize[i]; for (p = p << ESHIFT; p < npagesi && *n >= pgszi[p]; p++) *n -= pgszi[p]; } return p; } static void _pagelist32_add_page(pagelist32_t *pl) { PLTYPE npages0; int i; if (pl->npages[0] == pl->npages_allocated[0]) { pl->npages_allocated[0] += (1UL << ESHIFT); Renew(pl->pgsize[0], pl->npages_allocated[0], PLTYPE); Renew(pl->pgdata, pl->npages_allocated[0], PLTYPE*); } /* Mark one more page in use */ npages0 = pl->npages[0]; pl->pgsize[0][npages0] = 0; New(0, pl->pgdata[npages0], pl->pagesize, PLTYPE); pl->npages[0]++; /* Enlarge the higher levels if needed */ for (i = 1; i < ELEV; i++) { if (NEPG(pl->npages_allocated[0], i) > pl->npages_allocated[i]) { pl->npages_allocated[i] += 4 + NEPG(pl->npages_allocated[0], i); Renew(pl->pgsize[i], pl->npages_allocated[i], PLTYPE); } if (NEPG(pl->npages[0], i) > pl->npages[i]) { pl->pgsize[i][pl->npages[i]] = 0; pl->npages[i]++; } } CHECKPL(pl, "add page"); } static void pagelist32_append(pagelist32_t *pl, PLTYPE v) { PLTYPE *pgsz0 = pl->pgsize[0], ptail = pl->npages[0] - 1; if (pgsz0[ptail] >= pl->pagesize) { _pagelist32_add_page(pl); pgsz0 = pl->pgsize[0]; ptail = pl->npages[0] - 1; } pl->pgdata[ptail][pgsz0[ptail]] = v; ADDSIZE(pl, ptail, 1); pl->nelems++; CHECKPL(pl, "append"); } static PLTYPE pagelist32_val(pagelist32_t *pl, PLTYPE idx) { PLTYPE p = _pagelist32_find_page(pl, &idx); #if PLDEBUG if (p >= pl->npages[0]) croak("pagelist32: bad page in val"); if (idx >= pl->pgsize[0][p]) croak("pagelist32: bad index in val"); #endif return pl->pgdata[p][idx]; } static PLTYPE* pagelist32_to_array(UV *size, pagelist32_t *pl) { PLTYPE *pgsz0 = pl->pgsize[0]; PLTYPE d, p, *arr; New(0, arr, pl->nelems, PLTYPE); for (d = 0, p = 0; p < pl->npages[0]; p++) { memcpy(arr + d, pl->pgdata[p], pgsz0[p] * sizeof(PLTYPE)); d += pgsz0[p]; } if (d != pl->nelems) croak("pagelist32: bad number of elements in list"); *size = d; return arr; } static void pagelist32_delete(pagelist32_t *pl, PLTYPE idx) { /* idx 0,1,... */ PLTYPE npages0 = pl->npages[0], *pgsz0 = pl->pgsize[0]; PLTYPE p = _pagelist32_find_page(pl, &idx); if (p >= npages0) croak("pagelist32: bad page in delete"); if (idx < pgsz0[p]-1) memmove(pl->pgdata[p]+idx, pl->pgdata[p]+idx+1, (pgsz0[p]-1-idx) * sizeof(PLTYPE)); ADDSIZE(pl, p, -1); pl->nelems--; #if 1 /* Merge with leveled add/subtract. */ if ((p+1) < npages0 && (pgsz0[p] + pgsz0[p+1] <= DELFACTOR * pl->pagesize)) { int i; /* 1 copy data to end of this page, and remove next page data */ memcpy(pl->pgdata[p] + pgsz0[p], pl->pgdata[p+1], pgsz0[p+1] * sizeof(PLTYPE)); Safefree(pl->pgdata[p+1]); if ( (p+1) < (npages0-1) ) memmove(pl->pgdata + p + 1, pl->pgdata + p + 2, (npages0-1-p) * sizeof(PLTYPE*)); /* 2 adjust upper levels, moving sizes on boundaries */ for (i = 1; i < ELEV; i++) { PLTYPE ep, npagesi = pl->npages[i], *pgszi = pl->pgsize[i]; for (ep = 1 + ((p+0) >> (i*ESHIFT)); ep < npagesi; ep++) { PLTYPE amt = pgsz0[ep << (i*ESHIFT)]; pgszi[ep] -= amt; pgszi[ep-1] += amt; } pl->npages[i] = NEPG(npages0-1, i); /* Possibly lower now */ } /* 3 Move sizes at base level over efficiently */ pgsz0[p] += pgsz0[p+1]; if ( (p+1) < (npages0-1) ) memmove(pgsz0 + p + 1, pgsz0 + p + 2, (npages0-1-p) * sizeof(PLTYPE)); pl->npages[0]--; } #endif CHECKPL(pl, "delete"); } typedef struct pagelist32_iter_t { pagelist32_t *pl; PLTYPE p; PLTYPE idx; } pagelist32_iter_t; static pagelist32_iter_t pagelist32_iterator_create(pagelist32_t *pl, PLTYPE idx) { pagelist32_iter_t iter; iter.pl = pl; iter.p = _pagelist32_find_page(pl, &idx); iter.idx = idx; return iter; } static PLTYPE pagelist32_iterator_next(pagelist32_iter_t *iter) { PLTYPE v, p = iter->p; if (p >= iter->pl->npages[0]) return 0; v = iter->pl->pgdata[p][iter->idx]; if (++iter->idx >= iter->pl->pgsize[0][p]) { iter->p++; iter->idx = 0; } return v; } #undef PLTYPE #undef PLDEBUG #undef PAGESIZE #undef ELEV #undef ESHIFT #undef DELFACTOR #undef NEPG #undef ADDSIZE #undef CHECKPL #endif Math-Prime-Util-0.74/montmath.h000644 000765 000024 00000007524 15146553566 016420 0ustar00danastaff000000 000000 #ifndef MPU_MONTMATH_H #define MPU_MONTMATH_H #include "ptypes.h" #include "mulmod.h" #if BITS_PER_WORD == 64 && HAVE_UINT64 && 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 */ #if 0 /* AArch64 */ /* https://www.pure.ed.ac.uk/ws/portalfiles/portal/412503872/Concurrency_and_Computation_-_2023_-_Jesus_-_Vectorizing_and_distributing_number_theoretic_transform_to_count_Goldbach.pdf */ /* https://era.ed.ac.uk/server/api/core/bitstreams/ed9176f7-d8ed-4af9-aa20-3a82c5f8e353/content */ #define umul128(ph, pl, m0, m1) do { \ uint64_t __m0 = (m0), __m1 = (m1); \ __asm__ ("umulh\t%0, %1, %2" \ : "=r" (ph) \ : "r" (__m0), "r" (__m1)); \ (pl) = __m0 * __m1; \ } while(0) static INLINE uint64_t montmul(uint64_t a, uint64_t b, uint64_t n, uint64_t npi) { uint64_t m, xh, xl, yh, yl, z; umul128(xh, xl, a, b); /* x = a * b */ m = (uint64_t)(xl * npi) /* m = (x*N') mod R */ umul128(yh, yl, m, n); /* y = m * N */ z = xh+yh+((xl+yl) < xl); /* z = (x+y)/R */ return z >= N ? z-n : z; } /* Q = R^2 mod N to_mont(x) = xR mod N = montmul(x,Q) from_mont(X) = X/R mod N = montmul(X,1) */ #endif #endif Math-Prime-Util-0.74/almost_primes.h000644 000765 000024 00000001775 15145577415 017447 0ustar00danastaff000000 000000 #ifndef MPU_ALMOST_PRIMES_H #define MPU_ALMOST_PRIMES_H #include "ptypes.h" extern UV almost_prime_count(uint32_t k, UV n); extern UV almost_prime_count_approx(uint32_t k, UV n); extern UV nth_almost_prime(uint32_t k, UV n); extern UV nth_almost_prime_approx(uint32_t k, UV n); extern UV nth_almost_prime_lower(uint32_t k, UV n); extern UV nth_almost_prime_upper(uint32_t k, UV n); /* The largest k-almost-prime that fits in a UV */ extern UV max_nth_almost_prime(uint32_t k); /* The k-almost-prime count for 2^64-1 */ extern UV max_almost_prime_count(uint32_t k); /* Reasonably tight bounds on the counts */ extern UV almost_prime_count_upper(uint32_t k, UV n); extern UV almost_prime_count_lower(uint32_t k, UV n); extern UV range_construct_almost_prime(UV** list, uint32_t k, UV lo, UV hi); extern UV range_almost_prime_sieve(UV** list, uint32_t k, UV lo, UV hi); extern UV generate_almost_primes(UV** list, uint32_t k, UV lo, UV hi); extern bool is_chen_prime(UV n); extern UV next_chen_prime(UV n); #endif Math-Prime-Util-0.74/prime_count_cache.c000644 000765 000024 00000016214 15145577415 020225 0ustar00danastaff000000 000000 #include #include #include #define FUNC_popcnt 1 #include "ptypes.h" #include "cache.h" #include "sieve.h" #include "util.h" #include "lmo.h" /* * Cache small counts directly using a uint32_t array. * Very fast, but space intensive. * * Cache larger counts using a base count + a single-word bit count. * * We used to use a binary search on a prime list, which is reasonable, * but the bit mask uses less memory and is faster on average. It also * easily allows larger sizes. Note: in 32-bit this isn't very efficient. * * If memory is a concern, we could switch to a base count every two words. */ typedef struct { uint16_t *count; uint32_t *bm_count; UV *bm_mask; UV last_n; UV last_count_n; UV last_bmask_n; /* Statistics counting */ unsigned long nl_small; unsigned long nl_bmask; unsigned long nl_lmo; } pc_cache_t; UV prime_count_cache_lookup(void* cobj, UV n) { pc_cache_t *cache = (pc_cache_t*)cobj; if (n <= 2) return (n==2); /* Look in the small direct cache. */ if (n <= cache->last_count_n) { cache->nl_small++; return cache->count[(n-1)>>1]; } /* Look in bitmask */ if (n <= cache->last_bmask_n) { UV m = (n-1) >> 1; uint32_t idx = m / BITS_PER_WORD; uint32_t rem = m % BITS_PER_WORD; cache->nl_bmask++; return (UV)cache->bm_count[idx] + popcnt(cache->bm_mask[idx] >> (BITS_PER_WORD - 1 - rem)); } /* OK, call LMO/segment */ cache->nl_lmo++; return LMO_prime_count(n); } #if 0 static void _checkn(pc_cache_t *cache, UV n, UV count) { UV pc = prime_count_cache_lookup(cache, n); if (pc != count) croak(" pc cache [%lu] returned %lu instead of %lu\n", n, pc, count); } static void verify_cache(pc_cache_t *cache) { UV n = 3, c = 1, lastn = cache->last_n; _checkn(cache, 0, 0); _checkn(cache, 1, 0); _checkn(cache, 2, 1); START_DO_FOR_EACH_PRIME(3, next_prime(lastn)) { while (n < p) _checkn(cache, n++, c); _checkn(cache, n++, ++c); } END_DO_FOR_EACH_PRIME printf(" prime count cache verified to %lu complete\n", lastn); } static UV _bm_lookup(pc_cache_t *cache, UV n) { uint32_t m = (n-1) >> 1; uint32_t idx = m / BITS_PER_WORD; uint32_t rem = m % BITS_PER_WORD; return cache->bm_count[idx] + popcnt(cache->bm_mask[idx] >> (BITS_PER_WORD - 1 - rem)); } #else #define verify_cache(cache) /* nothing */ #define _bm_lookup(cache,n) prime_count_cache_lookup(cache,n) #endif void prime_count_cache_destroy(void* cobj) { pc_cache_t *cache = (pc_cache_t*)cobj; MPUverbose(2, " Prime Count Cache (max %lu):\n", (UV)cache->last_n); MPUverbose(2, " Small: %lu (%luk) Mask: %lu (%luk)\n", (unsigned long)cache->last_count_n, cache->last_count_n ? (unsigned long)(((cache->last_count_n-1)>>1)+1)*4/1024 : 0, (unsigned long)cache->last_bmask_n, (unsigned long) (sizeof(UV)+sizeof(uint32_t)) * (cache->last_bmask_n/(2*BITS_PER_WORD) + 1) / 1024); MPUverbose(2, " Lookups Small %lu Mask %lu LMO %lu\n", cache->nl_small, cache->nl_bmask, cache->nl_lmo); if (cache->count != 0) Safefree(cache->count); if (cache->bm_count != 0) Safefree(cache->bm_count); if (cache->bm_mask != 0) Safefree(cache->bm_mask); Safefree(cache); } /* prime_count(LIM_SMALL) <= 65535 */ #define LIM_SMALL 821640 void* prime_count_cache_create(UV n) { pc_cache_t *cache; if (n < 5) n = 5; #if BITS_PER_WORD == 64 /* The prime count has to fit in a uint32_t, so must be < 104484802057 */ /* Further limit to ~ 3GB. */ if (n > UVCONST( 34359738367)) n = UVCONST( 34359738367); #endif prime_precalc(LIM_SMALL); Newz(0, cache, 1, pc_cache_t); /* Allocate cache object, everything zero */ cache->last_n = n; /* Fill in small counts */ { uint32_t const count_last_n = (n <= LIM_SMALL) ? n : LIM_SMALL; uint32_t const count_last_idx = (count_last_n-1) >> 1; uint32_t idx = 1; uint16_t cnt = 1, *counts; New(0, counts, count_last_idx+1, uint16_t); counts[0] = 1; START_DO_FOR_EACH_PRIME(3, count_last_n) { while (idx < ((p-1)>>1)) counts[idx++] = cnt; counts[idx++] = ++cnt; } END_DO_FOR_EACH_PRIME while (idx <= count_last_idx) counts[idx++] = cnt; cache->count = counts; cache->last_count_n = count_last_n; } /* Fill in bitmask and base counts */ if (n > cache->last_count_n) { UV *mask; uint32_t *count, i; uint32_t words = (n / (2*BITS_PER_WORD)) + 1; /* 0-127=1, 128-255=2 */ Newz(0, count, words, uint32_t); Newz(0, mask, words, UV); mask[0] = UVCONST(15) << (BITS_PER_WORD-4); { unsigned char* segment; UV seg_base, seg_low, seg_high; void* 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 ) UV m = (p-1)>>1; uint32_t midx = m / BITS_PER_WORD; uint32_t mrem = m % BITS_PER_WORD; mask[midx] |= UVCONST(1) << (BITS_PER_WORD-1-mrem); END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } for (i = 1; i < words; i++) count[i] = count[i-1] + popcnt(mask[i-1]); cache->bm_mask = mask; cache->bm_count = count; cache->last_bmask_n = n; } verify_cache(cache); return cache; } void* prime_count_cache_create_with_primes(const uint32_t *primes, uint32_t lastidx) { #if 0 /* Slower */ return prime_count_cache_create(primes[lastidx]); #else /* Faster, but so much code duplication.... */ pc_cache_t *cache; uint32_t i, n; MPUassert(primes != 0, "prime_count_cache_create called with null pointer"); if (lastidx <= 1) return prime_count_cache_create(5); if (lastidx > 203280221) lastidx = 203280221; Newz(0, cache, 1, pc_cache_t); /* Allocate cache object, everything zero */ cache->last_n = n = primes[lastidx]; /* Fill in small counts */ { uint32_t const count_last_n = (n <= LIM_SMALL) ? n : LIM_SMALL; uint32_t const count_last_idx = (count_last_n-1) >> 1; uint32_t idx = 1; uint16_t cnt = 1, *counts; New(0, counts, count_last_idx+1, uint16_t); counts[0] = 1; for (i = 2; i <= lastidx; i++) { uint32_t p = primes[i]; if (p > count_last_n) break; while (idx < ((p-1)>>1)) counts[idx++] = cnt; counts[idx++] = ++cnt; } while (idx <= count_last_idx) counts[idx++] = cnt; cache->count = counts; cache->last_count_n = count_last_n; } /* Fill in bitmask and base counts */ if (n > cache->last_count_n) { UV *mask; uint32_t *count; uint32_t words = (n / (2*BITS_PER_WORD)) + 1; /* 0-127=1, 128-255=2 */ Newz(0, count, words, uint32_t); Newz(0, mask, words, UV); mask[0] = UVCONST(1) << (BITS_PER_WORD-1); for (i = 2; i <= lastidx; i++) { uint32_t p = primes[i]; uint32_t m = (p-1)>>1; uint32_t midx = m / BITS_PER_WORD; uint32_t mrem = m % BITS_PER_WORD; mask[midx] |= UVCONST(1) << (BITS_PER_WORD-1-mrem); } for (i = 1; i < words; i++) count[i] = count[i-1] + popcnt(mask[i-1]); cache->bm_mask = mask; cache->bm_count = count; cache->last_bmask_n = n; } verify_cache(cache); return cache; #endif } Math-Prime-Util-0.74/twin_primes.h000644 000765 000024 00000000532 15145577415 017117 0ustar00danastaff000000 000000 #ifndef MPU_TWIN_PRIMES_H #define MPU_TWIN_PRIMES_H #include "ptypes.h" extern UV twin_prime_count_range(UV beg, UV end); extern UV twin_prime_count(UV n); extern UV twin_prime_count_approx(UV n); extern UV nth_twin_prime(UV n); extern UV nth_twin_prime_approx(UV n); extern UV range_twin_prime_sieve(UV** list, UV lo, UV hi); #endif Math-Prime-Util-0.74/factor.c000644 000765 000024 00000161457 15154713505 016036 0ustar00danastaff000000 000000 #include #include #include #include #define FUNC_ipow 1 #define FUNC_isqrt 1 #define FUNC_gcd_ui 1 #define FUNC_is_perfect_square 1 #define FUNC_clz 1 #define FUNC_log2floor 1 #include "ptypes.h" #include "factor.h" #include "sieve.h" #include "util.h" #include "sort.h" #include "mulmod.h" #include "cache.h" #include "primality.h" #include "lucas_seq.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])) /* For doing trial division loops over the small primes. * Returns either 1 or the new unfactored n. * Puts any factors in place and increments *nfactors. * Assumes n has no factors smaller than primes_small[sp]. * Will check primes_small[sp] .. primes_small[endsp] inclusive. * endsp will be clamped to NPRIMES_SMALL-1. */ static uint32_t _trial32(uint32_t n, UV *factors, int *nfactors, uint32_t sp, uint32_t endsp) { uint32_t f; if (sp < 1) sp = 1; if (endsp > NPRIMES_SMALL-1) endsp = NPRIMES_SMALL-1; if (sp > endsp || n == 1) return n; do { f = primes_small[sp]; if (f*f > n) break; while (n % f == 0) { factors[(*nfactors)++] = f; n /= f; } } while (++sp <= endsp); if (f*f > n && n != 1) { factors[(*nfactors)++] = n; n = 1; } return n; } static UV _trialuv(UV n, UV *factors, int *nfactors, uint32_t sp, uint32_t endsp) { uint32_t f; if (sp < 1) sp = 1; if (endsp > NPRIMES_SMALL-1) endsp = NPRIMES_SMALL-1; if (sp > endsp || n == 1) return n; do { f = primes_small[sp]; if (f*f > n) break; while (n % f == 0) { factors[(*nfactors)++] = f; n /= f; } } while (++sp <= endsp); if (f*f > n && n != 1) { factors[(*nfactors)++] = n; n = 1; } return n; } static int _small_trial_factor(UV n, UV *factors, UV *newn, uint32_t *lastf) { int nfactors = 0; uint32_t const endsp = 82; uint32_t sp = 4; 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; } } /* Trial primes 7 to 421 */ n = (n <= 4294967295U) ? _trial32(n, factors, &nfactors, sp, endsp) : _trialuv(n, factors, &nfactors, sp, endsp); sp = endsp+1; /* 83 */ f = primes_small[sp]; /* 431 */ if (n < 2017*2017 && f*f <= n) { /* Trial division from 431 to 2011 */ uint32_t const lastsp = NPRIMES_SMALL-1; n = _trial32(n, factors, &nfactors, sp, lastsp); f = 2017; } 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) { uint32_t root; int nfactors, i, j, k; if (n > 3 && (k = powerof_ret(n, &root))) { nfactors = factor(root, 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, bool primality, bool 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 #if BITS_PER_WORD == 64 /* For small semiprimes the fastest solution is HOLF under 32, then * Lehman (no trial) under 38. On random inputs, HOLF is best somewhere * between 28 and 32 bits. Adding Lehman is always slower. */ if (n <= 0xFFFFFFFFU) { nfactors = holf32(n, factors, 10000); /* 2400 is enough */ if (nfactors > 1) return nfactors; } #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 = 100 + ( 100 * ((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 /* 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 = pbrent_factor(n, factors, 500000, 5); if (nfactors > 1) return nfactors; nfactors = prho_factor(n, factors, 180000); if (nfactors > 1) return nfactors; nfactors = cheb_factor(n, factors, 1000000, 0); 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; } void factorintp(factored_t *nf, UV n) { UV fac[MPU_MAX_FACTORS], *f = nf->f; uint8_t *e = nf->e; uint32_t nfactors, i, j; nf->n = n; if (n < 4) { f[0] = n; e[0] = 1; nf->nfactors = 1 - (n==1); return; } nfactors = factor(n, fac); f[0] = fac[0]; e[0] = 1; for (i = 1, j = 0; i < nfactors; i++) { if (fac[i] == fac[i-1]) e[j]++; else f[++j] = fac[i], e[j] = 1; } nf->nfactors = (uint16_t)j+1; } void factoredp_validate(const factored_t *nf) { if (nf->n == 0) { MPUassert(nf->nfactors == 1, "factored_t n=0 => nfactors = 0"); MPUassert(nf->f[0] == 0 && nf->e[0] == 1, "factored_t n=0 => vecprod = n"); } else if (nf->n == 1) { MPUassert(nf->nfactors == 0, "factored_t n=1 => nfactors = 0"); } else { UV lf = 0, N = 1, t; uint32_t i; MPUassert(nf->nfactors <= MPU_MAX_DFACTORS, "factored_t n has too many factors"); for (i = 0; i < nf->nfactors; i++) { MPUassert(is_prime(nf->f[i]), "factored_t n has non-prime factor"); MPUassert(lf < nf->f[i], "factored_t factors not in order"); lf = nf->f[i]; MPUassert(nf->e[i] < BITS_PER_WORD, "factored_t exponent k too high"); MPUassert(nf->e[i] > 0, "factored_t exponent k too low"); if (nf->e[i] == 1) { N *= nf->f[i]; } else { t = ipowsafe(nf->f[i], nf->e[i]); MPUassert(t != UV_MAX, "factored_t f^e overflows") N *= t; } } MPUassert(N == nf->n, "factored_t n is not equal to f^e * f^e ..."); } } uint32_t factoredp_total_factors(const factored_t *nf) { uint32_t i, nfacs = 0; for (i = 0; i < nf->nfactors; i++) nfacs += nf->e[i]; return nfacs; } bool factoredp_is_square_free(const factored_t *nf) { uint32_t i; for (i = 0; i < nf->nfactors; i++) if (nf->e[i] > 1) break; return i >= nf->nfactors; } signed char factoredp_moebius(const factored_t *nf) { #if 0 return !factoredp_is_square_free(nf) ? 0 : nf->nfactors % 2 ? -1 : 1; #else uint32_t i; for (i = 0; i < nf->nfactors; i++) if (nf->e[i] > 1) return 0; return nf->nfactors % 2 ? -1 : 1; #endif } uint32_t factoredp_linear_factors(UV fac[], const factored_t *nf) { uint32_t i, nfac = 0; for (i = 0; i < nf->nfactors; i++) { UV f = nf->f[i], e = nf->e[i]; while (e--) fac[nfac++] = f; } return nfac; } /******************************************************************************/ int prime_bigomega(UV n) { UV factors[MPU_MAX_FACTORS+1]; return factor(n, factors); } int prime_omega(UV n) { if (n <= 1) return (n==0); return factorint(n).nfactors; } 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 UV _divisors_from_factors(UV* res, factored_t nf, UV k) { UV count; uint32_t i; res[0] = count = 1; for (i = 0; i < nf.nfactors; i++) { UV s, scount = count, p = nf.f[i], mult = 1; uint32_t j, e = nf.e[i]; for (j = 0; j < e; j++) { mult *= p; for (s = 0; s < scount; s++) { UV t = res[s] * mult; if (t <= k) res[count++] = t; } } } return count; } UV* divisor_list(UV n, UV *num_divisors, UV maxd) { factored_t nf; UV ndivisors, *divs; uint32_t i; if (n == 0 || maxd == 0) { *num_divisors = 0; return 0; } else if (n == 1 || maxd == 1) { New(0, divs, 1, UV); divs[0] = 1; *num_divisors = 1; return divs; } if (maxd > n) maxd = n; /* Factor and convert to factor/exponent pair */ nf = factorint(n); /* Calculate number of divisors, allocate space, fill with divisors */ ndivisors = nf.e[0] + 1; for (i = 1; i < nf.nfactors; i++) ndivisors *= (nf.e[i] + 1); New(0, divs, ndivisors, UV); ndivisors = _divisors_from_factors(divs, nf, maxd); /* Sort divisors (numeric ascending) */ sort_uv_array(divs, ndivisors); /* 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) { factored_t nf; UV product; uint32_t i, j; if (k > 11 || (k > 0 && n >= sigma_overflow[k-1])) return 0; /* divisors(0) = [] divisors(1) = [1] */ if (n <= 1) return n; nf = factorint(n); product = 1; if (k == 0) { for (i = 0; i < nf.nfactors; i++) product *= (nf.e[i]+1); } else if (k == 1) { for (i = 0; i < nf.nfactors; i++) { UV f = nf.f[i]; uint16_t e = nf.e[i]; UV pke = f, fmult = 1 + f; while (e-- > 1) { pke *= f; fmult += pke; } product *= fmult; } } else { for (i = 0; i < nf.nfactors; i++) { UV f = nf.f[i]; uint16_t e = nf.e[i]; UV fmult, pke, pk = f; for (j = 1; j < k; j++) pk *= f; fmult = 1 + pk; pke = pk; while (e-- > 1) { pke *= pk; fmult += pke; } product *= fmult; } } return product; } /******************************************************************************/ /******************************************************************************/ /******************************************************************************/ static int found_factor(UV n, UV f, UV* factors) { UV g = n/f; if (f == 1 || f == n) { factors[0] = n; return 1; } factors[f >= g] = f; factors[f < g] = g; MPUassert( factors[0] * factors[1] == n , "incorrect factoring"); return 2; } static int no_factor(UV n, UV* factors) { factors[0] = n; return 1; } /* 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) return no_factor(n,factors); 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; uint32_t root; 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_ret(n,&root)) return found_factor(n, root, 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; while (rounds--) { s = 1 + (UV)isqrt(ni); m = (s*s) - ni; if (is_perfect_square_ret(m, &root)) { f = gcd_ui(n, s - root); if (f > 1 && f < n) return found_factor(n, f, factors); } if (ni >= (ni+npre)) break; ni += npre; } if (rounds == (UV) -1) return no_factor(n,factors); } 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_ret(m, &root)) { f = gcd_ui( (s>root) ? s-root : root-s, n); /* This should always succeed, but with overflow concerns.... */ return found_factor(n, f, factors); } } return no_factor(n,factors); } 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) return no_factor(n,factors); if (!(n&1)) { factors[0] = 2; factors[1] = n/2; return 2; } if (is_perfect_square_ret(n,&f)) { factors[0] = factors[1] = f; return 2; } ni = npre = (UV) n * ((BITS_PER_WORD == 64) ? 5040 : 1); while (rounds--) { s = 1 + isqrt(ni); m = ((UV)s*(UV)s) - ni; if (is_perfect_square_ret(m, &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; } return no_factor(n,factors); } #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); } return no_factor(n,factors); } #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); } return no_factor(n,factors); } #endif /* Pollard's Rho. */ int prho_factor(UV n, UV *factors, UV rounds) { UV f, i, m, oldU, oldV; const UV inner = 64; UV U = 7; UV V = 7; UV a = 1; int fails = 3; MPUassert( (n >= 3) && ((n%2) != 0) , "bad n in prho_factor"); 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 += 2; continue; } return found_factor(n, f, factors); } return no_factor(n,factors); } /* 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) return no_factor(n,factors); 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; uint32_t root; P = mult_save->P; bn = mult_save->bn; Qn = mult_save->Qn; Q0 = mult_save->Q0; b0 = mult_save->b0; i = mult_save->it; imax = i + mult_save->imax; #define SQUARE_SEARCH_ITERATION \ t1 = P; \ P = bn*Qn - P; \ t2 = Qn; \ Qn = Q0 + bn*(t1-P); \ Q0 = t2; \ bn = (b0 + P) / Qn; \ i++; while (1) { int j = 0; if (i & 0x1) { SQUARE_SEARCH_ITERATION; } /* i is now even */ while (1) { /* We need to know P, bn, Qn, Q0, iteration count, i from prev */ if (i >= imax) { /* save state and try another multiplier. */ mult_save->P = P; mult_save->bn = bn; mult_save->Qn = Qn; mult_save->Q0 = Q0; mult_save->it = i; return 0; } SQUARE_SEARCH_ITERATION; /* Even iteration. Check for square: Qn = S*S */ if (is_perfect_square_ret(Qn,&root)) break; /* Odd iteration. */ SQUARE_SEARCH_ITERATION; } S = root; /* 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) return no_factor(n,factors); 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 */ } } return no_factor(n,factors); } #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, bool 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+icbrt(n)); 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 BITS_PER_WORD == 64 if (n >= UVCONST(8796393022207)) return no_factor(n,factors); #endif 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 BITS_PER_WORD == 64 if (kN >= UVCONST(1152921504606846976)) return no_factor(n,factors); #endif 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 */ if (is_perfect_square_ret(c,&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); } return no_factor(n,factors); } /* Chebyshev polynomials of the first kind T_n(x) = V_n(2x,1) / 2. */ /* Basic algorithm from Daniel "Trizen" Șuteu */ int cheb_factor(UV n, UV *factors, UV B, UV initx) { UV sqrtB, inv, x, f, i; if (B == 0) { B = log2floor(n); B = 8*B*B; } if (B > isqrt(n)) B = isqrt(n); sqrtB = isqrt(B); inv = modinverse(2,n); /* multiplying by this will divide by two */ x = (initx == 0) ? 72 : initx; f = 1; START_DO_FOR_EACH_PRIME(2, B) { if (p <= sqrtB) { UV lgp = logint(B, p); UV plgp = ipowsafe(p, lgp); if (plgp < UV_MAX) { x = mulmod(lucasvmod(addmod(x,x,n), 1, plgp, n), inv, n); } else { for (i = 1; i <= lgp; i++) x = mulmod(lucasvmod(addmod(x,x,n), 1, p, n), inv, n); } } else { x = mulmod(lucasvmod(addmod(x,x,n), 1, p, n), inv, n); } f = gcd_ui(x-1, n); if (f > 1) break; } END_DO_FOR_EACH_PRIME if (f > 1 && f < n) return found_factor(n, f, factors); return no_factor(n,factors); } static const uint32_t _fr_chunk = 256*1024; /* Help performance by doing a cube root sieve for small ranges */ static bool _fr_full_sieve(UV sqrtn, UV range) /* range = hi-lo */ { if (sqrtn < 10000000U) return 1; /* Below 10^14 */ if (sqrtn < 35000000U) return (range > 900); /* Below 10^15 */ if (sqrtn < 100000000U) return (range > 1700); /* Below 10^16 */ if (sqrtn < 350000000U) return (range > 3400); /* Below 10^17 */ if (sqrtn < 1000000000U) return (range > 5500); /* Below 10^18 */ if (sqrtn < 3500000000U) return (range > 17000); /* Below 10^19 */ return (range > 19000); } static void _vec_factor(UV lo, UV hi, UV *nfactors, UV *farray, UV noffset, bool 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 = _fr_full_sieve(sqrthi, hi-lo) ? 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, bool square_free) { factor_range_context_t ctx; ctx.lo = lo; ctx.hi = hi; ctx.n = lo-1; ctx.is_square_free = square_free; 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 (!_fr_full_sieve(t, hi-lo)) 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 < clo) 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; } /******************************************************************************/ /* Find number of factors for all values in a range */ /******************************************************************************/ unsigned char* range_nfactor_sieve(UV lo, UV hi, bool with_multiplicity) { unsigned char* nf; UV *N, i, range = hi-lo+1, sqrtn = isqrt(hi); Newz(0, nf, range, unsigned char); New(0, N, range, UV); /* We could set to 1 and sieve from 2, or do this initialization */ for (i = lo; i <= hi && i >= lo; i++) { N[i-lo] = 1; if (!(i&1) && i >= 2) { UV k = i >> 1; unsigned char nz = 1; while (!(k&1)) { nz++; k >>= 1; } nf[i-lo] = (with_multiplicity) ? nz : 1; N[i-lo] = UVCONST(1) << nz; } } START_DO_FOR_EACH_PRIME(3, sqrtn) { UV pk, maxpk = UV_MAX/p; \ for (i = P_GT_LO_0(p,p,lo); i < range; i += p) { N[i] *= p; nf[i]++; } for (pk = p*p; pk <= hi; pk *= p) { for (i = P_GT_LO_0(pk,pk,lo); i < range; i += pk) { N[i] *= p; if (with_multiplicity) nf[i]++; } if (pk >= maxpk) break; /* Overflow protection */ } } END_DO_FOR_EACH_PRIME for (i = 0; i < range; i++) if (N[i] < (lo+i)) nf[i]++; Safefree(N); if (lo == 0) nf[0] = 1; return nf; } /******************************************************************************/ /* 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, bool 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 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; } /* This is confusing */ 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) { factored_t pf; UV x, sol[MPU_MAX_DFACTORS], mod[MPU_MAX_DFACTORS]; uint32_t i; if (p1 == 0) return 0; /* TODO: Should we plow on with p1=p-1? */ pf = factorint(p1); if (pf.nfactors == 1) return znlog_solve(a, g, p, p1); for (i = 0; i < pf.nfactors; i++) { UV pi = ipow(pf.f[i],pf.e[i]); UV delta = powmod(a,p1/pi,p); UV gamma = powmod(g,p1/pi,p); /* printf(" solving znlog(%"UVuf",%"UVuf",%"UVuf")\n", delta, gamma, p); */ sol[i] = znlog_solve( delta, gamma, p, znorder(gamma,p) ); mod[i] = pi; } if (chinese(&x, 0, sol, mod, pf.nfactors) == 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; /* TODO: Can these tests every fail? Do we need aorder? */ 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_counts.c prime_count_cache.c lmo.c legendre_phi.c real.c inverse_interpolate.c rootmod.c lucas_seq.c prime_powers.c sort.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.74/lucky_numbers.h000644 000765 000024 00000001200 15145577415 017432 0ustar00danastaff000000 000000 #ifndef MPU_LUCKY_NUMBERS_H #define MPU_LUCKY_NUMBERS_H #include "ptypes.h" extern bool is_lucky(UV n); extern uint32_t* lucky_sieve32(UV *size, uint32_t n); extern UV* lucky_sieve64(UV *size, UV n); extern UV* lucky_sieve_cgen(UV *size, UV n); extern UV* lucky_sieve_range(UV *size, UV beg, UV end); extern UV lucky_count_range(UV lo, UV hi); extern UV lucky_count(UV n); extern UV lucky_count_upper(UV n); extern UV lucky_count_lower(UV n); extern UV lucky_count_approx(UV n); extern UV nth_lucky(UV n); extern UV nth_lucky_lower(UV n); extern UV nth_lucky_upper(UV n); extern UV nth_lucky_approx(UV n); #endif Math-Prime-Util-0.74/inc/000755 000765 000024 00000000000 15154713771 015154 5ustar00danastaff000000 000000 Math-Prime-Util-0.74/legendre_phi.c000644 000765 000024 00000052360 15151337313 017171 0ustar00danastaff000000 000000 #include #include #include #define FUNC_isqrt 1 #include "sieve.h" #include "util.h" #include "prime_counts.h" #include "prime_count_cache.h" #include "legendre_phi.h" /* * tablephi / tiny_phi * a must be very small (e.g. 6, 7) * direct answer * * phi_small * a must be very small (e.g. 15) * calls tablephi * simple iteration using fixed size lists * * phi_recurse_small * memoryless recursive * calls phi_small, nth_prime (if a > 25), prev_prime, next_prime * good for very small a (e.g. less than 25) * * phi_recurse * recursive with a cache * calls tablephi, prime_count_cache, phi_recurse internal * generates primes to max(nth_prime(a),isqrt(x)) * * phi_walk * iterative using list merges * calls tablephi, prime_count_cache, phi_recurse internal * generates primes to max(nth_prime(a),isqrt(x)) * complicated, can be much faster than the others, but uses a lot of memory * * legendre_phi * decides what to do, including handling some special cases */ /*============================================================================*/ #define FAST_DIV(x,y) \ ( ((x) <= 4294967295U) ? (uint32_t)(x)/(uint32_t)(y) : (x)/(y) ) #define PHIC 6U /* phi(x,a) with a <= PHIC can go to tablephi */ #define PHIS 15U /* phi(x,a) with a <= PHIS can go to phi_small */ #define PHIS_XMIN (_snth[PHIS+1]-1U) /* nth_prime(PHIS+1)-1 */ #define PHIR 20U /* phi(x,a) with a <= PHIR is faster with phi_recurse_small */ /*============================================================================*/ /* For x >= 1 and a >= 4, phi(x,a) = phi(x-_pred7[x%210],a) * This allows us to collapse multiple x values, useful for caching. */ static const unsigned char _pred7[210] = {1,0,1,2,3,4,5,6,7,8,9,0,1,0,1,2,3,0,1,0,1,2,3,0,1,2,3,4,5,0,1,0,1,2,3,4,5,0,1,2,3,0,1,0,1,2,3,0,1,2,3,4,5,0,1,2,3,4,5,0,1,0,1,2,3,4,5,0,1,2,3,0,1,0,1,2,3,4,5,0,1,2,3,0,1,2,3,4,5,0,1,2,3,4,5,6,7,0,1,2,3,0,1,0,1,2,3,0,1,0,1,2,3,0,1,2,3,4,5,6,7,0,1,2,3,4,5,0,1,2,3,0,1,2,3,4,5,0,1,0,1,2,3,0,1,2,3,4,5,0,1,0,1,2,3,4,5,0,1,2,3,4,5,0,1,2,3,0,1,0,1,2,3,0,1,2,3,4,5,0,1,0,1,2,3,4,5,0,1,2,3,0,1,0,1,2,3,0,1,0,1,2,3,4,5,6,7,8,9,0}; /* Maps x to value <= x not divisible by first 4 primes */ /* mpu 'say join(",",map { legendre_phi($_,4)-1 } 0..209);' */ static const int8_t _coprime_idx210[210]={-1,0,0,0,0,0,0,0,0,0,0,1,1,2,2,2,2,3,3,4,4,4,4,5,5,5,5,5,5,6,6,7,7,7,7,7,7,8,8,8,8,9,9,10,10,10,10,11,11,11,11,11,11,12,12,12,12,12,12,13,13,14,14,14,14,14,14,15,15,15,15,16,16,17,17,17,17,17,17,18,18,18,18,19,19,19,19,19,19,20,20,20,20,20,20,20,20,21,21,21,21,22,22,23,23,23,23,24,24,25,25,25,25,26,26,26,26,26,26,26,26,27,27,27,27,27,27,28,28,28,28,29,29,29,29,29,29,30,30,31,31,31,31,32,32,32,32,32,32,33,33,34,34,34,34,34,34,35,35,35,35,35,35,36,36,36,36,37,37,38,38,38,38,39,39,39,39,39,39,40,40,41,41,41,41,41,41,42,42,42,42,43,43,44,44,44,44,45,45,46,46,46,46,46,46,46,46,46,46,47}; static UV _toindex210(UV x) { UV q = x / 210, r = x % 210; return 48 * q + _coprime_idx210[r]; } /* Small table of nth primes */ static const unsigned char _snth[25+1] = {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}; /*============================================================================*/ /* 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_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 + _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: #if PHIC == 6 default: #endif { 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]); } #if PHIC == 7 case 7: default:return tablephi(x,a-1) - tablephi(x/17,a-1); /* Hacky */ #endif } } /*============================================================================*/ /* Iterate with simple arrays, no merging or cleverness. */ static UV phi_small(UV x, uint32_t a) { UV sum = 0, xpos[1025], xneg[1025]; /* For 32-bit x, 848 is enough */ uint32_t i, npos, nneg; if (a < 4) { return (a==0) ? x : (a==1) ? x-x/2 : (a==2) ? x-x/2-x/3+x/6 : (x/30U) * 8U + _s3[x % 30U]; } MPUassert(a <= PHIS, "phi_small: a too large"); if (x < _snth[a+1]) return (x>0); for (npos = nneg = 0, xpos[npos++] = x; a > 4U; a--) { uint32_t oneg = nneg, opos = npos; for (i = 0; i < opos; i++) if (xpos[i] >= _snth[a]) xneg[nneg++] = xpos[i]/_snth[a]; for (i = 0; i < oneg; i++) if (xneg[i] >= _snth[a]) xpos[npos++] = xneg[i]/_snth[a]; } for (i = 0; i < npos; i++) sum += (xpos[i]/210U)*48U + _s4[xpos[i] % 210U]; for (i = 0; i < nneg; i++) sum -= (xneg[i]/210U)*48U + _s4[xneg[i] % 210U]; return sum; } /*============================================================================*/ /* Recurse until a <= PHIS */ static UV phi_recurse_small(UV x, UV a) { UV sum, i, xp, p, npa; if (x < 1 || a >= x) return (x > 0); if (a <= PHIS || x <= PHIS_XMIN) return phi_small(x, a); npa = (a <= 25) ? _snth[a] : nth_prime(a); sum = phi_small(x, PHIS); p = _snth[PHIS]; for (i = PHIS+1; i <= a; i++) { p = next_prime(p); xp = FAST_DIV(x,p); if (xp < p) { while (x < npa) { a--; npa = prev_prime(npa); } return (sum - a + i - 1); } sum -= phi_recurse_small(xp, i-1); } return sum; } /*============================================================================*/ /*============================================================================*/ /* Cache for phi(x,a) */ #define PHICACHEA 512 typedef struct { uint32_t siz[PHICACHEA]; /* how many entries we have allocated */ uint16_t *val[PHICACHEA]; uint32_t xlim; } phi_cache_t; static phi_cache_t* phi_cache_create(uint32_t xlim) { phi_cache_t *cache; int a; New(0, cache, 1, phi_cache_t); for (a = 0; a < PHICACHEA; a++) { cache->val[a] = 0; cache->siz[a] = 0; } cache->xlim = (xlim < 0xFFFFFFFFU) ? xlim : xlim-1; /* Reserve 0xFFFFFFFF */ return cache; } static void phi_cache_destroy(phi_cache_t* cache) { int a; for (a = 0; a < PHICACHEA; a++) { if (cache->val[a] != 0) Safefree(cache->val[a]); } Safefree(cache); } static void phi_cache_insert(uint32_t x, uint32_t a, IV sum, phi_cache_t* cache) { uint32_t i, newsize; if (sum < 0) sum = -sum; if (sum > 65535) return; /* If sum is too large for the cache, ignore it. */ if (x >= cache->siz[a]) { newsize = (x >= 0xFFFFFFFFUL-32) ? 0xFFFFFFFFUL-1 : x+32; if (cache->val[a] == 0) { Newz(0, cache->val[a], newsize, uint16_t); } else { Renew(cache->val[a], newsize, uint16_t); for (i = cache->siz[a]; i < newsize; i++) /* Zero the new entries */ cache->val[a][i] = 0; } cache->siz[a] = newsize; } cache->val[a][x] = (uint16_t) sum; } /* End of Phi cache definitions */ /* Struct of everything needed for recursive phi call */ typedef struct { const uint32_t* primes; uint32_t lastidx; void* cachepc; phi_cache_t* cachephi; } phidata_t; static phidata_t* phidata_create(const uint32_t* primes, uint32_t lastidx, UV x, UV a) { phidata_t *d; uint32_t xlim = (UV) pow(x, 1.0/2.70); if (xlim < 256) xlim = 256; (void)a; /* Currently unused */ New(0, d, 1, phidata_t); d->primes = primes; d->lastidx = lastidx; d->cachepc = prime_count_cache_create_with_primes(primes, lastidx); d->cachephi = phi_cache_create(xlim); return d; } static void phidata_destroy(phidata_t *d) { phi_cache_destroy(d->cachephi); prime_count_cache_destroy(d->cachepc); /* They own the primes */ Safefree(d); } #define PHI_IS_X_SMALL(x, a) \ ( ((x) <= primes[d->lastidx]) && ((x) < (UV)primes[a+1] * primes[a+1]) ) #define PHI_PRIMECOUNT(x) \ prime_count_cache_lookup(d->cachepc, (x)) /* The recursive cached phi routine, given the struct with primes and cache */ static IV _phi3(UV x, UV a, int sign, phidata_t *d) { const uint32_t* const primes = d->primes; phi_cache_t* pcache = d->cachephi; UV mapx; if (x < primes[a+1]) return sign; else if (a <= PHIC) return sign * tablephi(x,a); else if (PHI_IS_X_SMALL(x,a)) return sign * (PHI_PRIMECOUNT(x) - a + 1); /* Choose a mapping: x, (x+1)>>1, _toindex30(x), _toindex210(x) */ mapx = (a < PHICACHEA) ? _toindex210(x) : 0; if (a < PHICACHEA && mapx < pcache->siz[a]) { IV v = pcache->val[a][mapx]; if (v != 0) return sign * v; } { UV xp, i, iters = ((UV)a*a > x) ? PHI_PRIMECOUNT(isqrt(x)) : a; UV c = (iters > PHIC) ? PHIC : iters; IV sum = sign * (iters - a + tablephi(x,c)); /* for (i=c; ixlim) phi_cache_insert(mapx, a, sum, pcache); return sum; } } static UV phi_recurse(UV x, UV a) { uint32_t* primes; uint32_t lastidx; UV primes_to_n, sum = 1; if (x < 1 || a >= x) return (x > 0); if (a <= PHIS || x <= PHIS_XMIN) return phi_small(x, a); if (a > 203280221) croak("64-bit phi out of range"); primes_to_n = nth_prime_upper(a); if (isqrt(x) > primes_to_n) primes_to_n = isqrt(x); lastidx = range_prime_sieve_32(&primes, primes_to_n, 1); if (primes[a] < x) { phidata_t *d = phidata_create(primes, lastidx, x, a); /* Ensure testing with legendre_phi(1e13, 203280221) +/- 2 */ /* sum = (UV) _phi3(x, a, 1, d); */ sum = (UV) _phi3(x, a-1, 1, d) - (UV) _phi3(x/primes[a], a-1, 1, d); phidata_destroy(d); } Safefree(primes); return sum; } /*============================================================================*/ /*============================================================================*/ static int const verbose = 0; #define MAX_PHI_MEM (896*1024*1024) #define NTHRESH (MAX_PHI_MEM/16) /******************************************************************************/ /* 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. Must be done in decreasing size order. */ static void vcarray_insert(vcarray_t* l, UV val, IV count) { UV n = l->n; vc_t* arr = l->a; if (n > 0 && arr[n-1].v <= val) { if (arr[n-1].v == val) { arr[n-1].c += count; return; } croak("Previous value was %lu, inserting %lu out of order\n", arr[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; arr = l->a; } arr[n].v = val; arr[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; } /* phi(x,a) non-recursive, using list merging. Memory intensive. */ static UV phi_walk(UV x, UV a) { UV i, sval, lastidx, lastprime, primes_to_n; UV sum = 0; uint32_t* primes; vcarray_t a1, a2; vc_t* arr; phidata_t *d; if (x < 1 || a >= x) return (x > 0); if (x <= PHIC || a <= PHIC) return tablephi(x, (a > PHIC) ? PHIC : a); if (a > 203280221) croak("64-bit phi out of range"); primes_to_n = nth_prime_upper(a); if (isqrt(x) > primes_to_n) primes_to_n = isqrt(x); lastidx = range_prime_sieve_32(&primes, primes_to_n, 1); lastprime = primes[lastidx]; if (x < lastprime) { Safefree(primes); return 1; } d = phidata_create(primes, lastidx, x, a); a1 = vcarray_create(); a2 = vcarray_create(); vcarray_insert(&a1, x, 1); while (a > PHIC) { UV primea = primes[a]; arr = a1.a; for (i = 0; i < a1.n; i++) { sval = FAST_DIV(arr[i].v, primea); sval -= _pred7[sval % 210]; /* Reduce to lower value if possible */ if (sval < primea || PHI_IS_X_SMALL(sval, a-1)) break; vcarray_insert(&a2, sval, -arr[i].c); } for ( ; i < a1.n; i++) { sval = FAST_DIV(arr[i].v, primea); if (sval < primea) break; sum -= arr[i].c * (PHI_PRIMECOUNT(sval)-a+2); } 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); 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 * _phi3( arr[j].v, a-1, 1, d ); arr[j].c = 0; } } } vcarray_remove_zeros(&a1); a--; } phidata_destroy(d); Safefree(primes); vcarray_destroy(&a2); arr = a1.a; for (i = 0; i < a1.n; i++) sum += arr[i].c * tablephi( arr[i].v, PHIC ); vcarray_destroy(&a1); return (UV) sum; } /*============================================================================*/ /*============================================================================*/ uint32_t tiny_phi_max_a(void) { return PHIC; } UV tiny_phi(UV n, uint32_t a) { return (a <= PHIC) ? tablephi(n, a) : (a <= PHIS) ? phi_small(n, a) : phi_recurse_small(n, a); } uint32_t small_phi_max_a(void) { return PHIS; } UV small_phi(UV n, uint32_t a) { return (a <= PHIS) ? phi_small(n, a) : phi_recurse(n, a); } /*============================================================================*/ /*============================================================================*/ void* prepare_cached_legendre_phi(UV x, UV a) { uint32_t npa, lastidx, *primes; if (a > 203280221) a = 203280221; npa = nth_prime_upper(a); if (npa < isqrt(x)) npa = isqrt(x); lastidx = range_prime_sieve_32(&primes, npa, 1); return (void*) phidata_create(primes, lastidx, x, a); } UV cached_legendre_phi(void* cache, UV x, UV a) { phidata_t *d = (phidata_t*) cache; if (x < 1 || a >= x) return (x > 0); if (x <= PHIC || a <= PHIC) return tablephi(x, (a > PHIC) ? PHIC : a); if (a > (x >> 1)) return 1; /* Make the function work even if x,a outside of cached conditions */ if (a > 203280221) { /* prime_count(2**32) */ UV pc = prime_count(x); return (a >= pc) ? 1 : pc - a + 1; } if (a > d->lastidx) return legendre_phi(x, a); return (UV) _phi3(x, a-1, 1, d) - (UV) _phi3(x/d->primes[a], a-1, 1, d); } void destroy_cached_legendre_phi(void* cache) { phidata_t *d = (phidata_t*) cache; Safefree(d->primes); phidata_destroy(d); } /* static UV phi_stupid(UV x, UV a) { if (a <= PHIC) return tablephi(x,a); return phi_stupid(x, a-1) - phi_stupid(x/nth_prime(a), a-1); } */ /*============================================================================*/ /*============================================================================*/ UV legendre_phi(UV x, UV a) { UV sqrtx = isqrt(x); /* If 'x' is very small, give a quick answer with any 'a' */ if (x < 1 || a >= x) return (x > 0); if (x <= PHIC || a <= PHIC) return tablephi(x, (a > PHIC) ? PHIC : a); /* Very fast shortcuts for large values */ if (a > (x >> 1)) return 1; if (a >= sqrtx || a > 203280221) { /* 203280221 = prime_count(2^32) */ UV pc = prime_count(x); return (a >= pc) ? 1 : pc - a + 1; } /* After this: 7 <= a <= MIN(203280221, sqrtx) */ /* For very small a, calculate now. */ if (a <= PHIS) return phi_small(x, a); if (a <= PHIR) return phi_recurse_small(x, a); /* Better shortcuts, slightly more time */ if (prime_count_upper(x) <= a) return 1; /* Use 'a' instead of 'a+1' to ensure Legendre Pi doesn't call here */ if (prime_count_upper(sqrtx) < a) { UV pc = prime_count(x); return (a >= pc) ? 1 : pc - a + 1; } /* Because we used the fast bounds, there are still a few easy cases. */ /* The best crossover between recurse and walk is complicated */ /* TODO: More tuning of the crossovers, or just improve the algorithms. */ if (x < 1e10) return phi_recurse(x, a); if ( (x >= 1e10 && x < 1e11 && a < 2000) || (x >= 1e11 && x < 1e12 && a < 4000) || (x >= 1e12 && x < 1e13 && a < 10000) || (x >= 1e13 && x < 1e14 && a < 24000) || (x >= 1e14 && x < 1e15 && a < 80000) || (x > 1e15 && a < 150000) ) return phi_walk(x, a); return phi_recurse(x, a); } /*============================================================================*/ #if 0 // TODO: setup with initial function. optimize. export. IV phi_sum(UV x, UV a, int sign) { IV sum = 0; //if (x < 1) return 0; for (; a > 0; a--) { UV p = nth_prime(a); if (x <= p) { return sum + (long)sign; } sum += p * phi_sum(x / p, a-1, -sign); } if (sign > 0) sum += (x*(x+1))/2; else sum -= (x*(x+1))/2; return sum; } #endif Math-Prime-Util-0.74/sieve.c000644 000765 000024 00000051624 15145577415 015675 0ustar00danastaff000000 000000 #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_counts.h" /* Is it better to do a partial sieve + primality tests vs. full sieve? */ static bool 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; } bool 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 */ bool 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; } bool 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; } /**************************************************************************/ 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 = max_nprimes(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; } bool 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); } UV range_prime_sieve(UV**list, UV lo, UV hi) { UV *P, Psize, i = 0; if (hi < lo) { *list = 0; return 0; } Psize = prime_count_upper(hi) - prime_count_lower(lo) + 1; New(0, P, Psize, UV); if (lo <= 2 && hi >= 2) P[i++] = 2; if (lo <= 3 && hi >= 3) P[i++] = 3; if (lo <= 5 && hi >= 5) P[i++] = 5; { unsigned char* segment; UV seg_base, seg_low, seg_high; void* ctx = start_segment_primes(lo, hi, &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); } *list = P; return i; } uint32_t range_prime_sieve_32(uint32_t** list, uint32_t n, uint32_t offset) { uint32_t *P, i = offset; if (n < 2) { *list = 0; return 0; } New(0, P, max_nprimes(n) + offset + 3, uint32_t); /* Allocate list */ if (offset > 0) memset(P, 0, offset * sizeof(uint32_t)); /* Zero to offset */ P[i++] = 2; P[i++] = 3; P[i++] = 5; /* Fill in 2/3/5 */ if (n >= 7) { unsigned char* segment; UV seg_base, seg_low, seg_high; void* 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 ) P[i++] = p; END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } while (P[i-1] > n) i--; /* Truncate the count if necesssary. */ *list = P; return i-offset; /* Returns number of primes, excluding offset */ } Math-Prime-Util-0.74/prime_sums.h000644 000765 000024 00000000431 15145577415 016740 0ustar00danastaff000000 000000 #ifndef MPU_PRIME_SUMS_H #define MPU_PRIME_SUMS_H #include "ptypes.h" extern bool sum_primes(UV low, UV high, UV *sum); extern UV sum_primes64(UV n); #define HAVE_SUM_PRIMES128 (BITS_PER_WORD == 64 && HAVE_UINT128) extern bool sum_primes128(UV n, UV *hisum, UV *losum); #endif Math-Prime-Util-0.74/util.c000644 000765 000024 00000322116 15154176627 015534 0ustar00danastaff000000 000000 #include #include #include #include #include "ptypes.h" #define FUNC_isqrt 1 #define FUNC_lcm_ui 1 #define FUNC_ctz 1 #define FUNC_log2floor 1 #define FUNC_is_perfect_square #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 "legendre_phi.h" #include "prime_counts.h" #include "prime_powers.h" #include "factor.h" #include "mulmod.h" #include "constants.h" #include "montmath.h" #include "csprng.h" #include "inverse_interpolate.h" #include "rootmod.h" #include "lucas_seq.h" #include "sort.h" static int _verbose = 0; void _XS_set_verbose(int v) { _verbose = v; } int _XS_get_verbose(void) { return _verbose; } static int _call_gmp = 0; void _XS_set_callgmp(int v) { _call_gmp = v; } int _XS_get_callgmp(void) { return _call_gmp; } static bool _secure = 0; void _XS_set_secure(void) { _secure = 1; } bool _XS_get_secure(void) { return _secure; } /******************************************************************************/ /* Returns 0 if not found, index+1 if found (returns leftmost if dups) */ unsigned long index_in_sorted_uv_array(UV v, UV* L, unsigned long len) { unsigned long lo, hi; if (len == 0 || v < L[0] || v > L[len-1]) return 0; lo = 0; hi = len-1; while (lo < hi) { unsigned long mid = lo + ((hi-lo) >> 1); if (L[mid] < v) lo = mid + 1; else hi = mid; } return (L[lo] == v) ? lo+1 : 0; } unsigned long index_in_sorted_iv_array(IV v, IV* L, unsigned long len) { unsigned long lo, hi; if (len == 0 || v < L[0] || v > L[len-1]) return 0; lo = 0; hi = len-1; while (lo < hi) { unsigned long mid = lo + ((hi-lo) >> 1); if (L[mid] < v) lo = mid + 1; else hi = mid; } return (L[lo] == v) ? lo+1 : 0; } /* Do two sorted UV arrays have a non-zero intersection? */ bool do_arrays_intersect_uv(const UV* A, size_t alen, const UV* B, size_t blen) { size_t ia = 0, ib = 0; while (ia < alen && ib < blen) { if (A[ia] == B[ib]) return 1; else if (A[ia] < B[ib]) ia++; else ib++; } return 0; } bool do_arrays_intersect_iv(const IV* A, size_t alen, const IV* B, size_t blen) { size_t ia = 0, ib = 0; while (ia < alen && ib < blen) { if (A[ia] == B[ib]) return 1; else if (A[ia] < B[ib]) ia++; else ib++; } return 0; } /******************************************************************************/ /* 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 true if n is prime, false if not. Do it fast. */ bool is_prime(UV n) { if (n < UVCONST(500000000)) { if (n < 11) return 0xAC >> n & 1; if (is_divis_2_3_5_7(n)) return 0; /* Check static tiny sieve */ if (n < 30*NPRIME_SIEVE30) { UV d = n/30, m = n - d*30; return ((prime_sieve30[d] & masktab30[m]) == 0); } /* Check primary cache */ if (n <= get_prime_cache(0,0)) { const unsigned char* sieve; int isprime = -1; if (!(n%11) || !(n%13)) return 0; if (n <= get_prime_cache(0, &sieve)) { UV d = n/30, m = n - d*30; isprime = ((sieve[d] & masktab30[m]) == 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; } /* We're trying to quickly give a reasonable monotonic upper prime count */ UV max_nprimes(UV n) { /* 2-bit error term of the 1..726 func so 0-143 gives exact results */ static const uint32_t _cor[9] = {0x415556af,0x01400001,0x00014140,0x01150100,0x14001515,0xa5515014,0x01555696,0xbea95501,0xeaabfaba}; double r; if (n < 727) return (13 + n - 7*n*n/16384)/4 - (n < 144 ? _cor[n/16] >> n%16*2 & 3 : 0); r = 1/log(n); if (n < 59471) /* Special */ return (UV)(n*r * (1 + r*(1 + 2.47687*r))) + 1; if (n < 1333894) /* Dusart 2018 x > 1 */ return n*r * (1 + r*(1 + 2.53816*r)); if (n < 883495117) /* Dusart 2022 x > 1 */ return n*r * (1 + r*(1 + r*(2 + 7.59*r))); /* We could use better bounds with Li(n) but that is MUCH slower. */ /* Use prime_count_upper(n) if you want tighter bounds. */ /* Axler 2022 x > 1 Prp 4.6 */ return n*r * (1 + r*(1 + r*(2 + r*(6.024334 + r*(24.024334 + r*(120.12167 + r*(720.73002 + 6098*r))))))); } /******************************************************************************/ /* 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. */ 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; if (hi < lo) croak("range_mobius error hi %"UVuf" < lo %"UVuf"\n", hi, lo); 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] = (signed char)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 = P_GT_LO(p, p, lo); i >= lo && i <= hi; i += p) mu[i-lo] += logp; for (i = P_GT_LO(p2, p2, lo); i >= lo && i <= hi; i += p2) mu[i-lo] = (signed char)0x80; } END_DO_FOR_EACH_PRIME logp = (unsigned char)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; } static short* mertens_array(UV hi) { signed char* mu; short* M; UV i; /* We could blend this with range_moebius but it seems not worth it. */ mu = range_moebius(0, hi); New(0, M, hi+1, short); M[0] = 0; for (i = 1; i <= hi; i++) M[i] = M[i-1] + mu[i]; Safefree(mu); return M; } #if 0 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; } #endif typedef struct { UV n; IV sum; } mertens_value_t; static void _insert_mert_hash(mertens_value_t *H, UV hsize, UV n, IV sum) { UV idx = n % hsize; H[idx].n = n; H[idx].sum = sum; } static int _get_mert_hash(mertens_value_t *H, UV hsize, UV n, IV *sum) { UV idx = n % hsize; if (H[idx].n == n) { *sum = H[idx].sum; return 1; } return 0; } /* Thanks to Trizen for this algorithm. */ static IV _rmertens(UV n, UV maxmu, short *M, mertens_value_t *H, UV hsize) { UV s, k, ns, nk, nk1, mk, mnk; IV sum; if (n <= maxmu) return M[n]; if (_get_mert_hash(H, hsize, n, &sum)) return sum; s = isqrt(n); ns = n / (s+1); sum = 1; #if 0 for (k = 2; k <= ns; k++) sum -= _rmertens(n/k, maxmu, M, H, hsize); for (k = 1; k <= s; k++) sum -= M[k] * (n/k - n/(k+1)); #else /* Take the above: merge the loops and iterate the divides. */ if (s != ns && s != ns+1) croak("mertens s / ns"); nk = n; nk1 = n/2; sum -= (nk - nk1); for (k = 2; k <= ns; k++) { nk = nk1; nk1 = n/(k+1); mnk = (nk <= maxmu) ? M[nk] : _rmertens(nk, maxmu, M, H, hsize); mk = (k <= maxmu) ? M[k] : _rmertens(k, maxmu, M, H, hsize); sum -= mnk + mk * (nk-nk1); } if (s > ns) sum -= _rmertens(s, maxmu, M, H, hsize) * (n/s - n/(s+1)); #endif _insert_mert_hash(H, hsize, n, sum); return sum; } static short* _prep_rmertens(UV n, UV* pmaxmu, UV* phsize) { UV j = icbrt(n); UV maxmu = 1 * j * j; UV hsize = next_prime(100 + 8*j); /* At large sizes, start clamping memory use. */ if (maxmu > 100000000UL) { /* Exponential decay, reduce by factor of 1 to 8 */ double rfactor = 1.0 + 7.0 * (1.0 - exp(-(double)maxmu/8000000000.0)); maxmu /= rfactor; hsize = next_prime(hsize * 16); /* Increase the result cache size */ } #if BITS_PER_WORD == 64 /* A 16-bit signed short will overflow at maxmu > 7613644883 */ if (maxmu > UVCONST(7613644883)) maxmu = UVCONST(7613644883); #endif *pmaxmu = maxmu; *phsize = hsize; return mertens_array(maxmu); } IV mertens(UV n) { UV j, maxmu, hsize; short* M; /* 16 bits is enough range for all 32-bit M => 64-bit n */ mertens_value_t *H; /* Cache of calculated values */ IV sum; if (n <= 512) { static signed char MV16[33] = {0,-1,-4,-3,-1,-4,2,-4,-2,-1,0,-4,-5,-3,3,-1,-1,-3,-7,-2,-4,2,1,-1,-2,1,1,-3,-6,-6,-6,-5,-4}; j = n/16; sum = MV16[j]; for (j = j*16 + 1; j <= n; j++) sum += moebius(j); return sum; } M = _prep_rmertens(n, &maxmu, &hsize); Newz(0, H, hsize, mertens_value_t); sum = _rmertens(n, maxmu, M, H, hsize); Safefree(H); Safefree(M); return sum; } static const signed char _small_liouville[16] = {-1,1,-1,-1,1,-1,1,-1,-1,1,1,-1,-1,-1,1,1}; static signed char* liouville_array(UV hi) { signed char* l; UV a, b, k; if (hi < 16) hi = 15; New(0, l, hi+1, signed char); memcpy(l, _small_liouville, 16); if (hi >= 16) memset(l+16, -1, hi-16+1); for (a = 16; a <= hi; a = b+1) { /* TODO: 2*a >= UV_MAX */ b = (2*a-1 <= hi) ? 2*a-1 : hi; START_DO_FOR_EACH_PRIME(2, isqrt(b)) { for (k = 2*p; k <= b; k += p) { if (k >= a) l[k] = -1 * l[k/p]; } } END_DO_FOR_EACH_PRIME } return l; } int liouville(UV n) { if (n < 16) return _small_liouville[n]; else return( (prime_bigomega(n) & 1) ? -1 : 1 ); } IV sumliouville(UV n) { short* M; mertens_value_t *H; UV j, maxmu, hsize, k, nk, sqrtn; IV sum; if (n <= 96) { signed char* l = liouville_array(n); for (sum = 0, j = 1; j <= n; j++) sum += l[j]; Safefree(l); return sum; } M = _prep_rmertens(n, &maxmu, &hsize); Newz(0, H, hsize, mertens_value_t); sqrtn = isqrt(n); sum = _rmertens(n, maxmu, M, H, hsize); for (k = 2; k <= sqrtn; k++) { nk = n / (k*k); if (nk == 1) break; sum += (nk <= maxmu) ? M[nk] : _rmertens(nk, maxmu, M, H, hsize); } sum += (sqrtn + 1 - k); /* all k where n/(k*k) == 1 */ /* TODO: find method to get exact number of n/(k*k)==1 .. 4. Halves k */ /* Ends up with method like Lehmer's g. */ Safefree(H); Safefree(M); return sum; } /* This paper shows an algorithm for sieving an interval: *https://www.ams.org/journals/mcom/2008-77-263/S0025-5718-08-02036-X/S0025-5718-08-02036-X.pdf */ signed char* range_liouville(UV lo, UV hi) { UV i; signed char *l; unsigned char *nf; if (hi < lo) croak("range_liouvillle error hi %"UVuf" < lo %"UVuf"\n",hi,lo); nf = range_nfactor_sieve(lo, hi, 1); New(0, l, hi-lo+1, signed char); for (i = 0; i < hi-lo+1; i++) l[i] = (nf[i] & 1) ? -1 : 1; Safefree(nf); return l; } UV carmichael_lambda(UV n) { const unsigned char _totient[8] = {0,1,1,2,2,4,2,6}; uint32_t i; UV lambda = 1; if (n < 8) return _totient[n]; if ((n & (n-1)) == 0) return n >> 2; i = ctz(n); if (i > 0) { n >>= i; lambda <<= (i>2) ? i-2 : i-1; } { #if 1 /* This is very slightly faster */ UV fac[MPU_MAX_FACTORS+1]; uint32_t 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); } #else factored_t nf = factorint(n); for (i = 0; i < nf.nfactors; i++) { UV p = nf.f[i], pk = p-1, e = nf.e[i]; while (e-- > 1) pk *= p; lambda = lcm_ui(lambda, pk); } #endif } return lambda; } /******************************************************************************/ /* POWERS and ROOTS */ /******************************************************************************/ static float _cbrtf(float x) { float t, r; union { float f; uint32_t i; } xx = { x }; xx.i = (xx.i + 2129874493U)/3; t = xx.f; /* One round of Halley's method gets to 15.53 bits */ r = t * t * t; t *= (x + (x + r)) / ((x + r) + r); #if BITS_PER_WORD > 45 /* A second round gets us the 21.5 bits we need. */ r = t * t * t; t += t * (x - r) / (x + (r + r)); #endif return t; } uint32_t icbrt(UV n) { if (n > 0) { uint32_t root = (float)(_cbrtf((float)n) + 0.375f); UV rem = n - (UV)root * root * root; return root - ((IV)rem < 0); } return 0; } /******************************************************************************/ static UV _ipow(unsigned b, unsigned e, unsigned bit) { UV r = b; while (bit >>= 1) { r *= r; if (e & bit) r *= b; } return r; } /* Estimate the kth root of n. * * Returns exact root if n is a perfect power, otherwise either root or root+1. * Requires k >= 3 so a float can exactly represent the kth root. * * This version is heavily trimmed for internal use with rootint's prefilters. * * n > 1 * n>>k != 0 <=> n < 1<= 5, one round suffices. * Since k < 5 is handled already, this works for us. */ xk = x; while (msbit >>= 1) { xk *= xk; if (k & msbit) xk *= x; } err = y - xk; x += 2.0f*x*err / ((float)(int)k*(y+xk) - err); return (int)(x + 0.5f); } /* Trimmed for internal use. k MUST be between 4 and 15, n > 1 */ #define MAX_IROOTN ((BITS_PER_WORD == 64) ? 15 : 10) static uint32_t _irootn(UV n, uint32_t k) { uint32_t const msb = 4 << (k >= 8); uint32_t const r = _est_root(n,k,msb); return r - ((IV)(n - _ipow(r,k,msb)) < 0); } /******************************************************************************/ #if BITS_PER_WORD == 64 static const uint32_t root_max[1+MPU_MAX_POW3] = {0,0,4294967295U,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 static const uint32_t root_max[1+MPU_MAX_POW3] = {0,0,65535,1625,255,84,40,23,15,11,9,7,6,5,4,4,3,3,3,3,3}; #endif UV rootint(UV n, uint32_t k) { if (n <= 1) return (k != 0 && n != 0); switch (k) { case 0: return 0; case 1: return n; case 2: return isqrt(n); case 3: return icbrt(n); case 4: return _irootn(n,4); case 5: return _irootn(n,5); default: break; } /* MAX_IROOTN < BITS_PER_WORD/2 < MPU_MAX_POW3 */ /* 32-bit: 10 16 20 */ /* 64-bit: 15 32 40 */ if (n >> k == 0) return 1; if (k <= MAX_IROOTN) return _irootn(n,k); if (k > MPU_MAX_POW3) return 1 + (k < BITS_PER_WORD); if (k >= BITS_PER_WORD/2) return 2 + (n >= ipow(3,k)); /* k is now in range 11-15 (32-bit), 16-31 (64-bit). Binary search. */ { uint32_t lo = 1U << (log2floor(n)/k); uint32_t hi = root_max[k]; if (hi >= lo*2) hi = lo*2 - 1; while (lo < hi) { uint32_t mid = lo + (hi-lo+1)/2; if (ipow(mid,k) > n) hi = mid-1; else lo = mid; } return lo; } } /* Like ipow but returns UV_MAX if overflow */ UV ipowsafe(UV n, UV k) { UV p = 1; if (n == 0) return !k; /* 0^0 => 1, 0^x => 0 */ if (n == 1) return 1; /* 1^0 => 1, 1^x => 1 */ if (k <= MPU_MAX_POW3) { if (k == 0) return 1; if (k == 1) return n; return (n <= root_max[k]) ? ipow(n,k) : UV_MAX; } while (k) { if (k & 1) { if (UV_MAX/n < p) return UV_MAX; p *= n; } k >>= 1; if (k) { if (UV_MAX/n < n) return UV_MAX; n *= n; } } return p; } /******************************************************************************/ /* Mod 32 filters for allowable k-th root */ static const uint32_t _rootmask32[41] = { 0x00000000,0x00000000,0xfdfcfdec,0x54555454,0xfffcfffc, /* 0-4 */ 0x55555554,0xfdfdfdfc,0x55555554,0xfffffffc,0x55555554,0xfdfdfdfc,/* 5-10 */ 0x55555554,0xfffdfffc,0xd5555556,0xfdfdfdfc,0xf57d57d6,0xfffffffc,/* 11-16 */ 0xffffd556,0xfdfdfdfe,0xd57ffffe,0xfffdfffc,0xffd7ff7e,0xfdfdfdfe,/* 17-22 */ 0xffffd7fe,0xfffffffc,0xffffffd6,0xfdfffdfe,0xd7fffffe,0xfffdfffe,/* 23-28 */ 0xfff7fffe,0xfdfffffe,0xfffff7fe,0xfffffffc,0xfffffff6,0xfffffdfe,/* 29-34 */ 0xf7fffffe,0xfffdfffe,0xfff7fffe,0xfdfffffe,0xfffff7fe,0xfffffffc /* 35-40 */ }; bool is_power_ret(UV n, uint32_t k, uint32_t *root) { uint32_t r, msbit; /* Simple edge cases */ if (n < 2 || k == 1) { if (root) *root = n; return 1; } if (k == 0) return 0; if (k > MPU_MAX_POW3) { if (root) *root = 2; return (k < BITS_PER_WORD && n == (UV)1 << k); } if (k == 2) return is_perfect_square_ret(n,root); /* Filter out many numbers which cannot be k-th roots */ if ((1U << (n&31)) & _rootmask32[k]) return 0; if (k == 3) { r = n % 117; if ((r*833230740) & (r*120676722) & 813764715) return 0; r = icbrt(n); if (root) *root = r; return (UV)r*r*r == n; } for (msbit = 8 /* k >= 4 */; k >= msbit; msbit <<= 1) ; msbit >>= 1; r = _est_root(n, k, msbit); if (root) *root = r; return _ipow(r, k, msbit) == n; } #define PORET(base,exp) do { \ uint32_t n_ = base; /* In case base uses k or exp uses n */ \ k *= exp; \ n = n_; \ goto poreturn; \ } while (0) /* max power for 64-bit inputs */ static const uint8_t _maxpow128[128] = {31,7,0,11,2,7,0,17,3,17,0,13,0,11,0,11,2,11,0,29,0,13,0,11,3,11,0,7,0,7,0,7,5,7,0,13,2,7,0,11,3,7,0,31,0,7,0,11,0,11,0,11,0,11,0,13,3,13,0,13,0,19,0,7,3,7,0,17,2,17,0,11,3,11,0,23,0,17,0,13,0,13,0,13,0,7,0,19,3,19,0,19,0,11,0,11,5,11,0,7,2,13,0,13,3,13,0,7,0,23,0,7,0,7,0,37,0,7,0,11,3,11,0,11,0,13,0,7}; /* Returns maximal k for c^k = n for k > 1, n > 1. 0 otherwise. */ uint32_t powerof_ret(UV n, uint32_t *root) { uint32_t r, t, k = 1; /* SPECIAL: For n = 0 and n = 1, return k=1 with root n. */ /* This matches SAGE's .perfect_power(n) method (FLINT chooses k=2). */ if (n <= 1) { if (root) *root = n; return 1; } if ((n <= 3) || (n == UV_MAX)) return 0; if ((n & (n-1)) == 0) PORET(2,ctz(n)); while (is_perfect_square_ret(n,&r)) { n = r; k *= 2; } while (is_power_ret(n, 3, &r)) { n = r; k *= 3; } while (is_power_ret(n, 5, &r)) { n = r; k *= 5; } if (is_power_ret(n, 7, &r)) PORET(r,7); if ( !(((n%121)*0x8dd6295a) & 0x2088081) && is_power_ret(n, 11, &r) ) PORET(r,11); /* Reject 78% of inputs as not powers of 13,17,19,... */ if (_maxpow128[n % 128] < 13) goto poreturn; if (is_power_ret(n, 13, &r)) PORET(r,13); if (is_power_ret(n, 17, &r)) PORET(r,17); if (n >= 1162261467) { r = t = 0; switch (n) { case UVCONST(1162261467): t=19; r=3; break; #if BITS_PER_WORD == 64 case UVCONST(19073486328125): t=19; r=5; break; case UVCONST(609359740010496): t=19; r=6; break; case UVCONST(11398895185373143): t=19; r=7; break; case UVCONST(10000000000000000000): t=19; r=10;break; case UVCONST(94143178827): t=23; r=3; break; case UVCONST(11920928955078125): t=23; r=5; break; case UVCONST(789730223053602816): t=23; r=6; break; case UVCONST(68630377364883): t=29; r=3; break; case UVCONST(617673396283947): t=31; r=3; break; case UVCONST(450283905890997363): t=37; r=3; break; #endif default: break; } if (t != 0) { n = r; k *= t; } } poreturn: if (k <= 1) return 0; if (root) *root = n; return k; } /******************************************************************************/ /* Like lcm_ui, but returns 0 if overflow */ UV lcmsafe(UV x, UV y) { if (x==0 || y==0) return 0; y /= gcd_ui(x,y); if (UV_MAX/x < y) return 0; return x*y; } 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; } /* N => k^s * t => s = valuation_remainder(N, k, &t); */ UV valuation_remainder(UV n, UV k, UV *r) { UV v; if (k <= 1) { v = 0; } else if (k == 2) { v = ctz(n); n >>= v; } else { for (v=0; !(n % k); v++) n /= k; } *r = n; 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 b == 2 ? log2floor(n) : 0; /* b < 2 is invalid */ if (b > n) return 0; if (n > UV_MAX/b) { n /= b; e = 1; } for (v = b; v <= n; v *= b) e++; return e; } unsigned char* range_issquarefree(UV lo, UV hi) { unsigned char* isf; UV i, p2, range = hi-lo+1, sqrthi = isqrt(hi); if (hi < lo) return 0; New(0, isf, range, unsigned char); memset(isf, 1, range); if (lo == 0) isf[0] = 0; { /* Sieve multiples of 2^2,3^2,5^2 */ UV p = 2; while (p < 7 && p <= sqrthi) { for (p2=p*p, i = P_GT_LO(p2, p2, lo); i >= lo && i <= hi; i += p2) isf[i-lo] = 0; p += 1 + (p > 2); } } if (sqrthi >= 7) { /* Sieve multiples of higher prime squares */ unsigned char* segment; UV seg_base, seg_low, seg_high; void* ctx = start_segment_primes(7, sqrthi, &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 (p2=p*p, i = P_GT_LO(p2, p2, lo); i >= lo && i <= hi; i += p2) isf[i-lo] = 0; END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } return isf; } #if BITS_PER_WORD == 32 static const uint32_t _max_ps_n[32] = {0,92681,2343,361,116,53,30,20,14,11,8,7,6,5,4,4,3,3,3,3,3,2,2,2,2,2,2,2,2,2,2,2}; static const uint32_t _max_ps_calc[9] = {0,0,1624,0,67,44,19,17,9}; #else static const UV _max_ps_n[64] = {0,UVCONST(6074000999),3810777,92681,9839,2190,745,331,175,105,69,49,36,28,22,18,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,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2}; static const uint32_t _max_ps_calc[9] = {0,0,2642245,0,5724,1824,482,288,115}; #endif UV powersum(UV n, UV k) { UV a, a2, i, sum; if (n <= 1 || k == 0) return n; if (k >= BITS_PER_WORD || n > _max_ps_n[k]) return 0; if (n == 2) return 1 + (UVCONST(1) << k); a = (n+1)/2 * (n|1); /* (n*(n+1))/2 */ a2 = a*a; if (k == 1) return a; if (k == 3) return a2; if (k <= 8 && n <= _max_ps_calc[k]) { /* Use simple formula if possible */ if (k == 2) return a * (2*n+1) / 3; if (k == 4) return a * (2*n+1) * (3*n*(n+1)-1) / 15; if (k == 5) return a2 * (4*a - 1) / 3; if (k == 6) return a * (2*n+1) * (n*((n*(n*(3*n+6)))-3)+1) / 21; if (k == 7) return a2 * (6*a2 - 4*a + 1) / 3; if (k == 8) return a * (2*n+1) * (n*(n*(n*(n*(n*(5*n+15)+5)-15)-1)+9)-3)/45; } if (k <= 8 && k < n) { UV r, fac = 1; for (sum = 0, r = 1; r <= k; r++) { /* sum += factorial(r) * stirling2(k,r) * binomial(n+1,r+1); */ sum += fac * stirling2(k,r) * binomial(n+1,r+1);; fac *= (r+1); } return sum; } sum = 1 + (UVCONST(1)< 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 single decimal number",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; UV rem; 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; } rem = (-a) % b; a = (rem == 0) ? 0 : b-rem; 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); } #define MAX_PNPRIM ( (BITS_PER_WORD == 64) ? 15 : 9 ) #define MAX_PRIM ( (BITS_PER_WORD == 64) ? 52 : 28 ) #if BITS_PER_WORD == 64 static const UV _pn_prim[MAX_PNPRIM+1] = {1,2,6,30,210,2310,30030,510510,9699690,223092870, UVCONST(6469693230),UVCONST(200560490130),UVCONST(7420738134810),UVCONST(304250263527210),UVCONST(13082761331670030),UVCONST(614889782588491410)}; static const unsigned char _prim_map[MAX_PRIM+1] = {0,0,1,2,2,3,3,4,4,4,4,5,5,6,6,6,6,7,7,8,8,8,8,9,9,9,9,9,9,10,10,11,11,11,11,11,11,12,12,12,12,13,13,14,14,14,14,15,15,15,15,15,15}; #else static const UV _pn_prim[MAX_PNPRIM+1] = {1,2,6,30,210,2310,30030,510510,9699690,223092870}; static const unsigned char _prim_map[MAX_PRIM+1] = {0,0,1,2,2,3,3,4,4,4,4,5,5,6,6,6,6,7,7,8,8,8,8,9,9,9,9,9,9}; #endif UV pn_primorial(UV n) { return (n > MAX_PNPRIM) ? 0 : _pn_prim[n]; } UV primorial(UV n) { return (n > MAX_PRIM) ? 0 : _pn_prim[_prim_map[n]]; } UV factorial(UV n) { UV i, r = 1; if (n > (sizeof(UV) <= 4 ? 12 : 20)) return 0; for (i = 2; i <= n; i++) r *= i; return r; } UV subfactorial(UV n) { if (n <= 3) return (n ? n-1 : 1); if (n >= (BITS_PER_WORD == 64 ? 21 : 14)) return 0; return (n * subfactorial(n-1) + ((n & 1) ? -1 : 1)); } 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 fubini(UV n) { UV k, sum; if (n == 0) return 1; if (n >= ((BITS_PER_WORD == 64) ? 16 : 10)) return 0; for (sum = 1, k = 2; k <= n; k++) sum += factorial(k) * stirling2(n, k); return sum; } UV falling_factorial(UV n, UV m) { UV i, r = n; if (m == 0) return 1; if (m > n) return 0; for (i = 1; i < m; i++) { if (UV_MAX/(n-i) < r) return UV_MAX; /* Overflow */ r *= (n-i); } return r; } UV rising_factorial(UV n, UV m) { if (m == 0) return 1; if ((m-1) > (UV_MAX-n)) return UV_MAX; /* Overflow */ return falling_factorial(n+m-1, m); } IV falling_factorial_s(IV n, UV m) { UV r = (n>=0) ? falling_factorial(n,m) : rising_factorial(-n,m); if (r >= IV_MAX) return IV_MAX; /* Overflow */ return (n < 0 && (m&1)) ? -(IV)r : (IV)r; } IV rising_factorial_s(IV n, UV m) { UV r = (n>=0) ? rising_factorial(n,m) : falling_factorial(-n,m); if (r >= IV_MAX) return IV_MAX; /* Overflow */ return (n < 0 && (m&1)) ? -(IV)r : (IV)r; } /* We should do: * https://oeis.org/wiki/User:Peter_Luschny/ComputationAndAsymptoticsOfBernoulliNumbers#Seidel */ bool bernfrac(IV *num, UV *den, UV n) { if (n == 1) { *num = 1; *den = 2; return TRUE; } *num = 0; *den = 1; if (n & 1) return TRUE; n >>= 1; switch (n) { case 0: *num = 1; *den = 1; break; case 1: *num = 1; *den = 6; break; case 2: *num = -1; *den = 30; break; case 3: *num = 1; *den = 42; break; case 4: *num = -1; *den = 30; break; case 5: *num = 5; *den = 66; break; case 6: *num = -691; *den = 2730; break; case 7: *num = 7; *den = 6; break; case 8: *num = -3617; *den = 510; break; case 9: *num = 43867; *den = 798; break; case 10: *num = -174611; *den = 330; break; case 11: *num = 854513; *den = 138; break; case 12: *num = -236364091; *den = 2730; break; case 13: *num = 8553103; *den = 6; break; default: break; } return (*num != 0); } static void _harmonic_split(UV *n, UV *d, UV a, UV b) { if (b-a == 1) { *n = 1; *d = a; } else if (b-a == 2) { *n = a + a + 1; *d = a*a + a; } else { UV g,p,q,r,s, m = (a + b) >> 1; _harmonic_split(&p, &q, a, m); _harmonic_split(&r, &s, m, b); *n = p*s + q*r; *d = q*s; g = gcd_ui(*n,*d); *n /= g; *d /= g; } } bool harmfrac(UV *num, UV *den, UV n) { if (n >= BITS_PER_WORD/2) return FALSE; if (n == 0) { *num = 0; *den = 1; } else { UV N, D, g; _harmonic_split(&N, &D, 1, n+1); g = gcd_ui(N, D); *num = N/g; *den = D/g; } return TRUE; } bool is_cyclic(UV n) { UV phi, facs[MPU_MAX_FACTORS+1]; int i, nfacs; if (n < 4) return (n != 0); /* Fast filters for necessary conditions */ if ( !(n & 1) /* 2 only even */ || !(n% 9) || !(n%25) || !(n%49) /* not sq free */ || !(n%21) || !(n%39) || !(n%55) || !(n%57) || !(n%93) /* q = 1 mod p */ || !(n%121) || !(n%169) /* not sq free */ || !(n%111) || !(n%129) || !(n%155) || !(n%183)) /* q = 1 mod p */ return 0; if (n <= 200) return 1; /* Filters above were sufficient for tiny inputs */ /* return gcd_ui(n, totient(n)) == 1; */ nfacs = factor(n, facs); if (nfacs == 1) return 1; /* prime => cyclic */ for (i = 1; i < nfacs; i++) if (facs[i] == facs[i-1]) return 0; /* repeated factor => not cyclic */ for (phi = 1, i = 0; i < nfacs; i++) phi *= facs[i]-1; return gcd_ui(n, phi) == 1; /* cyclic <=> coprime with totient */ } bool is_carmichael(UV n) { factored_t nf; uint32_t i; /* 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; } nf = factorint(n); if (nf.nfactors < 3) return 0; for (i = 0; i < nf.nfactors; i++) { if (nf.e[i] > 1 || ((n-1) % (nf.f[i]-1)) != 0) return 0; } return 1; } static bool is_quasi_base(factored_t nf, UV b) { UV p = nf.n-b; uint32_t i; for (i = 0; i < nf.nfactors; i++) { UV d = nf.f[i] - b; if (d == 0 || (p % d) != 0) return 0; } return 1; } /* Returns number of bases that pass */ UV is_quasi_carmichael(UV n) { factored_t nf; UV nbases; UV spf, lpf, ndivisors, *divs; uint32_t i; 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; nf = factorint(n); /* Must be composite */ if (nf.nfactors < 2) return 0; /* Must be square free */ if (!factored_is_square_free(nf)) return 0; nbases = 0; spf = nf.f[0]; lpf = nf.f[nf.nfactors-1]; /* Algorithm from Hiroaki Yamanouchi, 2015 */ if (nf.nfactors == 2) { divs = divisor_list(n / spf - 1, &ndivisors, UV_MAX); for (i = 0; i < ndivisors; i++) { UV d = divs[i]; UV k = spf - d; if (d >= spf) break; if (is_quasi_base(nf, k)) nbases++; } } else { divs = divisor_list(lpf * (n / lpf - 1), &ndivisors, UV_MAX); for (i = 0; i < ndivisors; i++) { UV d = divs[i]; UV k = lpf - d; if (lpf > d && k >= spf) continue; if (k != 0 && is_quasi_base(nf, k)) nbases++; } } Safefree(divs); return nbases; } bool is_semiprime(UV n) { UV sp, p, factors[2]; uint32_t n2, n3; 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 (is_perfect_square_ret(n,&n2)) /* Fast square check */ return is_def_prime(n2); /* Find one factor, check primality of factor and co-factor */ if (factor_one(n, factors, 0, 0) != 2) return 0; return (is_def_prime(factors[0]) && is_def_prime(factors[1])); } bool is_almost_prime(UV k, UV n) { UV p, sp; if (k == 0) return (n == 1); if (k == 1) return is_prob_prime(n); if (k == 2) return is_semiprime(n); if ((n >> k) == 0) return 0; /* The smallest k-almost prime is 2^k */ while (k > 0 && !(n& 1)) { k--; n >>= 1; } while (k > 0 && !(n% 3)) { k--; n /= 3; } while (k > 0 && !(n% 5)) { k--; n /= 5; } while (k > 0 && !(n% 7)) { k--; n /= 7; } p = 11; if (k >= 5) { for (sp = 5; k > 1 && n > 1 && sp < NPRIMES_TINY-1; sp++) { p = primes_tiny[sp]; if (n < ipowsafe(p,k)) return 0; while ((n % p) == 0 && k > 0) { k--; n /= p; } } p = primes_tiny[sp]; } if (k == 0) return (n == 1); if (k == 1) return is_prob_prime(n); if (k == 2) return is_semiprime(n); if (n < ipowsafe(p,k)) return 0; return ((UV)prime_bigomega(n) == k); } bool is_fundamental(UV n, bool neg) { uint32_t r = n & 15; if (r) { if (neg) r = 16-r; if ((r & 3) == 0 && r != 4) return is_square_free(n >> 2); if ((r & 3) == 1) return is_square_free(n); } return 0; } UV pillai_v(UV n) { UV v, fac; /* if (n == 0) return 0; */ if (n < 23 || masktab30[n % 30] == 0 || n % 7 == 0) return 0; fac = 5040 % n; if (n < HALF_WORD) { for (v = 8; v < n-1 && fac != 0; v++) { fac = (fac*v) % n; if (fac == n-1 && (n % v) != 1) return v; } } else { for (v = 8; v < n-1 && fac != 0; v++) { fac = mulmod(fac,v,n); if (fac == n-1 && (n % v) != 1) return v; } } return 0; } #define MOB_TESTP(p) \ { uint32_t psq = p*p; if (n >= psq && (n % psq) == 0) return 0; } /* mpu 'for (0..255) { $x=moebius($_)+1; $b[$_ >> 4] |= ($x << (2*($_%16))); } say join ",",@b;' */ static const uint32_t _smoebius[16] = {2703565065U,23406865,620863913,1630114197,157354249,2844895525U,2166423889U,363177345,2835441929U,2709852521U,1095049497,92897577,1772687649,162113833,160497957,689538385}; int moebius(UV n) { if (n < 256) return (int)((_smoebius[n >> 4] >> (2*(n % 16))) & 3) - 1; if (!(n % 4) || !(n % 9) || !(n % 25) || !(n % 49) || !(n %121) || !(n %169)) return 0; MOB_TESTP(17); MOB_TESTP(19); MOB_TESTP(23); MOB_TESTP(29); MOB_TESTP(31); MOB_TESTP(37); return factored_moebius(factorint(n)); } #define ISF_TESTP(p) \ { uint32_t psq = p*p; if (psq > n) return 1; if ((n % psq) == 0) return 0; } static const uint32_t _isf[8] = {3840601326U,1856556782U,3941394158U,2362371810U,3970362990U,3471729898U,4008603310U,3938642668U}; bool is_square_free(UV n) { if (n < 256) return (_isf[n >> 5] & (1U << (n % 32))) != 0; if (!(n % 4) || !(n % 9) || !(n % 25) || !(n % 49) || !(n %121) || !(n %169)) return 0; ISF_TESTP(17); ISF_TESTP(19); ISF_TESTP(23); ISF_TESTP(29); ISF_TESTP(31); ISF_TESTP(37); return factored_is_square_free(factorint(n)); } bool is_perfect_number(UV n) { UV v, m; if (n == 0 || (n & 1)) return 0; v = valuation(n,2); m = n >> v; if (m & (m+1)) return 0; if ((m >> v) != 1) return 0; return is_mersenne_prime(v+1); } UV exp_mangoldt(UV n) { UV p; if (!prime_power(n,&p)) return 1; /* Not a prime power */ return p; } /* least quadratic non-residue mod p (p may be composite) */ /* The returned result will always be 0 or a prime */ UV qnr(UV n) { UV a; if (n <= 2) return n; /* If n is not a prime, this may or may not succeed */ if (kronecker_uu(2,n) == -1) return 2; if (is_prime(n)) { for (a = 3; a < n; a += 2) if (kronecker_uu(a,n) == -1) return a; } else { #if 0 /* Not terrible, but does more work than we need. */ for (a = 2; a < n; a = next_prime(a)) if (!sqrtmod(0, a, n)) return a; #endif factored_t nf; uint32_t i; if (!(n&1)) { /* Check and remove all multiples of 2 */ int e = ctz(n); n >>= e; if (e >= 2 || n == 1) return 2; } if (!(n % 3) || !(n % 5) || !(n % 11) || !(n % 13) || !(n % 19)) return 2; nf = factorint(n); for (a = 2; a < n; a = next_prime(a)) { for (i = 0; i < nf.nfactors; i++) if (a < nf.f[i] && kronecker_uu(a,nf.f[i]) == -1) return a; } } return 0; } bool is_qr(UV a, UV n) { bool res; if (n == 0) return (a == 1); /* Should return undef */ if (n <= 2) return 1; if (a >= n) a %= n; if (a <= 1) return 1; if (is_prob_prime(n)) { res = (kronecker_uu(a,n) == 1); } else { factored_t nf; uint32_t i; nf = factorint(n); for (i = 0, res = 1; res && i < nf.nfactors; i++) { if (nf.e[i] == 1 && (nf.f[i] == 2 || gcd_ui(a,nf.f[i]) != 1)) res = 1; else if (nf.e[i] == 1 || (nf.f[i] != 2 && gcd_ui(a,nf.f[i]) == 1)) res = (kronecker_uu(a,nf.f[i]) == 1); else { res = sqrtmod(0, a, ipow(nf.f[i],nf.e[i])); } } } return res; } UV znorder(UV a, UV n) { factored_t phif; UV k, phi; uint32_t i; 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); phif = factorint(phi); 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 < phif.nfactors; i++) { UV b, a1, ek, pi = phif.f[i], ei = phif.e[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 < phif.nfactors; i++) { UV b, a1, ek, pi = phif.f[i], ei = phif.e[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) { factored_t phif; UV phi_div_fac[MPU_MAX_DFACTORS]; UV p, phi, a, psquared; uint32_t i, root; bool isneven, ispow; if (n <= 4) return (n == 0) ? 0 : n-1; if (n % 4 == 0) return 0; isneven = !(n & 1); if (isneven) n >>= 1; ispow = powerof_ret(n,&root) > 1; p = ispow ? root : n; if (p == 3 && isneven) return 5; if (!is_prob_prime(p)) return 0; phi = p-1; /* p an odd prime */ psquared = ispow ? p*p : 0; phif = factorint(phi); for (i = 1; i < phif.nfactors; i++) phi_div_fac[i] = phi / phif.f[i]; #if USE_MONTMATH { UV r; const uint64_t npi = mont_inverse(p), mont1 = mont_get1(p); for (a = 2; a < p; a++) { if (isneven && !(a&1)) continue; if (a == 4 || a == 8 || a == 9) continue; /* Skip some perfect powers */ if (kronecker_uu(a, p) != -1) continue; r = mont_geta(a, p); for (i = 1; i < phif.nfactors; i++) if (mont_powmod(r, phi_div_fac[i], p) == mont1) break; if (i == phif.nfactors) if (!ispow || powmod(a, phi, psquared) != 1) return a; } } #else for (a = 2; a < p; a++) { if (isneven && !(a&1)) continue; if (a == 4 || a == 8 || a == 9) continue; /* Skip some perfect powers */ if (kronecker_uu(a, p) != -1) continue; for (i = 1; i < phif.nfactors; i++) if (powmod(a, phi_div_fac[i], p) == 1) break; if (i == phif.nfactors) if (!ispow || powmod(a, phi, psquared) != 1) return a; } #endif return 0; } bool is_primitive_root(UV a, UV n, bool nprime) { factored_t phif; UV p, phi; uint32_t i; /* Trivial but very slow: return totient(n) == znorder(a,n) */ if (n <= 1) return n; if (a >= n) a %= n; if (a == 0) return (n == 1); if (a == 1) return (n <= 2); if (n <= 4) return a == n-1; if (n % 4 == 0) return 0; if (!(n&1)) { /* If n is even, */ if (!(a&1)) return 0; /* 'a' cannot also be even */ n >>= 1; /* since 'a' is odd, it is also a root of p^k */ } if (is_perfect_square(a)) return 0; if (gcd_ui(a,n) != 1) return 0; if (!nprime) { UV k = prime_power(n, &p); if (!k) return 0; /* Not a prime power */ n = p; /* Check if a isn't a root for a power, only two known <= 10^16 */ if (k > 1 && powmod(a, p-1, p*p) == 1) return 0; } if (kronecker_uu(a,n) != -1) return 0; phi = n-1; /* a^x can be a primitive root only if gcd(x,phi) = 1. */ /* Checking powerof(a) will typically take more time than it saves. */ /* We already checked 'a' not a perfect square */ if (is_power(a,3) && gcd_ui(3,phi) != 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 ((phi % 2) == 0 && mont_powmod(a, phi/2, n) == mont1) return 0; if ((phi % 3) == 0 && mont_powmod(a, phi/3, n) == mont1) return 0; if ((phi % 5) == 0 && mont_powmod(a, phi/5, n) == mont1) return 0; phif = factorint(phi); for (i = 0; i < phif.nfactors; i++) if (phif.f[i] > 5 && mont_powmod(a, phi/phif.f[i], n) == mont1) return 0; } else #endif { /* Quick check for small factors before full factor */ if ((phi % 2) == 0 && powmod(a, phi/2, n) == 1) return 0; if ((phi % 3) == 0 && powmod(a, phi/3, n) == 1) return 0; if ((phi % 5) == 0 && powmod(a, phi/5, n) == 1) return 0; /* Complete factor and check each one not found above. */ phif = factorint(phi); for (i = 0; i < phif.nfactors; i++) if (phif.f[i] > 5 && powmod(a, phi/phif.f[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 olds = 1; IV t = 1; IV oldt = 0; IV r = b; IV oldr = a; if (a == 0 && b == 0) { olds = 0; t = 0; } while (r != 0) { IV quot = oldr / r; { IV tmp = r; r = oldr - quot * r; oldr = tmp; } { IV tmp = s; s = olds - quot * s; olds = tmp; } { IV tmp = t; t = oldt - quot * t; oldt = tmp; } } if (oldr < 0) /* correct sign */ { oldr = -oldr; olds = -olds; oldt = -oldt; } if (u != 0) *u = olds; if (v != 0) *v = oldt; if (cs != 0) *cs = s; if (ct != 0) *ct = t; return oldr; } /* 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); } UV gcddivmod(UV a, UV b, UV n) { UV g = gcd_ui(a,b); UV binv = modinverse(b/g, n); if (binv == 0) return 0; return mulmod(a/g, binv, n); } /* In C89, the division and modulo operators are implementation-defined * for negative inputs. C99 fixed this. */ #if __STDC_VERSION__ >= 199901L #define _tdivrem(q,r, D,d) q = D/d, r = D % d #else #define _tdivrem(q,r, D,d) \ q = ((D>=0) ? ( (d>=0) ? D/d : -(D/-d) ) \ : ( (d>=0) ? -(-D/d) : (-D/-d) ) ), \ r = D - d*q #endif IV tdivrem(IV *Q, IV *R, IV D, IV d) { IV q,r; _tdivrem(q,r,D,d); if (Q) *Q=q; if (R) *R=r; return r; } IV fdivrem(IV *Q, IV *R, IV D, IV d) { IV q,r; _tdivrem(q,r,D,d); if ((r > 0 && d < 0) || (r < 0 && d > 0)) { q--; r += d; } if (Q) *Q=q; if (R) *R=r; return r; } IV cdivrem(IV *Q, IV *R, IV D, IV d) { IV q,r; _tdivrem(q,r,D,d); if (r != 0 && ((D >= 0) == (d >= 0))) { q++; r -= d; } if (Q) *Q=q; if (R) *R=r; return r; } IV edivrem(IV *Q, IV *R, IV D, IV d) { IV q,r; _tdivrem(q,r,D,d); if (r < 0) { if (d > 0) { q--; r += d; } else { q++; r -= d; } } if (Q) *Q=q; if (R) *R=r; return r; } UV ivmod(IV a, UV n) { /* a mod n with signed a (0 <= r < n) */ if (n <= 1) return 0; if (a >= 0) { return (UV)(a) % n; } else { UV r = (UV)(-a) % n; return (r == 0) ? 0 : n-r; } } #if 0 int is_regular(UV a, UV n) { /* there exists an x s.t. a^2*x = a mod n */ UV d; if (a == 0) return 1; d = gcd_ui(a, n); return ( (d % n) == 0 && gcd_ui(d, n/d) == 1); } #endif /******************************************************************************/ /* N! MOD M */ /******************************************************************************/ static UV _powersin(UV p, UV d) { UV td = d/p, e = td; do { td/=p; e += td; } while (td > 0); return e; } static UV _facmod(UV n, UV m) { UV i, res = 1; if (n < 1000) { for (i = 2; i <= n && res != 0; i++) res = mulmod(res,i,m); } else { unsigned char* segment; UV seg_base, seg_low, seg_high; UV sqn = isqrt(n), nsqn = n/sqn, j = sqn, nlo = 0, nhi = 0, s1 = 1; void* ctx = start_segment_primes(7, n, &segment); for (i = 1; i <= 3; i++) { /* Handle 2,3,5 assume n>=25*/ UV p = primes_tiny[i]; res = mulmod(res, powmod(p,_powersin(p, n),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 ) if (p <= nsqn) { res = mulmod(res, powmod(p,_powersin(p,n),m), m); } else { while (p > nhi) { res = mulmod(res, powmod(s1,j,m), m); s1 = 1; j--; nlo = n/(j+1)+1; nhi = n/j; } if (p >= nlo) s1 = mulmod(s1, p, m); } if (res == 0) break; END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); res = mulmod(res, s1, m); } return res; } #if USE_MONTMATH static UV _facmod_mont(UV n, UV m) { const uint64_t npi = mont_inverse(m), mont1 = mont_get1(m); uint64_t monti = mont1; UV i, res = mont1; if (n < 1000) { for (i = 2; i <= n && res != 0; i++) { monti = addmod(monti,mont1,m); res = mont_mulmod(res,monti,m); } } else { unsigned char* segment; UV seg_base, seg_low, seg_high; UV sqn = isqrt(n), nsqn = n/sqn, j = sqn, nlo = 0, nhi = 0; UV s1 = mont1; void* ctx = start_segment_primes(7, n, &segment); for (i = 1; i <= 3; i++) { /* Handle 2,3,5 assume n>=25*/ UV p = primes_tiny[i]; UV mp = mont_geta(p,m); res = mont_mulmod(res, mont_powmod(mp,_powersin(p,n),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 mp = mont_geta(p,m); if (p <= nsqn) { res = mont_mulmod(res, mont_powmod(mp,_powersin(p,n),m), m); } else { while (p > nhi) { res = mont_mulmod(res, mont_powmod(s1,j,m), m); s1 = mont1; j--; nlo = n/(j+1)+1; nhi = n/j; } if (p >= nlo) s1 = mont_mulmod(s1, mp, m); } if (res == 0) break; END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); res = mont_mulmod(res, s1, m); } res = mont_recover(res, m); return res; } #endif UV factorialmod(UV n, UV m) { /* n! mod m */ UV d = n, res = 1; uint32_t i; bool m_prime; if (n >= m || m == 1) return 0; if (n <= 1 || m == 2) return (n <= 1); if (n <= 10) { /* Keep things simple for small n */ for (i = 2; i <= n && res != 0; i++) res = (res * i) % m; return res; } m_prime = is_prime(m); if (n > m/2 && m_prime) /* 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 > 100 && !m_prime) { /* Check for composite m that leads to 0 */ factored_t mf = factorint(m); UV maxpk = 0; for (i = 0; i < mf.nfactors; i++) { UV t = mf.f[i] * mf.e[i]; /* Possibly too high if exp[j] > fac[j] */ if (t > maxpk) maxpk = t; } /* Maxpk is >= S(m), the Kempner number A002034 */ if (n >= maxpk) return 0; } #if USE_MONTMATH if (m & 1) { res = _facmod_mont(d, m); } else #endif { res = _facmod(d, m); } if (d != n && res != 0) { /* Handle backwards case */ if (!(d&1)) res = submod(m,res,m); res = modinverse(res,m); } return res; } /******************************************************************************/ /* BINOMIAL(N,K) MOD M */ /******************************************************************************/ static UV _factorial_valuation(UV n, UV p) { UV k = 0; while (n >= p) { n /= p; k += n; } return k; } static int _binoval(UV n, UV k, UV m) { return _factorial_valuation(n,m) - _factorial_valuation(k,m) - _factorial_valuation(n-k,m); } static UV _factorialmod_without_prime(UV n, UV p, UV m) { UV i, pmod, r = 1; MPUassert(p >= 2 && m >= p && (m % p) == 0, "_factorialmod called with wrong args"); if (n <= 1) return 1; if (n >= m) { /* Note with p=2 the behaviour is different */ if ( ((n/m) & 1) && (p > 2 || m == 4) ) r = m-1; n %= m; } #if USE_MONTMATH if (m & 1) { const uint64_t npi = mont_inverse(m), mont1 = mont_get1(m); uint64_t mi = mont1; r = mont_geta(r, m); for (i = pmod = 2; i <= n; i++) { mi = addmod(mi, mont1, m); if (pmod++ == p) pmod = 1; else r = mont_mulmod(r, mi, m); } r = mont_recover(r, m); } else #endif { for (i = pmod = 2; i <= n; i++) { if (pmod++ == p) pmod = 1; else r = mulmod(r, i, m); } } return r; } static UV _factorialmod_without_prime_powers(UV n, UV p, UV m) { UV ip, r = 1; for (ip = n; ip > 1; ip /= p) r = mulmod(r, _factorialmod_without_prime(ip, p, m), m); return r; } static UV _binomial_mod_prime_power(UV n, UV k, UV p, UV e) { UV r, b, m, i, num, den, ip, ires; if (k > n) return 0; if (k == 0 || k == n) return 1; if (k > n/2) k = n-k; b = _binoval(n,k,p); if (e <= b) return 0; m = ipow(p,e); if (k == 1) return n % m; /* Both methods work fine -- choose based on performance. */ den = _factorialmod_without_prime_powers(k, p, m); if (k >= m) { num = _factorialmod_without_prime_powers(n, p, m); ip = _factorialmod_without_prime_powers(n-k, p, m); den = mulmod(den, ip, m); } else { #if USE_MONTMATH if (m & 1) { const uint64_t npi = mont_inverse(m), mont1 = mont_get1(m); num = mont1; for (i = n-k+1, ires = (i-1)%p; i <= n; i++) { ip = i; if (++ires == p) { ires = 0; do { ip /= p; } while ((ip % p) == 0); } num = mont_mulmod(num, mont_geta(ip, m), m); } num = mont_recover(num, m); } else #endif { num = 1; for (i = n-k+1, ires = (i-1) % p; i <= n; i++) { ip = i; if (++ires == p) { ires = 0; do { ip /= p; } while ((ip % p) == 0); } num = mulmod(num, ip, m); } } } r = divmod(num, den, m); if (b > 0) r = mulmod(r, ipow(p,b), m); return r; } static UV _binomial_lucas_mod_prime(UV n, UV k, UV p) { UV res, t, vn[BITS_PER_WORD], vk[BITS_PER_WORD]; int i, ln, lk; if (p < 2) return 0; if (p == 2) return !(~n & k); for (t = n, ln = 0; t > 0; t /= p) vn[ln++] = t % p; for (t = k, lk = 0; t > 0; t /= p) vk[lk++] = t % p; res = 1; for (i = ln-1; i >= 0; i--) { UV ni = vn[i]; UV ki = (i < lk) ? vk[i] : 0; res = mulmod(res, _binomial_mod_prime_power(ni, ki, p, 1), p); } return res; } /* Based on Granville's paper on the generalization of Lucas's theorem to * prime powers: https://www.dms.umontreal.ca/~andrew/Binomial/genlucas.html * and Max Alekseyev's binomod.gp program. */ static UV _binomial_lucas_mod_prime_power(UV n, UV k, UV p, UV q) { UV N[BITS_PER_WORD], K[BITS_PER_WORD], R[BITS_PER_WORD], e[BITS_PER_WORD]; UV i, d, m, n1, k1, r1, m1, res; MPUassert(q < BITS_PER_WORD, "bad exponent in binomialmod generalized lucas"); m = ipow(p, q); /* Construct the digits for N, K, and N-K (R). */ n1 = n; k1 = k; r1 = n-k; for (d = 0; n1 > 0; d++) { N[d] = n1 % p; n1 /= p; K[d] = k1 % p; k1 /= p; R[d] = r1 % p; r1 /= p; } /* Compute the number of carries. */ for (i = 0; i < d; i++) e[i] = (N[i] < (K[i] + ((i > 0) ? e[i-1] : 0))); /* Turn the carries into a cumulative count. */ for (i = d-1; i >= 1; i--) e[i-1] += e[i]; if (e[0] >= q) return 0; q -= e[0]; m1 = ipow(p, q); /* Now make the digits for the reduced N, K, N-K */ n1 = n; k1 = k; r1 = n-k; for (d = 0; n1 > 0; d++) { N[d] = n1 % m1; n1 /= p; K[d] = k1 % m1; k1 /= p; R[d] = r1 % m1; r1 /= p; } /* Theorem 1 from Granville indicates the +/- 1. */ res = ((p > 2 || q < 3) && q < d && e[q-1] % 2) ? m-1 : 1; res = mulmod(res, powmod(p, e[0], m), m); /* Compute the individual binomials (again, theorem 1) */ for (i = 0; i < d; i++) { UV ni = _factorialmod_without_prime(N[i], p, m); UV ki = _factorialmod_without_prime(K[i], p, m); UV ri = _factorialmod_without_prime(R[i], p, m); UV r = divmod(ni, mulmod(ki, ri, m), m); res = mulmod(res, r, m); } return res; } bool binomialmod(UV *res, UV n, UV k, UV m) { if (m <= 1) { *res = 0; return 1; } if (k == 0 || k >= n) { *res = (k == 0 || k == n); return 1; } if (m == 2) { *res = !(~n & k); return 1; } #if 0 if ( (*res = binomial(n,k)) ) { *res %= m; return 1; } #endif if (is_prime(m)) { *res = _binomial_lucas_mod_prime(n, k, m); return 1; } { UV bin[MPU_MAX_DFACTORS], mod[MPU_MAX_DFACTORS]; uint32_t i; factored_t mf = factorint(m); for (i = 0; i < mf.nfactors; i++) { if (mf.e[i] == 1) { bin[i] = _binomial_lucas_mod_prime(n, k, mf.f[i]); mod[i] = mf.f[i]; } else { /* bin[i] = _binomial_mod_prime_power(n, k, mf.f[i], mf.e[i]); */ /* Use generalized Lucas */ bin[i] = _binomial_lucas_mod_prime_power(n, k, mf.f[i], mf.e[i]); mod[i] = ipow(mf.f[i], mf.e[i]); } } /* chinese with p^e as modulos, so should never get -1 back */ return chinese(res, 0, bin, mod, mf.nfactors) == 1; } } /* Pisano period. */ /* Thanks to Trizen & Charles R Greathouse IV for ideas and working examples. */ /* Algorithm from Charles R Greathouse IV, https://oeis.org/A001175 */ static UV _pisano_prime_power(UV p, UV e) { UV k; if (e == 0) return 1; if (p == 2) return 3UL << (e-1); if (p == 3) k = 8; else if (p == 5) k = 20; else if (p == 7) k = 16; else if (p < 300) { /* Simple search */ UV a = 1,b = 1, t; k = 1; while (!(a == 0 && b == 1)) { k++; t = b; b = addmod(a,b,p); a = t; } } else { /* Look through divisors of p-(5|p) */ factored_t kf; uint32_t i, j; k = p - kronecker_uu(5,p); kf = factorint(k); for (i = 0; i < kf.nfactors; i++) { for (j = 0; j < kf.e[i]; j++) { if (lucasumod(1, p-1, k/kf.f[i], p) != 0) break; k /= kf.f[i]; } } } return (e == 1) ? k : k * ipow(p, e-1); } UV pisano_period(UV n) { factored_t nf; UV r, lim, k; uint32_t i; if (n <= 1) return (n == 1); nf = factorint(n); for (i = 0, k = 1; i < nf.nfactors; i++) { k = lcmsafe(k, _pisano_prime_power(nf.f[i], nf.e[i])); if (k == 0) return 0; } /* Do this carefully to avoid overflow */ r = 0; lim = (UV_MAX/6 < n) ? UV_MAX : 6*n; do { r += k; if (lucasumod(1, n-1, r-1, n) == 1) return r; } while (r <= (lim-k)); return 0; } /******************************************************************************/ /* HAPPY */ /******************************************************************************/ static UV sum_of_digits(UV n, uint32_t base, uint32_t k) { UV t, r, sum = 0; while (n) { t = n / base; r = n - base * t; switch (k) { case 0: sum += 1; break; case 1: sum += r; break; case 2: sum += r*r; break; default: sum += ipow(r,k); break; } n = t; } return sum; } static UV sum_of_squared_digits(UV n) { UV t, r, sum = 0; while (n) { t = n / 10; r = n - 10 * t; sum += r*r; n = t; } return sum; } int happy_height(UV n, uint32_t base, uint32_t exponent) { int h; if (base == 10 && exponent == 2) { static const char sh[101] = {0,1,0,0,0,0,0,6,0,0,2,0,0,3,0,0,0,0,0,5,0,0,0,4,0,0,0,0,4,0,0,3,4,0,0,0,0,0,0,0,0,0,0,0,5,0,0,0,0,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3,0,6,0,0,0,0,0,0,0,0,4,0,0,4,0,0,0,3,0,0,0,0,5,0,0,5,0,0,4,0,0,2}; for (h = 0; n > 100; h++) n = sum_of_squared_digits(n); return (sh[n] == 0) ? 0 : h+sh[n]; } else { UV ncheck = 0; for (h = 1; n > 1 && n != ncheck; h++) { if ((h & (h-1)) == 0) ncheck = n; /* Brent cycle finding */ n = sum_of_digits(n, base, exponent); } } return (n == 1) ? h : 0; } /******************************************************************************/ /* CRT */ /******************************************************************************/ /* works only for co-prime inputs and also slower than the algorithm below, * but handles the case where IV_MAX < lcm <= UV_MAX. * status = 1 means good result, 0 means try another method. */ static bool _simple_chinese(UV *r, UV *mod, const UV* a, const UV* n, UV num) { UV i, lcm = 1, res = 0; if (num == 0) { *r = 0; if (mod) *mod = 0; return 1; } /* Dubious return */ 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); } *r = res; if (mod) *mod = lcm; return 1; } /* status: 1 ok, -1 no inverse, 0 overflow */ int chinese(UV *r, UV *mod, UV* a, UV* n, UV num) { static unsigned short sgaps[] = {7983,3548,1577,701,301,132,57,23,10,4,1,0}; UV gcd, i, j, lcm, sum, gi, gap; if (num == 0) { *r = 0; if (mod) *mod = 0; return 1; } /* Dubious return */ /* 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[num-1] == 0) return -1; /* mod 0 */ if (n[0] > IV_MAX) return _simple_chinese(r,mod,a,n,num); 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))) return -1; if (s < 0) s = -s; if (t < 0) t = -t; if (s > (IV)(IV_MAX/lcm)) return _simple_chinese(r,mod,a,n,num); 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 ); } *r = sum; if (mod) *mod = lcm; return 1; } bool prep_pow_inv(UV *a, UV *k, int kstatus, UV n) { if (n == 0) return 0; if (kstatus < 0) { if (*a != 0) *a = modinverse(*a, n); if (*a == 0) return 0; *k = -(IV)*k; } return 1; } #if HAVE_UINT64 #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(uint32_t 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 >= 1 && digits <= DBL_DIG && digits <= 18) { Newz(0, out, 20, char); (void)snprintf(out, 20, "%.*lf", (digits-1), 3.141592653589793238); return out; } digits++; /* For rounding */ c = 14*(digits/4 + 2); /* 1 for decimal point, 3 for possible extra in loop. */ New(0, out, digits+1+3, char); *out++ = '3'; /* We'll turn "31415..." below into ".1415..." */ New(0, a, c, uint32_t); for (b = 0; b < c; b++) a[b] = 2000; d = i = 0; while (i < digits) { b = c -= 14; d = e = d % f; if (b > 107001) { /* 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; for (b = i; out[--b] == '9';) out[b] = '0'; out[b]++; } d3 = d4/10; d2 = d3/10; d1 = d2/10; out[i++] = '0' + (char)d1; out[i++] = '0' + (char)(d2-d1*10); out[i++] = '0' + (char)(d3-d2*10); out[i++] = '0' + (char)(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]++; } out[digits-1] = '\0'; /* trailing null overwrites rounding digit */ *out-- = '.'; /* "331415..." => "3.1415..." */ return out; } static int strnum_parse(const char **sp, STRLEN *slen) { const char* s = *sp; STRLEN i = 0, len = *slen; int neg = 0; if (s != 0 && len > 0) { neg = (s[0] == '-'); if (s[0] == '-' || s[0] == '+') { s++; len--; } while (len > 0 && *s == '0') { s++; len--; } if (len == 0) { s--; len = 1; neg = 0; } /* value is 0 */ for (i = 0; i < len; i++) if (!isDIGIT(s[i])) break; } if (s == 0 || len == 0 || i < len) croak("Parameter must be an integer"); *sp = s; *slen = len; return neg; } int strnum_cmp(const char* a, STRLEN alen, const char* b, STRLEN blen) { STRLEN i; int aneg = strnum_parse(&a, &alen); int bneg = strnum_parse(&b, &blen); if (aneg != bneg) return (bneg) ? 1 : -1; if (aneg) { /* swap a and b if both negative */ const char* t = a; STRLEN tlen = alen; a = b; b = t; alen = blen; blen = tlen; } if (alen != blen) return (alen > blen) ? 1 : -1; for (i = 0; i < blen; i++) if (a[i] != b[i]) return (a[i] > b[i]) ? 1 : -1; return 0; } /* 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. */ bool strnum_minmax(bool min, const char* a, STRLEN alen, const char* b, STRLEN blen) { int aneg, bneg; STRLEN i; /* a is checked, process b */ bneg = strnum_parse(&b, &blen); 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 */ } bool 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; 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; } bool from_digit_to_UV(UV* rn, const 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); } bool from_digit_to_str(char** rstr, const 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'+(char)d : 'a'+(char)(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'+(char)dig : 'a'+(char)(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; if (lo == 0) { hi = -hi; } else { 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' + (char)(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; } #if BITS_PER_WORD == 64 #define MAX_FIB_LEN 92 #define MAX_FIB_STR "10100101000100000101000100010010001001000000001001000100100010101000100000101000101000001010" #else #define MAX_FIB_LEN 46 #define MAX_FIB_STR "1010001000010101000101000100000001000100100100" #endif #define MAX_FIB_VAL (MAX_FIB_LEN+1) /* 0 = bad, -1 = not canonical, 1 = good, 2 = ok but out of UV range */ int validate_zeckendorf(const char* str) { int i; if (str == 0) return 0; if (str[0] != '1') return (str[0] == '0' && str[1] == '\0'); /* str[0] = 1 */ for (i = 1; str[i] != '\0'; i++) { if (str[i] == '1') { if (str[i-1] == '1') return -1; } else if (str[i] != '0') { return 0; } } /* Valid number. Check if in range. */ if (i > MAX_FIB_LEN || (i == MAX_FIB_LEN && strcmp(str, MAX_FIB_STR) > 0)) return 2; return 1; } UV from_zeckendorf(const char* str) { int i, len; UV n, fa = 0, fb = 1, fc = 1; /* fc = fib(2) */ if (str == 0) return 0; for (len = 0; len < MAX_FIB_LEN && str[len] != '\0'; len++) if (str[len] != '0' && str[len] != '1') return 0; if (len == 0 || len > MAX_FIB_LEN) return 0; n = (str[len-1] == '1'); for (i = len-2; i >= 0; i--) { fa = fb; fb = fc; fc = fa+fb; /* Advance */ if (str[i] == '1') n += fc; } return n; } char* to_zeckendorf(UV n) { char *str; int i, k, spos = 0; UV fa = 0, fb = 1, fc = 1; /* fc = fib(2) */ New(0, str, MAX_FIB_LEN+1, char); if (n == 0) { str[spos++] = '0'; } else { UV rn = n; for (k = 2; k <= MAX_FIB_VAL && fc <= rn; k++) { fa = fb; fb = fc; fc = fa+fb; /* Advance: fc = fib(k) */ } for (i = k-1; i >= 2; i--) { fc = fb; fb = fa; fa = fc-fb; /* Reverse: fc = fib(i) */ str[spos++] = '0' + (fc <= rn); if (fc <= rn) rn -= fc; } } str[spos++] = '\0'; #if 0 if (validate_zeckendorf(str) != 1) croak("to_zeckendorf bad for %lu\n",n); if (from_zeckendorf(str) != n) croak("to_zeckendorf wrong for %lu\n",n); #endif return str; } /* 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; } bool is_catalan_pseudoprime(UV n) { UV m, a; 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. */ { uint32_t i; factored_t nf = factorint(n); #if BITS_PER_WORD == 32 if (nf.nfactors == 2) return 0; /* Page 9, all 32-bit semiprimes */ #else if (nf.nfactors == 2) { /* Conditions from Aebi and Cairns (2008) */ if (n < UVCONST(10000000000)) return 0; /* Page 9 */ if (2*nf.f[0]+1 >= nf.f[1]) return 0; /* Corollary 2 and 3 */ } #endif /* Test every factor */ for (i = 0; i < nf.nfactors; i++) { if (_catalan_vtest(a << 1, nf.f[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, lim); 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, bool* overflow) { UV D, R; MPUassert(k >= 3, "is_polygonal root < 3"); *overflow = 0; if (n <= 1) return n; if (k == 4) { uint32_t root; return is_perfect_square_ret(n,&root) ? root : 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; } /* # On Mac M1. The combinatorial solution that we use is both slower and # has *much* worse growth than the Rademacher implementation that uses high # precision floating point (e.g. Pari, MPFR, Arb). # # 10^5 10^6 10^7 10^8 10^9 10^10 # Perl-comb 78 ---- # GMP-comb 0.32 44 ---- # Sympy 1.7.1 0.0045 0.018 0.091 0.62 5.3 51 # Pari 2.14 0.00043 0.0018 0.013 0.19 4.5 54 # Bober 0.6 0.00010 0.00085 0.062 0.91 10.9 15 # Arb 2.19 0.00018 0.00044 0.004 0.011 0.031 0.086 # # Arb 2.19 takes only 62 seconds for 10^14. */ UV npartitions(UV n) { UV *part, *pent, i, j, k, d, npart; if (n <= 3) return (n == 0) ? 1 : n; if (n > ((BITS_PER_WORD == 32) ? 127 : 416)) return 0; /* Overflow */ d = isqrt(n+1); New(0, pent, 2*d+2, UV); pent[0] = 0; pent[1] = 1; for (i = 1; i <= d; i++) { pent[2*i ] = ( i *(3*i+1)) / 2; pent[2*i+1] = ((i+1)*(3*i+2)) / 2; } New(0, part, n+1, UV); part[0] = 1; for (j = 1; j <= n; j++) { UV psum = 0; for (k = 1; pent[k] <= j; k++) { if ((k+1) & 2) psum += part[ j - pent[k] ]; else psum -= part[ j - pent[k] ]; } part[j] = psum; } npart = part[n]; Safefree(part); Safefree(pent); return npart; } UV consecutive_integer_lcm(UV n) { UV i, ilcm, sqrtn; if (n <= 2) return (n == 0) ? 1 : n; ilcm = 1; sqrtn = isqrt(n); for (i = 1; i < NPRIMES_TINY; i++) { uint32_t p = primes_tiny[i]; if (p > n) break; if (p <= sqrtn) p = ipow(p, logint(n,p)); if (ilcm > UV_MAX/p) return 0; ilcm *= p; } return ilcm; } UV frobenius_number(UV* A, uint32_t alen) { UV g, i, j, max, *N, nlen; if (alen <= 1) return 0; sort_uv_array(A, alen); if (A[0] <= 1) return 0; for (g = A[0], i = 1; i < alen; i++) g = gcd_ui(g, A[i]); if (g != 1) croak("Frobenius number set must be coprime"); if (UV_MAX/A[0] < A[1]) return UV_MAX; /* Overflow */ if (alen == 2) return A[0] * A[1] - A[0] - A[1]; /* Algorithm "Round Robin" by Böcker and Lipták * * https://bio.informatik.uni-jena.de/wp/wp-content/uploads/2024/01/BoeckerLiptak_FastSimpleAlgorithm_reprint_2007.pdf * * This is the basic version, not the optimized one. It's quite fast * in general, but the time is more or less O(A[0] * alen) and uses * A[0] * sizeof(UV) memory. This means it's not going to work with very * large inputs, where something like DQQDU would work much better. * * See https://www.combinatorics.org/ojs/index.php/eljc/article/view/v12i1r27/pdf */ nlen = A[0]; /* if (nlen > 1000000000U) croak("overflow in frobenius number"); */ New(0, N, nlen+1, UV); N[0] = 0; for (j = 1; j < nlen; j++) N[j] = UV_MAX; for (i = 1; i < alen; i++) { UV r, d, np, ai = A[i]; np = N[ai % nlen]; if (np != UV_MAX && np <= ai) continue; /* Redundant basis (opt 3) */ d = gcd_ui(nlen, ai); for (r = 0; r < d; r++) { UV p, q, n = 0; if (r > 0) { for (n = UV_MAX, q = r; q < nlen; q += d) if (N[q] < n) n = N[q]; } if (n != UV_MAX) { for (j = 0; j < (nlen / d); j++) { n += ai; p = n % nlen; if (N[p] >= n) N[p] = n; else n = N[p]; } } } } max = 0; for (i = 0; i < nlen; i++) if (N[i] == UV_MAX || (N[i] != UV_MAX && N[i] > max)) max = N[i]; Safefree(N); if (max == UV_MAX) return UV_MAX; return max - nlen; } /* 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. */ bool 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; } bool 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); sort_uv_array(S, k); 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; } } } } #define SMOOTH_TEST(n,k,p,nextprime) \ if (n < p*p) return (n <= k); /* p*p > n means n is prime */ \ if ((n%p) == 0) { \ do { n /= p; } while ((n%p) == 0); \ if (n < nextprime) return 1; \ } \ if (k < nextprime) return (n <= k); bool is_smooth(UV n, UV k) { UV fac[MPU_MAX_FACTORS+1]; uint32_t i, p, pn, nfac; /* True if no prime factors of n are larger than k. */ if (n <= 1) return 1; /* (0,k) = 1, (1,k) = 1 */ if (k <= 1) return 0; /* (n,0) = (n,1) = 0 if n > 1 */ if (n <= k) return 1; /* k >= 2, n >= 2 */ if (k == 2) return ((n & (n-1)) == 0); while (n > 1 && !(n&1)) n >>= 1; if (n <= k) return 1; /* k >= 3, n >= 3 */ SMOOTH_TEST(n, k, 3, 5); /* after this, k >= 5, n > 3*3 */ SMOOTH_TEST(n, k, 5, 7); /* after this, k >= 7, n > 5*5 */ SMOOTH_TEST(n, k, 7, 11); /* after this, k >= 11, n > 7*7 */ /* Remove tiny factors. Tests to 499. */ for (i = 5, pn = primes_tiny[i]; i < NPRIMES_TINY-1; i++) { p = pn; pn = primes_tiny[i+1]; SMOOTH_TEST(n, k, p, pn); } if (k < pn || n < pn*pn) return (n <= k); /* k >= 503 and n >= 503*503. */ if (is_prime(n)) return 0; if (k <= 290000) { nfac = trial_factor(n, fac, pn, k); return (fac[nfac-1] <= k); } nfac = trial_factor(n, fac, pn, 4999); n = fac[nfac-1]; pn = 5003; if (k < pn || n < pn*pn) return (n <= k); /* k > 290k, n > 25M */ { /* Complete factoring including primality test */ factored_t nf = factorint(n); return nf.f[nf.nfactors-1] <= k; } } bool is_rough(UV n, UV k) { UV fac[MPU_MAX_FACTORS+1]; int nfac; /* True if no prime factors of n are smaller than k. */ if (n == 0) return (k == 0); if (n == 1) return 1; /* n >= 2 */ if (k <= 1) return 1; if (k == 2) return (n >= 1); if (k == 3) return (n > 1 && (n&1)); /* k >= 4 */ if (!(n&1)) return 0; if (!(n%3)) return 0; if (k <= 5) return 1; if (!(n%5)) return 0; if (k <= 2500) { nfac = trial_factor(n, fac, 7, k); return (fac[0] >= k); } /* TODO: look into factor_one. */ /* But it doesn't guarantee returning a prime factor or the smallest. */ nfac = trial_factor(n, fac, 7, 200); if (nfac > 1 && fac[nfac-2] <= k) return 0; n = fac[nfac-1]; if (n < k) return 0; if ( (n >> 30) >= 64) { /* Arbitrarily chose 2^36 for more tests */ if (is_prime(n)) return 1; nfac = pminus1_factor(n, fac, 500, 500); if (nfac > 1) { /* 2 factors, but they could be composites */ if (fac[0] < k || fac[1] < k) return 0; if (factorint(fac[0]).f[0] < k) return 0; if (factorint(fac[1]).f[0] < k) return 0; return 1; } } /* Complete factoring including primality test */ return factorint(n).f[0] >= k; } static UV _divsum1(UV prod, UV f, uint32_t e) { UV pke, fmult; for (pke = f, fmult = 1+f; e > 1; e--) { pke *= f; fmult += pke; } return prod * fmult; } bool is_practical(UV n) { factored_t nf; UV prod; uint32_t i; if (n == 0 || (n & 1)) return (n == 1); if ((n & (n-1)) == 0) return 1; /* All powers of 2 are practical */ /* Allowable prefixes: {6,4} => {6,20,28,8} => {6,20,28,88,104,16} */ if ((n % 6) && (n % 20) && (n % 28) && (n % 88) && (n % 104) && (n % 16)) return 0; /* In theory for better performance we should test with small primes * before fully factoring. On average it doesn't seem to help. */ nf = factorint(n); MPUassert(nf.f[0] == 2, "is_practical first factor must be 2"); prod = _divsum1(1, 2, nf.e[0]); for (i = 1; i < nf.nfactors; i++) { if (nf.f[i] > (1 + prod)) return 0; prod = _divsum1(prod, nf.f[i], nf.e[i]); } return 1; } int is_delicate_prime(UV n, uint32_t b) { if (b < 2) croak("is_delicate_prime base must be >= 2"); if (b == 10 && n < 100) return 0; /* All 1,2,3,4 digit inputs are false */ if (b == 3 && n == 2) return 1; if (!is_prime(n)) return 0; if (b == 10) { UV d, dold, dnew, digpow, maxd = (BITS_PER_WORD == 32) ? 9 : 19; if (n >= ipow(10,maxd)) return -1; /* We can't check all values */ /* Check the last digit, given a > 1 digit prime, must be one of these. */ dold = n % 10; if ( (dold != 1 && is_prime(n - dold + 1)) || (dold != 3 && is_prime(n - dold + 3)) || (dold != 7 && is_prime(n - dold + 7)) || (dold != 9 && is_prime(n - dold + 9)) ) return 0; /* Check the rest of the digits. */ for (d = 1, digpow = 10; d <= maxd && n >= digpow; digpow *= 10, d++) { dold = (n / digpow) % 10; for (dnew = 0; dnew < 10; dnew++) if (dnew != dold && is_prime(n - dold*digpow + dnew*digpow)) return 0; } } else if (b == 2) { UV bit; if (n < 127) return 0; for (bit = log2floor(n); bit > 0; bit--) if (is_prime(n ^ (UVCONST(1) << bit))) return 0; } else { #if 0 /* Our simpler method, but must add proper overflow check. */ UV dold, dnew, digpow, N; for (digpow = 1; n >= digpow; digpow *= b) { dold = (n / digpow) % b; if ( (UV_MAX-(b-1)*digpow) < (n-dold*digpow) ) return -1; for (dnew = 0, N = n-dold*digpow; dnew < b; dnew++, N += digpow) if (dnew != dold && is_prime(N)) return 0; } #endif /* Algorithm isWeakly from Emily Stamm, 2020. */ UV current, bm; for (bm = 1; n >= bm; bm *= b) { uint32_t j, counter; UV bmb = bm * b; if ( ((UV_MAX/b) < bm) || ((UV_MAX-bmb) < n) ) return -1; /* overflow */ /* Check all n + j * b^m are composite */ for (counter = 0, current = n+bm; (n % bm) != (current % bmb); counter++, current += bm) { if (counter >= b-1) croak("is_delicate_prime overflow failure\n"); if (is_prime(current)) return 0; } /* Check all n - j * b^m are composite */ for (j = 1, current = n-bm; j < b-counter; j++, current -= bm) { if (is_prime(current)) return 0; } } } return 1; } bool is_sum_of_two_squares(UV n) { factored_t nf; uint32_t i; if (n < 3) return 1; while (!(n&1)) n >>= 1; /* Remove all factors of two */ if ((n % 4) == 3) return 0; /* if (is_prime(n)) return ((n % 4) == 1); */ /* TODO: a factor iterator should handle this reasonably */ for (i = 0; !(n % 3); n /= 3) { i++; } if ((i & 1) == 1) return 0; for (i = 0; !(n % 7); n /= 7) { i++; } if ((i & 1) == 1) return 0; for (i = 0; !(n % 11); n /= 11) { i++; } if ((i & 1) == 1) return 0; for (i = 0; !(n % 19); n /= 19) { i++; } if ((i & 1) == 1) return 0; for (i = 0; !(n % 23); n /= 23) { i++; } if ((i & 1) == 1) return 0; for (i = 0; !(n % 31); n /= 31) { i++; } if ((i & 1) == 1) return 0; nf = factorint(n); for (i = 0; i < nf.nfactors; i++) if ( (nf.f[i] % 4) == 3 && (nf.e[i] & 1) == 1 ) return 0; return 1; } bool is_sum_of_three_squares(UV n) { UV tz = valuation(n,2); return ((tz & 1) == 1) || (((n>>tz) % 8) != 7); } #if 0 /* https://eprint.iacr.org/2023/807.pdf */ static UV halfgcd(UV m, UV u) { UV l = isqrt(m); UV a = m, b = u; while (a > l) { UV r = a % b; a = b; b = r; } return a; } /* Given an initial root, solve */ static bool corn_one(UV *x, UV *y, UV u, UV d, UV p) { UV rk = halfgcd(p, u); u = negmod(sqrmod(rk,p),p); u = (u % d == 0) ? u/d : 0; if (u && is_perfect_square(u)) { *x = rk; *y = isqrt(u); return 1; } return 0; } #else /* Given an initial root, solve. Algorithm 2.3.12 of C&P */ static bool corn_one(UV *x, UV *y, UV u, UV d, UV p) { UV a = p; UV b = (u >= p-u) ? u : p-u; /* Select larger root */ uint32_t c = isqrt(p); while (b > c) { UV t = a % b; a = b; b = t; } u = p - b*b; u = (u % d == 0) ? u/d : 0; if (u && is_perfect_square_ret(u,&c)) { *x = b; *y = c; return 1; } return 0; } #endif /* Cornacchia-Smith run over each root. */ static bool corn_all(UV *x, UV *y, UV d, UV p) { UV negd = negmod(d,p), i, nroots, *roots; bool success = 0; roots = allsqrtmod(&nroots, negd, p); if (roots) { for (i = 0; i < nroots/2 && !success; i++) success = corn_one(x, y, roots[i], d, p); Safefree(roots); } return success; } bool cornacchia(UV *x, UV *y, UV d, UV p) { UV u, negd, limu; uint32_t root; if (p == 0) { *x = *y = 0; return 1; } if (d == 0) { if (!is_perfect_square_ret(p,&root)) return 0; *x = root; *y = 0; return 1; } negd = negmod(d, p); if (is_prime(p)) { if (kronecker_uu(negd,p) == -1) return 0; if (!sqrtmodp(&u, negd, p)) return 0; return corn_one(x, y, u, d, p); } if (((p >> 31) >> 22) && kronecker_uu(negd,p) != -1 && corn_all(x, y, d, p)) return 1; /* Loop through all valid integers until one is found. * Until p is quite large, this is faster than using allsqrtmod. * It also finds many solutions for composites. */ for (u = 0, limu = isqrt(p/d); u <= limu; u++) { UV t = p - d*u*u; if (is_perfect_square_ret(t,&root)) { *x = root; *y = u; return 1; } } return 0; } /* TODO: */ /* See https://arxiv.org/pdf/2208.01725.pdf for new info on smooth count * estimate methods. Consider adding an estimate function. */ static const unsigned char _psi_cache_v__7[128] = {8,9,10,10,11,11,12,13,14,14,15,15,16,17,17,17,18,19,19,20,21,21,22,22,23,23,23,24,25,25,25,25,26,26,27,27,27,28,28,28,29,30,31,31,31,31,32,32,33,33,33,33,34,34,34,35,36,36,36,36,36,36,37,37,38,38,38,39,39,39,39,39,40,41,41,41,42,42,42,42,42,42,43,43,43,43,43,43,44,44,45,45,46,46,46,46,46,47,47,47,48,48,48,48,49,49,49,49,49,49,49,49,50,50,50,50,50,51,52,52,53,53,53,53,53,53,53,54}; static const unsigned char _psi_cache_v_11[96] = {12,12,13,14,15,15,16,16,17,18,19,19,20,21,21,22,23,23,24,24,25,26,26,27,28,28,28,28,29,29,30,30,31,32,32,32,33,34,35,35,35,35,36,37,38,38,38,38,39,39,39,40,41,41,42,42,42,42,43,43,44,44,44,45,45,46,46,46,47,48,48,48,49,49,49,49,50,50,51,51,51,51,51,51,52,52,53,54,55,55,55,55,55,56,56,56}; static const unsigned char _psi_cache_v_13[64] = {14,15,16,16,17,17,18,19,20,20,21,22,23,24,25,25,26,26,27,28,28,29,30,30,30,31,32,32,33,33,34,35,35,35,36,37,38,38,39,39,40,41,42,42,42,42,43,43,43,44,45,46,47,47,47,47,48,48,49,49,49,50,50,51}; UV debruijn_psi(UV x, UV y) { UV sum, x3, x5; if (x < 1) return 0; if (y <= 1) return 1; if (y >= x) return x; if (y == 2) return 1 + log2floor(x); if (!(y&1)) y--; /* Make y odd for simplicity */ /* Caches etc. to avoid recursion - about 1.6x speedup for big inputs */ if (y == 7 && x- 7 <=128) return _psi_cache_v__7[x-1- 7]; if (y == 11 && x-11 <= 96) return _psi_cache_v_11[x-1-11]; if (y == 13 && x-13 <= 64) return _psi_cache_v_13[x-1-13]; if (y >= 17 && x <= 128) { /* mpu 'for (7..128) { $f=(factor($_))[-1]; push(@$X,$_),push(@$Y,$f) if $f > 17; } say scalar(@$X); say join(",",@$_) for ($X,$Y);' */ static const unsigned char xt[48] = {19,23,29,31,37,38,41,43,46,47,53,57,58,59,61,62,67,69,71,73,74,76,79,82,83,86,87,89,92,93,94,95,97,101,103,106,107,109,111,113,114,115,116,118,122,123,124,127}; static const unsigned char yt[48] = {19,23,29,31,37,19,41,43,23,47,53,19,29,59,61,31,67,23,71,73,37,19,79,41,83,43,29,89,23,31,47,19,97,101,103,53,107,109,37,113,19,23,29,59,61,41,31,127}; unsigned char i; for (i = 0, sum = x; i < 48 && x >= xt[i]; i++) if (y < yt[i]) sum--; return sum; } /* given z < y < x, (e.g. z=2 or z=19) * psi(x,y) = psi(x,z) + sum[z+1..y] psi(x/p,p) */ sum = 1 + log2floor(x); /* debruijn_psi(x,2) */ /* if (y >= 3) sum += debruijn_psi(x/3, 3); */ /* if (y >= 5) sum += debruijn_psi(x/5, 5); */ if (y >= 3) { for (x3 = x/3; x3 > 3; x3 /= 3) sum += 1+log2floor(x3); sum += x3; } if (y >= 5) { for (x5 = x/5; x5 > 5; x5 /= 5) { sum += 1+log2floor(x5); for (x3 = x5/3; x3 > 3; x3 /= 3) sum += 1+log2floor(x3); sum += x3; } sum += x5; } if (y >= 7) sum += debruijn_psi(x/ 7, 7); if (y >= 11) sum += debruijn_psi(x/11,11); if (y >= 13) sum += debruijn_psi(x/13,13); if (y >= 17) sum += debruijn_psi(x/17,17); if (y >= 19) sum += debruijn_psi(x/19,19); if (y >= 23) sum += debruijn_psi(x/23,23); if (y >= 29) { START_DO_FOR_EACH_PRIME(29, y) { UV xp = x/p; sum += (p >= xp) ? xp : debruijn_psi(xp, p); } END_DO_FOR_EACH_PRIME } return sum; } UV buchstab_phi(UV x, UV y) { if (y <= 2) return x; if (y <= 3) return x - x/2; if (y <= 5) return x - x/2 - x/3 + x/6; /* We'll use the legendre_phi function we already have. */ return legendre_phi(x, prime_count(y-1)); } 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.74/omega_primes.c000644 000765 000024 00000017100 15151337776 017221 0ustar00danastaff000000 000000 /******************************************************************************/ /* OMEGA PRIMES */ /******************************************************************************/ #include #include #include #include #define FUNC_isqrt 1 #include "ptypes.h" #include "constants.h" #include "cache.h" #include "sieve.h" #include "util.h" #include "sort.h" #include "prime_counts.h" #include "prime_powers.h" #include "factor.h" #include "inverse_interpolate.h" #include "omega_primes.h" bool is_omega_prime(uint32_t k, UV n) { if (k > 0 && !(n& 1)) { k--; do { n >>= 1; } while (!(n& 1)); } if (k > 0 && !(n% 3)) { k--; do { n /= 3; } while (!(n% 3)); } if (k > 0 && !(n% 5)) { k--; do { n /= 5; } while (!(n% 5)); } if (k > 0 && !(n% 7)) { k--; do { n /= 7; } while (!(n% 7)); } if (k > 0 && !(n%11)) { k--; do { n /= 11; } while (!(n%11)); } if (n == 1) return (k == 0); if (k == 0) return (n == 1); if (k == 1) return is_prime_power(n); if (n < ipowsafe(13,k)) return 0; return ((UV)prime_omega(n) == k); } /* See https://arxiv.org/pdf/2006.16491.pdf page 12 for a brief note */ /* For the interpolation */ static UV opce(UV mid, UV k) { return omega_prime_count(k, mid); } /********************************* Construction *****************************/ static void _omega_prime_gen_rec(UV** kop, UV* skop, UV* nkop, uint32_t k, UV lo, UV hi, UV m, UV pstart) { UV v, *l = *kop, lsize = *skop, n = *nkop; if (k > 1) { SIMPLE_FOR_EACH_PRIME(pstart, rootint(hi/m, k)) { if ((m % p) == 0) continue; if (UV_MAX/m < p) break; for (v = m*p; UV_MAX/v >= p && v*p <= hi; v *= p) _omega_prime_gen_rec(kop, skop, nkop, k-1, lo, hi, v, p); } END_SIMPLE_FOR_EACH_PRIME return; } START_DO_FOR_EACH_PRIME(pstart, rootint(hi/m, k)) { if ((m % p) == 0) continue; for (v = m; UV_MAX/v >= p && v*p <= hi; ) { v *= p; if (v >= lo) { /* Add v to kop list */ if (n >= lsize) { lsize = 1 + lsize * 1.2; Renew(l, lsize, UV); } l[n++] = v; } } } END_DO_FOR_EACH_PRIME *kop = l; *skop = lsize; *nkop = n; } static UV rec_omega_primes(UV** ret, uint32_t k, UV lo, UV hi) { UV nkop, skop; if (hi < lo) croak("range_omega_prime_sieve error hi %"UVuf" < lo %"UVuf"\n",hi,lo); nkop = 0; skop = 256; New(0, *ret, skop, UV); _omega_prime_gen_rec(ret, &skop, &nkop, k, lo, hi, 1, 2); sort_uv_array(*ret, nkop); return nkop; } UV range_omega_prime_sieve(UV** ret, uint32_t k, UV lo, UV hi) { UV i, min, lmax = 0, n = 0; UV* l = 0; unsigned char *nf; if (hi < lo) croak("range_omega_prime_sieve error hi %"UVuf" < lo %"UVuf"\n",hi,lo); min = pn_primorial(k); if (min == 0 || min > hi) return 0; if (lo < min) lo = min; if (k == 1) return prime_power_sieve(ret, lo, hi); /* TODO: The recursive routine should compute primes like the count does */ if ( ((hi-lo) > 100000000UL) || (k >= 10 && (hi-lo) > 5000000UL) ) return rec_omega_primes(ret, k, lo, hi); nf = range_nfactor_sieve(lo, hi, 0); if (ret != 0) { lmax = 1000; New(0, l, lmax, UV); } for (i = 0; i < hi-lo+1; i++) { if (nf[i] != k) continue; if (l != 0) { if (n >= lmax) { lmax = 1 + lmax * 1.2; Renew(l, lmax, UV); } l[n] = lo+i; } n++; } Safefree(nf); if (ret != 0) *ret = l; return n; } /* TODO: Should make a single construct routine that calls sieve or recurse */ /********************************* Counting *********************************/ UV max_omega_prime_count(uint32_t k) { #if BITS_PER_WORD == 32 static const UV max[10] = {1,203287168,838888926,1389246717,1178725572,540561553,129357524,14327954,567659,4221}; if (k >= 10) return 0; #else static const UV max[16] = {1, UVCONST(425656284140516112), /* prime powers */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* TODO: find these */ UVCONST(5512134903353),UVCONST(87133769732),UVCONST(446745559),299178 }; if (k >= 16) return 0; #endif if (k >= BITS_PER_WORD) return 0; if (max[k] == 0) return UV_MAX; return max[k]; } UV max_nth_omega_prime(uint32_t k) { #if BITS_PER_WORD == 32 static const UV offset[10] = {0,4,1,8,5,0,34,3,1305,46665}; if (k >= 10) return 0; #else static const UV offset[16] = {0,58,7,2,3,5,25,0,48,255,1155,46017,15, UVCONST(125585475),UVCONST(522131625),UVCONST(338362334325)}; if (k >= 16) return 0; #endif if (k >= BITS_PER_WORD) return 0; return UV_MAX - offset[k]; } #define RECURSIVE_OMEGA_COUNT(k,n,pr,npr) \ _omega_prime_count_rec2(k, n, 1, 2, rootint(n,k), 1, pr, npr) /* Initial call: m = 1, p = 2, s = sqrtn(n), j = 1 */ static UV _omega_prime_count_rec2(uint32_t k, UV n, UV m, UV p, UV s, UV j, uint32_t* pr, UV numprimes) { UV t, r, count = 0; if (k == 2) { UV r2, w, u, k, rlim; for (; p <= s; j++, p = r) { r = (j < numprimes) ? pr[j] : next_prime(p); for (t = m*p, w = n/t; t <= n && w >= r; t *= p, w = n/t) { #if 1 count += prime_count(w) - j; for (k = j, r2 = r, rlim = isqrt(w); r2 <= rlim; r2 = (++k < numprimes) ? pr[k] : rlim+1) { u = t * r2; do { u *= r2; count++; } while (n/r2 >= u); } #else /* This is the basic method from the definition, before optimizing */ UV q; count += prime_power_count(w); rlim = prev_prime(r); for (k = 1, q = 2; q <= rlim; q = (++k < numprimes) ? pr[k-1] : nth_prime(k)) { count -= logint(w, q); } #endif if (t > n/p) break; } } return count; } for (; p <= s; j++, p = r) { r = (j < numprimes) ? pr[j] : next_prime(p); for (t = m*p; t <= n; t *= p) { UV S = rootint(n/t, k-1); if (r > S) break; count += _omega_prime_count_rec2(k-1, n, t, r, S, j+1, pr, numprimes); if (t > n/p) break; } } return count; } UV omega_prime_count(uint32_t k, UV n) { uint32_t* pr; UV maxpr, npr, sum, lo; if (k == 0) return (n >= 1); if (k == 1) return prime_power_count(n); /* The first k-omega-prime is primorial(p_k) (ignoring zero for k=1) */ lo = pn_primorial(k); if (lo == 0 || n < lo) return 0; maxpr = rootint(n, (k > 10) ? 4 : (k > 6) ? 3 : 2); npr = range_prime_sieve_32(&pr, maxpr, 0); /* p[0]=2, p[1]=3,... */ sum = RECURSIVE_OMEGA_COUNT(k, n, pr, npr); Safefree(pr); return sum; } /* An upper bound for the omega prime count, when n >= 10^12 is shown in * Bayless,Kinlaw,Klyve 2019, page 4 * https://www.researchgate.net/profile/Paul-Kinlaw/publication/329788487_Sums_over_primitive_sets_with_a_fixed_number_of_prime_factors/links/5c44103d92851c22a3825286/Sums-over-primitive-sets-with-a-fixed-number-of-prime-factors.pdf * double logn = log(n), loglogn = log(logn); * double lim = (1.0989 * n * pow(loglogn + 1.1174, k-1)) / (factorial(k-1)*logn); */ /************************************ nth ***********************************/ UV nth_omega_prime(uint32_t k, UV n) { UV lo, hi; if (n == 0) return 0; if (k == 0) return (n == 1) ? 1 : 0; if (k > 15 || n > max_omega_prime_count(k)) return 0; lo = pn_primorial(k); if (lo == 0) return 0; if (n == 1) return lo; if (k == 1) { hi = nth_prime(n); if (hi == 0) hi = max_nth_omega_prime(1); lo = hi >> 1; /* We could do better */ } else { hi = 0; /* Let the interpolation routine find it */ } hi = inverse_interpolate_k(lo, hi, n, k, &opce, 600); while (!is_omega_prime(k,hi)) hi--; /* if (omega_prime_count(k,hi) != n) croak("bad nth"); */ return hi; } Math-Prime-Util-0.74/LICENSE000644 000765 000024 00000043675 14751613141 015417 0ustar00danastaff000000 000000 This software is Copyright (c) 2011-2025 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-2025 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-2025 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.74/cpanfile000644 000765 000024 00000001003 15151213253 016064 0ustar00danastaff000000 000000 requires '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.999814'; requires 'Math::BigFloat', '1.59'; recommends 'Math::Prime::Util::GMP', '0.53'; recommends 'Math::BigInt::GMP'; recommends 'Math::GMPz', '0.68'; recommends 'Digest::SHA', '5.87'; on test => sub { requires 'Test::More', '0.96'; requires 'bignum', '0.65'; recommends 'Test::Warn'; }; Math-Prime-Util-0.74/goldbach.h000644 000765 000024 00000000311 15146553566 016317 0ustar00danastaff000000 000000 #ifndef MPU_GOLDBACH_H #define MPU_GOLDBACH_H #include "ptypes.h" extern UV minimal_goldbach_pair(UV n); extern UV* goldbach_pairs(size_t *size, UV n); extern UV goldbach_pair_count(UV n); #endif Math-Prime-Util-0.74/rational.h000644 000765 000024 00000001457 15145577415 016377 0ustar00danastaff000000 000000 #ifndef MPU_RATIONAL_H #define MPU_RATIONAL_H #include "ptypes.h" /* Returns steps */ extern int contfrac(UV** cfrac, UV *rem, UV num, UV den); extern bool next_calkin_wilf(UV* num, UV* den); extern bool next_stern_brocot(UV* num, UV* den); extern UV calkin_wilf_n(UV num, UV den); extern UV stern_brocot_n(UV num, UV den); extern bool nth_calkin_wilf(UV* num, UV* den, UV n); extern bool nth_stern_brocot(UV* num, UV* den, UV n); extern UV nth_stern_diatomic(UV n); extern UV farey_length(uint32_t n); extern bool next_farey(uint32_t n, uint32_t* p, uint32_t* q); extern bool kth_farey(uint32_t n, UV k, uint32_t* p, uint32_t* q); extern UV farey_array(uint32_t n, uint32_t **num, uint32_t **den); /* How many fractions are < p/q in F_n */ extern UV farey_rank(uint32_t n, uint32_t p, uint32_t q); #endif Math-Prime-Util-0.74/lehmer.h000644 000765 000024 00000000331 15145577415 016030 0ustar00danastaff000000 000000 #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.74/chacha.h000644 000765 000024 00000001522 15145577415 015766 0ustar00danastaff000000 000000 #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; bool goodseed; } chacha_context_t; /* API */ extern void chacha_seed(chacha_context_t *cs, uint32_t bytes, const unsigned char* data, bool isgood); 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 bool chacha_selftest(void); #endif Math-Prime-Util-0.74/sieve_cluster.c000644 000765 000024 00000026740 15145577415 017437 0ustar00danastaff000000 000000 #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 #define MAXSMALLPRIME 997 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, const uint32_t* cl) { uint32_t i, j, c; char rset[MAXSMALLPRIME]; 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, const 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, const 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, const 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.74/bin/000755 000765 000024 00000000000 15154713771 015153 5ustar00danastaff000000 000000 Math-Prime-Util-0.74/keyval.h000644 000765 000024 00000014206 15153323660 016043 0ustar00danastaff000000 000000 #ifndef MPU_KEYVAL_H #define MPU_KEYVAL_H /* This includes: * keyval_t simple key/val type, both UV * set a key value set, with "add" function for new=old+new * setlist key (UV) plus dynamic array of UVs. "append" functionality * * Key=0 is not allowed. */ #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; for (i = 0; i < L->maxsize; i++) if (L->keylist[i].size > 0) Safefree(L->keylist[i].vals); Safefree(L->keylist); L->size = L->maxsize = 0; } 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++) { /* if (list[j] > UV_MAX/mult) croak("overflow in addlist mult"); */ 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++) { /* if (list[j] > UV_MAX/mult) croak("overflow in addlist mult"); */ 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); } } } #if 0 static void setlist_zerolist(set_list_t *L, UV key) { long i = setlist_search(*L, key); if (i != -1) { Safefree(L->keylist[i].vals); L->keylist[i].vals = 0; L->keylist[i].size = L->keylist[i].maxsize = 0; } } #endif #endif Math-Prime-Util-0.74/random_prime.h000644 000765 000024 00000000674 15145577415 017242 0ustar00danastaff000000 000000 #ifndef MPU_RANDOM_PRIME_H #define MPU_RANDOM_PRIME_H #include "ptypes.h" extern UV random_safe_prime(void* ctx, UV bits); extern UV random_nbit_prime(void* ctx, UV bits); extern UV random_ndigit_prime(void* ctx, UV digits); extern UV random_prime(void* ctx, UV lo, UV hi); extern bool is_mr_random(void* ctx, UV n, UV k); extern UV random_semiprime(void* ctx, UV bits); extern UV random_unrestricted_semiprime(void* ctx, UV bits); #endif Math-Prime-Util-0.74/prime_powers.h000644 000765 000024 00000001457 15145577415 017301 0ustar00danastaff000000 000000 #ifndef MPU_PRIME_POWERS_H #define MPU_PRIME_POWERS_H #include "ptypes.h" /* returns power */ extern int prime_power(UV n, UV* prime); static INLINE bool is_prime_power(UV n) { return !!prime_power(n,0); } extern UV next_prime_power(UV x); extern UV prev_prime_power(UV x); extern UV prime_power_sieve2(UV** list, UV lo, UV hi); /* p^e with e >= 2 */ extern UV prime_power_sieve(UV** list, UV lo, UV hi); /* p^e with e >= 1 */ extern UV prime_power_count_range(UV lo, UV hi); extern UV prime_power_count(UV n); extern UV prime_power_count_lower(UV n); extern UV prime_power_count_upper(UV n); extern UV prime_power_count_approx(UV n); extern UV nth_prime_power(UV n); extern UV nth_prime_power_lower(UV n); extern UV nth_prime_power_upper(UV n); extern UV nth_prime_power_approx(UV n); #endif Math-Prime-Util-0.74/Changes000644 000765 000024 00000253255 15154713570 015707 0ustar00danastaff000000 000000 Revision history for Perl module Math::Prime::Util 0.74 2026-03-13 [API Changes] - is_pseudoprime, is_euler_pseudoprime, and is_strong_pseudoprime will use an implicit base of 2 rather than a missing base error. This also means is_pseudoprime($n, @bases) works properly. - is_strong_pseudoprime passes for bases equal to 0 mod n. This matches what the GMP code always did, and means primes return 1 for any base. - divisor_sum(0) returns 0. divisors(0) returns an empty list. - divisors takes an optional second argument to prune the returned list. - consecutive_integer_lcm(0) was returning 0. Now returns 1, matching the original GMP API as well as the OEIS series. - some error messages with invalid arguments have changed. - Callers must 'use Math::Prime::Util::MemFree;' if they want to use it. - bernfrac was documented to only accept non-negative inputs. This is now enforced. - bernfrac and harmfrac return values are only bigints if needed. - The real functions no longer modify their behavior based on whether the "bignum" package was loaded, whether in scope or not. [ADDED] - powersum(n,k) sum of k-th powers of positive ints <= n - sumpowerful(n[,k]) sum of k-powerful numbers <= n - sumliouville(n) L(n), sum of liouville(1..n) - sumtotient(n) sum of euler_phi(1..n) - prime_bigomega(n) # of factors (with multiplicity) - prime_omega(n) # of factors (distinct) - powint(a, b) signed integer a^b - mulint(a, b) signed integer a*b - addint(a, b) signed integer a+b - subint(a, b) signed integer a-b - add1int(n) signed integer n+1 - sub1int(n) signed integer n-1 - divint(a, b) signed integer a/b (floor) - modint(a, b) signed integer a%b (floor) - cdivint(a, b) signed integer a/b (ceiling) - divrem(a, b) Euclidean quotient and remainder - fdivrem(a, b) Floored quotient and remainder - cdivrem(a, b) Ceiling quotient and remainder - tdivrem(a, b) Truncated quotient and remainder - lshiftint(n, k) left shift n by k bits - rshiftint(n, k) right shift n by k bits (truncating) - rashiftint(n, k) right shift n by k bits (flooring) - absint(n) integer absolute value - negint(n) integer negation - cmpint(a, b) integer comparison (like <=>) - signint(n) integer sign (-1,0,1) - random_safe_prime for n-bit safe primes - inverse_li_nv(x) float inverse logarithmic integral - is_gaussian_prime(a,b) is a+bi a Gaussian prime - is_lucky(n) predicate for lucky number sieve - is_happy(n) if n happy number, returns height of n - is_happy(n,base,exponent) as above but with given base and power - is_smooth(n,k) is n a k-smooth number - is_rough(n,k) is n a k-rough number - is_practical(n) is n a practical number - is_delicate_prime(n[,b]) is n a digitally delicate prime (base b) - is_sum_of_squares(n[,k]) can n be a sum of k squares (dflt k=2) - is_congruent_number(n) is n a "congruent number" - is_perfect_number(n) is n equal to sum of its proper divisors - is_omega_prime(k,n) is n divisible by exactly k primes - is_almost_prime(k,n) does n have exactly k prime factors - is_chen_prime(n) is n prime and n+2 prime or semiprime - is_powerfree(n[,k]) is n a k-powerfree number (default k=2) - is_powerful(n[,k]) is n a k-powerful number (default k=2) - is_perfect_power(n) is n a perfect power (1,4,8,9,16,25,..) - is_odd(n) is n an odd integer (not divisible by 2) - is_even(n) is n an even integer (divisible by 2) - is_divisible(n,d) is n exactly divisible by d - is_congruent(n,c,d) is n congruent to c mod d - is_qr(a,n) is a a quadratic residue mod n - is_cyclic(n) does n have exactly one group of order n - forsquarefreeint {} lo,hi loop over square-free integers - almost_primes(k,[start,]end) array ref of k-almost-primes - almost_prime_count(k,n) count of integers with exactly k factors - almost_prime_count_approx(k,n) fast approximate k-almost-prime count - almost_prime_count_lower(k,n) fast k-almost-prime count lower bound - almost_prime_count_upper(k,n) fast k-almost-prime count upper bound - nth_almost_prime(k,n) The nth number with exactly k factors - nth_almost_prime_approx(k,n) fast approximate nth k-almost-prime - nth_almost_prime_lower(k,n) fast nth k-almost-prime lower bound - nth_almost_prime_upper(k,n) fast nth k-almost-prime upper bound - foralmostprimes {} k,a,b loop over k-almost-primes - omega_primes(k,[start,]end) array ref of k-omega-primes - omega_prime_count(k,n) count nums divisible by exactly k primes - nth_omega_prime(k,n) The nth number dvsbl by exactly k primes - powerful_numbers([lo,]hi[,k]) array ref of k-powerful from lo to hi - powerful_count(n[,k]) count of k-powerful numbers <= n - nth_powerful(n[,k]) the nth k-powerful number (default k=2) - powerfree_count(n[,k]) count of k-powerfree numbers <= n - nth_powerfree(n[,k]) The nth k-powerfree number (default k=2) - powerfree_sum(n[,k]) sum of k-powerfree numbers <= n - powerfree_part(n[,k]) remove excess powers from n - powerfree_part_sum(n[,k]) sum of k-powerfree parts for 1 to n - squarefree_kernel(n) integer radical of |n| - perfect_power_count([lo,] hi) count of perfect powers - smooth_count(n,k) count of k-smooth numbers <= n - rough_count(n,k) count of k-rough numbers <= n - allsqrtmod(a,n) all square roots of a (mod n) - qnr(n) least quadratic non-residue - subfactorial(n) count of derangements of n objects - fubini(n) Fubini (Ordered Bell) number - falling_factorial(x,n) falling factorial - rising_factorial(x,n) rising factorial - binomialmod(n,k,m) fast binomial(n,k) mod m - negmod(a, n) -a mod n - submod(a, b, n) a - b mod n - muladdmod(a, b, c, n) a * b + c mod n - mulsubmod(a, b, c, n) a * b - c mod n - rootmod(a, k, n) modular k-th root - allrootmod(a,k,n) all k-th roots of a (mod n) - cornacchia(d,n) find x,y for x^2 + d * y^2 = n - vecequal(\@a, \@b) compare two array refs for equality - tozeckendorf(n) Zeckendorf binary string from n - fromzeckendorf(str) n from Zeckendorf binary string - lucasu(p,q,k) U(p,q)_k - lucasv(p,q,k) V(p,q)_k - lucasuv(p,q,k) U(p,q)_k, V(p,q)_k - lucasumod(p,q,k,n) U(p,q)_k mod n - lucasvmod(p,q,k,n) V(p,q)_k mod n - lucasuvmod(p,q,k,n) (U(p,q)_k mod n, V(p,q)_k mod n) - pisano_period(n) period of modular Fibonacci sequence - prime_powers([start,] end) array ref of prime powers - next_prime_power(n) next prime power: p > n - prev_prime_power(n) previous prime power: p < n - prime_power_count([start,] end) count of prime powers - prime_power_count_approx(n) fast approximate prime power count - prime_power_count_lower(n) fast prime power count lower bound - prime_power_count_upper(n) fast prime power count upper bound - nth_prime_power(n) the nth prime power - nth_prime_power_approx(n) fast approximate nth prime power - nth_prime_power_lower(n) fast nth prime power lower bound - nth_prime_power_upper(n) fast nth prime power upper bound - next_perfect_power(n) next perfect power: p > n - prev_perfect_power(n) previous perfect power: p < n - perfect_power_count([beg,] end) count of perfect powers - perfect_power_count_approx(n) fast approximate perfect power count - perfect_power_count_lower(n) fast perfect power count lower bound - perfect_power_count_upper(n) fast perfect power count upper bound - nth_perfect_power(n) the nth perfect power - nth_perfect_power_approx(n) fast approximate nth perfect power - nth_perfect_power_lower(n) fast nth perfect power lower bound - nth_perfect_power_upper(n) fast nth perfect power upper bound - next_chen_prime(n) next Chen prime: p > n - lucky_numbers([start],] end) array ref of lucky numbers - lucky_count([start,] end) count of lucky numbers - lucky_count_approx(n) fast approximate lucky count - lucky_count_lower(n) fast lucky count lower bound - lucky_count_upper(n) fast lucky count upper bound - nth_lucky(n) the nth lucky number - nth_lucky_approx(n) fast approximate nth lucky number - nth_lucky_lower(n) fast nth lucky number lower bound - nth_lucky_upper(n) fast nth lucky number upper bound - chinese2([a1,m1],[a2,m2],...) CRT returning (solution,modulus) - frobenius_number(...) Frobenius number of a set - vecmex(...) least non-negative value not in list - vecpmex(...) least positive value not in list - vecuniq(...) remove duplicates from list of integers - vecfreq(...) return hash of item => count from list - vecsingleton(...) remove all items that aren't unique - vecslide { ... } @list calls block for each pair in list - vecsort(@L) numerically sort integer list - vecsorti(\@L) in-place numeric sort a list ref - vecsample(k,@list) return k random elements of list - toset(...) convert to int set (unique sorted aref) - setinsert(\@A,$v) insert integer v into integer set A - setinsert(\@A,\@B) insert list B into integer set A - setremove(\@A,$v) remove integer v from integer set A - setremove(\@A,\@B) remove list B values from integer set A - setinvert(\@A,$v) if v is in set A, remove, otherwise add - setinvert(\@A,\@B) invert for all values in integer list B - setcontains(\@A,...) are list values all in int set A - setcontains(\@A,\@B) is int set B a subset of int set A - setcontainsany(\@A,...) are any list values in int set A - setcontainsany(\@A,\@B) is any value in B in int set A - setbinop {...} \@A[,\@B] apply op to cross product of set(s) - sumset(\@A[,\@B]) new set from a+b {a:A,b:B} - setunion(\@A,\@B) union of two integer lists - setintersect(\@A,\@B) intersection of two integer lists - setminus(\@A,\@B) difference of two integer lists - setdelta(\@A,\@B) symmetric difference of two int lists - is_sidon_set(\@L) is integer list L a Sidon set - is_sumfree_set(\@L) is integer list L a sum-free set - set_is_disjoint(\@A,\@B) is set B disjoint from set A - set_is_equal(\@A,\@B) is set B equal to set A - set_is_subset(\@A,\@B) is set B a subset of set A - set_is_proper_subset(\@A,\@B) is set B a proper subset of set A - set_is_superset(\@A,\@B) is set B a superset of set A - set_is_proper_superset(\@A,\@B) is set B a proper superset of set A - set_is_proper_intersection(\@A,\@B) "" a proper intersection "" - contfrac(n,d) list of continued fraction for n/d - from_contfrac(@A) return (p,q) rational from cfrac list - next_calkin_wilf(n,d) next breadth-first CW rational - next_stern_brocot(n,d) next breadth-first SB rational - calkin_wilf_n(n,d) index of breadth-first CW rational - stern_brocot_n(n,d) index of breadth-first SB rational - nth_calkin_wilf(n) CW rational at breadth-first index n - nth_stern_brocot(n) SB rational at breadth-first index n - nth_stern_diatomic(n) Stern's Diatomic series; fusc(n) - farey(n) list of Farey sequence order n - farey(n,k) k'th entry of Farey sequence order n - next_farey(n,[p,q]) next order-n rational after p/q - farey_rank(n,[p,q]) number of F_n less than p/q - minimal_goldbach_pair(n) least prime p where n-p is also prime - goldbach_pair_count(n) count of how many prime pairs sum to n - goldbach_pairs(n) array of all p where p and n-p are prime [FIXES] - nth_ramanujan_* returns undef with input of 0. - PP code for is_polygonal with n=0 was wrong. Fixed and refactored. - Some large results that used GMP are properly objectified. - When using GMP, native int results are no longer objectified. - AKS was modding a with r, since 2012. - is_totient(2^k) with k >= 33, found by Trizen in 2019. - forsquarefree and forfactored were missing a destroy. From Trizen. - todigitstring with non-standard bases and long strings. From Trizen. - Fix v0.62 breaking extended precision long doubles on some machines. Big difference in epsilon-level precision for LambertW, Li, Zeta. - sieve_range documentation for depth didn't exactly match the XS code. - is_extra_strong_lucas_pseudoprime(5) was returning 0. - lucas_sequence wasn't right for some outlier cases. This did not impact any primality tests or other internal code. - gcd(-n) and lcm(-n) would return -n instead of n. - All mod functions are more consistent. Like Pari, we use mod abs(n). If n=0, we return undef. If n=1, we return 0. - invmod(0,1) = 0 instead of undef. Both cases make sense, but Pari, Mathematica, SAGE, and Math::BigInt all return 0. - sqrtmod was not solving some cases, e.g. sqrtmod(4,8). - chinese uses abs modulos, and values are all pre-modded. This fixes negative inputs, e.g. chinese([-4,17],[17,-19]) - The 70-rt-bignum test was horrendously slow with bignum 0.60+. It was bypassing the validation that sanitized the input. - Fix logint for base > n. Github #75. - lcm with empty list returns 1 instead of 0. Github #73. - fix an XS stack issue with calling other routines inside forprimes - is_pseudoprime and is_euler_pseudoprime have consistent XS, PP, and GMP behaviour. Specifically, single digit inputs and bases a multiple of n. - kronecker in XS with 63-bit signed a and 64-bit unsigned n fixed. - forfactored and forsquarefree were incorrect near 64-bit boundary. - trial_factor etc. take an SV rather than silently coerce to a UV. - PP trial_factor corrects for MPU::GMP's different API. - PP is_perfect_square was wrong for 18446744073709551521 on 64-bit. [FUNCTIONALITY AND PERFORMANCE] - LMO prime count is 1.2-1.5x faster. - refactor objectification. Doesn't force. Enable on Perl < 5.9. - save a nanosecond or two in 32-bit primality testing. - Rewrite Ramanujan prime bounds using Axler (2017). For large values this is much improved. Big speedup for large exact nth/count. - Approx Ramanujan prime nth and count are much more accurate. - Internally, approx prime counts are faster, as we don't need to compute RiemannR to extreme precision. - Faster and tighter nth_prime_upper bounds. - Rewritten C version of Mertens based on pseudocode from Trizen. Over 100x faster at 2^32 and grows O(n^(2/3)) vs O(n). - fromdigits for bigints uses subquadratic algorithm, thanks from Trizen. It also will call GMP if possible. The large example runs 100x faster. - ExponentialIntegral with quadmath is much more precise across the range. - rewrote C factorialmod. 1.1-2x faster for small inputs, 3-4x for large. The PP non-GMP version also has optimizations added. - sum_primes faster for some inputs. - Rewrote legendre_phi and removed code duplication. Much faster. Also makes _legendre_pi(n) about 4x faster. - Rewrote prime count caching and removed code duplication. Uses less memory at large sizes and is faster. - Error message "must be a positive integer" changed to "must be a non-negative integer" when zero is allowed. - More accurate semiprime_count_approx and nth_semiprime_approx. - Switched from Kahan to Neumaier sum in some real computations. - is_primitive_root faster. Much faster for p^k and 2p^k with k >= 2. - znprimroot faster. 2-20x faster for p^k and 2p^k with k >= 2. - native integer input parsing is a little faster. A big deal for fast functions and long lists. - rootint, is_power, {next,prev}_perfect_power up to 2x faster. - inverse_totient memory leak fixed, memory use reduced, slightly faster. - forsetproduct handles tied input arrays. - stirling first kind without GMP is faster for some inputs. - Block functions that use MULTICALL now will pre-check the block to see if it needs to be run in its own scope. If not, then we get a 10-30% performance increase with lightweight blocks. [OTHER] - Legendre, Meissel, and Lehmer prime counting got rewritten to use our common code. 3x less code. No longer buildable standalone. Included by default, though still not called internally. - lucas_sequence(n,p,q,k) deprecated. Use lucasuvmod(p,q,k,n) instead. - Documentation more consistent with 'positive' vs 'non-negative'. - valuation(n,k) now will error if k < 2. This follows Pari and SAGE. undef is returned for n = 0. Arguable "Inf" would be preferable. - Added ability to select the bigint library, and rewrote large parts of the Perl backend to support other bigint classes (e.g. Math::GMPz and Math::GMP) rather than being specific to Math::BigInt. - Older versions of Test::More with Math::GMPz and Math::GMP have issues comparing big integers. Lots of the tests will stringify the output so is(x,y,txt) will work even if x or y is an object. 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. This removes the use of Bytes::Random::Secure::Tiny. - 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.74/sort.c000644 000765 000024 00000032660 15154033650 015534 0ustar00danastaff000000 000000 #include #include #include #define FUNC_log2floor 1 #include "util.h" #include "sort.h" #define USE_QUADSORT 0 /* * Sorting arrays of integers. * * We really have two quite different use cases. The first is for internal * use, where it's very common to have a small number of inputs. * E.g. sorting roots, factors, divisors, totients, prime powers, etc. Most * of these will have small arrays and the overall time is dominated by the * real work that created the data. * There are some degenerate cases that generate many inputs, but these are * exceptional. Most sorts from our test suite are 32 or fewer items, with * the largest being 576 items. * * The second use is from vecsort, where the user or our PP code has given * us a possibly large array to sort. Here we have the additional challenge * of making sure the overhead of Perl->C->Perl is as small as possible. * * We have a number of possible choices. * * 1) Perl's sort. A cache-aware merge sort, which makes a lot of sense for * its use with arbitrary and complicated data structures, possibly * expensive comparisons, and where a stable sort is highly desirable. * Most of this is irrelevant for sorting simple integers. * Problem 1: We can sort SV's but there isn't a simple UV interface. * Problem 2: It's slow for shuffled inputs, like most stable merge sorts. * * 2) qsort. Easy and works, but system dependent. * Can be quite fast -- MacOS/clang is 3x faster than merge sort for * shuffled inputs, and has fast behavior with sorted/reversed data. * * 3) fluxsort/quadsort/timsort/powersort/glidesort/etc. * fluxsort is extremely fast and has excellent behavior with ordered data. * The main reason it isn't being used here is the code size. * * 4) insertion / Shell. Fastest on tiny arrays and very compact. We use * insertion sort for small chunks. * * 5) heapsort. lobby99's implementation here is surprisingly fast and very * consistent across a variety of inputs. It is used as a fallback if * quicksort is choosing bad partitions. * * 6) quicksort. Yes, yet another quicksort implementation. Fast for small * inputs, competitive for larger. This uses true median of 9 * partitioning, insertion sort for small partitions, and will switch to * heapsort after enough bad partitions, so there is no O(n^2) disaster. * * 5) radix sort. With enough integers, radix sort beats everything else on * shuffled data. Performance on ordered data is decent though not like * fluxsort. Uses auxiliary data equal to the input size. * * We use our quicksort for small arrays, radixsort for larger. * */ /******************************************************************************/ static void insertionsort_uv(UV *array, size_t len) { size_t i,j; for (i = 1; i < len; i++) { UV t = array[i]; for (j = i; j > 0 && array[j-1] > t; j--) array[j] = array[j-1]; array[j] = t; } } static void insertionsort_iv(IV *array, size_t len) { size_t i,j; for (i = 1; i < len; i++) { IV t = array[i]; for (j = i; j > 0 && array[j-1] > t; j--) array[j] = array[j-1]; array[j] = t; } } #if 0 static void shellsort_uv(UV *array, size_t len) { static unsigned short sgaps[] = {209,109,41,19,5,1}; /* Sedgewick 1986 */ size_t i, j, gap, gi = 0; do { gap = sgaps[gi++]; for (i = gap; i < len; i++) { UV t = array[i]; for (j = i; j >= gap && array[j-gap] > t; j -= gap) array[j] = array[j-gap]; array[j] = t; } } while (gap > 1); } static void shellsort_iv(IV *array, size_t len) { static unsigned short sgaps[] = {209,109,41,19,5,1}; /* Sedgewick 1986 */ size_t i, j, gap, gi = 0; do { gap = sgaps[gi++]; for (i = gap; i < len; i++) { IV t = array[i]; for (j = i; j >= gap && array[j-gap] > t; j -= gap) array[j] = array[j-gap]; array[j] = t; } } while (gap > 1); } #endif /******************************************************************************/ /* RADIX SORT */ /******************************************************************************/ #define RADIX_BIT 8 #define RADIX (1u<> RADIX_BIT); count[d % RADIX]++; } if (passmask < RADIX) { /* If all values < RADIX, Use *fast* counting sort */ if (passmask) { size_t j = 0, lim = 0; for (r = 0; r < RADIX; r++) for (lim += count[r]; j < lim; j++) array[j] = r; } return 1; } /* Allocate second ping-pong buffer */ a = array; b = (UV*)malloc(n * sizeof(UV)); if (b == 0) return 0; /* Each pass radix-sorts and counts for next pass */ for (sh = 0; UV_MAX >> sh >= RADIX; sh += RADIX_BIT) { UV *p = b; if ((passmask >> sh) % RADIX == 0) continue; for (r = 0; r < RADIX; r++) { ptr[r] = p; p += count[r]; } /* assert(p == b + n); */ memset(count, 0, sizeof count); for (i = 0; i < n; i++) { UV d = a[i]; *(ptr[(d>>sh) % RADIX]++) = d; count[(d >> (sh + RADIX_BIT)) % RADIX]++; } p = b; b = a; a = p; } /* Last pass does no more counting */ if (passmask >> sh) { UV *p = b; unsigned signbit = is_iv ? 1 << (BITS_PER_WORD-1)%RADIX_BIT : 0; for (r = 0; r < RADIX; r++) { ptr[r^signbit] = p; p += count[r^signbit]; } /* assert(p == b + n); */ for (i = 0; i < n; i++) { UV d = a[i]; *(ptr[(d>>sh) % RADIX]++) = d; } p = b; b = a; a = p; } /* Move back to input array if necessary */ if (a != array) { memcpy(array, a, n * sizeof *array); b = a; } free(b); return 1; } #undef RADIX_BIT #undef RADIX /******************************************************************************/ /* HEAP SORT */ /******************************************************************************/ static void _heapsort(UV *array, size_t len, bool is_iv) { size_t a = len/2; if (!a) /* Trivial cases: len < 2 */ return; for (len--;;) { UV r; /* Value from array[a] being sifted down */ size_t b, c; /* Current descendent and its child */ /* * Elements [0,a) are unsorted. * Elements [a,n] are in the heap. * Elements (n,...) are sorted. */ if (a > 0) /* Building heap: sift down array[--a] */ r = array[--a]; else if (len > 0) { /* Extracting: Swap root<->array[n--] */ r = array[len]; array[len--] = array[0]; } else /* Extraction complete */ return; /* Sift element r (at "a") down into heap. */ if (!is_iv) { for (b = a; (c = 2*b + 1) < len; b = c) { UV s = array[c]; if (array[c+1] >= s) s = array[++c]; if (r >= s) goto sift_done; array[b] = s; } } else { for (b = a; (c = 2*b + 1) < len; b = c) { IV s = array[c]; if ((IV)array[c+1] >= s) s = array[++c]; if ((IV)r >= s) goto sift_done; array[b] = s; } } if (c == len) { /* Corner case: last leaf with no sibling */ if ( (!is_iv && r < array[c]) || (is_iv && (IV)r < (IV)array[c]) ) { array[b] = array[c]; b = c; } } sift_done: array[b] = r; } } #define radixsort_uv(L,len) _radixsort(L, len, 0) #define radixsort_iv(L,len) _radixsort((UV*)L, len, 1) #define heapsort_uv(L,len) _heapsort(L, len, 0) #define heapsort_iv(L,len) _heapsort((UV*)L, len, 1) /******************************************************************************/ /* QUICK SORT */ /******************************************************************************/ static size_t _mid3_uv_val(UV* L, size_t a, size_t b, size_t c) { const UV s[3] = {L[a],L[b],L[c]}; /* Scandum's branchless method */ int x = s[0] > s[1]; int y = s[0] > s[2]; int z = s[1] > s[2]; return s[(x == y) + (y ^ z)]; } static size_t _mid3_iv_val(IV* L, size_t a, size_t b, size_t c) { const IV s[3] = {L[a],L[b],L[c]}; /* Scandum's branchless method */ int x = s[0] > s[1]; int y = s[0] > s[2]; int z = s[1] > s[2]; return s[(x == y) + (y ^ z)]; } static void _mid2_of_4_uv(UV* L) { UV swap; /* 1) put first two and last two in order */ size_t x; /* 2) L[2] = max(L[0],L[2]); L[1] = min(L[1],L[3]); */ x = L[0] > L[1]; swap = L[!x]; L[0]=L[x]; L[1]=swap; L += 2; x = L[0] > L[1]; swap = L[!x]; L[0]=L[x]; L[1]=swap; L -= 2; x = (L[0] <= L[2]) * 2; L[2] = L[x]; L += 1; x = (L[0] > L[2]) * 2; L[0] = L[x]; } static void _mid2_of_4_iv(IV* L) { IV swap; /* 1) put first two and last two in order */ size_t x; /* 2) L[2] = max(L[0],L[2]); L[1] = min(L[1],L[3]); */ x = L[0] > L[1]; swap = L[!x]; L[0]=L[x]; L[1]=swap; L += 2; x = L[0] > L[1]; swap = L[!x]; L[0]=L[x]; L[1]=swap; L -= 2; x = (L[0] <= L[2]) * 2; L[2] = L[x]; L += 1; x = (L[0] > L[2]) * 2; L[0] = L[x]; } /* Using scandum's median of 9 gives better partitions than the median of * three medians, and gives better actual run times for large inputs. */ static size_t _partition_uv(UV* L, size_t lo, size_t hi) { size_t i = lo-1, j = hi+1, len = hi-lo+1; UV pivot; if (len <= 7) { pivot = L[len/2]; } else if (len <= 40) { pivot = _mid3_uv_val(L, lo, lo+(hi-lo)/2, hi); } else { /* Fluxsort's median_of_nine */ UV swap[9], *X = L+lo; size_t x, step = (len-1)/8; for (x = 0; x < 9; x++) { swap[x] = *X; X += step; } _mid2_of_4_uv(swap); /* [X v v X v v v v v] */ _mid2_of_4_uv(swap+4); /* [X v v X X v v X v] */ swap[0] = swap[5]; swap[3] = swap[8]; _mid2_of_4_uv(swap); /* [X v v X X X v X X] */ pivot = _mid3_uv_val(swap, 6, 1, 2); } while (1) { do { i++; } while (L[i] < pivot); do { j--; } while (L[j] > pivot); if (i >= j) return j; { UV t = L[i]; L[i] = L[j]; L[j] = t; } } } static size_t _partition_iv(IV* L, size_t lo, size_t hi) { size_t i = lo-1, j = hi+1, len = hi-lo+1; IV pivot; if (len <= 7) { pivot = L[len/2]; } else if (len <= 40) { pivot = _mid3_iv_val(L, lo, lo+(hi-lo)/2, hi); } else { /* Fluxsort's median_of_nine */ IV swap[9], *X = L+lo; size_t x, step = (len-1)/8; for (x = 0; x < 9; x++) { swap[x] = *X; X += step; } _mid2_of_4_iv(swap); /* [X v v X v v v v v] */ _mid2_of_4_iv(swap+4); /* [X v v X X v v X v] */ swap[0] = swap[5]; swap[3] = swap[8]; _mid2_of_4_iv(swap); /* [X v v X X X v X X] */ pivot = _mid3_iv_val(swap, 6, 1, 2); } while (1) { do { i++; } while (L[i] < pivot); do { j--; } while (L[j] > pivot); if (i >= j) return j; { IV t = L[i]; L[i] = L[j]; L[j] = t; } } } static void _qs_uv(UV* L, size_t lo, size_t hi, int badpartsleft) { size_t p, size = hi-lo+1; if (size <= 16) { insertionsort_uv(L+lo, size); return; } p = _partition_uv(L, lo, hi); { /* check for unbalanced partitions, same as pdqsort */ size_t l_size = p - lo + 1; size_t r_size = hi - (p+1) + 1; bool highly_unbalanced = l_size < size / 8 || r_size < size / 8; if (highly_unbalanced && --badpartsleft <= 0) { heapsort_uv(L+lo, size); return; } } _qs_uv(L, lo, p, badpartsleft); _qs_uv(L, p+1, hi, badpartsleft); } static void _qs_iv(IV* L, size_t lo, size_t hi, int badpartsleft) { size_t p, size = hi-lo+1; if (size <= 16) { insertionsort_iv(L+lo, size); return; } p = _partition_iv(L, lo, hi); { /* check for unbalanced partitions, same as pdqsort */ size_t l_size = p - lo + 1; size_t r_size = hi - (p+1) + 1; bool highly_unbalanced = l_size < size / 8 || r_size < size / 8; if (highly_unbalanced && --badpartsleft <= 0) { heapsort_iv(L+lo, size); return; } } _qs_iv(L, lo, p, badpartsleft); _qs_iv(L, p+1, hi, badpartsleft); } static void quicksort_uv(UV *L, size_t len) { if (len > 1) _qs_uv(L, 0, len-1, log2floor(len)); } static void quicksort_iv(IV *L, size_t len) { if (len > 1) _qs_iv(L, 0, len-1, log2floor(len)); } #if USE_QUADSORT #include "quadsortuv.h" void sort_uv_array(UV* L, size_t len) { quadsort_uv(L, len, 0); } void sort_iv_array(IV* L, size_t len) { quadsort_iv(L, len, 0); } #else void sort_uv_array(UV* L, size_t len) { if (len < 800) { quicksort_uv(L, len); } else { /* We could use an in-place radix sort like Ska Sort. Our radix sort * is traditional and uses O(n) extra memory. If we cannot get the * extra memory, we fall back to an in-place sort. */ if (!radixsort_uv(L, len)) quicksort_uv(L, len); } } void sort_iv_array(IV* L, size_t len) { if (len < 800) { quicksort_iv(L, len); } else { if (!radixsort_iv(L, len)) /* radixsort could fail aux allocation */ quicksort_iv(L, len); } } #endif /******************************************************************************/ void sort_dedup_uv_array(UV* L, bool data_is_signed, size_t *len) { if (*len > 1) { size_t i, j; if (data_is_signed) sort_iv_array((IV *)L, *len); else sort_uv_array(L, *len); for (i=0, j=1; j < *len; j++) { i += (L[i] != L[j]); L[i] = L[j]; } *len = i+1; } } Math-Prime-Util-0.74/csprng.c000644 000765 000024 00000024727 15154034770 016052 0ustar00danastaff000000 000000 /* 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((chacha_context_t*)ctx,bytes,data,good) #define CRBYTES(ctx,bytes,data) chacha_rand_bytes((chacha_context_t*)ctx,bytes,data) #define CIRAND32(ctx) chacha_irand32((chacha_context_t*)ctx) #define CIRAND64(ctx) chacha_irand64((chacha_context_t*)ctx) #define CSELFTEST() chacha_selftest() /* Helper macros, similar to ChaCha, so we're consistent. */ #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 & 0xFF; \ (p)[1] = _v >> 8 & 0xFF; \ (p)[2] = _v >> 16 & 0xFF; \ (p)[3] = _v >> 24 & 0xFF; \ } while (0) #endif /*****************************************************************************/ /* 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(void* 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; } void* 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((void*)state); state[0] += a; (void) prng_next((void*)state); return (void*) state; } #else /* PCG RXS M XS 32. 32-bit output, 32-bit state and types. */ uint32_t prng_next(void* 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; } void* 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((void*)state); state[0] += a; (void) prng_next((void*)state); state[0] ^= c; (void) prng_next((void*)state); state[0] ^= d; (void) prng_next((void*)state); return (void*) 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 { void* 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 } /*****************************************************************************/ bool is_csprng_well_seeded(void *ctx) { chacha_context_t *cs = (chacha_context_t*)ctx; return cs->goodseed; } /* There are many ways to get floats from integers. A few good, many bad. * * Vigna in https://prng.di.unimi.it recommends this C99: * #include * (x64 >> 11) * 0x1.0p-53 * Or the older: * (x64 >> 11) * (1.0 / (1ULL<<53)). * * 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. * * As of C99 or MSVC 15.6, we could better write these as e.g. 0x1.0p-64. */ #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/64-bit integer between 0 to n-1 inclusive * * https://www.pcg-random.org/posts/bounded-rands.html * https://arxiv.org/pdf/1805.10941 * * I have also tried Stephen Canon's method: * https://github.com/swiftlang/swift/pull/39143 * which is consistently slower for me. * * Here we will select one: * * OPENBSD = DEBIASED_MODx2 * LEMIRE = INT_MULT_TOPT_MOPT * * The main issue with LEMIRE is that it *requires* full width multiplies. * We still try to support old systems that may not have 64-bit. * We definitely expect 64-bit systems without uint128_t support. */ /* If this is set, we will try to use Lemire / O'Neill method. */ #define PREFER_LEMIRE 0 #if PREFER_LEMIRE && HAVE_UINT64 uint32_t urandomm32(void *ctx, uint32_t n) { uint32_t x, l; uint64_t m; if (n <= 1) return 0; x = CIRAND32(ctx); m = (uint64_t) x * (uint64_t) n; l = (uint32_t) m; if (l < n) { uint32_t t = -n; /* t = -n % n; try to skip the mod */ if (t >= n) { t -= n; if (t >= n) t %= n; } while (l < t) { x = CIRAND32(ctx); m = (uint64_t) x * (uint64_t) n; l = (uint32_t) m; } } return m >> 32; } #else 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; } #endif #if PREFER_LEMIRE && HAVE_UINT64 && HAVE_UINT128 UV urandomm64(void *ctx, UV n) { uint64_t x, l; uint128_t m; if (n <= 4294967295UL) return urandomm32(ctx,n); if (n-1 == 4294967295UL) return irand32(ctx); x = CIRAND64(ctx); m = (uint128_t) x * (uint128_t) n; l = (uint64_t) m; if (l < n) { uint64_t t = -n; /* t = -n % n; try to skip the mod */ if (t >= n) { t -= n; if (t >= n) t %= n; } while (l < t) { x = CIRAND64(ctx); m = (uint128_t) x * (uint128_t) n; l = (uint64_t) m; } } return m >> 64; } #else 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; } #endif 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.74/ramanujan_primes.c000644 000765 000024 00000027745 15151337121 020105 0ustar00danastaff000000 000000 #include #include #include #define FUNC_log2floor 1 #define FUNC_is_prime_in_sieve 1 #include "ptypes.h" #include "sieve.h" #include "util.h" #include "prime_counts.h" #include "inverse_interpolate.h" #include "ramanujan_primes.h" /******************************************************************************/ /* RAMANUJAN PRIMES */ /******************************************************************************/ static const uint8_t small_ram_primes[] = { 2,11,17,29,41,47,59,67,71,97,101,107,127,149,151,167,179,181,227,229,233,239,241 }; #define NSMALL_RAM (sizeof(small_ram_primes)/sizeof(small_ram_primes[0])) #define FAST_SMALL_NTH(n) \ if (n <= NSMALL_RAM) \ { return (n == 0) ? 0 : small_ram_primes[n-1]; } #define FAST_SMALL_COUNT(n) \ if (n <= small_ram_primes[NSMALL_RAM-1]) { \ UV i; \ for (i = 0; i < NSMALL_RAM; i++) \ if (n < small_ram_primes[i]) break; \ return i; \ } /******************************* Bounds *******************************/ /* Upper and lower bounds done using Axler 2017: * https://arxiv.org/pdf/1711.04588.pdf * The parameter values have been computed using exact nth_prime, * so does not depend on the nth_prime_upper / nth_prime_lower method. */ UV nth_ramanujan_prime_upper(UV n) { long double R = 0, D = 0.565; FAST_SMALL_NTH(n); if (n < 12581) { if (n < 168) R = ramanujan_axler(n, -4.7691, -6.2682); else if (n < 2290) R = ramanujan_axler(n, -0.9315, -0.5635); else if (n < 5225) R = ramanujan_axler(n, -0.5318, -0.0710); else if (n < 12581) R = ramanujan_axler(n, 0.1212, 0.7973); return nth_prime_upper(R); } if (n < 18175) D = 0.3548; else if (n < 82883) D = -0.2450; else if (n < 316314) D = -0.6384; else if (n < 1000001) D = -0.9353; else if (n < 4000001) D = -1.1271; else if (n < 16000001) D = -1.4152; else if (n < 64000001) D = -1.6671; else if (n < 128000001) D = -1.8855; else if (n < 256000001) D = -1.9325; else if (n < 384000001) D = -2.0190; else if (n < 512000001) D = -2.0310; else { D = -2.0884; if (n > UVCONST( 3999654659)) D = -2.235; #if BITS_PER_WORD == 64 if (n > UVCONST( 84086679236)) D = -2.435; if (n > UVCONST( 514808375201)) D = -2.535; if (n > UVCONST( 3594243587299)) D = -2.635; if (n > UVCONST( 28330126673435)) D = -2.735; if (n > UVCONST(117462814829787)) D = -2.8; #endif } return nth_prime_upper(ramanujan_axler(n, 0.0, D)); } UV nth_ramanujan_prime_lower(UV n) { double R = 0, D = 0; FAST_SMALL_NTH(n); if (n < 34816) { if (n < 189) R = ramanujan_axler(n, 4.2720, 0.340); else if (n < 1245) R = ramanujan_axler(n, -0.2179, -6.179); else if (n < 2984) R = ramanujan_axler(n, 0.1446, -4.8693); else if (n < 14303) R = ramanujan_axler(n, -0.3570, -5.1154); else if (n < 34816) R = ramanujan_axler(n, -1.5770, -7.5332); return nth_prime_lower(R); } if (n < 76400) D = 0.0126; else if (n < 280816) D = 0.5132; else if (n < 915887) D = 0.9967; else if (n < 4000001) D = 1.5004; else if (n < 16000001) D = 1.7184; else if (n < 64000001) D = 1.9860; else if (n < 128000001) D = 2.1352; else if (n < 256000001) D = 2.1658; else if (n < 384000001) D = 2.1999; else if (n < 512000001) D = 2.2047; else if (n < 640000001) D = 2.2324; else { D = 2.2385; #if BITS_PER_WORD == 64 if (n > UVCONST( 14888378285)) D = 2.29; if (n > UVCONST( 467037926604)) D = 2.31; if (n > UVCONST( 2778491401197)) D = 2.315; if (n > UVCONST( 10656144781918)) D = 2.317; if (n > UVCONST( 63698770351741)) D = 2.319; #endif } return nth_prime_lower(ramanujan_axler(n, 1.472, D)); } /* For Ramanujan prime count bounds, use binary searches on the inverses. */ UV ramanujan_prime_count_lower(UV n) { UV lo, hi; FAST_SMALL_COUNT(n); /* 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; return inverse_interpolate(lo, hi, n, &nth_ramanujan_prime_upper, 0); } UV ramanujan_prime_count_upper(UV n) { UV lo, hi; FAST_SMALL_COUNT(n); /* 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; return inverse_interpolate(lo, hi, n, &nth_ramanujan_prime_lower, 0); } /**************************** Approximate ****************************/ UV ramanujan_prime_count_approx(UV n) { FAST_SMALL_COUNT(n); /* Extremely accurate but a bit slow */ return prime_count_approx(n) - prime_count_approx(n >> 1); } UV nth_ramanujan_prime_approx(UV n) { UV lo, hi; FAST_SMALL_NTH(n); /* Interpolating using ramanujan prime count approximation */ lo = nth_ramanujan_prime_lower(n) - 1; hi = nth_ramanujan_prime_upper(n); return inverse_interpolate(lo, hi, n, &ramanujan_prime_count_approx, 0); } /******************************* Arrays *******************************/ /* 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; if (n <= NSMALL_RAM) { New(0, L, n, UV); for (k = 0; k < n; k++) L[k] = small_ram_primes[k]; return L; } 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(mink-2) - prime_count((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; } /* 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; } UV range_ramanujan_prime_sieve(UV** list, UV lo, UV hi) { UV first, last, *L; L = ramanujan_primes(&first, &last, lo, hi); if (L == 0 || first > last) { *list = 0; return 0; } if (first > 0) memmove( L + 0, L + first, (last-first+1) * sizeof(UV) ); *list = L; return last-first+1; } /* Generate a small window of Rp's around n */ static UV* _ramanujan_prime_window(UV n, UV* winsize, UV* npos) { UV i, v, *L, window, swin, ewin, wlen, winmult = 1; MPUverbose(1, "ramanujan_prime_count calculating Pi(%"UVuf")\n",n); v = prime_count(n) - prime_count(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, " %s increasing window\n", "ramanujan_prime_count"); } *winsize = swin; *npos = i-1; return L; } /******************************* Exact *******************************/ UV nth_ramanujan_prime(UV n) { UV rn, *L; FAST_SMALL_NTH(n); L = n_range_ramanujan_primes(n, n); rn = L[0]; Safefree(L); return rn; } bool is_ramanujan_prime(UV n) { UV i, d, *L, swin, rn; bool res; if (!is_prime(n)) return 0; if (n < 17) return (n == 2 || n == 11); /* Pre-test: Check if Pi(n/2) increases before Pi(n) does. */ if (is_prime(n/2+1)) return 0; d = (next_prime(n) - n)/2; for (i = 2; i <= d; i++) if (is_prime(n/2+i)) return 0; /* Very straightforward, but not the fastest method: * return nth_ramanujan_prime(ramanujan_prime_count(n)) == n; * * Slower than below for most input sizes: * L = ramanujan_primes(&beg, &end, n, n); * Safefree(L); * return (beg <= end); */ L = _ramanujan_prime_window(n, &swin, &rn); res = (L[rn] == n); Safefree(L); return res; } #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 UV ramanujan_prime_count(UV n) { UV swin, rn, *L, log2 = log2floor(n); if ((n & (n-1)) == 0 && log2 <= RAMPC2) /* Powers of two from table */ return ramanujan_counts_pow2[log2]; FAST_SMALL_COUNT(n); L = _ramanujan_prime_window(n, &swin, &rn); Safefree(L); return swin+rn; } UV ramanujan_prime_count_range(UV lo, UV hi) { if (hi < 2 || hi < lo) return 0; return ramanujan_prime_count(hi) - ((lo <= 2) ? 0 : ramanujan_prime_count(lo-1)); } Math-Prime-Util-0.74/aks.c000644 000765 000024 00000030347 15146553566 015341 0ustar00danastaff000000 000000 #include #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) { if (n < k) return 0; 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); if (a >= n) a %= n; 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 */ bool is_aks_prime(UV n) { UV r, s, a, starta = 1; if (n < 2) return 0; if (n == 2) return 1; if (powerof(n) > 1) 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.74/prime_count_tables.h000644 000765 000024 00000035352 15145577415 020445 0ustar00danastaff000000 000000 #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.74/MANIFEST000644 000765 000024 00000015247 15154713772 015546 0ustar00danastaff000000 000000 Changes Timeline 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 mathl.h montmath.h multicall.h mulmod.h ppport.h aks.h aks.c almost_primes.h almost_primes.c cache.h cache.c congruent_numbers.h congruent_numbers.c constants.h ds_bitmask126.h ds_pagelist32.h ds_pagelist64.h ds_iset.h ds_iset.c entropy.h entropy.c factor.h factor.c goldbach.h goldbach.c inverse_interpolate.h inverse_interpolate.c keyval.h legendre_phi.h legendre_phi.c lehmer.h lehmer.c lmo.h lmo.c lucas_seq.h lucas_seq.c lucky_numbers.h lucky_numbers.c omega_primes.h omega_primes.c perfect_powers.h perfect_powers.c powerfree.h powerfree.c powerful.h powerful.c primality.h primality.c prime_count_cache.c prime_count_cache.h prime_count_tables.h prime_counts.h prime_counts.c prime_powers.h prime_powers.c prime_sums.h prime_sums.c ramanujan_primes.h ramanujan_primes.c random_prime.h random_prime.c rational.h rational.c real.h real.c rootmod.h rootmod.c semi_primes.h semi_primes.c sieve.h sieve.c sieve_cluster.h sieve_cluster.c sort.h sort.c threadlock.h totients.h totients.c twin_primes.h twin_primes.c 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/bench-set-tiny.pl bench/factor-gnufactor.pl bench/setops.pl bench/setreject.pl bench/sort.pl bench/vecequal.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/findomegaseq.c 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-primepowers.t t/11-ramanujanprimes.t t/11-semiprimes.t t/11-twinprimes.t t/11-sumprimes.t t/11-clusters.t t/11-almostprimes.t t/11-omegaprimes.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-10-unary_int.t t/18-15-cmpint.t t/18-20-addint.t t/18-22-mulint.t t/18-24-powint.t t/18-26-shiftint.t t/18-40-divmodrem.t t/18-50-sqrtint.t t/18-52-rootint.t t/18-60-logint.t t/18-90-int_rtype.t t/18-91-edge.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-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-binomial.t t/26-binomialmod.t t/26-chenprimes.t t/26-combinatorial.t t/26-congruentnum.t t/26-contfrac.t t/26-cornacchia.t t/26-delicateprime.t t/26-digits.t t/26-factorial.t t/26-factorialmod.t t/26-frobeniusnum.t t/26-goldbach.t t/26-isalmostprime.t t/26-iscarmichael.t t/26-iscyclic.t t/26-isdivisible.t t/26-isfundamental.t t/26-isgaussianprime.t t/26-ishappy.t t/26-isodd.t t/26-isomegaprime.t t/26-isperfectnumber.t t/26-ispower.t t/26-issemiprime.t t/26-issquarefree.t t/26-istotient.t t/26-lucky.t t/26-mex.t t/26-modops.t t/26-perfectpowers.t t/26-pillai.t t/26-pisano.t t/26-polygonal.t t/26-powerfree.t t/26-powerful.t t/26-powersum.t t/26-practical.t t/26-randperm.t t/26-rationaltrees.t t/26-rootmod.t t/26-setbinop.t t/26-setops.t t/26-smooth.t t/26-stirling.t t/26-sumset.t t/26-vec.t t/26-zeckendorf.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/53-realfunctions.t t/70-rt-bignum.t t/80-pp.t t/81-bigint.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/A003459.pl xt/allrootmod.pl xt/almost-primes-big.pl xt/binomialmod.pl xt/check-bigint.pl xt/check-nth-bounds.pl xt/chinese.pl xt/create-pc-tables.pl xt/division.pl xt/divisors.pl xt/divtest.pl xt/foralmostprimes.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/kronecker.pl xt/legendre_phi.t xt/lucasseq.pl xt/lucky.c 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/rootmod.pl xt/rwh_primecount.py xt/rwh_primecount_numpy.py xt/setop.pl xt/sort-return.pl 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-rootint.pl xt/test-sets.pl xt/test-znlog.pl xt/totientsum.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.74/totients.h000644 000765 000024 00000000614 15145577415 016431 0ustar00danastaff000000 000000 #ifndef MPU_TOTIENTS_H #define MPU_TOTIENTS_H #include "ptypes.h" extern UV totient(UV n); extern UV* range_totient(UV low, UV high); extern UV sumtotient(UV n); extern int sumtotient128(UV n, UV *hisum, UV *losum); extern UV jordan_totient(UV k, UV n); extern bool is_totient(UV n); extern UV inverse_totient_count(UV n); extern UV* inverse_totient_list(UV *ntotients, UV n); #endif Math-Prime-Util-0.74/lmo.c000644 000765 000024 00000057600 15145577415 015351 0ustar00danastaff000000 000000 #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 #include "util.h" #include "constants.h" #include "prime_counts.h" #include "cache.h" #include "sieve.h" #include "legendre_phi.h" #include "lmo.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_t* plist; #if 1 *number_of_primes = range_prime_sieve_32(&plist, n, 1); #else uint32 i = 0; uint32 max_index = max_nprimes(n); *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; #endif 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] = (uint16) 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; /* TODO p > 65535? */ 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; } /****************************************************************************/ 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. * Kim W. gave a nice branchless speedup for sieve_zero */ #define sieve_zero(sieve, si, wordcount) \ { uint32 index_ = si/SWORD_BITS; \ sword_t mask_ = SWORD_MASKBIT(si); \ sword_t is_bit = (sieve[index_] >> (si % SWORD_BITS)) & 1; \ sieve[index_] &= ~mask_; \ wordcount[index_] -= is_bit; \ } #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] = (uint8) 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 = tiny_phi_max_a(); /* 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 > 500000000000UL) { /* Crossover on 2020 Macbook M1 (with parallel!) */ FILE *f; char cmd[100]; snprintf(cmd, 100, "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 = tiny_phi(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 = tiny_phi(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.74/prime_counts.h000644 000765 000024 00000001071 15145577415 017265 0ustar00danastaff000000 000000 #ifndef MPU_PRIME_COUNTS_H #define MPU_PRIME_COUNTS_H #include "ptypes.h" extern UV segment_prime_count(UV low, UV high); extern UV prime_count_range(UV low, UV high); extern UV prime_count(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 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); /* Used for Ramanujan prime bounds */ extern double ramanujan_axler(long double n, long double c, long double d); #endif Math-Prime-Util-0.74/rootmod.c000644 000765 000024 00000076273 15152715573 016251 0ustar00danastaff000000 000000 /******************************************************************************/ /* MODULAR ROOTS */ /******************************************************************************/ #include #include #include #include "ptypes.h" #define FUNC_isqrt 1 #define FUNC_is_perfect_square 1 #define FUNC_gcd_ui 1 #define FUNC_ipow 1 #include "util.h" #include "sort.h" #include "mulmod.h" #include "factor.h" #include "rootmod.h" /* Pick one or both */ #define USE_ROOTMOD_SPLITK 1 /* enables rootmod_composite1 */ #define USE_ROOTMOD_SPLITN 1 /* enables rootmod_composite2 */ /******************************************************************************/ /* SQRT(N) MOD M */ /******************************************************************************/ /* _sqrtmod_prime assumes 1 < a < p, n > 1, p > 2, p prime. * _sqrtmod_prime_power assumes 1 < a < p, n > 1, p > 2, p prime. * If any of these are not true, the result is undefined. * * _sqrtmod_composite takes care of the edge conditions and factors n. * * _sqrtmod_composite and _sqrtmod_prime_power always return UV_MAX * if no root exists, while any other return value will be a valid root. * * The exported functions sqrtmod(a,n) and rootmod(a,2,n) further: * - verify the result and return success / fail in a separate int. * - always returns the smaller of the two roots. * * sqrtmodp / rootmodp does the same except n is assumed prime. */ #if !USE_MONTMATH static 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; /* Algorithm 1.5.1 from Cohen. Tonelli/Shanks. */ { UV x, q, e, t, z, r, m, b; q = p-1; e = valuation_remainder(q, 2, &q); 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; } } #else static 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; /* Algorithm 1.5.1 from Cohen. Tonelli/Shanks. */ { UV x, q, e, t, z, r, m, b; q = p-1; e = valuation_remainder(q, 2, &q); 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 static UV _sqrtmod_prime_power(UV a, UV p, UV e) { UV r, s, n, pk, apk, ered, np; if (e == 1) { if (a >= p) a %= p; if (p == 2 || a == 0) return a; r = _sqrtmod_prime(a,p); if (p-r < r) r = p-r; return (sqrmod(r,p) == a) ? r : UV_MAX; } n = ipow(p,e); pk = p*p; if ((a % n) == 0) return 0; if ((a % pk) == 0) { apk = a / pk; s = _sqrtmod_prime_power(apk, p, e-2); if (s == UV_MAX) return UV_MAX; return s * p; } if ((a % p) == 0) return UV_MAX; ered = (p > 2 || e < 5) ? (e+1)>>1 : (e+3)>>1; s = _sqrtmod_prime_power(a, p, ered); if (s == UV_MAX) return UV_MAX; np = (p != 2 || (n > (UV_MAX/p))) ? n : n * p; r = addmod(s, gcddivmod(submod(a,sqrmod(s,np),np), addmod(s,s,np), n), n); if (n-r < r) r = n-r; if (sqrmod(r,n) != (a % n)) return UV_MAX; return r; } static UV _sqrtmod_composite(UV a, UV n) { factored_t nf; UV r, s, t, fe, N, inv; uint32_t i, root; if (n == 0) return UV_MAX; if (a >= n) a %= n; if (n <= 2 || a <= 1) return a; if (is_perfect_square_ret(a,&root)) return root; nf = factorint(n); N = ipow(nf.f[0], nf.e[0]); r = _sqrtmod_prime_power(a, nf.f[0], nf.e[0]); if (r == UV_MAX) return UV_MAX; for (i = 1; i < nf.nfactors; i++) { fe = ipow(nf.f[i], nf.e[i]); s = _sqrtmod_prime_power(a, nf.f[i], nf.e[i]); if (s == UV_MAX) return UV_MAX; inv = modinverse(N, fe); t = mulmod(inv, submod(s % fe,r % fe,fe), fe); r = addmod(r, mulmod(N,t,n), n); N *= fe; } return r; } /* Micro-optimization for fast returns with small values */ #define NSMALL 16 static char _small[NSMALL-3+1][NSMALL-2+1] = { {0}, {0,0}, {0,0,2}, {0,3,2,0}, {3,0,2,0,0}, {0,0,2,0,0,0}, {0,0,2,0,0,4,0}, {0,0,2,5,4,0,0,3}, {0,5,2,4,0,0,0,3,0}, {0,0,2,0,0,0,0,3,0,0}, {0,4,2,0,0,0,0,3,6,0,5}, {4,0,2,0,0,7,6,3,0,5,0,0}, {0,0,2,0,6,0,0,3,5,0,0,0,0}, {0,0,2,0,0,0,0,3,0,0,0,0,0,0}, }; static bool _sqrtmod_small_return(UV *s, UV a, UV n) { if (n == 0) return 0; if (a >= n) a %= n; if (n > 2 && a > 1) { a = _small[n-3][a-2]; if (a == 0) return 0; } if (s != 0) *s = a; return 1; } static bool _sqrtmod_return(UV r, UV *s, UV a, UV p) { if (p-r < r) r = p-r; if (mulmod(r, r, p) != (a % p)) return 0; if (s != 0) *s = r; return 1; } bool sqrtmodp(UV *s, UV a, UV p) { if (p == 0) return 0; if (a >= p) a %= p; if (p <= NSMALL || a <= 1) return _sqrtmod_small_return(s,a,p); return _sqrtmod_return(_sqrtmod_prime(a,p), s, a, p); } bool sqrtmod(UV *s, UV a, UV n) { /* return rootmod(s, a, 2, n); */ if (n == 0) return 0; if (a >= n) a %= n; if (n <= NSMALL || a <= 1) return _sqrtmod_small_return(s,a,n); return _sqrtmod_return(_sqrtmod_composite(a,n), s, a, n); } /******************************************************************************/ /* K-TH ROOT OF N MOD M */ /******************************************************************************/ static bool _rootmod_return(UV r, UV *s, UV a, UV k, UV p) { if (k == 2 && p-r < r) r = p-r; if (powmod(r, k, p) != (a % p)) return 0; if (s != 0) *s = r; return 1; } /* Generalized Tonelli-Shanks for k-th root mod a prime, with k prime */ static UV _ts_prime(UV a, UV k, UV p, UV *z) { UV A, B, y, x, r, T, ke, t; /* Assume: k > 1, 1 < a < p, p > 2, k prime, p prime */ for (r = p-1; !(r % k); r /= k) ; /* p-1 = r * k^e => ke = ipow(k,e) = (p-1)/r */ ke = (p-1)/r; x = powmod(a, modinverse(k % r, r), p); B = mulmod(powmod(x, k, p), modinverse(a, p), p); for (T = 2, y = 1; y == 1; T++) { t = powmod(T, r, p); y = powmod(t, ke/k, p); } while (ke != k) { ke = ke/k; T = t; t = powmod(t, k, p); A = powmod(B, ke/k, p); while (A != 1) { x = mulmod(x, T, p); B = mulmod(B, t, p); A = mulmod(A, y, p); } } if (z) *z = t; return x; } #if USE_ROOTMOD_SPLITK /* Alternate, taking prime p but composite k. */ /* k-th root using Tonelli-Shanks for prime k and p */ /* This works much better for me than AMM (Holt 2003 or Cao/Sha/Fan 2011). */ /* See Algorithm 3.3 of van de Woestijne (2006). */ /* https://www.opt.math.tugraz.at/~cvdwoest/maths/dissertatie.pdf */ /* Also see Pari's Tonelli-Shanks by Bill Allombert, 2014,2017, which seems */ /* to be the same algorithm. */ /* Algorithm 3.3, step 2 "Find generator" */ static void _find_ts_generator(UV *py, UV *pm, /* a not used */ UV k, UV p) { UV e, r, y, m, x, ke1; /* Assume: k > 2, 1 < a < p, p > 2, k prime, p prime */ /* e = valuation_remainder(p-1,k,&r); */ for (e = 0, r = p-1; !(r % k); r /= k) e++; ke1 = ipow(k, e-1); for (x = 2, m = 1; m == 1; x++) { y = powmod(x, r, p); if (y != 1) m = powmod(y, ke1, p); MPUassert(x < p, "bad Tonelli-Shanks input\n"); } *py = y; *pm = m; } static UV _ts_rootmod(UV a, UV k, UV p, UV y, UV m) { UV e, r, A, x, l, T, z, kz; /* Assume: k > 2, 1 < a < p, p > 2, k prime, p prime */ /* It is not expected to work with prime powers. */ /* e = valuation_remainder(p-1,k,&r); */ for (e = 0, r = p-1; !(r % k); r /= k) e++; /* p-1 = r * k^e */ x = powmod(a, modinverse(k % r, r), p); A = (a == 0) ? 0 : mulmod(powmod(x, k, p), modinverse(a, p), p); if (y == 0 && A != 1) _find_ts_generator(&y, &m /* ,a */, k, p); while (A != 1) { for (l = 1, T = A; T != 1; l++) { if (l >= e) return 0; z = T; T = powmod(T, k, p); } kz = negmod( znlog_solve(z, m, p, k), k); /* k = znorder(m,p) */ m = powmod(m, kz, p); T = powmod(y, kz * ipow(k, e-l), p); /* In the loop we always end with l < e, so e always gets smaller */ e = l-1; x = mulmod(x, T, p); y = powmod(T, k, p); if (y <= 1) return 0; /* In theory this will never be hit. */ A = mulmod(A, y, p); } return x; } static UV _compute_generator(UV l, UV e, UV r, UV p) { UV x, y, m = 1; UV lem1 = ipow(l, e-1); for (x = 2; m == 1; x++) { y = powmod(x, r, p); if (y == 1) continue; m = powmod(y, lem1, p); } return y; /* We might want to also return m */ } /* Following Pari, we calculate a root of unity to allow finding other roots */ static UV _rootmod_prime_splitk(UV a, UV k, UV p, UV *zeta) { UV g; if (zeta) *zeta = 1; if (a >= p) a %= p; if (a == 0 || (a == 1 && !zeta)) return a; /* Assume: k >= 2, 1 < a < p, p > 2, p prime */ if (k == 2) { if (zeta) *zeta = p-1; return _sqrtmod_prime(a, p); } /* See Algorithm 2.1 of van de Woestijne (2006), or Lindhurst (1997) */ /* The latter's proposition 7 generalizes to composite p */ g = gcd_ui(k, p-1); if (g != 1) { uint32_t i; factored_t nf = factorint(g); for (i = 0; a != 0 && i < nf.nfactors; i++) { UV y, m, F = nf.f[i], E = nf.e[i]; if (zeta) { UV REM, V, Y; V = valuation_remainder(p-1, F, &REM); Y = _compute_generator(F, V, REM, p); *zeta = mulmod(*zeta, powmod(Y, ipow(F, V-E), p), p); } _find_ts_generator(&y, &m /* ,a */, F, p); while (E-- > 0) a = _ts_rootmod(a, F, p, y, m); } } if (g != k) { UV kg = k/g, pg = (p-1)/g; a = powmod(a, modinverse(kg % pg, pg), p); } return a; } #endif #if 0 /* For testing purposes only. */ static UV _trial_rootmod(UV a, UV k, UV n) { UV r; if (n == 0) return 0; if (a >= n) a %= n; if (a <= 1) return a; for (r = 2; r < n; r++) if (powmod(r, k, n) == a) return r; return 0; } static UV* _trial_allsqrtmod(UV* nroots, UV a, UV n) { UV i, *roots, numr = 0, allocr = 16; if (n == 0) return 0; if (a >= n) a %= n; New(0, roots, allocr, UV); for (i = 0; i <= n/2; i++) { if (mulmod(i,i,n) == a) { if (numr >= allocr-1) Renew(roots, allocr += 256, UV); roots[numr++] = i; if (i != 0 && 2*i != n) roots[numr++] = n-i; } } sort_uv_array(roots, numr); *nroots = numr; return roots; } static UV* _trial_allrootmod(UV* nroots, UV a, UV g, UV n) { UV i, *roots, numr = 0, allocr = 16; if (n == 0) return 0; if (a >= n) a %= n; New(0, roots, allocr, UV); for (i = 0; i < n; i++) { if (powmod(i,g,n) == a) { if (numr >= allocr-1) Renew(roots, allocr += 256, UV); roots[numr++] = i; } } *nroots = numr; return roots; } #endif /******************************************************************************/ /* K-TH ROOT OF N MOD M (splitk) */ /******************************************************************************/ #if USE_ROOTMOD_SPLITK /* Given a solution to r^k = a mod p^(e-1), return r^k = a mod p^e */ static bool _hensel_lift(UV *re, UV r, UV a, UV k, UV pe) { UV f, fp, d; /* UV pe = ipow(p, e); */ if (a >= pe) a %= pe; f = submod(powmod(r, k, pe), a, pe); if (f == 0) { *re = r; return 1; } fp = mulmod(k, powmod(r, k-1, pe), pe); d = divmod(f, fp, pe); if (d == 0) return 0; /* We need a different base root */ *re = submod(r, d, pe); return 1; } static UV _rootmod_composite1(UV a, UV k, UV n) { factored_t nf; UV fac[MPU_MAX_DFACTORS], exp[MPU_MAX_DFACTORS]; UV f, g, e, r; uint32_t i; /* Assume: k >= 2, 1 < a < n, n > 2, n composite */ #if 0 /* For square roots of p^k with gcd(a,p)==1, this is straightforward. */ if (k == 2 && (i = primepower(n, &f)) && (a % f) > 1) { UV x = _sqrtmod_prime(a % f, f); UV r = n/f; UV j = powmod(x, r, n); UV k = powmod(a, (n - r - r + 1) >> 1, n); return mulmod(j, k, n); } #endif nf = factorint(n); for (i = 0; i < nf.nfactors; i++) { f = fac[i] = nf.f[i]; /* Find a root mod f. If none exists, there is no root for n. */ r = _rootmod_prime_splitk(a%f, k, f, 0); if (powmod(r, k, f) != (a%f)) return 0; /* If we have a prime power, use Hensel lifting to solve for p^e */ if (nf.e[i] > 1) { UV fe = f; for (e = 2; e <= nf.e[i]; e++) { fe *= f; /* We aren't guaranteed a solution, though we usually get one. */ if (!_hensel_lift(&r, r, a, k, fe)) { /* Search for a different base root */ UV t, m = fe / (f*f); for (t = 1; t < f; t++) { if (_hensel_lift(&r, r + t*m, a, k, fe)) break; } /* That didn't work, do a stronger but time consuming search. */ if (t >= f) { UV afe = a % fe; for (r = (a % f); r < fe; r += f) if (powmod(r, k, fe) == afe) break; if (r >= fe) return 0; } } } fac[i] = fe; } exp[i] = r; } if (chinese(&g, 0, exp, fac, nf.nfactors) != 1) return 0; return g; } #endif /******************************************************************************/ /* K-TH ROOT OF N MOD M (splitn) */ /******************************************************************************/ /* _rootmod_composite2 factors k and combines: * _rootmod_kprime takes prime k along with factored n: * _rootmod_prime_power splits p^e into primes (prime k): * _rootmod_prime finds a root (prime p and prime k) * _sqrtmod_prime (if k==2) * _ts_prime */ #if USE_ROOTMOD_SPLITN && !USE_ROOTMOD_SPLITK static UV _rootmod_prime(UV a, UV k, UV p) { UV r, g; /* Assume: p is prime, k is prime */ if (a >= p) a %= p; if (p == 2 || a == 0) return a; if (k == 2) { r = _sqrtmod_prime(a,p); return (sqrmod(r,p) == a) ? r : UV_MAX; } /* If co-prime, we have one root */ g = gcd_ui(k, p-1); if (g == 1) return powmod(a, modinverse(k % (p-1), p-1), p); /* Check generalized Euler's criterion */ if (powmod(a, (p-1)/g, p) != 1) return UV_MAX; return _ts_prime(a, k, p, 0); } static UV _rootmod_prime_power(UV a, UV k, UV p, UV e) { UV r, s, t, n, np, pk, apk, ered; /* Assume: p is prime, k is prime, e >= 1 */ if (k == 2) return _sqrtmod_prime_power(a, p, e); if (e == 1) return _rootmod_prime(a, k, p); n = ipow(p,e); pk = ipow(p,k); /* Note: a is not modded */ if ((a % n) == 0) return 0; if ((a % pk) == 0) { apk = a / pk; s = _rootmod_prime_power(apk, k, p, e-k); if (s == UV_MAX) return UV_MAX; return s * p; } if ((a % p) == 0) return UV_MAX; ered = (p > 2 || e < 5) ? (e+1)>>1 : (e+3)>>1; s = _rootmod_prime_power(a, k, p, ered); if (s == UV_MAX) return UV_MAX; np = (p != k || (n > (UV_MAX/p))) ? n : n * p; t = powmod(s, k-1, np); r = addmod(s, gcddivmod(submod(a,mulmod(t,s,np),np), mulmod(k,t,np), n), n); if (powmod(r, k, n) != (a % n)) return UV_MAX; return r; } static UV _rootmod_kprime(UV a, UV k, factored_t nf) { UV N, fe, r, s, t, inv; uint32_t i; /* Assume: k is prime */ N = ipow(nf.f[0], nf.e[0]); r = _rootmod_prime_power(a, k, nf.f[0], nf.e[0]); if (r == UV_MAX) return UV_MAX; for (i = 1; i < nf.nfactors; i++) { fe = ipow(nf.f[i], nf.e[i]); s = _rootmod_prime_power(a, k, nf.f[i], nf.e[i]); if (s == UV_MAX) return UV_MAX; inv = modinverse(N, fe); t = mulmod(inv, submod(s % fe,r % fe,fe), fe); r = addmod(r, mulmod(N,t,nf.n), nf.n); N *= fe; } return r; } static UV _rootmod_composite2(UV a, UV k, UV n) { factored_t nf; UV r, kfac[MPU_MAX_FACTORS]; uint32_t i, kfactors; if (n == 0) return 0; if (a >= n) a %= n; if (n <= 2 || a <= 1) return a; if (k <= 1) return (k == 0) ? 1 : a; /* Factor n */ nf = factorint(n); if (is_prime(k)) return _rootmod_kprime(a, k, nf); kfactors = factor(k, kfac); r = a; for (i = 0; i < kfactors; i++) { /* for each prime k */ r = _rootmod_kprime(r, kfac[i], nf); if (r == UV_MAX) { /* Bad path. We have to use a fallback method. */ #if USE_ROOTMOD_SPLITK r = _rootmod_composite1(a,k,n); #else UV *roots, numr; roots = allrootmod(&numr,a,k,n); r = (numr > 0) ? roots[0] : UV_MAX; Safefree(roots); #endif break; } } return r; } #endif bool rootmodp(UV *s, UV a, UV k, UV p) { UV r; uint32_t R; if (p == 0) return 0; if (a >= p) a %= p; /* return _rootmod_return(_trial_rootmod(a,k,n), s, a, k, p); */ if (p <= 2 || a <= 1) r = a; else if (k <= 1) r = (k == 0) ? 1 : a; else if (k < BITS_PER_WORD && is_power_ret(a,k,&R)) r = R; #if USE_ROOTMOD_SPLITK else r = _rootmod_prime_splitk(a,k,p,0); #else else r = _rootmod_composite2(a,k,p); #endif return _rootmod_return(r, s, a, k, p); } bool rootmod(UV *s, UV a, UV k, UV n) { UV r; uint32_t R; if (n == 0) return 0; if (a >= n) a %= n; /* return _rootmod_return(_trial_rootmod(a,k,n), s, a, k, n); */ if (n <= 2 || a <= 1) r = a; else if (k <= 1) r = (k == 0) ? 1 : a; else if (k < BITS_PER_WORD && is_power_ret(a,k,&R)) r = R; #if USE_ROOTMOD_SPLITK else if (is_prime(n)) r = _rootmod_prime_splitk(a,k,n,0); else r = _rootmod_composite1(a,k,n); #else else r = _rootmod_composite2(a,k,n); #endif return _rootmod_return(r, s, a, k, n); } /******************************************************************************/ /* SQRTMOD AND ROOTMOD RETURNING ALL RESULTS */ /******************************************************************************/ /* We could alternately just let the allocation fail */ #define MAX_ROOTS_RETURNED 600000000 /* Combine roots using Cartesian product CRT */ static UV* _rootmod_cprod(UV* nroots, UV nr1, UV *roots1, UV p1, UV nr2, UV *roots2, UV p2) { UV i, j, nr, *roots, inv; nr = nr1 * nr2; if (nr > MAX_ROOTS_RETURNED) croak("Maximum returned roots exceeded"); New(0, roots, nr, UV); inv = modinverse(p1, p2); for (i = 0; i < nr1; i++) { UV r1 = roots1[i]; for (j = 0; j < nr2; j++) { UV r2 = roots2[j]; #if 0 UV ca[2], cn[2]; ca[0] = r1; cn[0] = p1; ca[1] = r2; cn[1] = p2; if (chinese(roots + i * nr2 + j, 0, ca, cn, 2) != 1) croak("chinese fail in allrootmod"); #else UV t = mulmod(inv, submod(r2 % p2,r1 % p2,p2), p2); roots[i * nr2 + j] = addmod(r1, mulmod(p1,t,p1*p2), p1*p2); #endif } } Safefree(roots1); Safefree(roots2); *nroots = nr; return roots; } static UV* _one_root(UV* nroots, UV r) { UV *roots; New(0, roots, 1, UV); roots[0] = r; *nroots = 1; return roots; } static UV* _two_roots(UV* nroots, UV r, UV s) { UV *roots; New(0, roots, 2, UV); roots[0] = r; roots[1] = s; *nroots = 2; return roots; } /* allsqrtmod algorithm from Hugo van der Sanden, 2021 */ static UV* _allsqrtmodpk(UV *nroots, UV a, UV p, UV k) { UV *roots, *roots2, nr2 = 0; UV i, j, pk, pj, q, q2, a2; pk = ipow(p,k); *nroots = 0; if ((a % p) == 0) { if ((a % pk) == 0) { UV low = ipow(p, k >> 1); UV high = (k & 1) ? low * p : low; if (low > MAX_ROOTS_RETURNED) croak("Maximum returned roots exceeded"); New(0, roots, low, UV); for (i = 0; i < low; i++) roots[i] = high * i; *nroots = low; return roots; } a2 = a / p; if ((a2 % p) != 0) return 0; pj = pk / p; roots2 = _allsqrtmodpk(&nr2, a2/p, p, k-2); if (roots2 == 0) return 0; *nroots = nr2 * p; if (*nroots > MAX_ROOTS_RETURNED) croak("Maximum returned roots exceeded"); New(0, roots, *nroots, UV); for (i = 0; i < nr2; i++) for (j = 0; j < p; j++) roots[i*p+j] = roots2[i] * p + j * pj; Safefree(roots2); return roots; } q = _sqrtmod_prime_power(a,p,k); if (q == UV_MAX) return 0; New(0, roots, 4, UV); roots[0] = q; roots[1] = pk - q; if (p != 2) { *nroots = 2; } else if (k == 1) { *nroots = 1; } else if (k == 2) { *nroots = 2; } else { pj = pk / p; q2 = mulmod(q, pj-1, pk); roots[2] = q2; roots[3] = pk - q2; *nroots = 4; } return roots; } static UV* _allsqrtmodfact(UV *nroots, UV a, factored_t nf) { factored_t rf; UV *roots, *roots1, *roots2, nr, nr1, nr2, p, k, pk; uint32_t i; p = nf.f[0], k = nf.e[0]; *nroots = 0; /* nr1,roots1 are roots of p^k for the first prime power */ roots1 = _allsqrtmodpk(&nr1, a, p, k); if (roots1 == 0) return 0; if (nf.nfactors == 1) { *nroots = nr1; return roots1; } /* rf = nf with the first factor removed */ pk = ipow(p, k); rf.n = nf.n/pk; rf.nfactors = nf.nfactors-1; for (i = 0; i < rf.nfactors; i++) { rf.f[i] = nf.f[i+1]; rf.e[i] = nf.e[i+1]; } /* nr2,roots2 are roots of all the rest, found recursively */ roots2 = _allsqrtmodfact(&nr2, a, rf); if (roots2 == 0) { Safefree(roots1); return 0; } roots = _rootmod_cprod(&nr, nr1, roots1, pk, nr2, roots2, rf.n); *nroots = nr; return roots; } UV* allsqrtmod(UV* nroots, UV a, UV n) { UV *roots, numr = 0; if (n == 0) return 0; if (a >= n) a %= n; /* return _trial_allsqrtmod(nroots, a, n); */ if (n <= 2) return _one_root(nroots, a); roots = _allsqrtmodfact(&numr, a, factorint(n)); if (numr > 0) sort_uv_array(roots, numr); *nroots = numr; return roots; } /* allrootmod factors k and combines: * _allrootmod_kprime takes prime k and factored n: * _allrootmod_prime_power splits p^e into primes: * _allrootmod_prime finds all the roots for prime p and prime k * _ts_prime (could alternately call _rootmod_prime_splitk) */ static UV* _allrootmod_prime(UV* nroots, UV a, UV k, UV p) { UV r, g, z, r2, *roots, numr = 0; *nroots = 0; if (a >= p) a %= p; /* Assume: p is prime, k is prime */ /* simple case */ if (p == 2 || a == 0) return _one_root(nroots, a); /* If co-prime, we have one root */ g = gcd_ui(k, p-1); if (g == 1) { r = powmod(a, modinverse(k % (p-1), p-1), p); return _one_root(nroots, r); } /* At this point k < p. (k is a prime so if k>=p, g=1) */ /* Check generalized Euler's criterion: * r^k = a mod p has a solution iff a^((p-1)/gcd(p-1,k)) = 1 mod p */ if (powmod(a, (p-1)/g, p) != 1) return 0; /* Special case p=3 for performance */ if (p == 3) return (k == 2 && a == 1) ? _two_roots(nroots, 1, 2) : 0; /* functionally identical: r = _rootmod_prime_splitk(a, k, p, &z); */ r = _ts_prime(a, k, p, &z); if (powmod(r,k,p) != a || z == 0) croak("allrootmod: failed to find root"); New(0, roots, k, UV); roots[numr++] = r; for (r2 = mulmod(r, z, p); r2 != r && numr < k; r2 = mulmod(r2, z, p) ) roots[numr++] = r2; if (r2 != r) croak("allrootmod: excess roots found"); *nroots = numr; return roots; } static UV* _allrootmod_prime_power(UV* nroots, UV a, UV k, UV p, UV e) { UV n, i, j, pk, s, t, r, numr = 0, *roots = 0, nr2 = 0, *roots2 = 0; #if 0 MPUassert(p >= 2, "_allrootmod_prime_power must be given a prime modulus"); MPUassert(e >= 1, "_allrootmod_prime_power must be given exponent >= 1"); MPUassert(k >= 2, "_allrootmod_prime_power must be given k >= 2"); MPUassert(is_prime(k), "_allrootmod_prime_power must be given prime k"); MPUassert(is_prime(p), "_allrootmod_prime_power must be given prime p"); #endif if (e == 1) return _allrootmod_prime(nroots, a, k, p); n = ipow(p,e); pk = ipow(p, k); /* Note: a is not modded */ if ((a % n) == 0) { t = ((e-1) / k) + 1; s = ipow(p,t); numr = ipow(p,e-t); New(0, roots, numr, UV); for (i = 0; i < numr; i++) roots[i] = mulmod(i, s, n); } else if ((a % pk) == 0) { UV apk = a / pk; UV pe1 = ipow(p, k-1); UV pek = ipow(p, e-k+1); roots2 = _allrootmod_prime_power(&nr2, apk, k, p, e-k); numr = pe1 * nr2; New(0, roots, numr, UV); for (i = 0; i < nr2; i++) for (j = 0; j < pe1; j++) roots[i*pe1+j] = addmod(mulmod(roots2[i],p,n), mulmod(j,pek,n), n); Safefree(roots2); } else if ((a % p) != 0) { UV np = (n > (UV_MAX/p)) ? n : n*p; UV ered = (p > 2 || e < 5) ? (e+1)>>1 : (e+3)>>1; roots2 = _allrootmod_prime_power(&nr2, a, k, p, ered); if (k != p) { for (j = 0; j < nr2; j++) { s = roots2[j]; t = powmod(s, k-1, n); r = addmod(s,gcddivmod(submod(a,mulmod(t,s,n),n),mulmod(k,t,n),n),n); roots2[j] = r; } roots = roots2; numr = nr2; } else { /* Step 1, transform roots, eliding any that aren't valid */ for (j = 0; j < nr2; j++) { s = roots2[j]; t = powmod(s, k-1, np); r = addmod(s,gcddivmod(submod(a,mulmod(t,s,np),np),mulmod(k,t,np),n),n); if (powmod(r, k, n) == (a % n)) roots2[numr++] = r; } nr2 = numr; /* Step 2, Expand out by k */ if (nr2 > 0) { numr = nr2 * k; New(0, roots, numr, UV); for (j = 0; j < nr2; j++) { r = roots2[j]; for (i = 0; i < k; i++) roots[j*k+i] = mulmod(r, addmod( mulmod(i,n/p,n), 1, n), n); } } Safefree(roots2); /* Step 3, Remove any duplicates */ if (numr == 2 && roots[0] == roots[1]) numr = 1; if (numr > 2) { sort_uv_array(roots, numr); for (j = 0, i = 1; i < numr; i++) if (roots[j] != roots[i]) roots[++j] = roots[i]; numr = j+1; } } } *nroots = numr; return roots; } static UV* _allrootmod_kprime(UV* nroots, UV a, UV k, factored_t nf) { UV fe, N, *roots = 0, *roots2, numr = 0, nr2; uint32_t i; if (k == 2) return _allsqrtmodfact(nroots, a, nf); *nroots = 0; N = ipow(nf.f[0], nf.e[0]); roots = _allrootmod_prime_power(&numr, a, k, nf.f[0], nf.e[0]); if (numr == 0) { Safefree(roots); return 0; } for (i = 1; i < nf.nfactors; i++) { fe = ipow(nf.f[i], nf.e[i]); roots2 = _allrootmod_prime_power(&nr2, a, k, nf.f[i], nf.e[i]); if (nr2 == 0) { Safefree(roots); Safefree(roots2); return 0; } /* Cartesian product using CRT. roots and roots2 are freed. */ roots = _rootmod_cprod(&numr, numr, roots, N, nr2, roots2, fe); N *= fe; } MPUassert(N == nf.n, "allrootmod: Incorrect factoring"); *nroots = numr; return roots; } UV* allrootmod(UV* nroots, UV a, UV k, UV n) { factored_t nf; UV numr = 0, *roots = 0; UV kfac[MPU_MAX_FACTORS+1]; uint32_t i, kfactors; /* return _trial_allrootmod(nroots, a, k, n); */ *nroots = 0; if (n == 0) return 0; if (a >= n) a %= n; if (n <= 2 || k == 1) return _one_root(nroots, a); /* n=1 => [0], n=2 => [0] or [1] */ if (k == 0) { if (a != 1) return 0; if (n > MAX_ROOTS_RETURNED) croak("Maximum returned roots exceeded"); New(0, roots, n, UV); for (i = 0; i < n; i++) roots[i] = i; *nroots = n; return roots; } /* Factor n */ nf = factorint(n); if (is_prime(k)) { roots = _allrootmod_kprime(&numr, a, k, nf); } else { /* Split k into primes */ kfactors = factor(k, kfac); roots = _allrootmod_kprime(&numr, a, kfac[0], nf); for (i = 1; numr > 0 && i < kfactors; i++) { /* for each prime k */ UV j, t, allocr = numr, primek = kfac[i]; UV *roots2 = 0, nr2 = 0, *roots3 = 0, nr3 = 0; New(0, roots3, allocr, UV); for (j = 0; j < numr; j++) { /* get a list from each root */ roots2 = _allrootmod_kprime(&nr2, roots[j], primek, nf); if (nr2 == 0) continue; /* Append to roots3 */ if (nr3 + nr2 > MAX_ROOTS_RETURNED) croak("Maximum returned roots exceeded"); if (nr3 + nr2 >= allocr) Renew(roots3, allocr += nr2, UV); for (t = 0; t < nr2; t++) roots3[nr3++] = roots2[t]; Safefree(roots2); } /* We've walked through all the roots combining to roots3 */ Safefree(roots); roots = roots3; numr = nr3; } } if (numr > 1) sort_uv_array(roots, numr); *nroots = numr; return roots; } Math-Prime-Util-0.74/congruent_numbers.c000644 000765 000024 00000061344 15146553566 020323 0ustar00danastaff000000 000000 #include #include /* * A nice discussion of congruent numbers can be found in: * * https://pub.math.leidenuniv.nl/~stevenhagenp/ANTproc/19yui.pdf * */ #include "ptypes.h" #include "congruent_numbers.h" #define FUNC_isqrt 1 #define FUNC_is_perfect_square 1 #include "util.h" #include "factor.h" #include "rootmod.h" #define SWAP2(x,y) { UV t; t=x; x=y; y=t; } /******************************************************************************/ /* We only look at the non-square portion of n. */ static void remove_square_part(factored_t *nf) /* Turn n*c^2 into n */ { if (nf->n > 3) { uint16_t i, j; for (i = 0; i < nf->nfactors; i++) if (nf->e[i] > 1) break; if (i < nf->nfactors) { UV N = 1; for (i = 0, j = 0; i < nf->nfactors; i++) if (nf->e[i] & 1) { N *= nf->f[i]; nf->e[j] = 1; nf->f[j++] = nf->f[i]; } nf->n = N; nf->nfactors = j; } } /* factoredp_validate(nf); */ } /* Cycle through n! permutations of factors (if used). */ static factored_t permute_odd_factors(const factored_t NF, UV k) { factored_t nf; int permvec[MPU_MAX_DFACTORS]; bool iseven = NF.f[0] == 2; uint32_t noddfac = NF.nfactors - iseven; uint16_t i; nf.n = NF.n; nf.nfactors = NF.nfactors; if (iseven) { nf.f[0] = 2; nf.e[0] = NF.e[0]; } num_to_perm(k, noddfac, permvec); for (i = 0; i < noddfac; i++) { nf.f[i + iseven] = NF.f[permvec[i] + iseven]; nf.e[i + iseven] = NF.e[permvec[i] + iseven]; } return nf; } /******************************************************************************/ /* Tunnell's method, counting integer solutions to ternary quadratics. * Assumes the weak BSD conjecture. * Weak BSD holds for n < 42553. (Nemenzo 1998) * Weak BSD holds for n < 71474. (Wado 2005) * Weak BSD holds for n < 300000. (Matsuno 2005] * Weak BSD holds for n < 1000000. (Matsuno 2006 + Elkies 2002) * * The final answer. * Most of the rest of this file is trying to avoid calling this if possible. */ static bool _is_congruent_number_tunnell(UV n) { UV x, y, z, limz, limy, limx, n8z, zsols, sols[2] = {0,0}; /* The input MUST be square-free or the result will not be correct. */ if (n&1) { for (z = 0, limz = isqrt(n/8); z <= limz; z++) { zsols = 0; n8z = n - 8*z*z; for (y = 0, limy = isqrt(n8z/2); y <= limy; y++) { x = n8z - 2*y*y; /* n odd => n8z odd => x odd */ if (is_perfect_square(x)) zsols += 1 << (1+(y>0)+(z>0)); } sols[z&1] += zsols; } } else { for (z = 0, limz = isqrt((n/2)/8); z <= limz; z++) { zsols = 0; n8z = n/2 - 8*z*z; for (x = 1, limx = isqrt(n8z); x <= limx; x += 2) { y = n8z - x*x; if (y == 0 || is_perfect_square(y)) zsols += 1 << (1+(y>0)+(z>0)); } sols[z&1] += zsols; } } return (sols[0] == sols[1]); } /******************************************************************************/ #define SWAP4(x,y) { UV t; t=x; x=y; y=t; t=x##8; x##8=y##8; y##8=t; } #define KPQ kronecker_uu(p,q) #define KQP kronecker_uu(q,p) /* For 3 factors */ #define KPR kronecker_uu(p,r) #define KQR kronecker_uu(q,r) #define KRP kronecker_uu(r,p) #define KRQ kronecker_uu(r,q) /* For 4 factors */ #define KPS kronecker_uu(p,s) #define KQS kronecker_uu(q,s) #define KRS kronecker_uu(r,s) #define KSP kronecker_uu(s,p) #define KSQ kronecker_uu(s,q) #define KSR kronecker_uu(s,r) #define LAGRANGE_COND1 (KPQ==KPR || KQR==KQP || KRP==KRQ) #define LAGRANGE_COND2 ((KPQ==1 && KPR==1) || (KQR==1 && KQP==1) || (KRP==1 && KRQ==1)) #define LAGRANGE_COND3 ((KPQ==-1 && KPR==-1) || (KQR==-1 && KQP==-1) || (KRP==-1 && KRQ==-1)) static bool _can_order_kronecker2(UV p, UV q) { return KPQ==-1 || KQP == -1; } static bool _can_order_kronecker3(UV p, UV q, UV r) { return (KPR==-1 && KQR==-1 && _can_order_kronecker2(p,q)) || (KPQ==-1 && KRQ==-1 && _can_order_kronecker2(p,r)) || (KQP==-1 && KRP==-1 && _can_order_kronecker2(q,r)); } static bool _can_order_kronecker4(UV p, UV q, UV r, UV s) { return (KPS==-1 && KQS==-1 && KRS==-1 && _can_order_kronecker3(p,q,r)) || (KPR==-1 && KQR==-1 && KSR==-1 && _can_order_kronecker3(p,q,s)) || (KPQ==-1 && KRQ==-1 && KSQ==-1 && _can_order_kronecker3(p,r,s)) || (KQP==-1 && KRP==-1 && KSP==-1 && _can_order_kronecker3(q,r,s)); } static bool _can_orderk_r(uint32_t nfac, UV fac[]) { uint32_t i,j; if (nfac <= 1) return TRUE; if (nfac == 2) return _can_order_kronecker2(fac[0],fac[1]); for (i = 0; i < nfac; i++) { SWAP2(fac[i], fac[nfac-1]); /* Test with this factor at the end */ for (j = 0; j < nfac-1; j++) if (kronecker_uu(fac[j],fac[nfac-1]) != -1) break; if (j == nfac-1 && _can_orderk_r(nfac-1, fac)) break; } return i < nfac; } /* Can we order s.t. (p|q) == (p|r) == (q|r) == -1 */ static bool _can_orderk(uint32_t nfac, const UV fac[]) { UV F[MPU_MAX_DFACTORS]; if (nfac > MPU_MAX_DFACTORS) return FALSE; memcpy(F, fac, nfac*sizeof(UV)); /* We can safely permute the ordering */ return _can_orderk_r(nfac, F); } /* Returns -1 if not known, 0 or 1 indicate definite results. */ static int _is_congruent_number_filter1(const factored_t nf) { const UV n = nf.n; const bool isodd = n & 1; const bool iseven = !isodd; UV p, q, r, s; /* Four odd factors in mod 8 order */ UV p8, q8, r8, s8; /* values mod 8 */ UV fac[MPU_MAX_DFACTORS] = {0}; /* The odd factors, in mod 8 order */ uint32_t nfac = 0; MPUassert(n >= 13, "n too small in icn_filter"); /* The ACK conjecture (Alter, Curtz, and Kubota 1972): * n = {5,6,7} mod 8 => n is a congruent number * also follows from the weak BSD conjecture. */ if (n % 8 == 5 || n % 8 == 6 || n % 8 == 7) return 1; /* No filter here handles more than 4 odd factors */ if (nf.nfactors-iseven > 4) return -1; { /* Sort odd factors into fac array by mod 8 */ uint32_t i; for (i=0; i 1) ? fac[1] : 0; r = (nfac > 2) ? fac[2] : 0; s = (nfac > 3) ? fac[3] : 0; p8 = p % 8; q8 = q % 8; r8 = r % 8; s8 = s % 8; /* Evink 2021 https://arxiv.org/pdf/2105.01450.pdf * Feng 1996 http://matwbn.icm.edu.pl/ksiazki/aa/aa75/aa7513.pdf * Monsky 1990 https://gdz.sub.uni-goettingen.de/id/PPN266833020_0204 * Lagrange 1974 https://www.numdam.org/item/SDPP_1974-1975__16_1_A11_0.pdf */ if (isodd && nfac == 1) { /* n = p */ UV root; if (p8 == 3) return 0; /* Genocchi 1855 */ /* https://arxiv.org/pdf/2105.01450.pdf, Prop 2.1.2 */ if (sqrtmodp(&root, 2, p) && kronecker_uu(1+root, p) == -1) return 0; #if 0 { /* Evink 2021 shows these are equivalent to the sqrt test above */ UV a,b; if (1 && cornacchia(&a, &b, 1, p)) { if (p != (a*a+b*b)) croak("bad corn for %lu\n",p); if (sqrmod(a+b,16) != 1) { printf("ret\n"); return 0; } } if (1 && cornacchia(&a, &b, 4, p)) if (kronecker_uu(a+2*b, p) == -1) { printf("ret 2\n"); return 0; } } #endif } else if (iseven && nfac == 1) { /* n = 2p */ if (p8 == 3 || p8 == 7) return 1; /* we already returned 1 earlier */ if (p8 == 5) return 0; /* Genocchi 1855 */ if (p % 16 == 9) return 0; /* Bastien 1915 */ } else if (isodd && nfac == 2) { /* n = pq */ if (p8 == 3 && q8 == 3) return 0; /* Genocchi 1855 */ #if 0 /* Monsky, all produce n mod 8 = 5 or 7: we already returned 1 */ if (p8 == 3 && q8 == 7) return 1; if (p8 == 3 && q8 == 5) return 1; if (p8 == 1 && q8 == 5 && KPQ == -1) return 1; if (p8 == 1 && q8 == 7 && KPQ == -1) return 1; #endif /* Lagrange 1974 */ if (p8 == 1 && q8 == 3 && KPQ == -1) return 0; if (p8 == 5 && q8 == 7 && KPQ == -1) return 0; } else if (iseven && nfac == 2) { /* n = 2pq */ if (p8 == 5 && q8 == 5) return 0; /* Genocchi 1855 */ #if 0 /* Monsky, all produce n mod 8 = 6: we already returned 1 */ if (p8 == 3 && q8 == 5) return 1; if (p8 == 5 && q8 == 7) return 1; if (p8 == 1 && q8 == 7 && KPQ == -1) return 1; if (p8 == 1 && q8 == 3 && KPQ == -1) return 1; #endif /* Lagrange 1974 */ if (p8 == 3 && q8 == 3) return 0; if (p8 == 1 && q8 == 5 && KPQ == -1) return 0; if (p8 == 3 && q8 == 7 && KPQ == -1) return 0; if (p8 == 7 && q8 == 7 && KPQ == 1 && q % 16 == 7) return 0; if (p8 == 1 && q8 == 1 && KPQ == -1 && (p*q) % 16 == 9) return 0; } else if (isodd && nfac == 3) { /* n = pqr */ #if 0 /* Serf 1991, all produce n mod 8 = 5 or 7: we already returned 1 */ if (p8 == 3 && q8 == 3 && r8 == 5) return 1; if (p8 == 3 && q8 == 3 && r8 == 7) return 1; if (p8 == 7 && q8 == 7 && r8 == 7 && KPQ == -KPR && KPQ == KQR) return 1; #endif /* Lagrange 1974 */ if (p8 == 1 && q8 == 3 && r8 == 3 && KPQ == -KPR) return 0; if (p8 == 3 && q8 == 5 && r8 == 7 && KQR == -1) return 0; if (p8 == 3 && q8 == 7 && r8 == 7 && KPQ == -KPR && KPQ == KQR) return 0; if (p8 == 1 && q8 == 1 && r8 == 3 && LAGRANGE_COND3) return 0; if (p8 == 1 && q8 == 5 && r8 == 7 && LAGRANGE_COND3) return 0; if (p8 == 3 && q8 == 5 && r8 == 5 && LAGRANGE_COND3) return 0; if (p8 == 3 && q8 == 3 && r8 == 3 && LAGRANGE_COND1) return 0; if (p8 == 1 && q8 == 1 && r8 == 1 && LAGRANGE_COND3) { UV c,d; if (cornacchia(&c, &d, 8, n) && d&1) return 0; } } else if (iseven && nfac == 3) { /* n = 2pqr */ #if 0 /* Serf 1991, all produce n mod 8 = 6: we already returned 1 */ if (p8 == 3 && q8 == 3 && r8 == 7) return 1; if (p8 == 3 && q8 == 5 && r8 == 5) return 1; if (p8 == 5 && q8 == 5 && r8 == 7) return 1; if (p8 == 7 && q8 == 7 && r8 == 7 && KPQ == -KPR && KPQ == KQR) return 1; #endif /* Lagrange 1974 */ if (p8 == 1 && q8 == 3 && r8 == 3 && KPQ == -KPR) return 0; if (p8 == 1 && q8 == 5 && r8 == 5 && KPQ == -KPR) return 0; if (p8 == 3 && q8 == 5 && r8 == 7 && KRP == KRQ) return 0; if (p8 == 1 && q8 == 1 && r8 == 1 && LAGRANGE_COND3 && (p*q*r) % 16 == 9) return 0; if (p8 == 5 && q8 == 7 && r8 == 7 && KQP == KQR && KQP == -KRP) return 0; if (p8 == 1 && q8 == 1 && r8 == 5 && LAGRANGE_COND3) return 0; /* Lagrange's 1 3 7 seems to be incorrect. * 13706 = 2*7*11*89 = 2*89*7*11, so p = 1, q = -1, r = 3 mod 8. * cond3 (q|r)= (q|p) = -1. * but 13706 is a congruent number. * Cheng/Guo 2018 show this case with a third congruency. */ if (p8 == 3 && q8 == 3 && r8 == 5 && LAGRANGE_COND1) return 0; if (p8 == 5 && q8 == 5 && r8 == 5 && LAGRANGE_COND2) return 0; /* Cheng/Guo 2018, Theorem 1.3.6 */ if (p8 == 1 && q8 == 3 && r8 == 7 && KPQ == -1 && KPR == -1 && KQR == -1) return 0; } else if (isodd && nfac == 4) { /* n = pqrs */ /* Serf 1991 */ if (p8 == 5 && q8 == 5 && r8 == 7 && s8 == 7 && ( (KPR == 1 && KQR == -1 && KPS == -1) || (KPR == -1 && KPS == 1 && KQS == -1) || (KPR == -1 && KPS == -1 && KQR == -KQS))) return 0; /* Cheng/Guo 2018, Theorem 1.3.1 */ if (p8 == 3 && q8 == 3 && r8 == 5 && s8 == 7 && (KPQ == -1 || KQP == -1) && KPR == -1 && KQR == -1 && KPS == -1 && KQS == -1 && KRS == -1) return 0; /* Cheng/Guo 2018, Theorem 1.2.5 */ if (p8 == 1 && q8 == 3 && r8 == 3 && s8 == 3 && KPQ == -1 && KPR == -1 && KPS == -1 && _can_order_kronecker3(q,r,s)) return 0; /* Iskra 1996 (also Cheng/Guo 2018, Theorem 1.1.2) */ if (p8 == 3 && q8 == 3 && r8 == 3 && s8 == 3 && _can_order_kronecker4(p,q,r,s)) return 0; /* Das 2020 4 factors */ if (p8 == 1 && q8 == 3 && r8 == 5 && s8 == 7 && (KQS == -1 || KSQ == -1) && KPR == 1 && KRP == 1 && KPS == 1 && KRQ == 1 && KPQ == -1 && KRS == -1) return 0; /* Das 2020 4 factors */ if (p8 == 1 && q8 == 1 && r8 == 3 && s8 == 3 && (KRS == -1 || KSR == -1) && KPQ == 1 && KQP == 1 && ( (KPR == -1 && KQS == -1 && KPS == 1 && KQR == 1) || (KQR == -1 && KPS == -1 && KQS == 1 && KPR == 1) )) return 0; } else if (iseven && nfac == 4) { /* n = 2pqrs */ /* Serf 1991 */ if (p8 == 1 && q8 == 1 && r8 == 3 && s8 == 3 && ( (KPQ == 1 && KPR == -KPS && KQR == -KQS) || (KPQ == -1 && KPR == KPS && KQR == -KQS) || (KPQ == -1 && KPR == -KPS))) return 0; /* Cheng/Guo 2018, Theorem 1.3.2 */ if (p8 == 3 && q8 == 5 && r8 == 5 && s8 == 7 && (KQR == -1 || KRQ == -1) && KPQ == -1 && KPR == -1 && KPS == -1 && KQS == -1 && KRS == -1) return 0; /* Cheng/Guo 2018, Theorem 1.3.8 */ if (p8 == 1 && q8 == 3 && r8 == 3 && s8 == 5 && (KQR == -1 || KRQ == -1) && KPQ == -1 && KPR == -1 && KPS == -1 && KQS == -1 && KRS == -1) return 0; /* Cheng/Guo 2018, Theorem 1.2.3 */ if (p8 == 3 && q8 == 3 && r8 == 3 && s8 == 7 && KPS == -1 && KQS == -1 && KRS == -1 && _can_order_kronecker3(p,q,r)) return 0; /* Cheng/Guo 2018, Theorem 1.2.6 */ if (p8 == 1 && q8 == 5 && r8 == 5 && s8 == 5 && KPQ == -1 && KPR == -1 && KPS == -1 && _can_order_kronecker3(q,r,s)) return 0; /* Cheng/Guo 2018, Theorem 1.1.1 (even analog of Iskra 1996) */ if (p8 == 3 && q8 == 3 && r8 == 3 && s8 == 3 && _can_order_kronecker4(p,q,r,s)) return 0; /* Cheng/Guo 2018, Theorem 1.1.3 */ if (p8 == 5 && q8 == 5 && r8 == 5 && s8 == 5 && _can_order_kronecker4(p,q,r,s)) return 0; /* Cheng/Guo 2018, Theorem 1.2.1 */ if (p8 == 3 && q8 == 3 && r8 == 5 && s8 == 5 && (KPQ == -1 || KQP == -1) && (KRS == -1 || KSR == -1) && KPR == -1 && KQR == -1 && KPS == -1 && KQS == -1) return 0; } return -1; } /******************************************************************************/ /* This has more complicated filters that take arbitrary numbers of factors, * and have to handle permutations. */ /* Returns -1 if not known, 0 or 1 indicate definite results. */ static int _is_congruent_number_filter2(const factored_t nf) { const bool iseven = nf.f[0] == 2; const uint32_t noddfac = nf.nfactors - iseven; const UV *oddfac = nf.f + iseven; uint16_t i; bool allmod3; for (i = 0; i < noddfac; i++) if (oddfac[i] % 8 != 3) break; allmod3 = !(i < noddfac); /* Iskra 1996 (odd) ; Cheng/Guo 2019 Theorem 1.1.1 (even) */ if (allmod3 && _can_orderk(noddfac, oddfac)) return 0; return -1; } /******************************************************************************/ /* More complicated filters that are factor-permutation dependent, but don't * yet have code to understand that. Ideally that would get done, they would * be moved to _filter2, and this function would go away. * * Currently all inputs with fewer than 4 odd factors are handled earlier. * * For now we either call it once optimistically, or we call it multiple times * with permuted factors. */ /* Returns -1 if not known, 0 or 1 indicate definite results. */ static int _is_congruent_number_filter3(const factored_t nf) { const UV *fac = nf.f; const UV n = nf.n; const int nfactors = nf.nfactors; int i, j; /* Reinholz 2013 https://central.bac-lac.gc.ca/.item?id=TC-BVAU-44941&op=pdf * Cheng 2018 http://maths.nju.edu.cn/~guoxj/articles/IJNT2019.pdf * Cheng 2019 https://www.sciencedirect.com/science/article/pii/S0022314X18302774 * Das 2020 https://math.colgate.edu/~integers/u55/u55.pdf */ { const int noddfactors = (n&1) ? nfactors : nfactors-1; const UV* oddfac = (n&1) ? fac : fac+1; int k, l, allmod3 = 1; for (i = 1; allmod3 && i <= noddfactors; i++) if ((oddfac[i-1] % 8) != 3) allmod3 = 0; /* Reinholz, Spearman, Yang 2013 */ if (allmod3 && (n&1)) { int m; for (m = 2; m <= nfactors; m += 2) { int reinholz = 1; for (i = 1; reinholz && i < nfactors; i++) for (j = 0; reinholz && j < i; j++) if (j == 0 && i == m-1) reinholz &= kronecker_uu(fac[j],fac[i]) == 1; else reinholz &= kronecker_uu(fac[j],fac[i]) == -1; if (reinholz) return 0; } } /* Cheng/Guo 2019 "Some new families of non-congruent numbers" */ if (allmod3) { for (k = 2; k <= noddfactors; k++) { for (l = 1; l < k; l++) { int cheng = 1; if (!((k - l) & 1)) continue; for (i = 2; cheng && i <= noddfactors; i++) for (j = 1; cheng && j < i; j++) if (i == k && j == l) cheng &= kronecker_uu(oddfac[j-1],oddfac[i-1]) == -1; else cheng &= kronecker_uu(oddfac[j-1],oddfac[i-1]) == 1; if (cheng) return 0; } } } /* Cheng / Guo 2018 "The non-congruent numbers via Monsky’s formula" */ if (1) { bool quad; int g[8] = {0}; /* The number in each mod */ UV P[MPU_MAX_DFACTORS], Q[MPU_MAX_DFACTORS], R[MPU_MAX_DFACTORS], S[MPU_MAX_DFACTORS]; const int eps = (n&1) ? 1 : 2; for (i = 0; i < noddfactors; i++) { UV m = oddfac[i] % 8; if (m == 1) P[ g[m]++ ] = oddfac[i]; if (m == 3) Q[ g[m]++ ] = oddfac[i]; if (m == 5) R[ g[m]++ ] = oddfac[i]; if (m == 7) S[ g[m]++ ] = oddfac[i]; } quad = 1; for (i = 2; quad && i <= g[1]; i++) for (j = 1; j < i; j++) quad &= kronecker_uu(P[j-1],P[i-1]) == -1; for (i = 2; quad && i <= g[3]; i++) for (j = 1; j < i; j++) quad &= kronecker_uu(Q[j-1],Q[i-1]) == -1; for (i = 2; quad && i <= g[5]; i++) for (j = 1; j < i; j++) quad &= kronecker_uu(R[j-1],R[i-1]) == -1; for (i = 2; quad && i <= g[7]; i++) for (j = 1; j < i; j++) quad &= kronecker_uu(S[j-1],S[i-1]) == -1; for (i = 1; quad && i <= g[3]; i++) for (j = 1; j <= g[1]; j++) quad &= kronecker_uu(P[j-1],Q[i-1]) == -1; for (i = 1; quad && i <= g[5]; i++) for (j = 1; j <= g[1]; j++) quad &= kronecker_uu(P[j-1],R[i-1]) == -1; for (i = 1; quad && i <= g[7]; i++) for (j = 1; j <= g[1]; j++) quad &= kronecker_uu(P[j-1],S[i-1]) == -1; for (i = 1; quad && i <= g[5]; i++) for (j = 1; j <= g[3]; j++) quad &= kronecker_uu(Q[j-1],R[i-1]) == -1; for (i = 1; quad && i <= g[7]; i++) for (j = 1; j <= g[3]; j++) quad &= kronecker_uu(Q[j-1],S[i-1]) == -1; for (i = 1; quad && i <= g[7]; i++) for (j = 1; j <= g[5]; j++) quad &= kronecker_uu(R[j-1],S[i-1]) == -1; if (quad) { #if 1 /* Theorem 1.1 */ if ( (g[1] == 0 && g[5] == 0 && g[7] == 0 && eps == 2 && g[3] % 2 == 0) || (g[1] == 0 && g[5] == 0 && g[7] == 0 && eps == 1) || (g[1] == 0 && g[3] == 0 && g[7] == 0 && eps == 2 && g[5] % 2 == 0)) return 0; #endif #if 1 /* Theorem 1.2 */ if ( (g[1] == 0 && g[7] == 0 && eps == 1 && (g[3] % 2) == 1 && g[5] >= 1 && g[5] % 2 == 0) || (g[1] == 0 && g[7] == 0 && eps == 2 && g[3] >= 1 && g[5] >= 1 && g[3] % 2 == 0 && g[5] % 2 == 0) || (g[1] == 0 && g[7] == 0 && eps == 2 && g[3] >= 1 && g[5] == 1 && g[3] % 2 == 0) || (g[1] == 0 && g[5] == 0 && eps == 2 && g[7] == 1 && g[3] % 2 == 1) || (g[1] == 0 && g[3] == 0 && eps == 1 && g[5] == 1 && g[7] == 1) || (g[5] == 0 && g[7] == 0 && eps == 1 && g[1] > 1 && g[1] % 2 == 0 && g[3] % 2 == 1) || (g[5] == 0 && g[7] == 0 && eps == 1 && g[1] == 1 && g[3] % 2 == 1) || (g[3] == 0 && g[7] == 0 && eps == 2 && g[1] == 1 && g[5] % 2 == 1) || (g[3] == 0 && g[7] == 0 && eps == 2 && g[5] == 1 && g[1] > 1 && g[1] % 2 == 0) ) return 0; #endif #if 1 /* Theorem 1.3 */ if ( (g[1] == 0 && eps == 1 && g[5] == 1 && g[7] == 1 && g[3] >= 1) || (g[1] == 0 && eps == 1 && g[5] >= 2 && g[7] == 1 && g[3] % 2 == 1 && g[5] % 2 == 1) || (g[1] == 0 && eps == 2 && g[5] >= 1 && g[7] == 1 && g[3] % 2 == 1 && g[5] % 2 == 0) || (g[3] == 0 && eps == 1 && g[7] == 1 && g[1] % 2 == 1 && g[5] % 2 == 1) /* No examples 1.3.4 */ || (g[3] == 0 && eps == 2 && g[5] == 1 && g[7] == 1 && g[1] % 2 == 1) /* No examples 1.3.5 */ || (g[5] == 0 && eps == 1 && g[1] >= 1 && g[3] >= 1 && g[7] == 1 && g[1] % 2 == 0 && g[3] % 2 == 0) || (g[5] == 0 && eps == 2 && g[1] >= 1 && g[3] >= 1 && g[7] == 1 && g[1] % 2 == 1 && g[3] % 2 == 1) || (g[7] == 0 && eps == 1 && g[1] >= 1 && g[5] >= 1 && g[1] % 2 == 0 && g[5] % 2 == 0 && g[3] % 2 == 1) || (g[7] == 0 && eps == 2 && g[1] == 1 && g[3] >= 1 && g[3] % 2 == 0 && g[5] % 2 == 1) || (g[7] == 0 && eps == 2 && g[1] >= 1 && g[3] >= 1 && g[5] == 1 && g[1] % 2 == 0 && g[3] % 2 == 0) ) return 0; #endif #if 1 /* Theorem 1.4 */ if ( (eps == 1 && g[1] >= 1 && g[7] == 1 && g[1] % 2 == 0 && g[3] % 2 == 1 && g[5] % 2 == 1) || (eps == 1 && g[3] >= 1 && g[7] == 1 && g[1] % 2 == 1 && g[5] % 2 == 1 && g[3] % 2 == 0) ) return 0; #endif } } } /**************************************************************************/ /* Das / Saikia 2020, extending Lagrange 1974 and Serf 1989 */ if ((n&1) && nfactors % 2 == 0 && nfactors >= 4 && nfactors <= 20) { int cntmod[8] = {0}; for (i = 0; i < nfactors; i++) { int m = fac[i] % 8; cntmod[m]++; } if (cntmod[1] == cntmod[3] && cntmod[5] == cntmod[7]) { /* We can separate all factors into (1,3) and (5,7) pairs. */ UV pf[10], qf[10]; int pindexbymod[8], qindexbymod[8]; const int npairs = nfactors >> 1; bool das; pindexbymod[1] = qindexbymod[3] = 0; pindexbymod[5] = qindexbymod[7] = cntmod[1]; for (i = 0; i < nfactors; i++) { int m = fac[i] % 8; if (m == 1 || m == 5) pf[pindexbymod[m]++] = fac[i]; else qf[qindexbymod[m]++] = fac[i]; } /* See if these conditions hold for all pairs */ das = TRUE; for (i = 0; i < npairs; i++) das &= kronecker_uu(pf[i],qf[i]) == -1; for (i = 0; das && i < npairs; i++) { for (j = 0; j < npairs; j++) { if (i > j && kronecker_uu(qf[j],qf[i]) != -1) das = FALSE; if (i != j && kronecker_uu(pf[i],pf[j]) != 1) das = FALSE; if (i != j && kronecker_uu(pf[i],qf[j]) != 1) das = FALSE; } } if (das) return 0; } } return -1; } /******************************************************************************/ /* Allow testing the filters and the counting functions separately */ int is_congruent_number_filter(UV n) { int res; factored_t nf = factorint(n); remove_square_part(&nf); if (nf.n < 13) return (nf.n >= 5 && nf.n <= 7); res = _is_congruent_number_filter1(nf); if (res != -1) return res; res = _is_congruent_number_filter2(nf); if (res != -1) return res; res = _is_congruent_number_filter3(nf); if (res != -1) return res; #if 0 if (1 && res == -1) { uint32_t noddfac = nf.nfactors - (nf.f[0] == 2); if (noddfac > 3) { UV i, nperms = factorial(noddfac); for (i = 1; res == -1 && i < nperms; i++) { factored_t trynf = permute_odd_factors(nf, i); res = _is_congruent_number_filter3(trynf); } } } /* if (res != -1) printf("%lu\n", nf.n); */ #endif return res; } bool is_congruent_number_tunnell(UV n) { factored_t nf = factorint(n); remove_square_part(&nf); if (nf.n < 13) return (nf.n >= 5 && nf.n <= 7); return _is_congruent_number_tunnell(nf.n); } /******************************************************************************/ /* is_congruent_number(n). OEIS A003273. */ bool is_congruent_number(UV n) { int res; factored_t nf = factorint(n); remove_square_part(&nf); if (nf.n < 13) return (nf.n >= 5 && nf.n <= 7); /* Relatively simple filters. Order doesn't matter. */ res = _is_congruent_number_filter1(nf); if (res != -1) return res; /* More complicated filters. Permutation is handled. */ res = _is_congruent_number_filter2(nf); if (res != -1) return res; /* More complicated filters. We haven't implemented permutations. */ res = _is_congruent_number_filter3(nf); if (res != -1) return res; if (0) { /* Try filter3 with all odd factor permutations */ uint32_t noddfac = nf.nfactors - (nf.f[0] == 2); if (noddfac > 3) { UV i, nperms = factorial(noddfac); for (i = 1; res == -1 && i < nperms; i++) { factored_t trynf = permute_odd_factors(nf, i); res = _is_congruent_number_filter3(trynf); } } if (res != -1) return res; } return _is_congruent_number_tunnell(nf.n); } Math-Prime-Util-0.74/cache.h000644 000765 000024 00000002700 15145577415 015621 0ustar00danastaff000000 000000 #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.74/threadlock.h000644 000765 000024 00000003321 15145577415 016676 0ustar00danastaff000000 000000 #ifndef MPU_THREADLOCK_H #define MPU_THREADLOCK_H #include "ptypes.h" #ifdef STANDALONE #undef USE_ITHREADS #define MUTEX_INIT(x) #define MUTEX_LOCK(x) #define MUTEX_UNLOCK(x) #define MUTEX_DESTROY(x) #define COND_INIT(x) #define COND_DESTROY(x) #endif #ifndef USE_ITHREADS #define MUTEX_DECL(x) #define READ_WRITE_LOCK_DECL(x) #define WRITE_LOCK_START(x) #define WRITE_LOCK_END(x) #define READ_LOCK_START(x) #define READ_LOCK_END(x) #else #define MUTEX_DECL(x) \ static perl_mutex x ## _mutex #define READ_WRITE_LOCK_DECL(x) \ static perl_mutex x ## _mutex; \ static perl_cond x ## _turn; \ static int x ## _reading; \ static int x ## _writing; \ static int x ## _writers #define WRITE_LOCK_START(x) \ do { \ MUTEX_LOCK(& x ## _mutex); \ x ## _writers++; \ while (x ## _reading || x ## _writing) \ COND_WAIT(& x ## _turn, & x ## _mutex); \ x ## _writing++; \ MUTEX_UNLOCK(& x ## _mutex); \ } while (0) #define WRITE_LOCK_END(x) \ do { \ MUTEX_LOCK(& x ## _mutex); \ x ## _writing--; \ x ## _writers--; \ COND_BROADCAST(& x ## _turn); \ MUTEX_UNLOCK(& x ## _mutex); \ } while (0) #define READ_LOCK_START(x) \ do { \ MUTEX_LOCK(& x ## _mutex); \ if (x ## _writers) \ COND_WAIT(& x ## _turn, & x ## _mutex); \ while (x ## _writing) \ COND_WAIT(& x ## _turn, & x ## _mutex); \ x ## _reading++; \ MUTEX_UNLOCK(& x ## _mutex); \ } while (0) #define READ_LOCK_END(x) \ do { \ MUTEX_LOCK(& x ## _mutex); \ x ## _reading--; \ COND_BROADCAST(& x ## _turn); \ MUTEX_UNLOCK(& x ## _mutex); \ } while (0) #endif #endif Math-Prime-Util-0.74/ds_iset.c000644 000765 000024 00000022022 15153424727 016176 0ustar00danastaff000000 000000 #include #include #include #include "ptypes.h" #include "ds_iset.h" #include "util.h" #include "sort.h" #define FILL_RATIO 0.55 #if BITS_PER_WORD == 32 /* 16 0x45d9f3b 16 0x45d9f3b 16 */ /* 16 0x21f0aaad 15 0x735a2d97 15 */ static UV _hash(UV x) { x = ((x >> 16) ^ x) * 0x45d9f3b; x = ((x >> 16) ^ x) * 0x45d9f3b; x = (x >> 16) ^ x; return x; } #else /* 30 0xbf58476d1ce4e5b9 27 0x94d049bb133111eb 31 SplitMix64/Meuller */ /* 32 0xd6e8feb86659fd93 32 0xd6e8feb86659fd93 32 degski */ /* 33 0xff51afd7ed558ccd 33 0xc4ceb9fe1a85ec53 33 Murmur64 */ /* 32 0xe9846af9b1a615d 32 0xe9846af9b1a615d 28 xmxmx */ /* 32 0xbea225f9eb34556d 29 0xbea225f9eb34556d 32 0xbea225f9eb34556d 29 mx3 */ static UV _hash(UV x) { x = (x ^ (x >> 32)) * UVCONST(0xe9846af9b1a615d); x = (x ^ (x >> 32)) * UVCONST(0xe9846af9b1a615d); x = x ^ (x >> 28); return x; } #endif #define HVAL(x,mask) (_hash(x) & mask) /******************************************************************************/ iset_t iset_create(size_t init_size) { iset_t set; int bits = 4; const int maxsizebits = 8 * sizeof(size_t); set.size = 0; set.contains_zero = 0; set.type = 0; while (bits < maxsizebits-1 && ((1UL << bits) * FILL_RATIO + 1) < init_size) bits++; set.maxsize = 1UL << bits; set.mask = set.maxsize - 1; Newz(0, set.arr, set.maxsize, UV); return set; } void iset_destroy(iset_t *set) { set->maxsize = 0; set->size = 0; set->contains_zero = 0; set->type = 0; Safefree(set->arr); set->arr = 0; } static size_t _iset_pos(const UV* arr, UV mask, UV val) { size_t h = HVAL(val,mask); while (arr[h] != 0 && arr[h] != val) h = (h+1) & mask; return h; } bool iset_contains(const iset_t set, UV val) { if (val == 0) return set.contains_zero; return set.arr[_iset_pos(set.arr, set.mask, val)] == val; } static void _iset_resize(iset_t *set) { UV v, *narr; size_t i, oldsize, newsize, newmask; oldsize = set->maxsize; newsize = oldsize << 1; if (newsize < oldsize) croak("iset: max set size overflow"); newmask = newsize - 1; Newz(0, narr, newsize, UV); for (i = 0; i < oldsize; i++) if (v = set->arr[i], v != 0) narr[ _iset_pos(narr,newmask,v) ] = v; Safefree(set->arr); set->arr = narr; set->maxsize = newsize; set->mask = newmask; } bool iset_add(iset_t *set, UV val, int sign) { if (sign == 0) set->type = ISET_TYPE_INVALID; else if (val > (UV)IV_MAX) set->type |= ((sign > 0) ? ISET_TYPE_UV : ISET_TYPE_IV); if (val == 0) { if (set->contains_zero) return 0; set->contains_zero = 1; set->size++; } else { size_t h = _iset_pos(set->arr, set->mask, val); if (set->arr[h] == val) return 0; set->arr[h] = val; if (++set->size > FILL_RATIO * (double)set->maxsize) _iset_resize(set); } return 1; } iset_t iset_create_from_array(UV* d, size_t dlen, int dsign) { iset_t s = iset_create(dlen); if (dsign != 0) { unsigned char typemask = ((dsign > 0) ? ISET_TYPE_UV : ISET_TYPE_IV); size_t i; for (i = 0; i < dlen; i++) { UV val = d[i]; if (val == 0) { if (!s.contains_zero) { s.contains_zero = 1; s.size++; } } else { size_t h = _iset_pos(s.arr, s.mask, val); if (s.arr[h] != val) { s.arr[h] = val; if (++s.size > FILL_RATIO * (double)s.maxsize) _iset_resize(&s); } if (val > (UV)IV_MAX) s.type |= typemask; } } } return s; } void iset_allvals(const iset_t set, UV* array) { size_t j, i = 0; if (set.contains_zero) array[i++] = 0; for (j = 0; j < set.maxsize; j++) if (set.arr[j] != 0) array[i++] = set.arr[j]; if (i != set.size) croak("iset_allvals bad size"); if (set.type == ISET_TYPE_IV) sort_iv_array((IV*)array, i); else sort_uv_array(array, i); } #if 0 void iset_minmax(const iset_t set, UV *min, UV *max) { size_t i; *min = *max = 0; if (set.type == ISET_TYPE_INVALID || set.size == 0) return; if (set.type != ISET_TYPE_IV) { if (!set.contains_zero) { *min = UV_MAX; } for (i = 0; i < set.maxsize; i++) { UV v = set.arr[i]; if (v != 0) { if (v < *min) *min = v; if (v > *max) *max = v; } } } else { IV smin = set.contains_zero ? 0 : IV_MAX; IV smax = set.contains_zero ? 0 : IV_MIN; for (i = 0; i < set.maxsize; i++) { IV sv = (IV) set.arr[i]; if (sv != 0) { if (sv < smin) smin = sv; if (sv > smax) smax = sv; } } *min = (UV)smin; *max = (UV)smax; } } #endif /******************************************************************************/ void iset_union_with(iset_t *set, const iset_t L) { size_t i, lsize; UV v, *larr; int lsign = iset_sign(L); lsize = L.maxsize; larr = L.arr; for (i = 0; i < lsize; i++) if (v = larr[i], v != 0) iset_add(set, v, lsign); if (L.contains_zero && !set->contains_zero) iset_add(set,0,1); } void iset_intersect_with(iset_t *set, const iset_t L) { iset_t s = iset_intersection_of(*set, L); iset_destroy(set); *set = s; } void iset_difference_with(iset_t *set, const iset_t L) { iset_t s = iset_difference_of(*set, L); iset_destroy(set); *set = s; } void iset_symdiff_with(iset_t *set, const iset_t L) { iset_t s = iset_symdiff_of(*set, L); iset_destroy(set); *set = s; } /******************************************************************************/ iset_t iset_union_of(const iset_t A, const iset_t B) { size_t i; UV v; int asign = iset_sign(A), bsign = iset_sign(B); iset_t s = iset_create(A.size + B.size); for (i = 0; i < A.maxsize; i++) if (v = A.arr[i], v != 0) iset_add(&s, v, asign); for (i = 0; i < B.maxsize; i++) if (v = B.arr[i], v != 0) iset_add(&s, v, bsign); if (A.contains_zero || B.contains_zero) iset_add(&s,0,1); return s; } iset_t iset_intersection_of(const iset_t A, const iset_t B) { int asign = iset_sign(A), bsign = iset_sign(B); int samesign = (asign == bsign); size_t i; UV v; iset_t s; if (A.size > B.size) /* Swap for performance. */ return iset_intersection_of(B,A); s = iset_create((A.size < B.size) ? A.size : B.size); for (i = 0; i < A.maxsize; i++) if (v = A.arr[i], v != 0) if ( !((v > (UV)IV_MAX) && !samesign) && iset_contains(B, v)) iset_add(&s, v, asign); if (A.contains_zero && B.contains_zero) iset_add(&s,0,1); return s; } iset_t iset_difference_of(const iset_t A, const iset_t B) { int asign = iset_sign(A), bsign = iset_sign(B); int samesign = (asign == bsign); size_t i; UV v; iset_t s = iset_create((A.size > B.size) ? A.size : B.size); for (i = 0; i < A.maxsize; i++) if (v = A.arr[i], v != 0) if ( ((v > (UV)IV_MAX) && !samesign) || !iset_contains(B, v) ) iset_add(&s, v, asign); if (A.contains_zero && !B.contains_zero) iset_add(&s,0,1); return s; } iset_t iset_symdiff_of(const iset_t A, const iset_t B) { int asign = iset_sign(A), bsign = iset_sign(B); int samesign = (asign == bsign); size_t i; UV v; iset_t s = iset_create((A.size > B.size) ? A.size : B.size); for (i = 0; i < A.maxsize; i++) if (v = A.arr[i], v != 0) if ( ((v > (UV)IV_MAX) && !samesign) || !iset_contains(B, v) ) iset_add(&s, v, asign); for (i = 0; i < B.maxsize; i++) if (v = B.arr[i], v != 0) if ( ((v > (UV)IV_MAX) && !samesign) || !iset_contains(A, v) ) iset_add(&s, v, bsign); if ((A.contains_zero + B.contains_zero) == 1) iset_add(&s,0,1); return s; } bool iset_is_subset_of(const iset_t A, const iset_t B) { int samesign = (iset_sign(A) == iset_sign(B)); size_t i; UV v; if (A.size > B.size) return 0; if (A.contains_zero && !B.contains_zero) return 0; for (i = 0; i < A.maxsize; i++) if (v = A.arr[i], v != 0) if ( ((v > (UV)IV_MAX) && !samesign) || !iset_contains(B, v) ) return 0; return 1; } /******************************************************************************/ void iset_test(void) { #if 0 iset_t s; UV *S; size_t i; const size_t ts = 30000000; printf("create .. "); fflush(stdout); s = iset_create(0); printf("done\n"); fflush(stdout); for (i = ts/2; i < ts; i++) { iset_add(&s, i, 1); } printf("done adding. size is %lu\n", (unsigned long)iset_size(s)); fflush(stdout); if (iset_contains(s,0) != 0) croak("fail 0"); for (i = 0; i < ts; i++) { iset_add(&s, i, 1); } printf("done adding. size is %lu\n", (unsigned long)iset_size(s)); fflush(stdout); if (iset_contains(s,1) != 1) croak("fail 1"); if (iset_contains(s,ts-1) != 1) croak("fail 999"); if (iset_contains(s,ts) != 0) croak("fail 1000"); if (iset_contains(s,0) != 1) croak("fail 0"); if (iset_sign(s) != 1) croak("fail sign"); if (iset_is_invalid(s) != 0) croak("fail invalid"); if (iset_size(s) != ts) croak("fail size"); New(0,S,iset_size(s),UV); iset_allvals(s,S); for (i = 0; i < ts; i++) if (S[i] != i) croak("fail element %lu expected %lu got %lu\n", (unsigned long)i, (unsigned long)i, S[i]); iset_destroy(&s); #endif } Math-Prime-Util-0.74/inverse_interpolate.c000644 000765 000024 00000020407 15152466006 020625 0ustar00danastaff000000 000000 #include #include #include #include "ptypes.h" #include "inverse_interpolate.h" #include "util.h" #include "mathl.h" static const int _dbgprint = 0; /* TODO: Consider Brent's method. */ /* Return x with v(x)=func(x,k) s.t. either of: * 1. v(x) == n and v(x-1-threshold) < n * 2. v(x) < n and v(x+1) > n */ #define LINEAR_INTERP(n, lo, hi, rlo, rhi) \ (lo + (UV) (((double)(n-rlo) * (double)(hi-lo) / (double)(rhi-rlo))+0.5)) #define MPU_CALLBACK(n) ((funck) ? funck(n,k) : func(n)) #if 0 /* Debugging return, checking the conditions above. */ #define RETURNI(x) \ { \ UV v = x; \ UV rv = MPU_CALLBACK(v); \ /* printf("v %lu rv %lu n %lu\n",v,rv,n); */\ MPUassert( rv <= n, "BAD INTERP v > n" ); \ if (rv == n) { \ if (v > threshold) { \ /* printf("threshold %lu v %lu func(%lu) = %lu\n", threshold, v, v-1-threshold, MPU_CALLBACK(v-1-threshold)); */\ MPUassert( MPU_CALLBACK(v-1-threshold) < n, "BAD INTERP v-1-thresh >= n" ); \ } \ } else { \ MPUassert( MPU_CALLBACK(v+1) > n, "BAD INTERP v+1 <= n" ); \ } \ return v; \ } #else #define RETURNI(x) { return x; } #endif static UV _inverse_interpolate(UV lo, UV hi, UV n, UV k, UV (*funck)(UV mid, UV k), UV (*func)(UV mid), UV threshold) { UV mid, rlo, rhi, rmid, iloopc; if (hi != 0) { /* Given both lo and hi, halve the range on start. */ mid = lo + ((hi-lo)>>1); rmid = MPU_CALLBACK(mid); if(_dbgprint)printf(" 01 lo %lu mid %lu hi %lu\n", lo, mid, hi); if (rmid >= n) { hi = mid; rhi = rmid; rlo = MPU_CALLBACK(lo); if (rlo == n) RETURNI(lo); /* Possible bad limit */ } else { lo = mid; rlo = rmid; rhi = MPU_CALLBACK(hi); } } else { /* They don't know what hi might be, so estimate something. */ rlo = MPU_CALLBACK(lo); if (rlo == n) RETURNI(lo); /* Possible bad limit */ rhi = UV_MAX; /* this should always be replaced below */ while (hi == 0) { double estf = (double)n/(double)rlo - 0.004; if (estf <= 1.004) estf = 1.004; else if (estf > 8.0) estf = 8.0; mid = ((double)UV_MAX/(double)lo <= estf) ? UV_MAX : (UV) (estf * (double)lo + 1); if(_dbgprint)printf(" 0s lo %lu mid %lu hi %lu\n", lo, mid, hi); rmid = MPU_CALLBACK(mid); if (rmid >= n) { hi = mid; rhi = rmid; } else { lo = mid; rlo = rmid; } if (lo == UV_MAX) break; /* Overflow */ } } MPUassert(rlo <= n && rhi >= n, "interpolation: bad initial limits"); if ((hi-lo) <= 1) RETURNI( (rlo == n || (rlo < n && rhi > n)) ? lo : hi ); /* Step 1. Linear interpolation until rhi is correct. */ if(_dbgprint)printf(" 1 lo %lu hi %lu\n", lo, hi); mid = (n == rhi) ? hi-1 : LINEAR_INTERP(n,lo,hi,rlo,rhi); if (mid == lo) mid++; else if (mid == hi) mid--; for (iloopc = 1; (hi-lo) > 1 && rhi > n; iloopc++) { MPUassert(lo < mid && mid < hi, "interpolation: assume 3 unique points"); rmid = MPU_CALLBACK(mid); if (rmid >= n) { hi = mid; rhi = rmid; } else { lo = mid; rlo = rmid; } if (rhi == n) break; mid += (IV)(((double)n-(double)rmid)*(double)(hi-lo) / (double)(rhi-rlo)); /* Sometimes we get stuck getting closer and closer but not bracketing. * We could do Ridder's method of alternating bisection, or using a * multiplier on mid on alternate iterations to reflect about n. * What we're going to do instead is, every few loops, check if we're * very close to one of the edges and try to pull in the other edge. */ if ((iloopc % 6) == 0) { UV close = .003*(hi-lo) + 1.0; if (lo+close > mid) mid = lo+close; else if (hi-close < mid) mid = hi-close; } /* Alternately: if (mid == lo) { mid = lo + .01*(hi-lo); } else if (mid == hi) { mid = hi - .01*(hi-lo); } */ if (mid <= lo) mid=lo+1; else if (mid >= hi) mid=hi-1; MPUassert(lo <= mid && mid <= hi, "interpolation: range error"); if(_dbgprint)printf(" 1s lo %lu mid %lu hi %lu (%lu)\n", lo, mid, hi, rhi-n); } if (rlo == n) RETURNI(lo); if ((hi-lo) <= 1) RETURNI((rlo == n || (rlo < n && rhi > n)) ? lo : hi); MPUassert(rlo < n && rhi == n, "interpolation: bad step 1 interpolation"); /* Step 2. Ridder's method until we're very close. */ MPUassert(rlo < n && rhi >= n, "interpolation: Ridder initial assumption"); if(_dbgprint)printf(" 2 lo %lu mid %lu hi %lu\n", lo, mid, hi); while ((hi-lo) > 8 && ((hi-lo) > threshold || rhi > n)) { UV x0 = lo, x1 = lo + ((hi-lo)>>1); /* x2 = hi */ UV rx1 = MPU_CALLBACK(x1); IV fx0 = rlo-n, fx1 = rx1-n, fx2=rhi-n+1; double pos = ((double)(x1-x0) * (double)fx1) / sqrtl((double)fx1 * (double)fx1 - (double)fx0 * (double)fx2); UV x3 = x1 - (IV)(pos+0.5); if(_dbgprint)printf(" 2s lo %lu mid %lu hi %lu (%lu)\n", lo, x1, hi, (rx1>n) ? rx1-n : n-rx1); if (x3 >= hi || x3 <= lo || x3 == x1) { /* We got nothing from the new point. Just use the bisection. */ if (rx1 >= n) { hi = x1; rhi = rx1; } else { lo = x1; rlo = rx1; } } else { UV rx3 = MPU_CALLBACK(x3); if(_dbgprint)printf(" 2S lo %lu mid %lu hi %lu (%lu)\n", lo, x3, hi, (rx3>n) ? rx3-n : n-rx3); /* Swap if needed to have: [lo x1 x3 hi] */ if (rx1 > rx3) { UV t=x1; x1=x3; x3=t; t=rx1; fx1=rx3; rx3=t; } if (rx1 >= n) { hi = x1; rhi = rx1; } else if (rx3 >= n) { lo = x1; rlo = rx1; hi = x3; rhi = rx3; } else { lo = x3; rlo = rx3; } } MPUassert(rlo < n && rhi >= n, "interpolation: Ridder step error"); } /* Step 3. Binary search. */ /* Binary search until within threshold */ while ((hi-lo) > 1 && ((hi-lo) > threshold || rhi > n)) { mid = lo + ((hi-lo)>>1); if (MPU_CALLBACK(mid) < n) lo = mid; /* Keeps invariant f(lo) < n */ else hi = mid; } if(_dbgprint)printf("final %lu - %lu threshold %lu\n", lo, hi, threshold); RETURNI(hi); } UV inverse_interpolate(UV lo, UV hi, UV n, UV (*func)(UV mid), UV threshold) { return _inverse_interpolate(lo,hi,n,0,0,func,threshold); } UV inverse_interpolate_k(UV lo, UV hi, UV n, UV k, UV (*funck)(UV mid, UV k), UV threshold) { return _inverse_interpolate(lo,hi,n,k,funck,0,threshold); } /******************************************************************************/ UV interpolate_with_approx(UV n, UV *gcount, UV tol, UV (*fnth)(UV n), UV (*fcnt)(UV n), bool (*fis)(UV n) /* optional */ ) { UV approx_nth_n, guess, gn, count, ming = 0, maxg = UV_MAX; approx_nth_n = guess = fnth(n); for (gn = 2; gn < 20; gn++) { IV adjust; MPUverbose(2, " interp %"UVuf"-th is around %"UVuf" ... ", n, guess); count = fcnt(guess); MPUverbose(2, "(%"IVdf")\n", (IV)(n-count)); /* Stop guessing if within our tolerance */ if (n==count || (n>count && n-count < tol) || (n ming) ming = guess; /* Previous guesses */ if (count >= 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 + tol - 1; if (guess >= maxg) guess = maxg - tol + 1; /* TODO: if min/max dist is small, split the difference. */ } if (gn == 20) count = fcnt(guess); if (fis) { if (count < n) { /* Increase count one at a time if needed */ for ( ; count < n; count++) while (!fis(++guess)) ; } else if (count >= n) { /* Make sure this is the least value at this count */ while (!fis(guess)) guess--; /* Reduce count one at a time if needed */ for ( ; count > n; count--) while (!fis(--guess)) ; } } if (gcount) *gcount = count; return guess; } Math-Prime-Util-0.74/multicall.h000644 000765 000024 00000010766 15145577415 016557 0ustar00danastaff000000 000000 /* 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.74/lucas_seq.h000644 000765 000024 00000000770 15154713505 016532 0ustar00danastaff000000 000000 #ifndef MPU_LUCAS_SEQ_H #define MPU_LUCAS_SEQ_H #include "ptypes.h" extern void lucasuvmod(UV* U, UV* V, UV P, UV Q, UV k, UV n); /* If caller has IV P and Q, send through ivmod(P,n) first */ extern UV lucasvmod(UV P, UV Q, UV k, UV n); extern UV lucasumod(UV P, UV Q, UV k, UV n); /* No modulo, returns false if it overflows. */ extern bool lucasuv(IV* U, IV* V, IV P, IV Q, UV k); /* Legacy version, also returns Qk */ extern void lucas_seq(UV* U, UV* V, UV* Qk, UV n, IV P, IV Q, UV k); #endif Math-Prime-Util-0.74/real.h000644 000765 000024 00000000641 15146553566 015505 0ustar00danastaff000000 000000 #ifndef MPU_REAL_H #define MPU_REAL_H #include "ptypes.h" extern NV Ei(NV x); extern NV Li(NV x); extern long double ld_inverse_li(long double x); extern long double ld_riemann_zeta(long double x); extern long double RiemannR(long double x, long double eps); extern NV lambertw(NV k); extern UV inverse_li(UV x); extern UV inverse_R(UV x); extern NV chebyshev_psi(UV n); extern NV chebyshev_theta(UV n); #endif Math-Prime-Util-0.74/ppport.h000644 000765 000024 00002113161 15146617124 016101 0ustar00danastaff000000 000000 #if 0 my $void = <<'SKIP'; #endif /* ---------------------------------------------------------------------- ppport.h -- Perl/Pollution/Portability Version 3.73 Automatically created by Devel::PPPort running under perl 5.042000. 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.73 =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 API that isn't supported all the way back --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_07, and has been tested up to 5.35.9. =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_07. 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 FULLY supported by F, and below which version of Perl they probably won't be available or work. By FULLY, we mean that support isn't provided all the way back to the first version of Perl that F supports at all. =head2 --api-info=I Show portability information for elements matching I. If I is surrounded by slashes, it is interpreted as a regular expression. Normally, only API elements are shown, but if there are no matching API elements but there are some other matching elements, those are shown. This allows you to conveniently find when functions internal to the core implementation were added; only people working on the core are likely to find this last part useful. =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 * Although the purpose of F is to keep you from having to concern yourself with what version you are running under, there may arise instances where you have to do so. These macros, the same ones as in base Perl, are available to you in all versions, and are what you should use: =over 4 =item C(major, minor, patch)> Returns whether or not the perl currently being compiled has the specified relationship I to the perl given by the parameters. I is one of C, C, C, C, C, C. For example, #if PERL_VERSION_GT(5,24,2) code that will only be compiled on perls after v5.24.2 #else fallback code #endif Note that this is usable in making compile-time decisions You may use the special value '*' for the final number to mean ALL possible values for it. Thus, #if PERL_VERSION_EQ(5,31,'*') means all perls in the 5.31 series. And #if PERL_VERSION_NE(5,24,'*') means all perls EXCEPT 5.24 ones. And #if PERL_VERSION_LE(5,9,'*') is effectively #if PERL_VERSION_LT(5,10,0) =back =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 ----------------------------------------------------------------------------------------- caller_cx() NEED_caller_cx NEED_caller_cx_GLOBAL ck_warner() NEED_ck_warner NEED_ck_warner_GLOBAL ck_warner_d() NEED_ck_warner_d NEED_ck_warner_d_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 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 my_strnlen() NEED_my_strnlen NEED_my_strnlen_GLOBAL newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL PL_signals NEED_PL_signals NEED_PL_signals_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_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_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 sv_vstring_get() NEED_sv_vstring_get NEED_sv_vstring_get_GLOBAL utf8_to_uvchr_buf() NEED_utf8_to_uvchr_buf NEED_utf8_to_uvchr_buf_GLOBAL vload_module() NEED_vload_module NEED_vload_module_GLOBAL vmess() NEED_vmess NEED_vmess_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 Some of the suggested edits and/or generated patches may not compile as-is without tweaking manually. This is generally due to the need for an extra parameter to be added to the call to prevent buffer overflow. If this version of F is causing failure during the compilation of this module, please check if newer versions of either this module or C are available on CPAN before sending a bug report. If F was generated using the latest version of C and is causing failure of this module, please file a bug report at L Please include the following information: =over 4 =item 1. The complete output from running "perl -V" =item 2. This file. =item 3. The name and version of the module you were trying to build. =item 4. A full log of the build that failed. =item 5. Any other information that you think could be relevant. =back For the latest version of this code, please get the C module from CPAN. =head1 COPYRIGHT Version 3.x, Copyright (c) 2004-2013, Marcus Holland-Moritz. Version 2.x, Copyright (C) 2001, Paul Marquess. Version 1.x, Copyright (C) 1999, Kenneth Albanowski. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO See L. =cut # These are tools that must be included in ppport.h. It doesn't work if given # a .pl suffix. # # WARNING: Use only constructs that are legal as far back as D:P handles, as # this is run in the perl version being tested. # What revisions are legal, to be output as-is and converted into a pattern # that matches them precisely my $r_pat = "[57]"; sub format_version { # Given an input version that is acceptable to parse_version(), return a # string of the standard representation of it. my($r,$v,$s) = parse_version(shift); if ($r < 5 || ($r == 5 && $v < 6)) { my $ver = sprintf "%d.%03d", $r, $v; $s > 0 and $ver .= sprintf "_%02d", $s; return $ver; } return sprintf "%d.%d.%d", $r, $v, $s; } sub parse_version { # Returns a triplet, (revision, major, minor) from the input, treated as a # string, which can be in any of several typical formats. my $ver = shift; $ver = "" unless defined $ver; my($r,$v,$s); if ( ($r, $v, $s) = $ver =~ /^([0-9]+)([0-9]{3})([0-9]{3})$/ # 5029010, from the file # names in our # parts/base/ and # parts/todo directories or ($r, $v, $s) = $ver =~ /^([0-9]+)\.([0-9]+)\.([0-9]+)$/ # 5.25.7 or ($r, $v, $s) = $ver =~ /^([0-9]+)\.([0-9]{3})([0-9]{3})$/ # 5.025008, from the # output of $] or ($r, $v, $s) = $ver =~ /^([0-9]+)\.([0-9]{1,3})()$/ # 5.24, 5.004 or ($r, $v, $s) = $ver =~ /^([0-9]+)\.(00[1-5])_?([0-9]{2})$/ # 5.003_07 ) { $s = 0 unless $s; die "Only Perl $r_pat are supported '$ver'\n" unless $r =~ / ^ $r_pat $ /x; die "Invalid version number: $ver\n" if $v >= 1000 || $s >= 1000; return (0 +$r, 0 + $v, 0 + $s); } # For some safety, don't assume something is a version number if it has a # literal dot as one of the three characters. This will have to be fixed # when we reach x.46 (since 46 is ord('.')) if ($ver !~ /\./ && (($r, $v, $s) = $ver =~ /^(.)(.)(.)$/)) # vstring 5.25.7 { $r = ord $r; $v = ord $v; $s = ord $s; die "Only Perl $r_pat are supported '$ver'\n" unless $r =~ / ^ $r_pat $ /x; return ($r, $v, $s); } my $mesg = ""; $mesg = ". (In 5.00x_yz, x must be 1-5.)" if $ver =~ /_/; die "Invalid version number format: '$ver'$mesg\n"; } sub int_parse_version { # Returns integer 7 digit human-readable version, suitable for use in file # names in parts/todo parts/base. return 0 + join "", map { sprintf("%03d", $_) } parse_version(shift); } sub ivers # Shorter name for int_parse_version { return int_parse_version(shift); } sub format_version_line { # Returns a floating point representation of the input version my $version = int_parse_version(shift); $version =~ s/ ^ ( $r_pat ) \B /$1./x; return $version; } BEGIN { if ("$]" < "5.006" ) { # On early perls, the implicit pass by reference doesn't work, so we have # to use the globals to initialize. eval q[sub dictionary_order($$) { _dictionary_order($a, $b) } ]; } elsif ("$]" < "5.022" ) { eval q[sub dictionary_order($$) { _dictionary_order(@_) } ]; } else { eval q[sub dictionary_order :prototype($$) { _dictionary_order(@_) } ]; } } sub _dictionary_order { # Sort caselessly, ignoring punct my ($valid_a, $valid_b) = @_; my ($lc_a, $lc_b); my ($squeezed_a, $squeezed_b); $valid_a = '' unless defined $valid_a; $valid_b = '' unless defined $valid_b; $lc_a = lc $valid_a; $lc_b = lc $valid_b; $squeezed_a = $lc_a; $squeezed_a =~ s/^_+//g; # No leading underscores $squeezed_a =~ s/\B_+\B//g; # No connecting underscores $squeezed_a =~ s/[\W]//g; # No punct $squeezed_b = $lc_b; $squeezed_b =~ s/^_+//g; $squeezed_b =~ s/\B_+\B//g; $squeezed_b =~ s/[\W]//g; return( $squeezed_a cmp $squeezed_b or $lc_a cmp $lc_b or $valid_a cmp $valid_b); } sub sort_api_lines # Sort lines of the form flags|return|name|args... # by 'name' { $a =~ / ^ [^|]* \| [^|]* \| ( [^|]* ) /x; # 3rd field '|' is sep my $a_name = $1; $b =~ / ^ [^|]* \| [^|]* \| ( [^|]* ) /x; my $b_name = $1; return dictionary_order($a_name, $b_name); } 1; use strict; BEGIN { require warnings if "$]" > '5.006' } # Disable broken TRIE-optimization BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if "$]" >= "5.009004" && "$]" <= "5.009005"} my $VERSION = 3.73; 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}; $opt{'compat-version'} = 5.003_07 unless exists $opt{'compat-version'}; $opt{'compat-version'} = int_parse_version($opt{'compat-version'}); my $int_min_perl = int_parse_version(5.003_07); # Each element of this hash looks something like: # 'Poison' => { # 'base' => '5.008000', # 'provided' => 1, # 'todo' => '5.003007' # }, 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 ) : ()), (index($4, 'c') >= 0 ? ( core_only => 1 ) : ()), (index($4, 'd') >= 0 ? ( deprecated => 1 ) : ()), (index($4, 'i') >= 0 ? ( inaccessible => 1 ) : ()), (index($4, 'x') >= 0 ? ( experimental => 1 ) : ()), (index($4, 'u') >= 0 ? ( undocumented => 1 ) : ()), (index($4, 'o') >= 0 ? ( ppport_fnc => 1 ) : ()), (index($4, 'V') >= 0 ? ( unverified => 1 ) : ()), } ) : die "invalid spec: $_" } qw( ABDAY_1|5.027010||Viu ABDAY_2|5.027010||Viu ABDAY_3|5.027010||Viu ABDAY_4|5.027010||Viu ABDAY_5|5.027010||Viu ABDAY_6|5.027010||Viu ABDAY_7|5.027010||Viu ABMON_10|5.027010||Viu ABMON_11|5.027010||Viu ABMON_12|5.027010||Viu ABMON_1|5.027010||Viu ABMON_2|5.027010||Viu ABMON_3|5.027010||Viu ABMON_4|5.027010||Viu ABMON_5|5.027010||Viu ABMON_6|5.027010||Viu ABMON_7|5.027010||Viu ABMON_8|5.027010||Viu ABMON_9|5.027010||Viu ABORT|5.003007||Viu abort|5.005000||Viu abort_execution|5.025010||Viu accept|5.005000||Viu ACCEPT|5.009005||Viu ACCEPT_t8|5.035004||Viu ACCEPT_t8_p8|5.033003||Viu ACCEPT_t8_pb|5.033003||Viu ACCEPT_tb|5.035004||Viu ACCEPT_tb_p8|5.033003||Viu ACCEPT_tb_pb|5.033003||Viu access|5.005000||Viu add_above_Latin1_folds|5.021001||Viu add_cp_to_invlist|5.013011||Viu add_data|5.005000||Vniu add_multi_match|5.021004||Viu _add_range_to_invlist|5.016000||cViu add_utf16_textfilter|5.011001||Viu adjust_size_and_find_bucket|5.019003||Vniu advance_one_LB|5.023007||Viu advance_one_SB|5.021009||Viu advance_one_WB|5.021009||Viu AHOCORASICK|5.009005||Viu AHOCORASICKC|5.009005||Viu AHOCORASICKC_t8|5.035004||Viu AHOCORASICKC_t8_p8|5.033003||Viu AHOCORASICKC_t8_pb|5.033003||Viu AHOCORASICKC_tb|5.035004||Viu AHOCORASICKC_tb_p8|5.033003||Viu AHOCORASICKC_tb_pb|5.033003||Viu AHOCORASICK_t8|5.035004||Viu AHOCORASICK_t8_p8|5.033003||Viu AHOCORASICK_t8_pb|5.033003||Viu AHOCORASICK_tb|5.035004||Viu AHOCORASICK_tb_p8|5.033003||Viu AHOCORASICK_tb_pb|5.033003||Viu ALIGNED_TYPE_NAME|||Viu ALIGNED_TYPE|||Viu alloccopstash|5.017001|5.017001|x alloc_LOGOP|5.025004||xViu allocmy|5.008001||Viu ALLOC_THREAD_KEY|5.005003||Viu ALT_DIGITS|5.027010||Viu amagic_call|5.003007|5.003007|u amagic_cmp|5.009003||Viu amagic_cmp_desc|5.031011||Viu amagic_cmp_locale|5.009003||Viu amagic_cmp_locale_desc|5.031011||Viu amagic_deref_call|5.013007|5.013007|u amagic_i_ncmp|5.009003||Viu amagic_i_ncmp_desc|5.031011||Viu amagic_is_enabled|5.015008||Viu amagic_ncmp|5.009003||Viu amagic_ncmp_desc|5.031011||Viu AMG_CALLun|5.003007||Viu AMG_CALLunary|5.013009||Viu AMGfallNEVER|5.003007||Viu AMGfallNO|5.003007||Viu AMGfallYES|5.003007||Viu AMGf_assign|5.003007||Viu AMGf_noleft|5.003007||Viu AMGf_noright|5.003007||Viu AMGf_numarg|5.021009||Viu AMGf_numeric|5.013002||Viu AMGf_unary|5.003007||Viu AMGf_want_list|5.017002||Viu AM_STR|5.027010||Viu AMT_AMAGIC|5.004000||Viu AMT_AMAGIC_off|5.004000||Viu AMT_AMAGIC_on|5.004000||Viu AMTf_AMAGIC|5.004000||Viu _aMY_CXT|5.009000|5.009000|p aMY_CXT|5.009000|5.009000|p aMY_CXT_|5.009000|5.009000|p anchored_end_shift|5.009005||Viu anchored_offset|5.005000||Viu anchored_substr|5.005000||Viu anchored_utf8|5.008000||Viu ANGSTROM_SIGN|5.017003||Viu anonymise_cv_maybe|5.013003||Viu any_dup|5.006000||Vu ANYOF|5.003007||Viu ANYOF_ALNUM|5.006000||Viu ANYOF_ALNUML|5.004000||Viu ANYOF_ALPHA|5.006000||Viu ANYOF_ALPHANUMERIC|5.017008||Viu ANYOF_ASCII|5.006000||Viu ANYOF_BIT|5.004005||Viu ANYOF_BITMAP|5.006000||Viu ANYOF_BITMAP_BYTE|5.006000||Viu ANYOF_BITMAP_CLEAR|5.006000||Viu ANYOF_BITMAP_CLEARALL|5.007003||Viu ANYOF_BITMAP_SET|5.006000||Viu ANYOF_BITMAP_SETALL|5.007003||Viu ANYOF_BITMAP_SIZE|5.006000||Viu ANYOF_BITMAP_TEST|5.006000||Viu ANYOF_BITMAP_ZERO|5.006000||Viu ANYOF_BLANK|5.006001||Viu ANYOF_CASED|5.017008||Viu ANYOF_CLASS_OR|5.017007||Viu ANYOF_CLASS_SETALL|5.013011||Viu ANYOF_CLASS_TEST_ANY_SET|5.013008||Viu ANYOF_CNTRL|5.006000||Viu ANYOF_COMMON_FLAGS|5.019008||Viu ANYOFD|5.023003||Viu ANYOF_DIGIT|5.006000||Viu ANYOFD_t8|5.035004||Viu ANYOFD_t8_p8|5.033003||Viu ANYOFD_t8_pb|5.033003||Viu ANYOFD_tb|5.035004||Viu ANYOFD_tb_p8|5.033003||Viu ANYOFD_tb_pb|5.033003||Viu ANYOF_FLAGS|5.006000||Viu ANYOF_FLAGS_ALL|5.006000||Viu ANYOF_GRAPH|5.006000||Viu ANYOFH|5.029007||Viu ANYOFHb|5.031001||Viu ANYOFHb_t8|5.035004||Viu ANYOFHb_t8_p8|5.033003||Viu ANYOFHb_t8_pb|5.033003||Viu ANYOFHb_tb|5.035004||Viu ANYOFHb_tb_p8|5.033003||Viu ANYOFHb_tb_pb|5.033003||Viu ANYOF_HORIZWS|5.009005||Viu ANYOFHr|5.031002||Viu ANYOFHr_t8|5.035004||Viu ANYOFHr_t8_p8|5.033003||Viu ANYOFHr_t8_pb|5.033003||Viu ANYOFHr_tb|5.035004||Viu ANYOFHr_tb_p8|5.033003||Viu ANYOFHr_tb_pb|5.033003||Viu ANYOFHs|5.031007||Viu ANYOFHs_t8|5.035004||Viu ANYOFHs_t8_p8|5.033003||Viu ANYOFHs_t8_pb|5.033003||Viu ANYOFHs_tb|5.035004||Viu ANYOFHs_tb_p8|5.033003||Viu ANYOFHs_tb_pb|5.033003||Viu ANYOFH_t8|5.035004||Viu ANYOFH_t8_p8|5.033003||Viu ANYOFH_t8_pb|5.033003||Viu ANYOFH_tb|5.035004||Viu ANYOFH_tb_p8|5.033003||Viu ANYOFH_tb_pb|5.033003||Viu ANYOF_INVERT|5.004000||Viu ANYOFL|5.021008||Viu ANYOFL_FOLD|5.023007||Viu ANYOF_LOCALE_FLAGS|5.019005||Viu ANYOF_LOWER|5.006000||Viu ANYOFL_SHARED_UTF8_LOCALE_fold_HAS_MATCHES_nonfold_REQD|5.023007||Viu ANYOFL_SOME_FOLDS_ONLY_IN_UTF8_LOCALE|5.023007||Viu ANYOFL_t8|5.035004||Viu ANYOFL_t8_p8|5.033003||Viu ANYOFL_t8_pb|5.033003||Viu ANYOFL_tb|5.035004||Viu ANYOFL_tb_p8|5.033003||Viu ANYOFL_tb_pb|5.033003||Viu ANYOFL_UTF8_LOCALE_REQD|5.023007||Viu ANYOFM|5.027009||Viu ANYOF_MATCHES_ALL_ABOVE_BITMAP|5.021004||Viu ANYOF_MATCHES_POSIXL|5.021004||Viu ANYOF_MAX|5.006000||Viu ANYOFM_t8|5.035004||Viu ANYOFM_t8_p8|5.033003||Viu ANYOFM_t8_pb|5.033003||Viu ANYOFM_tb|5.035004||Viu ANYOFM_tb_p8|5.033003||Viu ANYOFM_tb_pb|5.033003||Viu ANYOF_NALNUM|5.006000||Viu ANYOF_NALNUML|5.004000||Viu ANYOF_NALPHA|5.006000||Viu ANYOF_NALPHANUMERIC|5.017008||Viu ANYOF_NASCII|5.006000||Viu ANYOF_NBLANK|5.006001||Viu ANYOF_NCASED|5.017008||Viu ANYOF_NCNTRL|5.006000||Viu ANYOF_NDIGIT|5.006000||Viu ANYOF_NGRAPH|5.006000||Viu ANYOF_NHORIZWS|5.009005||Viu ANYOF_NLOWER|5.006000||Viu ANYOF_NPRINT|5.006000||Viu ANYOF_NPUNCT|5.006000||Viu ANYOF_NSPACE|5.006000||Viu ANYOF_NSPACEL|5.004000||Viu ANYOF_NUPPER|5.006000||Viu ANYOF_NVERTWS|5.009005||Viu ANYOF_NWORDCHAR|5.017005||Viu ANYOF_NXDIGIT|5.006000||Viu ANYOF_ONLY_HAS_BITMAP|5.021004||Viu ANYOFPOSIXL|5.029004||Viu ANYOF_POSIXL_AND|5.019005||Viu ANYOF_POSIXL_BITMAP|5.035003||Viu ANYOF_POSIXL_CLEAR|5.019005||Viu ANYOF_POSIXL_MAX|5.019005||Viu ANYOF_POSIXL_OR|5.019005||Viu ANYOF_POSIXL_SET|5.019005||Viu ANYOF_POSIXL_SETALL|5.019005||Viu ANYOF_POSIXL_SET_TO_BITMAP|5.029004||Viu ANYOF_POSIXL_SSC_TEST_ALL_SET|5.019009||Viu ANYOF_POSIXL_SSC_TEST_ANY_SET|5.019009||Viu ANYOFPOSIXL_t8|5.035004||Viu ANYOFPOSIXL_t8_p8|5.033003||Viu ANYOFPOSIXL_t8_pb|5.033003||Viu ANYOFPOSIXL_tb|5.035004||Viu ANYOFPOSIXL_tb_p8|5.033003||Viu ANYOFPOSIXL_tb_pb|5.033003||Viu ANYOF_POSIXL_TEST|5.019005||Viu ANYOF_POSIXL_TEST_ALL_SET|5.019005||Viu ANYOF_POSIXL_TEST_ANY_SET|5.019005||Viu ANYOF_POSIXL_ZERO|5.019005||Viu ANYOF_PRINT|5.006000||Viu ANYOF_PUNCT|5.006000||Viu ANYOFR|5.031007||Viu ANYOFRb|5.031007||Viu ANYOFRbase|5.031007||Viu ANYOFR_BASE_BITS|5.031007||Viu ANYOFRb_t8|5.035004||Viu ANYOFRb_t8_p8|5.033003||Viu ANYOFRb_t8_pb|5.033003||Viu ANYOFRb_tb|5.035004||Viu ANYOFRb_tb_p8|5.033003||Viu ANYOFRb_tb_pb|5.033003||Viu ANYOFRdelta|5.031007||Viu ANYOFR_t8|5.035004||Viu ANYOFR_t8_p8|5.033003||Viu ANYOFR_t8_pb|5.033003||Viu ANYOFR_tb|5.035004||Viu ANYOFR_tb_p8|5.033003||Viu ANYOFR_tb_pb|5.033003||Viu ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER|5.023003||Viu ANYOF_SHARED_d_UPPER_LATIN1_UTF8_STRING_MATCHES_non_d_RUNTIME_USER_PROP|5.023006||Viu ANYOF_SPACE|5.006000||Viu ANYOF_SPACEL|5.004000||Viu ANYOF_t8|5.035004||Viu ANYOF_t8_p8|5.033003||Viu ANYOF_t8_pb|5.033003||Viu ANYOF_tb|5.035004||Viu ANYOF_tb_p8|5.033003||Viu ANYOF_tb_pb|5.033003||Viu ANYOF_UNIPROP|5.017006||Viu ANYOF_UPPER|5.006000||Viu ANYOF_VERTWS|5.009005||Viu ANYOF_WORDCHAR|5.017005||Viu ANYOF_XDIGIT|5.006000||Viu ao|5.005000||Viu _append_range_to_invlist|5.013010||Viu append_utf8_from_native_byte|5.019004||cVniu apply|5.003007||Viu apply_attrs|5.006000||Viu apply_attrs_my|5.007003||Viu apply_attrs_string|5.006001|5.006001|xu ARCHLIB|5.003007|5.003007|Vn ARCHLIB_EXP|5.003007|5.003007|Vn ARCHNAME|5.004000|5.004000|Vn ARG1|5.003007||Viu ARG1_LOC|5.005000||Viu ARG1_SET|5.005000||Viu ARG2|5.003007||Viu ARG2L|5.009005||Viu ARG2L_LOC|5.009005||Viu ARG2_LOC|5.005000||Viu ARG2L_SET|5.009005||Viu ARG2_SET|5.005000||Viu ARG|5.005000||Viu ARG_LOC|5.005000||Viu ARGp|5.031010||Viu ARGp_LOC|5.031010||Viu ARGp_SET|5.031010||Viu ARG__SET|5.005000||Viu ARG_SET|5.005000||Viu ARGTARG|5.003007||Viu ARG_VALUE|5.005000||Viu argvout_final|5.029006||Viu ASCIIish|5.005003||Viu ASCII_MORE_RESTRICT_PAT_MODS|5.013010||Viu ASCII_PLATFORM_UTF8_MAXBYTES|5.035004||Viu ASCII_RESTRICT_PAT_MOD|5.013009||Viu ASCII_RESTRICT_PAT_MODS|5.013009||Viu ASCII_TO_NATIVE|5.007001||Viu ASCII_TO_NEED|5.019004||dcVnu asctime|5.009000||Viu ASCTIME_R_PROTO|5.008000|5.008000|Vn assert|5.003007||Viu __ASSERT_|5.019007|5.008008|p ASSERT_CURPAD_ACTIVE|5.008001||Viu ASSERT_CURPAD_LEGAL|5.008001||Viu ASSERT_IS_LITERAL|||Viu ASSERT_IS_PTR|||Viu assert_not_glob|5.009004||Viu ASSERT_NOT_PTR|5.035004||Viu assert_not_ROK|5.008001||Viu assert_uft8_cache_coherent|5.013003||Viu assignment_type|5.021005||Viu ASSUME|5.019006|5.003007|p atfork_lock|5.007003|5.007003|nu atfork_unlock|5.007003|5.007003|nu aTHX|5.006000|5.003007|p aTHX_|5.006000|5.003007|p aTHXa|5.017006||Viu aTHXo|5.006000||Viu aTHXR||5.003007|ponu aTHXR_||5.003007|ponu aTHXx|5.006000||Viu Atof|5.006000||Viu Atol|5.006000||Viu atoll|5.008000||Viu Atoul|5.006000||Viu AvALLOC|5.003007||Viu AvARRAY|5.003007|5.003007| AvARYLEN|5.003007||Viu av_arylen_p|||cu av_clear|5.003007|5.003007| av_count|5.033001|5.003007|p av_create_and_push||| av_create_and_unshift_one||| av_delete|5.006000|5.006000| av_exists|5.006000|5.006000| av_extend|5.003007|5.003007| av_extend_guts|5.017004||Viu av_fetch|5.003007|5.003007| av_fetch_simple|5.035002||cV av_fill|5.003007|5.003007| AvFILL|5.003007|5.003007| AvFILLp|5.004005||pcV av_iter_p|||cu av_len|5.003007|5.003007| av_make|5.003007|5.003007| AvMAX|5.003007||Viu av_new_alloc|5.035001|5.035001| av_nonelem|5.027009||Viu av_pop|5.003007|5.003007| av_push|5.003007|5.003007| AvREAL|5.003007||Viu AvREALISH|5.003007||Viu AvREAL_off|5.003007||Viu AvREAL_on|5.003007||Viu AvREAL_only|5.009003||Viu AvREIFY|5.003007||Viu av_reify|5.004004||cViu AvREIFY_off|5.003007||Viu AvREIFY_on|5.003007||Viu AvREIFY_only|5.009003||Viu av_shift|5.003007|5.003007| av_store|5.003007|5.003007| av_store_simple|5.035002||cV av_tindex|5.017009|5.003007|p av_tindex_skip_len_mg|5.025010||Viu av_top_index|5.017009|5.003007|p av_top_index_skip_len_mg|5.025010||Viu av_undef|5.003007|5.003007| av_unshift|5.003007|5.003007| ax|5.003007|5.003007| backup_one_GCB|5.025003||Viu backup_one_LB|5.023007||Viu backup_one_SB|5.021009||Viu backup_one_WB|5.021009||Viu bad_type_gv|5.019002||Viu bad_type_pv|5.016000||Viu BADVERSION|5.011004||Viu BASEOP|5.003007||Viu BhkDISABLE|5.013003||xV BhkENABLE|5.013003||xV BhkENTRY|5.013003||xVi BhkENTRY_set|5.013003||xV BHKf_bhk_eval|5.013006||Viu BHKf_bhk_post_end|5.013006||Viu BHKf_bhk_pre_end|5.013006||Viu BHKf_bhk_start|5.013006||Viu BhkFLAGS|5.013003||xVi BIN|5.003007|5.003007|Vn bind|5.005000||Viu bind_match|5.003007||Viu BIN_EXP|5.004000|5.004000|Vn BIT_BUCKET|5.003007||Viu BIT_DIGITS|5.004000||Viu BITMAP_BYTE|5.009005||Viu BITMAP_TEST|5.009005||Viu blk_eval|5.003007||Viu blk_format|5.011000||Viu blk_gimme|5.003007||Viu blk_givwhen|5.027008||Viu blk_loop|5.003007||Viu blk_oldcop|5.003007||Viu blk_oldmarksp|5.003007||Viu blk_oldpm|5.003007||Viu blk_oldsaveix|5.023008||Viu blk_oldscopesp|5.003007||Viu blk_oldsp|5.003007||Viu blk_old_tmpsfloor|5.023008||Viu blk_sub|5.003007||Viu blk_u16|5.011000||Viu block_end|5.021006|5.021006| block_gimme|5.004000|5.004000|u blockhook_register|||x block_start|5.021006|5.021006| BmFLAGS|5.009005||Viu BmPREVIOUS|5.003007||Viu BmRARE|5.003007||Viu BmUSEFUL|5.003007||Viu BOL|5.003007||Viu BOL_t8|5.035004||Viu BOL_t8_p8|5.033003||Viu BOL_t8_pb|5.033003||Viu BOL_tb|5.035004||Viu BOL_tb_p8|5.033003||Viu BOL_tb_pb|5.033003||Viu BOM_UTF8|5.025005|5.003007|p BOM_UTF8_FIRST_BYTE|5.019004||Viu BOM_UTF8_TAIL|5.019004||Viu boolSV|5.004000|5.003007|p boot_core_builtin|5.035007||Viu boot_core_mro|5.009005||Viu boot_core_PerlIO|5.007002||Viu boot_core_UNIVERSAL|5.003007||Viu BOUND|5.003007||Viu BOUNDA|5.013009||Viu BOUNDA_t8|5.035004||Viu BOUNDA_t8_p8|5.033003||Viu BOUNDA_t8_pb|5.033003||Viu BOUNDA_tb|5.035004||Viu BOUNDA_tb_p8|5.033003||Viu BOUNDA_tb_pb|5.033003||Viu BOUNDL|5.004000||Viu BOUNDL_t8|5.035004||Viu BOUNDL_t8_p8|5.033003||Viu BOUNDL_t8_pb|5.033003||Viu BOUNDL_tb|5.035004||Viu BOUNDL_tb_p8|5.033003||Viu BOUNDL_tb_pb|5.033003||Viu BOUND_t8|5.035004||Viu BOUND_t8_p8|5.033003||Viu BOUND_t8_pb|5.033003||Viu BOUND_tb|5.035004||Viu BOUND_tb_p8|5.033003||Viu BOUND_tb_pb|5.033003||Viu BOUNDU|5.013009||Viu BOUNDU_t8|5.035004||Viu BOUNDU_t8_p8|5.033003||Viu BOUNDU_t8_pb|5.033003||Viu BOUNDU_tb|5.035004||Viu BOUNDU_tb_p8|5.033003||Viu BOUNDU_tb_pb|5.033003||Viu BRANCH|5.003007||Viu BRANCHJ|5.005000||Viu BRANCHJ_t8|5.035004||Viu BRANCHJ_t8_p8|5.033003||Viu BRANCHJ_t8_pb|5.033003||Viu BRANCHJ_tb|5.035004||Viu BRANCHJ_tb_p8|5.033003||Viu BRANCHJ_tb_pb|5.033003||Viu BRANCH_next|5.009005||Viu BRANCH_next_fail|5.009005||Viu BRANCH_next_fail_t8|5.035004||Viu BRANCH_next_fail_t8_p8|5.033003||Viu BRANCH_next_fail_t8_pb|5.033003||Viu BRANCH_next_fail_tb|5.035004||Viu BRANCH_next_fail_tb_p8|5.033003||Viu BRANCH_next_fail_tb_pb|5.033003||Viu BRANCH_next_t8|5.035004||Viu BRANCH_next_t8_p8|5.033003||Viu BRANCH_next_t8_pb|5.033003||Viu BRANCH_next_tb|5.035004||Viu BRANCH_next_tb_p8|5.033003||Viu BRANCH_next_tb_pb|5.033003||Viu BRANCH_t8|5.035004||Viu BRANCH_t8_p8|5.033003||Viu BRANCH_t8_pb|5.033003||Viu BRANCH_tb|5.035004||Viu BRANCH_tb_p8|5.033003||Viu BRANCH_tb_pb|5.033003||Viu BSD_GETPGRP|5.003007||Viu BSDish|5.008001||Viu BSD_SETPGRP|5.003007||Viu BUFSIZ|5.003007||Viu _byte_dump_string|5.025006||cViu BYTEORDER|5.003007|5.003007|Vn bytes_cmp_utf8|5.013007|5.013007| bytes_from_utf8|5.007001|5.007001|x bytes_from_utf8_loc|5.027001||xcVn bytes_to_utf8|5.006001|5.006001|x call_argv|5.006000|5.003007|p call_atexit|5.006000|5.006000|u CALL_BLOCK_HOOKS|5.013003||xVi CALL_CHECKER_REQUIRE_GV|5.021004|5.021004| caller_cx|5.013005|5.006000|p CALL_FPTR|5.006000||Viu call_list|5.004000|5.004000|u call_method|5.006000|5.003007|p calloc|5.029005||Vn call_pv|5.006000|5.003007|p CALLREGCOMP|5.005000||Viu CALLREGCOMP_ENG|5.009005||Viu CALLREGDUPE|5.009005||Viu CALLREGDUPE_PVT|5.009005||Viu CALLREGEXEC|5.005000||Viu CALLREGFREE|5.006000||Viu CALLREGFREE_PVT|5.009005||Viu CALLREG_INTUIT_START|5.006000||Viu CALLREG_INTUIT_STRING|5.006000||Viu CALLREG_NAMED_BUFF_ALL|5.009005||Viu CALLREG_NAMED_BUFF_CLEAR|5.009005||Viu CALLREG_NAMED_BUFF_COUNT|5.009005||Viu CALLREG_NAMED_BUFF_DELETE|5.009005||Viu CALLREG_NAMED_BUFF_EXISTS|5.009005||Viu CALLREG_NAMED_BUFF_FETCH|5.009005||Viu CALLREG_NAMED_BUFF_FIRSTKEY|5.009005||Viu CALLREG_NAMED_BUFF_NEXTKEY|5.009005||Viu CALLREG_NAMED_BUFF_SCALAR|5.009005||Viu CALLREG_NAMED_BUFF_STORE|5.009005||Viu CALLREG_NUMBUF_FETCH|5.009005||Viu CALLREG_NUMBUF_LENGTH|5.009005||Viu CALLREG_NUMBUF_STORE|5.009005||Viu CALLREG_PACKAGE|5.009005||Viu CALLRUNOPS|5.005000||Viu call_sv|5.006000|5.003007|p CAN64BITHASH|5.027001||Viu CAN_COW_FLAGS|5.009000||Viu CAN_COW_MASK|5.009000||Viu cando|5.003007||Viu CAN_PROTOTYPE|5.003007||Viu C_ARRAY_END|5.013002|5.003007|p C_ARRAY_LENGTH|5.008001|5.003007|p case_100_SBOX32|5.027001||Viu case_101_SBOX32|5.027001||Viu case_102_SBOX32|5.027001||Viu case_103_SBOX32|5.027001||Viu case_104_SBOX32|5.027001||Viu case_105_SBOX32|5.027001||Viu case_106_SBOX32|5.027001||Viu case_107_SBOX32|5.027001||Viu case_108_SBOX32|5.027001||Viu case_109_SBOX32|5.027001||Viu case_10_SBOX32|5.027001||Viu case_110_SBOX32|5.027001||Viu case_111_SBOX32|5.027001||Viu case_112_SBOX32|5.027001||Viu case_113_SBOX32|5.027001||Viu case_114_SBOX32|5.027001||Viu case_115_SBOX32|5.027001||Viu case_116_SBOX32|5.027001||Viu case_117_SBOX32|5.027001||Viu case_118_SBOX32|5.027001||Viu case_119_SBOX32|5.027001||Viu case_11_SBOX32|5.027001||Viu case_120_SBOX32|5.027001||Viu case_121_SBOX32|5.027001||Viu case_122_SBOX32|5.027001||Viu case_123_SBOX32|5.027001||Viu case_124_SBOX32|5.027001||Viu case_125_SBOX32|5.027001||Viu case_126_SBOX32|5.027001||Viu case_127_SBOX32|5.027001||Viu case_128_SBOX32|5.027001||Viu case_129_SBOX32|5.027001||Viu case_12_SBOX32|5.027001||Viu case_130_SBOX32|5.027001||Viu case_131_SBOX32|5.027001||Viu case_132_SBOX32|5.027001||Viu case_133_SBOX32|5.027001||Viu case_134_SBOX32|5.027001||Viu case_135_SBOX32|5.027001||Viu case_136_SBOX32|5.027001||Viu case_137_SBOX32|5.027001||Viu case_138_SBOX32|5.027001||Viu case_139_SBOX32|5.027001||Viu case_13_SBOX32|5.027001||Viu case_140_SBOX32|5.027001||Viu case_141_SBOX32|5.027001||Viu case_142_SBOX32|5.027001||Viu case_143_SBOX32|5.027001||Viu case_144_SBOX32|5.027001||Viu case_145_SBOX32|5.027001||Viu case_146_SBOX32|5.027001||Viu case_147_SBOX32|5.027001||Viu case_148_SBOX32|5.027001||Viu case_149_SBOX32|5.027001||Viu case_14_SBOX32|5.027001||Viu case_150_SBOX32|5.027001||Viu case_151_SBOX32|5.027001||Viu case_152_SBOX32|5.027001||Viu case_153_SBOX32|5.027001||Viu case_154_SBOX32|5.027001||Viu case_155_SBOX32|5.027001||Viu case_156_SBOX32|5.027001||Viu case_157_SBOX32|5.027001||Viu case_158_SBOX32|5.027001||Viu case_159_SBOX32|5.027001||Viu case_15_SBOX32|5.027001||Viu case_160_SBOX32|5.027001||Viu case_161_SBOX32|5.027001||Viu case_162_SBOX32|5.027001||Viu case_163_SBOX32|5.027001||Viu case_164_SBOX32|5.027001||Viu case_165_SBOX32|5.027001||Viu case_166_SBOX32|5.027001||Viu case_167_SBOX32|5.027001||Viu case_168_SBOX32|5.027001||Viu case_169_SBOX32|5.027001||Viu case_16_SBOX32|5.027001||Viu case_170_SBOX32|5.027001||Viu case_171_SBOX32|5.027001||Viu case_172_SBOX32|5.027001||Viu case_173_SBOX32|5.027001||Viu case_174_SBOX32|5.027001||Viu case_175_SBOX32|5.027001||Viu case_176_SBOX32|5.027001||Viu case_177_SBOX32|5.027001||Viu case_178_SBOX32|5.027001||Viu case_179_SBOX32|5.027001||Viu case_17_SBOX32|5.027001||Viu case_180_SBOX32|5.027001||Viu case_181_SBOX32|5.027001||Viu case_182_SBOX32|5.027001||Viu case_183_SBOX32|5.027001||Viu case_184_SBOX32|5.027001||Viu case_185_SBOX32|5.027001||Viu case_186_SBOX32|5.027001||Viu case_187_SBOX32|5.027001||Viu case_188_SBOX32|5.027001||Viu case_189_SBOX32|5.027001||Viu case_18_SBOX32|5.027001||Viu case_190_SBOX32|5.027001||Viu case_191_SBOX32|5.027001||Viu case_192_SBOX32|5.027001||Viu case_193_SBOX32|5.027001||Viu case_194_SBOX32|5.027001||Viu case_195_SBOX32|5.027001||Viu case_196_SBOX32|5.027001||Viu case_197_SBOX32|5.027001||Viu case_198_SBOX32|5.027001||Viu case_199_SBOX32|5.027001||Viu case_19_SBOX32|5.027001||Viu case_1_SBOX32|5.027001||Viu case_200_SBOX32|5.027001||Viu case_201_SBOX32|5.027001||Viu case_202_SBOX32|5.027001||Viu case_203_SBOX32|5.027001||Viu case_204_SBOX32|5.027001||Viu case_205_SBOX32|5.027001||Viu case_206_SBOX32|5.027001||Viu case_207_SBOX32|5.027001||Viu case_208_SBOX32|5.027001||Viu case_209_SBOX32|5.027001||Viu case_20_SBOX32|5.027001||Viu case_210_SBOX32|5.027001||Viu case_211_SBOX32|5.027001||Viu case_212_SBOX32|5.027001||Viu case_213_SBOX32|5.027001||Viu case_214_SBOX32|5.027001||Viu case_215_SBOX32|5.027001||Viu case_216_SBOX32|5.027001||Viu case_217_SBOX32|5.027001||Viu case_218_SBOX32|5.027001||Viu case_219_SBOX32|5.027001||Viu case_21_SBOX32|5.027001||Viu case_220_SBOX32|5.027001||Viu case_221_SBOX32|5.027001||Viu case_222_SBOX32|5.027001||Viu case_223_SBOX32|5.027001||Viu case_224_SBOX32|5.027001||Viu case_225_SBOX32|5.027001||Viu case_226_SBOX32|5.027001||Viu case_227_SBOX32|5.027001||Viu case_228_SBOX32|5.027001||Viu case_229_SBOX32|5.027001||Viu case_22_SBOX32|5.027001||Viu case_230_SBOX32|5.027001||Viu case_231_SBOX32|5.027001||Viu case_232_SBOX32|5.027001||Viu case_233_SBOX32|5.027001||Viu case_234_SBOX32|5.027001||Viu case_235_SBOX32|5.027001||Viu case_236_SBOX32|5.027001||Viu case_237_SBOX32|5.027001||Viu case_238_SBOX32|5.027001||Viu case_239_SBOX32|5.027001||Viu case_23_SBOX32|5.027001||Viu case_240_SBOX32|5.027001||Viu case_241_SBOX32|5.027001||Viu case_242_SBOX32|5.027001||Viu case_243_SBOX32|5.027001||Viu case_244_SBOX32|5.027001||Viu case_245_SBOX32|5.027001||Viu case_246_SBOX32|5.027001||Viu case_247_SBOX32|5.027001||Viu case_248_SBOX32|5.027001||Viu case_249_SBOX32|5.027001||Viu case_24_SBOX32|5.027001||Viu case_250_SBOX32|5.027001||Viu case_251_SBOX32|5.027001||Viu case_252_SBOX32|5.027001||Viu case_253_SBOX32|5.027001||Viu case_254_SBOX32|5.027001||Viu case_255_SBOX32|5.027001||Viu case_256_SBOX32|5.027001||Viu case_25_SBOX32|5.027001||Viu case_26_SBOX32|5.027001||Viu case_27_SBOX32|5.027001||Viu case_28_SBOX32|5.027001||Viu case_29_SBOX32|5.027001||Viu case_2_SBOX32|5.027001||Viu case_30_SBOX32|5.027001||Viu case_31_SBOX32|5.027001||Viu case_32_SBOX32|5.027001||Viu case_33_SBOX32|5.027001||Viu case_34_SBOX32|5.027001||Viu case_35_SBOX32|5.027001||Viu case_36_SBOX32|5.027001||Viu case_37_SBOX32|5.027001||Viu case_38_SBOX32|5.027001||Viu case_39_SBOX32|5.027001||Viu case_3_SBOX32|5.027001||Viu case_40_SBOX32|5.027001||Viu case_41_SBOX32|5.027001||Viu case_42_SBOX32|5.027001||Viu case_43_SBOX32|5.027001||Viu case_44_SBOX32|5.027001||Viu case_45_SBOX32|5.027001||Viu case_46_SBOX32|5.027001||Viu case_47_SBOX32|5.027001||Viu case_48_SBOX32|5.027001||Viu case_49_SBOX32|5.027001||Viu case_4_SBOX32|5.027001||Viu case_50_SBOX32|5.027001||Viu case_51_SBOX32|5.027001||Viu case_52_SBOX32|5.027001||Viu case_53_SBOX32|5.027001||Viu case_54_SBOX32|5.027001||Viu case_55_SBOX32|5.027001||Viu case_56_SBOX32|5.027001||Viu case_57_SBOX32|5.027001||Viu case_58_SBOX32|5.027001||Viu case_59_SBOX32|5.027001||Viu case_5_SBOX32|5.027001||Viu case_60_SBOX32|5.027001||Viu case_61_SBOX32|5.027001||Viu case_62_SBOX32|5.027001||Viu case_63_SBOX32|5.027001||Viu case_64_SBOX32|5.027001||Viu case_65_SBOX32|5.027001||Viu case_66_SBOX32|5.027001||Viu case_67_SBOX32|5.027001||Viu case_68_SBOX32|5.027001||Viu case_69_SBOX32|5.027001||Viu case_6_SBOX32|5.027001||Viu case_70_SBOX32|5.027001||Viu case_71_SBOX32|5.027001||Viu case_72_SBOX32|5.027001||Viu case_73_SBOX32|5.027001||Viu case_74_SBOX32|5.027001||Viu case_75_SBOX32|5.027001||Viu case_76_SBOX32|5.027001||Viu case_77_SBOX32|5.027001||Viu case_78_SBOX32|5.027001||Viu case_79_SBOX32|5.027001||Viu case_7_SBOX32|5.027001||Viu case_80_SBOX32|5.027001||Viu case_81_SBOX32|5.027001||Viu case_82_SBOX32|5.027001||Viu case_83_SBOX32|5.027001||Viu case_84_SBOX32|5.027001||Viu case_85_SBOX32|5.027001||Viu case_86_SBOX32|5.027001||Viu case_87_SBOX32|5.027001||Viu case_88_SBOX32|5.027001||Viu case_89_SBOX32|5.027001||Viu case_8_SBOX32|5.027001||Viu case_90_SBOX32|5.027001||Viu case_91_SBOX32|5.027001||Viu case_92_SBOX32|5.027001||Viu case_93_SBOX32|5.027001||Viu case_94_SBOX32|5.027001||Viu case_95_SBOX32|5.027001||Viu case_96_SBOX32|5.027001||Viu case_97_SBOX32|5.027001||Viu case_98_SBOX32|5.027001||Viu case_99_SBOX32|5.027001||Viu case_9_SBOX32|5.027001||Viu CASE_STD_PMMOD_FLAGS_PARSE_SET|5.009005||Viu CASTFLAGS|5.003007|5.003007|Vn cast_i32|5.006000||cVnu cast_iv|5.006000||cVnu CASTNEGFLOAT|5.003007|5.003007|Vn cast_ulong|5.003007||cVnu cast_uv|5.006000||cVnu CAT2|5.003007|5.003007|Vn CATCH_GET|5.004000||Viu CATCH_SET|5.004000||Viu category_name|5.027008||Vniu cBINOP|5.003007||Viu cBINOPo|5.004005||Viu cBINOPx|5.006000||Viu cBOOL|5.013000|5.003007|p cCOP|5.003007||Viu cCOPo|5.004005||Viu cCOPx|5.006000||Viu C_FAC_POSIX|5.009003||Viu cGVOP_gv|5.006000||Viu cGVOPo_gv|5.006000||Viu cGVOPx_gv|5.006000||Viu change_engine_size|5.029004||Viu CHANGE_MULTICALL_FLAGS|5.018000||Viu CHARBITS|5.011002|5.011002|Vn CHARSET_PAT_MODS|5.013010||Viu chdir|5.005000||Viu checkcomma|5.003007||Viu check_end_shift|5.009005||Viu check_locale_boundary_crossing|5.015006||Viu CHECK_MALLOC_TAINT|5.008001||Viu CHECK_MALLOC_TOO_LATE_FOR|5.008001||Viu check_offset_max|5.005000||Viu check_offset_min|5.005000||Viu check_substr|5.005000||Viu check_type_and_open|5.009003||Viu check_uni|5.003007||Viu check_utf8|5.008000||Viu check_utf8_print|5.013009||Viu child_offset_bits|5.009003||Viu chmod|5.005000||Viu chsize|5.005000||Viu ckDEAD|5.006000||Viu ck_entersub_args_core|||iu ck_entersub_args_list|5.013006|5.013006| ck_entersub_args_proto|5.013006|5.013006| ck_entersub_args_proto_or_list|5.013006|5.013006| ckWARN2|5.006000|5.003007|p ckWARN2_d|5.006000|5.003007|p ckWARN3|5.007003|5.003007|p ckWARN3_d|5.007003|5.003007|p ckWARN4|5.007003|5.003007|p ckWARN4_d|5.007003|5.003007|p ckWARN|5.006000|5.003007|p ckwarn_common|5.011001||Viu ckwarn|||cu ckWARN_d|5.006000|5.003007|p ckwarn_d|||cu ck_warner|5.011001||pvV ck_warner_d|5.011001||pvV CLANG_DIAG_IGNORE|5.023006||Viu CLANG_DIAG_IGNORE_DECL|5.027007||Viu CLANG_DIAG_IGNORE_STMT|5.027007||Viu CLANG_DIAG_PRAGMA|5.023006||Viu CLANG_DIAG_RESTORE|5.023006||Viu CLANG_DIAG_RESTORE_DECL|5.027007||Viu CLANG_DIAG_RESTORE_STMT|5.027007||Viu CLASS||5.003007| CLEAR_ARGARRAY|5.006000||Viu clear_defarray|5.023008|5.023008|u clearerr|5.003007||Viu CLEAR_ERRSV|5.025007|5.025007| CLEARFEATUREBITS|5.031006||Viu clear_placeholders|5.009004||xViu clear_special_blocks|5.021003||Viu cLISTOP|5.003007||Viu cLISTOPo|5.004005||Viu cLISTOPx|5.006000||Viu cLOGOP|5.003007||Viu cLOGOPo|5.004005||Viu cLOGOPx|5.006000||Viu CLONEf_CLONE_HOST|5.007002||Viu CLONEf_COPY_STACKS|5.007001||Viu CLONEf_JOIN_IN|5.008001||Viu CLONEf_KEEP_PTR_TABLE|5.007001||Viu clone_params_del|||nu clone_params_new|||nu cLOOP|5.003007||Viu cLOOPo|5.004005||Viu cLOOPx|5.006000||Viu CLOSE|5.003007||Viu close|5.005000||Viu closedir|5.005000||Viu closest_cop|5.007002||Viu CLOSE_t8|5.035004||Viu CLOSE_t8_p8|5.033003||Viu CLOSE_t8_pb|5.033003||Viu CLOSE_tb|5.035004||Viu CLOSE_tb_p8|5.033003||Viu CLOSE_tb_pb|5.033003||Viu CLUMP_2IV|5.006000||Viu CLUMP_2UV|5.006000||Viu CLUMP|5.006000||Viu CLUMP_t8|5.035004||Viu CLUMP_t8_p8|5.033003||Viu CLUMP_t8_pb|5.033003||Viu CLUMP_tb|5.035004||Viu CLUMP_tb_p8|5.033003||Viu CLUMP_tb_pb|5.033003||Viu cMETHOPx|5.021005||Viu cMETHOPx_meth|5.021005||Viu cMETHOPx_rclass|5.021007||Viu cmpchain_extend|5.031011||Viu cmpchain_finish|5.031011||Viu cmpchain_start|5.031011||Viu cmp_desc|5.031011||Viu cmp_locale_desc|5.031011||Viu cntrl_to_mnemonic|5.021004||cVniu CODESET|5.027010||Viu COMBINING_DOT_ABOVE_UTF8|5.029008||Viu COMBINING_GRAVE_ACCENT_UTF8|5.017004||Viu COMMIT|5.009005||Viu COMMIT_next|5.009005||Viu COMMIT_next_fail|5.009005||Viu COMMIT_next_fail_t8|5.035004||Viu COMMIT_next_fail_t8_p8|5.033003||Viu COMMIT_next_fail_t8_pb|5.033003||Viu COMMIT_next_fail_tb|5.035004||Viu COMMIT_next_fail_tb_p8|5.033003||Viu COMMIT_next_fail_tb_pb|5.033003||Viu COMMIT_next_t8|5.035004||Viu COMMIT_next_t8_p8|5.033003||Viu COMMIT_next_t8_pb|5.033003||Viu COMMIT_next_tb|5.035004||Viu COMMIT_next_tb_p8|5.033003||Viu COMMIT_next_tb_pb|5.033003||Viu COMMIT_t8|5.035004||Viu COMMIT_t8_p8|5.033003||Viu COMMIT_t8_pb|5.033003||Viu COMMIT_tb|5.035004||Viu COMMIT_tb_p8|5.033003||Viu COMMIT_tb_pb|5.033003||Viu compile_wildcard|5.031010||Viu compute_EXACTish|5.017003||Vniu COND_BROADCAST|5.005000||Viu COND_DESTROY|5.005000||Viu COND_INIT|5.005000||Viu COND_SIGNAL|5.005000||Viu COND_WAIT|5.005000||Viu connect|5.005000||Viu construct_ahocorasick_from_trie|5.021001||Viu CONTINUE_PAT_MOD|5.009005||Viu cop_fetch_label|5.031004|5.031004|x CopFILE|5.006000|5.003007|p CopFILEAV|5.006000|5.003007|p CopFILEAVn|5.035006|5.035006| cop_file_avn|5.035006||cVu CopFILEAVx|5.009003||Viu CopFILE_free|5.007003||Viu CopFILEGV|5.006000|5.003007|p CopFILEGV_set|5.006000|5.003007|p CopFILE_set|5.006000|5.003007|p CopFILE_setn|5.009005||Viu CopFILESV|5.006000|5.003007|p cop_free|5.006000||Viu cophh_2hv|5.013007|5.013007|x cophh_copy|5.013007|5.013007|x cophh_delete_pv|5.013007|5.013007|x cophh_delete_pvn|5.013007|5.013007|x cophh_delete_pvs|5.013007|5.013007|x cophh_delete_sv|5.013007|5.013007|x COPHH_EXISTS|5.033008||Viu cophh_exists_pv|5.033008|5.033008|x cophh_exists_pvn|5.033008|5.033008|x cophh_exists_pvs|5.033008|5.033008|x cophh_exists_sv|5.033008|5.033008|x cophh_fetch_pv|5.013007|5.013007|x cophh_fetch_pvn|5.013007|5.013007|x cophh_fetch_pvs|5.013007|5.013007|x cophh_fetch_sv|5.013007|5.013007|x cophh_free|5.013007|5.013007|x COPHH_KEY_UTF8|5.013007|5.013007| cophh_new_empty|5.013007|5.013007|x cophh_store_pv|5.013007|5.013007|x cophh_store_pvn|5.013007|5.013007|x cophh_store_pvs|5.013007|5.013007|x cophh_store_sv|5.013007|5.013007|x CopHINTHASH_get|5.013007||Viu CopHINTHASH_set|5.013007||Viu cop_hints_2hv|5.013007|5.013007| cop_hints_exists_pv|5.033008|5.033008| cop_hints_exists_pvn|5.033008|5.033008| cop_hints_exists_pvs|5.033008|5.033008| cop_hints_exists_sv|5.033008|5.033008| cop_hints_fetch_pv|5.013007|5.013007| cop_hints_fetch_pvn|5.013007|5.013007| cop_hints_fetch_pvs|5.013007|5.013007| cop_hints_fetch_sv|5.013007|5.013007| CopHINTS_get|5.009004||Viu CopHINTS_set|5.009004||Viu CopLABEL|5.009005|5.009005| CopLABEL_alloc|5.009005||Viu CopLABEL_len|5.016000|5.016000| CopLABEL_len_flags|5.016000|5.016000| CopLINE|5.006000|5.006000| CopLINE_dec|5.006000||Viu CopLINE_inc|5.006000||Viu CopLINE_set|5.006000||Viu COP_SEQMAX_INC|5.021006||Viu COP_SEQ_RANGE_HIGH|5.009005||Viu COP_SEQ_RANGE_LOW|5.009005||Viu CopSTASH|5.006000|5.003007|p CopSTASH_eq|5.006000|5.003007|p CopSTASH_ne|5.006000||Viu CopSTASHPV|5.006000|5.003007|p CopSTASHPV_set|5.017001|5.017001|p CopSTASH_set|5.006000|5.003007|p cop_store_label|5.031004|5.031004|x Copy|5.003007|5.003007| CopyD|5.009002|5.003007|p copy_length|||Viu core_prototype|5.015002||Vi coresub_op|5.015003||Viu CowREFCNT|5.017007||Viu cPADOP|5.006000||Viu cPADOPo|5.006000||Viu cPADOPx|5.006000||Viu CPERLarg|5.005000||Viu CPERLscope|5.005000|5.003007|pdV cPMOP|5.003007||Viu cPMOPo|5.004005||Viu cPMOPx|5.006000||Viu CPPLAST|5.006000|5.006000|Vn CPPMINUS|5.003007|5.003007|Vn CPPRUN|5.006000|5.006000|Vn CPPSTDIN|5.003007|5.003007|Vn cPVOP|5.003007||Viu cPVOPo|5.004005||Viu cPVOPx|5.006000||Viu create_eval_scope|5.009004||xViu CR_NATIVE|5.019004||Viu CRNCYSTR|5.027010||Viu croak|5.003007||vV croak_caller|5.025004||vVniu croak_memory_wrap|5.019003||pcVnu croak_nocontext|5.006000||pvVn croak_no_mem|5.017006||Vniu croak_no_modify|5.013003|5.003007|pn croak_popstack|5.017008||cVniu croak_sv|5.013001|5.003007|p croak_xs_usage|5.010001|5.003007|pn cr_textfilter|5.006000||Viu crypt|5.009000||Viu CRYPT_R_PROTO|5.008000|5.008000|Vn CSH|5.003007|5.003007|Vn csighandler1|5.031007||cVnu csighandler3|5.031007||cVnu csighandler|5.008001||cVnu cSVOP|5.003007||Viu cSVOPo|5.004005||Viu cSVOPo_sv|5.006000||Viu cSVOP_sv|5.006000||Viu cSVOPx|5.006000||Viu cSVOPx_sv|5.006000||Viu cSVOPx_svp|5.006000||Viu ctermid|5.009000||Viu CTERMID_R_PROTO|5.008000|5.008000|Vn ctime|5.009000||Viu CTIME_R_PROTO|5.008000|5.008000|Vn Ctl|5.003007||Viu CTYPE256|5.003007||Viu cUNOP|5.003007||Viu cUNOP_AUX|5.021007||Viu cUNOP_AUXo|5.021007||Viu cUNOP_AUXx|5.021007||Viu cUNOPo|5.004005||Viu cUNOPx|5.006000||Viu CURLY|5.003007||Viu CURLY_B_max|5.009005||Viu CURLY_B_max_fail|5.009005||Viu CURLY_B_max_fail_t8|5.035004||Viu CURLY_B_max_fail_t8_p8|5.033003||Viu CURLY_B_max_fail_t8_pb|5.033003||Viu CURLY_B_max_fail_tb|5.035004||Viu CURLY_B_max_fail_tb_p8|5.033003||Viu CURLY_B_max_fail_tb_pb|5.033003||Viu CURLY_B_max_t8|5.035004||Viu CURLY_B_max_t8_p8|5.033003||Viu CURLY_B_max_t8_pb|5.033003||Viu CURLY_B_max_tb|5.035004||Viu CURLY_B_max_tb_p8|5.033003||Viu CURLY_B_max_tb_pb|5.033003||Viu CURLY_B_min|5.009005||Viu CURLY_B_min_fail|5.009005||Viu CURLY_B_min_fail_t8|5.035004||Viu CURLY_B_min_fail_t8_p8|5.033003||Viu CURLY_B_min_fail_t8_pb|5.033003||Viu CURLY_B_min_fail_tb|5.035004||Viu CURLY_B_min_fail_tb_p8|5.033003||Viu CURLY_B_min_fail_tb_pb|5.033003||Viu CURLY_B_min_t8|5.035004||Viu CURLY_B_min_t8_p8|5.033003||Viu CURLY_B_min_t8_pb|5.033003||Viu CURLY_B_min_tb|5.035004||Viu CURLY_B_min_tb_p8|5.033003||Viu CURLY_B_min_tb_pb|5.033003||Viu CURLYM|5.005000||Viu CURLYM_A|5.009005||Viu CURLYM_A_fail|5.009005||Viu CURLYM_A_fail_t8|5.035004||Viu CURLYM_A_fail_t8_p8|5.033003||Viu CURLYM_A_fail_t8_pb|5.033003||Viu CURLYM_A_fail_tb|5.035004||Viu CURLYM_A_fail_tb_p8|5.033003||Viu CURLYM_A_fail_tb_pb|5.033003||Viu CURLYM_A_t8|5.035004||Viu CURLYM_A_t8_p8|5.033003||Viu CURLYM_A_t8_pb|5.033003||Viu CURLYM_A_tb|5.035004||Viu CURLYM_A_tb_p8|5.033003||Viu CURLYM_A_tb_pb|5.033003||Viu CURLYM_B|5.009005||Viu CURLYM_B_fail|5.009005||Viu CURLYM_B_fail_t8|5.035004||Viu CURLYM_B_fail_t8_p8|5.033003||Viu CURLYM_B_fail_t8_pb|5.033003||Viu CURLYM_B_fail_tb|5.035004||Viu CURLYM_B_fail_tb_p8|5.033003||Viu CURLYM_B_fail_tb_pb|5.033003||Viu CURLYM_B_t8|5.035004||Viu CURLYM_B_t8_p8|5.033003||Viu CURLYM_B_t8_pb|5.033003||Viu CURLYM_B_tb|5.035004||Viu CURLYM_B_tb_p8|5.033003||Viu CURLYM_B_tb_pb|5.033003||Viu CURLYM_t8|5.035004||Viu CURLYM_t8_p8|5.033003||Viu CURLYM_t8_pb|5.033003||Viu CURLYM_tb|5.035004||Viu CURLYM_tb_p8|5.033003||Viu CURLYM_tb_pb|5.033003||Viu CURLYN|5.005000||Viu CURLYN_t8|5.035004||Viu CURLYN_t8_p8|5.033003||Viu CURLYN_t8_pb|5.033003||Viu CURLYN_tb|5.035004||Viu CURLYN_tb_p8|5.033003||Viu CURLYN_tb_pb|5.033003||Viu CURLY_t8|5.035004||Viu CURLY_t8_p8|5.033003||Viu CURLY_t8_pb|5.033003||Viu CURLY_tb|5.035004||Viu CURLY_tb_p8|5.033003||Viu CURLY_tb_pb|5.033003||Viu CURLYX|5.003007||Viu CURLYX_end|5.009005||Viu CURLYX_end_fail|5.009005||Viu CURLYX_end_fail_t8|5.035004||Viu CURLYX_end_fail_t8_p8|5.033003||Viu CURLYX_end_fail_t8_pb|5.033003||Viu CURLYX_end_fail_tb|5.035004||Viu CURLYX_end_fail_tb_p8|5.033003||Viu CURLYX_end_fail_tb_pb|5.033003||Viu CURLYX_end_t8|5.035004||Viu CURLYX_end_t8_p8|5.033003||Viu CURLYX_end_t8_pb|5.033003||Viu CURLYX_end_tb|5.035004||Viu CURLYX_end_tb_p8|5.033003||Viu CURLYX_end_tb_pb|5.033003||Viu CURLYX_t8|5.035004||Viu CURLYX_t8_p8|5.033003||Viu CURLYX_t8_pb|5.033003||Viu CURLYX_tb|5.035004||Viu CURLYX_tb_p8|5.033003||Viu CURLYX_tb_pb|5.033003||Viu CURRENT_FEATURE_BUNDLE|5.015007||Viu CURRENT_HINTS|5.015007||Viu current_re_engine|5.017001||cViu curse|5.013009||Viu custom_op_desc|5.007003|5.007003|d custom_op_get_field|5.019006||cViu custom_op_name|5.007003|5.007003|d custom_op_register||| CUTGROUP|5.009005||Viu CUTGROUP_next|5.009005||Viu CUTGROUP_next_fail|5.009005||Viu CUTGROUP_next_fail_t8|5.035004||Viu CUTGROUP_next_fail_t8_p8|5.033003||Viu CUTGROUP_next_fail_t8_pb|5.033003||Viu CUTGROUP_next_fail_tb|5.035004||Viu CUTGROUP_next_fail_tb_p8|5.033003||Viu CUTGROUP_next_fail_tb_pb|5.033003||Viu CUTGROUP_next_t8|5.035004||Viu CUTGROUP_next_t8_p8|5.033003||Viu CUTGROUP_next_t8_pb|5.033003||Viu CUTGROUP_next_tb|5.035004||Viu CUTGROUP_next_tb_p8|5.033003||Viu CUTGROUP_next_tb_pb|5.033003||Viu CUTGROUP_t8|5.035004||Viu CUTGROUP_t8_p8|5.033003||Viu CUTGROUP_t8_pb|5.033003||Viu CUTGROUP_tb|5.035004||Viu CUTGROUP_tb_p8|5.033003||Viu CUTGROUP_tb_pb|5.033003||Viu CvANON|5.003007||Viu CvANONCONST|5.021008||Viu CvANONCONST_off|5.021008||Viu CvANONCONST_on|5.021008||Viu CvANON_off|5.003007||Viu CvANON_on|5.003007||Viu CvAUTOLOAD|5.015004||Viu CvAUTOLOAD_off|5.015004||Viu CvAUTOLOAD_on|5.015004||Viu cv_ckproto|5.009004||Viu cv_ckproto_len_flags|5.015004||xcViu CvCLONE|5.003007||Viu cv_clone|5.015001|5.015001| CvCLONED|5.003007||Viu CvCLONED_off|5.003007||Viu CvCLONED_on|5.003007||Viu cv_clone_into|5.017004||Viu CvCLONE_off|5.003007||Viu CvCLONE_on|5.003007||Viu CvCONST|5.007001||Viu CvCONST_off|5.007001||Viu CvCONST_on|5.007001||Viu cv_const_sv|5.003007|5.003007|n cv_const_sv_or_av|5.019003||Vniu CvCVGV_RC|5.013003||Viu CvCVGV_RC_off|5.013003||Viu CvCVGV_RC_on|5.013003||Viu CvDEPTH|5.003007|5.003007|nu CvDEPTHunsafe|5.021006||Viu cv_dump|5.006000||Vi CvDYNFILE|5.015002||Viu CvDYNFILE_off|5.015002||Viu CvDYNFILE_on|5.015002||Viu CvEVAL|5.005003||Viu CvEVAL_off|5.005003||Viu CvEVAL_on|5.005003||Viu CVf_ANON|5.003007||Viu CVf_ANONCONST|5.021008||Viu CVf_AUTOLOAD|5.015004||Viu CVf_BUILTIN_ATTRS|5.008000||Viu CVf_CLONE|5.003007||Viu CVf_CLONED|5.003007||Viu CVf_CONST|5.007001||Viu CVf_CVGV_RC|5.013003||Viu CVf_DYNFILE|5.015002||Viu CVf_HASEVAL|5.017002||Viu CvFILE|5.006000||Viu CvFILEGV|5.003007||Viu CvFILE_set_from_cop|5.007002||Viu CVf_ISXSUB|5.009004||Viu CvFLAGS|5.003007||Viu CVf_LEXICAL|5.021004||Viu CVf_LVALUE|5.006000||Viu CVf_METHOD|5.005000||Viu CVf_NAMED|5.017004||Viu CVf_NODEBUG|5.004000||Viu cv_forget_slab|5.017002||Vi CVf_SIGNATURE|5.035009||Viu CVf_SLABBED|5.017002||Viu CVf_UNIQUE|5.004000||Viu CVf_WEAKOUTSIDE|5.008001||Viu cv_get_call_checker|5.013006|5.013006| cv_get_call_checker_flags|5.027003|5.027003| CvGV|5.003007|5.003007| cvgv_from_hek|||ciu cvgv_set|5.013003||cViu CvGV_set|5.013003||Viu CvHASEVAL|5.017002||Viu CvHASEVAL_off|5.017002||Viu CvHASEVAL_on|5.017002||Viu CvHASGV|5.021004||Viu CvHSCXT|5.021006||Viu CvISXSUB|5.009004||Viu CvISXSUB_off|5.009004||Viu CvISXSUB_on|5.009004||Viu CvLEXICAL|5.021004||Viu CvLEXICAL_off|5.021004||Viu CvLEXICAL_on|5.021004||Viu CvLVALUE|5.006000||Viu CvLVALUE_off|5.006000||Viu CvLVALUE_on|5.006000||Viu CvMETHOD|5.005000||Viu CvMETHOD_off|5.005000||Viu CvMETHOD_on|5.005000||Viu cv_name|5.021005|5.021005| CvNAMED|5.017004||Viu CvNAMED_off|5.017004||Viu CvNAMED_on|5.017004||Viu CvNAME_HEK_set|5.017004||Viu CV_NAME_NOTQUAL|5.021005|5.021005| CvNODEBUG|5.004000||Viu CvNODEBUG_off|5.004000||Viu CvNODEBUG_on|5.004000||Viu CvOUTSIDE|5.003007||Viu CvOUTSIDE_SEQ|5.008001||Viu CvPADLIST|5.008001|5.008001|x CvPADLIST_set|5.021006||Viu CvPROTO|5.015004||Viu CvPROTOLEN|5.015004||Viu CvROOT|5.003007||Viu cv_set_call_checker|5.013006|5.013006| cv_set_call_checker_flags|5.021004|5.021004| CvSIGNATURE|5.035009||Viu CvSIGNATURE_off|5.035009||Viu CvSIGNATURE_on|5.035009||Viu CvSLABBED|5.017002||Viu CvSLABBED_off|5.017002||Viu CvSLABBED_on|5.017002||Viu CvSPECIAL|5.005003||Viu CvSPECIAL_off|5.005003||Viu CvSPECIAL_on|5.005003||Viu CvSTART|5.003007||Viu CvSTASH|5.003007|5.003007| cvstash_set|5.013007||cViu CvSTASH_set|5.013007||Viu cv_undef|5.003007|5.003007| cv_undef_flags|5.021004||Viu CV_UNDEF_KEEP_NAME|5.021004||Viu CvUNIQUE|5.004000||Viu CvUNIQUE_off|5.004000||Viu CvUNIQUE_on|5.004000||Viu CvWEAKOUTSIDE|5.008001||Vi CvWEAKOUTSIDE_off|5.008001||Viu CvWEAKOUTSIDE_on|5.008001||Viu CvXSUB|5.003007||Viu CvXSUBANY|5.003007||Viu CX_CUR|5.023008||Viu CX_CURPAD_SAVE|5.008001||Vi CX_CURPAD_SV|5.008001||Vi CX_DEBUG|5.023008||Viu cx_dump|5.003007||cVu cx_dup|5.006000||cVu CxEVALBLOCK|5.033007||Viu CxEVAL_TXT_REFCNTED|5.025007||Viu CxFOREACH|5.009003||Viu CxHASARGS|5.010001||Viu cxinc|5.003007||cVu CXINC|5.003007||Viu CxITERVAR|5.006000||Viu CxLABEL|5.010001||Viu CxLABEL_len|5.016000||Viu CxLABEL_len_flags|5.016000||Viu CX_LEAVE_SCOPE|5.023008||Viu CxLVAL|5.010001||Viu CxMULTICALL|5.009003||Viu CxOLD_IN_EVAL|5.010001||Viu CxOLD_OP_TYPE|5.010001||Viu CxONCE|5.010001||Viu CxPADLOOP|5.006000||Viu CXp_EVALBLOCK|5.033007||Viu CXp_FINALLY|5.035008||Viu CXp_FOR_DEF|5.027008||Viu CXp_FOR_GV|5.023008||Viu CXp_FOR_LVREF|5.021005||Viu CXp_FOR_PAD|5.023008||Viu CXp_HASARGS|5.011000||Viu CXp_MULTICALL|5.009003||Viu CXp_ONCE|5.011000||Viu CX_POP|5.023008||Viu cx_popblock|5.023008||xcVu cx_popeval|5.023008||xcVu cx_popformat|5.023008||xcVu cx_popgiven|5.027008||xcVu cx_poploop|5.023008||xcVu CX_POP_SAVEARRAY|5.023008||Viu cx_popsub|5.023008||xcVu cx_popsub_args|5.023008||xcVu cx_popsub_common|5.023008||xcVu CX_POPSUBST|5.023008||Viu cx_popwhen|5.027008||xcVu CXp_REAL|5.005003||Viu CXp_SUB_RE|5.018000||Viu CXp_SUB_RE_FAKE|5.018000||Viu CXp_TRY|5.033007||Viu CXp_TRYBLOCK|5.006000||Viu cx_pushblock|5.023008||xcVu cx_pusheval|5.023008||xcVu cx_pushformat|5.023008||xcVu cx_pushgiven|5.027008||xcVu cx_pushloop_for|5.023008||xcVu cx_pushloop_plain|5.023008||xcVu cx_pushsub|5.023008||xcVu CX_PUSHSUB_GET_LVALUE_MASK|5.023008||Viu CX_PUSHSUBST|5.023008||Viu cx_pushtry|5.033007||xcVu cx_pushwhen|5.027008||xcVu CxREALEVAL|5.005003||Viu cxstack|5.005000||Viu cxstack_ix|5.005000||Viu cxstack_max|5.005000||Viu CXt_BLOCK|5.003007||Viu CXt_DEFER|5.035004||Viu CXt_EVAL|5.003007||Viu CXt_FORMAT|5.006000||Viu CXt_GIVEN|5.027008||Viu CXt_LOOP_ARY|5.023008||Viu CXt_LOOP_LAZYIV|5.011000||Viu CXt_LOOP_LAZYSV|5.011000||Viu CXt_LOOP_LIST|5.023008||Viu CXt_LOOP_PLAIN|5.011000||Viu CXt_NULL|5.003007||Viu cx_topblock|5.023008||xcVu CxTRY|5.033007||Viu CxTRYBLOCK|5.006000||Viu CXt_SUB|5.003007||Viu CXt_SUBST|5.003007||Viu CXt_WHEN|5.027008||Viu CxTYPE|5.005003||Viu cx_type|5.009005||Viu CxTYPE_is_LOOP|5.011000||Viu CXTYPEMASK|5.005003||Viu dATARGET|5.003007||Viu dAX|5.007002|5.003007|p dAXMARK|5.009003|5.003007|p DAY_1|5.027010||Viu DAY_2|5.027010||Viu DAY_3|5.027010||Viu DAY_4|5.027010||Viu DAY_5|5.027010||Viu DAY_6|5.027010||Viu DAY_7|5.027010||Viu DB_Hash_t|5.003007|5.003007|Vn DBM_ckFilter|5.008001||Viu DBM_setFilter|5.008001||Viu DB_Prefix_t|5.003007|5.003007|Vn DBVARMG_COUNT|5.021005||Viu DBVARMG_SIGNAL|5.021005||Viu DBVARMG_SINGLE|5.021005||Viu DBVARMG_TRACE|5.021005||Viu DB_VERSION_MAJOR_CFG|5.007002|5.007002|Vn DB_VERSION_MINOR_CFG|5.007002|5.007002|Vn DB_VERSION_PATCH_CFG|5.007002|5.007002|Vn deb|5.003007||vVu deb_curcv|5.007002||Viu deb_nocontext|5.006000||vVnu debop|5.005000|5.005000|u debprof|5.005000||Viu debprofdump|5.005000|5.005000|u debstack|5.007003|5.007003|u deb_stack_all|5.008001||Viu deb_stack_n|5.008001||Viu debstackptrs|5.007003|5.007003|u DEBUG|5.003007||Viu DEBUG_A|5.009001||Viu DEBUG_A_FLAG|5.009001||Viu DEBUG_A_TEST|5.009001||Viu DEBUG_B|5.011000||Viu DEBUG_B_FLAG|5.011000||Viu DEBUG_BOTH_FLAGS_TEST|5.033007||Viu DEBUG_B_TEST|5.011000||Viu DEBUG_BUFFERS_r|5.009005||Viu DEBUG_c|5.003007||Viu DEBUG_C|5.009000||Viu DEBUG_c_FLAG|5.007001||Viu DEBUG_C_FLAG|5.009000||Viu DEBUG_COMPILE_r|5.009002||Viu DEBUG_c_TEST|5.007001||Viu DEBUG_C_TEST|5.009000||Viu DEBUG_D|5.003007||Viu DEBUG_DB_RECURSE_FLAG|5.007001||Viu DEBUG_D_FLAG|5.007001||Viu DEBUG_D_TEST|5.007001||Viu DEBUG_DUMP_PRE_OPTIMIZE_r|5.031004||Viu DEBUG_DUMP_r|5.009004||Viu DEBUG_EXECUTE_r|5.009002||Viu DEBUG_EXTRA_r|5.009004||Viu DEBUG_f|5.003007||Viu DEBUG_f_FLAG|5.007001||Viu DEBUG_FLAGS_r|5.009005||Viu DEBUG_f_TEST|5.007001||Viu DEBUG_GPOS_r|5.011000||Viu DEBUG_i|5.025002||Viu DEBUG_i_FLAG|5.025002||Viu DEBUG_INTUIT_r|5.009004||Viu DEBUG_i_TEST|5.025002||Viu DEBUG_J_FLAG|5.007003||Viu DEBUG_J_TEST|5.007003||Viu DEBUG_l|5.003007||Viu DEBUG_L|5.019009||Viu DEBUG_l_FLAG|5.007001||Viu DEBUG_L_FLAG|5.019009||Viu DEBUG_l_TEST|5.007001||Viu DEBUG_L_TEST|5.019009||Viu DEBUG_Lv|5.023003||Viu DEBUG_Lv_TEST|5.023003||Viu DEBUG_m|5.003007||Viu DEBUG_M|5.027008||Viu DEBUG_MASK|5.007001||Viu DEBUG_MATCH_r|5.009004||Viu DEBUG_m_FLAG|5.007001||Viu DEBUG_M_FLAG|5.027008||Viu DEBUG_m_TEST|5.007001||Viu DEBUG_M_TEST|5.027008||Viu DEBUG_o|5.003007||Viu DEBUG_o_FLAG|5.007001||Viu DEBUG_OPTIMISE_MORE_r|5.009005||Viu DEBUG_OPTIMISE_r|5.009002||Viu DEBUG_o_TEST|5.007001||Viu DEBUG_P|5.003007||Viu DEBUG_p|5.003007||Viu DEBUG_PARSE_r|5.009004||Viu DEBUG_P_FLAG|5.007001||Viu DEBUG_p_FLAG|5.007001||Viu DEBUG_POST_STMTS|5.033008||Viu DEBUG_PRE_STMTS|5.033008||Viu DEBUG_P_TEST|5.007001||Viu DEBUG_p_TEST|5.007001||Viu DEBUG_Pv|5.013008||Viu DEBUG_Pv_TEST|5.013008||Viu DEBUG_q|5.009001||Viu DEBUG_q_FLAG|5.009001||Viu DEBUG_q_TEST|5.009001||Viu DEBUG_r|5.003007||Viu DEBUG_R|5.007001||Viu DEBUG_R_FLAG|5.007001||Viu DEBUG_r_FLAG|5.007001||Viu DEBUG_R_TEST|5.007001||Viu DEBUG_r_TEST|5.007001||Viu DEBUG_s|5.003007||Viu DEBUG_S|5.017002||Viu DEBUG_SBOX32_HASH|5.027001||Viu DEBUG_SCOPE|5.008001||Viu DEBUG_s_FLAG|5.007001||Viu DEBUG_S_FLAG|5.017002||Viu DEBUG_STACK_r|5.009005||Viu debug_start_match|5.009004||Viu DEBUG_STATE_r|5.009004||Viu DEBUG_s_TEST|5.007001||Viu DEBUG_S_TEST|5.017002||Viu DEBUG_t|5.003007||Viu DEBUG_T|5.007001||Viu DEBUG_TEST_r|5.021005||Viu DEBUG_T_FLAG|5.007001||Viu DEBUG_t_FLAG|5.007001||Viu DEBUG_TOP_FLAG|5.007001||Viu DEBUG_TRIE_COMPILE_MORE_r|5.009002||Viu DEBUG_TRIE_COMPILE_r|5.009002||Viu DEBUG_TRIE_EXECUTE_MORE_r|5.009002||Viu DEBUG_TRIE_EXECUTE_r|5.009002||Viu DEBUG_TRIE_r|5.009002||Viu DEBUG_T_TEST|5.007001||Viu DEBUG_t_TEST|5.007001||Viu DEBUG_u|5.003007||Viu DEBUG_U|5.009005||Viu DEBUG_u_FLAG|5.007001||Viu DEBUG_U_FLAG|5.009005||Viu DEBUG_u_TEST|5.007001||Viu DEBUG_U_TEST|5.009005||Viu DEBUG_Uv|5.009005||Viu DEBUG_Uv_TEST|5.009005||Viu DEBUG_v|5.008001||Viu DEBUG_v_FLAG|5.008001||Viu DEBUG_v_TEST|5.008001||Viu DEBUG_X|5.003007||Viu DEBUG_x|5.003007||Viu DEBUG_X_FLAG|5.007001||Viu DEBUG_x_FLAG|5.007001||Viu DEBUG_X_TEST|5.007001||Viu DEBUG_x_TEST|5.007001||Viu DEBUG_Xv|5.008001||Viu DEBUG_Xv_TEST|5.008001||Viu DEBUG_y|5.031007||Viu DEBUG_y_FLAG|5.031007||Viu DEBUG_y_TEST|5.031007||Viu DEBUG_yv|5.031007||Viu DEBUG_yv_TEST|5.031007||Viu DEBUG_ZAPHOD32_HASH|5.027001||Viu DECLARATION_FOR_LC_NUMERIC_MANIPULATION|5.021010|5.021010|p DECLARE_AND_GET_RE_DEBUG_FLAGS|5.031011||Viu DECLARE_AND_GET_RE_DEBUG_FLAGS_NON_REGEX|5.031011||Viu DEFAULT_INC_EXCLUDES_DOT|5.025011|5.025011|Vn DEFAULT_PAT_MOD|5.013006||Viu defelem_target|5.019002||Viu DEFINE_INC_MACROS|5.027006||Viu DEFINEP|5.009005||Viu DEFINEP_t8|5.035004||Viu DEFINEP_t8_p8|5.033003||Viu DEFINEP_t8_pb|5.033003||Viu DEFINEP_tb|5.035004||Viu DEFINEP_tb_p8|5.033003||Viu DEFINEP_tb_pb|5.033003||Viu DEFSV|5.004005|5.003007|p DEFSV_set|5.010001|5.003007|p del_body_by_type|||Viu delete_eval_scope|5.009004||xViu delimcpy|5.004000|5.004000|n delimcpy_no_escape|5.025005||cVni DEL_NATIVE|5.017010||Viu del_sv|5.005000||Viu DEPENDS_PAT_MOD|5.013009||Viu DEPENDS_PAT_MODS|5.013009||Viu deprecate|5.011001||Viu deprecate_disappears_in|5.025009||Viu deprecate_fatal_in|5.025009||Viu despatch_signals|5.007001||cVu destroy_matcher|5.027008||Viu DETACH|5.005000||Viu dEXT|5.003007||Viu dEXTCONST|5.004000||Viu DFA_RETURN_FAILURE|5.035004||Viu DFA_RETURN_SUCCESS|5.035004||Viu DFA_TEASE_APART_FF|5.035004||Viu D_FMT|5.027010||Viu DIE|5.003007||Viu die|5.003007||vV die_nocontext|5.006000||vVn die_sv|5.013001|5.003007|p die_unwind|5.013001||Viu Direntry_t|5.003007|5.003007|Vn dirp_dup|5.013007|5.013007|u dITEMS|5.007002|5.003007|p div128|5.005000||Viu dJMPENV|5.004000||Viu djSP|5.004005||Vi dMARK|5.003007|5.003007| DM_ARRAY_ISA|5.013002||Viu DM_DELAY|5.003007||Viu DM_EGID|5.003007||Viu DM_EUID|5.003007||Viu DM_GID|5.003007||Viu DM_RGID|5.003007||Viu DM_RUID|5.003007||Viu DM_UID|5.003007||Viu dMULTICALL|5.009003|5.009003| dMY_CXT|5.009000|5.009000|p dMY_CXT_INTERP|5.009003||Viu dMY_CXT_SV|5.007003|5.003007|pV dNOOP|5.006000|5.003007|p do_aexec|5.009003||Viu do_aexec5|5.006000||Viu do_aspawn|5.008000||Vu do_binmode|5.004005|5.004005|du docatch|5.005000||Vi do_chomp|5.003007||Viu do_close|5.003007|5.003007|u do_delete_local|5.011000||Viu do_dump_pad|5.008001||Vi do_eof|5.003007||Viu does_utf8_overflow|5.025006||Vniu doeval_compile|5.023008||Viu do_exec3|5.006000||Viu do_exec|5.009003||Viu dofile|5.005003||Viu dofindlabel|5.003007||Viu doform|5.005000||Viu do_gv_dump|5.006000||cVu do_gvgv_dump|5.006000||cVu do_hv_dump|5.006000||cVu doing_taint|5.008001||cVnu DOINIT|5.003007||Viu do_ipcctl|5.003007||Viu do_ipcget|5.003007||Viu do_join|5.003007|5.003007|u do_magic_dump|5.006000||cVu do_msgrcv|5.003007||Viu do_msgsnd|5.003007||Viu do_ncmp|5.015001||Viu do_oddball|5.006000||Viu dooneliner|5.006000||Viu do_op_dump|5.006000||cVu do_open|5.003007|5.003007|u do_open6|5.019010||xViu do_open9|5.006000|5.006000|du do_openn|5.007001|5.007001|u doopen_pm|5.008001||Viu do_open_raw|5.019010||xViu doparseform|5.005000||Viu do_pmop_dump|5.006000||cVu dopoptoeval|5.003007||Viu dopoptogivenfor|5.027008||Viu dopoptolabel|5.005000||Viu dopoptoloop|5.005000||Viu dopoptosub_at|5.005000||Viu dopoptowhen|5.027008||Viu do_print|5.003007||Viu do_readline|5.003007||Viu doref|5.009003|5.009003|u dORIGMARK|5.003007|5.003007| do_seek|5.003007||Viu do_semop|5.003007||Viu do_shmio|5.003007||Viu DOSISH|5.003007||Viu do_smartmatch|5.027008||Viu do_spawn|5.008000||Vu do_spawn_nowait|5.008000||Vu do_sprintf|5.003007|5.003007|u do_sv_dump|5.006000||cVu do_sysseek|5.004000||Viu do_tell|5.003007||Viu do_trans|5.003007||Viu do_trans_complex|5.006001||Viu do_trans_count|5.006001||Viu do_trans_count_invmap|5.031006||Viu do_trans_invmap|5.031006||Viu do_trans_simple|5.006001||Viu DOUBLE_BIG_ENDIAN|5.021009||Viu DOUBLE_HAS_INF|5.025003|5.025003|Vn DOUBLE_HAS_NAN|5.025003|5.025003|Vn DOUBLE_HAS_NEGATIVE_ZERO|5.025007|5.025007|Vn DOUBLE_HAS_SUBNORMALS|5.025007|5.025007|Vn DOUBLEINFBYTES|5.023000|5.023000|Vn DOUBLE_IS_CRAY_SINGLE_64_BIT|5.025006|5.025006|Vn DOUBLE_IS_IBM_DOUBLE_64_BIT|5.025006|5.025006|Vn DOUBLE_IS_IBM_SINGLE_32_BIT|5.025006|5.025006|Vn DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN|5.021006|5.021006|Vn DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN|5.021006|5.021006|Vn DOUBLE_IS_IEEE_754_32_BIT_BIG_ENDIAN|5.021006|5.021006|Vn DOUBLE_IS_IEEE_754_32_BIT_LITTLE_ENDIAN|5.021006|5.021006|Vn DOUBLE_IS_IEEE_754_64_BIT_BIG_ENDIAN|5.021006|5.021006|Vn DOUBLE_IS_IEEE_754_64_BIT_LITTLE_ENDIAN|5.021006|5.021006|Vn DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE|5.021006|5.021006|Vn DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE|5.021006|5.021006|Vn DOUBLE_IS_IEEE_FORMAT|5.025003||Viu DOUBLE_IS_UNKNOWN_FORMAT|5.021006|5.021006|Vn DOUBLE_IS_VAX_D_FLOAT|5.025003|5.025003|Vn DOUBLE_IS_VAX_F_FLOAT|5.025003|5.025003|Vn DOUBLE_IS_VAX_FLOAT|5.025003||Viu DOUBLE_IS_VAX_G_FLOAT|5.025003|5.025003|Vn DOUBLEKIND|5.021006|5.021006|Vn DOUBLE_LITTLE_ENDIAN|5.021009||Viu DOUBLEMANTBITS|5.023000|5.023000|Vn DOUBLE_MIX_ENDIAN|5.021009||Viu DOUBLENANBYTES|5.023000|5.023000|Vn DOUBLESIZE|5.005000|5.005000|Vn DOUBLE_STYLE_IEEE|5.025007|5.025007|Vn DOUBLE_VAX_ENDIAN|5.025003||Viu do_uniprop_match|5.031011||cVniu dounwind|5.003007|5.003007|u DO_UTF8|5.006000|5.006000| do_vecget|5.006000||Viu do_vecset|5.003007||Viu do_vop|5.003007||Viu dowantarray|5.003007|5.003007|u dPOPiv|5.003007||Viu dPOPnv|5.003007||Viu dPOPnv_nomg|5.013002||Viu dPOPPOPiirl|5.003007||Viu dPOPPOPnnrl|5.003007||Viu dPOPPOPssrl|5.003007||Viu dPOPss|5.003007||Viu dPOPTOPiirl|5.003007||Viu dPOPTOPiirl_nomg|5.013002||Viu dPOPTOPiirl_ul_nomg|5.013002||Viu dPOPTOPnnrl|5.003007||Viu dPOPTOPnnrl_nomg|5.013002||Viu dPOPTOPssrl|5.003007||Viu dPOPuv|5.004000||Viu dPOPXiirl|5.004000||Viu dPOPXiirl_ul_nomg|5.013002||Viu dPOPXnnrl|5.004000||Viu dPOPXssrl|5.004000||Viu DPTR2FPTR|5.009003||Viu Drand01|5.006000|5.006000| drand48_init_r|||cniu drand48_r|||cniu DRAND48_R_PROTO|5.008000|5.008000|Vn dSAVEDERRNO|5.010001||Vi dSAVE_ERRNO|5.010001||Vi dSP|5.003007|5.003007| dSS_ADD|5.017007||Viu dTARG|5.003007||Viu dTARGET|5.003007|5.003007| dTARGETSTACKED|5.003007||Viu D_T_FMT|5.027010||Viu dTHR|5.004005|5.003007|p dTHX|5.003007|5.003007|p dTHXa|5.006000|5.003007|p dTHX_DEBUGGING|5.027009||Viu dTHXo|5.006000||Viu dTHXoa|5.006001|5.003007|p dTHXR||5.003007|ponu dTHXs|5.007002||Viu dTHXx|5.006000||Viu dTOPiv|5.003007||Viu dTOPnv|5.003007||Viu dTOPss|5.003007||Viu dTOPuv|5.004000||Viu dtrace_probe_call|||ciu dtrace_probe_load|||ciu dtrace_probe_op|||ciu dtrace_probe_phase|||ciu dump_all|5.006000|5.006000| dump_all_perl|5.011000||Viu dump_c_backtrace|5.021001||V dump_eval|5.006000|5.006000|u dump_exec_pos|5.009004||Viu dump_form|5.006000|5.006000|u dump_indent|5.006000||vcVu dump_mstats|5.003007||Vu dump_packsubs|5.006000|5.006000| dump_packsubs_perl|5.011000||Viu dump_regex_sets_structures|5.025006||Viu dump_sub|5.006000|5.006000|u dump_sub_perl|5.011000||Viu dump_sv_child|5.009003||Viu dump_trie|5.009004||Viu dump_trie_interim_list|5.009004||Viu dump_trie_interim_table|5.009004||Viu dumpuntil|5.005000||Viu dump_vindent|5.006000||cVu dUNDERBAR|5.009002|5.003007|p dup2|5.005000||Viu dup|5.005000||Viu dup_attrlist|5.006000||Viu DUP_WARNINGS|5.009004||Viu dup_warnings|||ciu dVAR|5.009003|5.003007|p dXCPT|5.009002|5.003007|p dXSARGS|5.003007|5.003007| dXSBOOTARGSAPIVERCHK|5.021006||Viu dXSBOOTARGSNOVERCHK|5.021006||Viu dXSBOOTARGSXSAPIVERCHK|5.021006||Viu dXSFUNCTION|5.005000||Viu dXSI32|5.003007|5.003007|V dXSTARG|5.006000|5.003007|poVnu dXSUB_SYS|5.003007||Viu edit_distance|5.023008||Vniu EIGHT_BIT_UTF8_TO_NATIVE|5.023003||Viu ELEMENT_RANGE_MATCHES_INVLIST|5.023002||Viu EMBEDMYMALLOC|5.006000||Viu emulate_cop_io|||xciu emulate_setlocale|5.027009||Vniu END|5.003007||Viu END_EXTERN_C|5.005000|5.003007|pV endgrent|5.009000||Viu ENDGRENT_R_HAS_FPTR|5.008000||Viu ENDGRENT_R_PROTO|5.008000|5.008000|Vn endhostent|5.005000||Viu ENDHOSTENT_R_PROTO|5.008000|5.008000|Vn ENDLIKE|5.009005||Viu ENDLIKE_t8|5.035004||Viu ENDLIKE_t8_p8|5.033003||Viu ENDLIKE_t8_pb|5.033003||Viu ENDLIKE_tb|5.035004||Viu ENDLIKE_tb_p8|5.033003||Viu ENDLIKE_tb_pb|5.033003||Viu endnetent|5.005000||Viu ENDNETENT_R_PROTO|5.008000|5.008000|Vn endprotoent|5.005000||Viu ENDPROTOENT_R_PROTO|5.008000|5.008000|Vn endpwent|5.009000||Viu ENDPWENT_R_HAS_FPTR|5.008000||Viu ENDPWENT_R_PROTO|5.008000|5.008000|Vn endservent|5.005000||Viu ENDSERVENT_R_PROTO|5.008000|5.008000|Vn END_t8|5.035004||Viu END_t8_p8|5.033003||Viu END_t8_pb|5.033003||Viu END_tb|5.035004||Viu END_tb_p8|5.033003||Viu END_tb_pb|5.033003||Viu ENTER|5.003007|5.003007| ENTER_with_name|5.011002|5.011002| ENV_INIT|5.031011||Viu environ|5.003007||Viu ENV_LOCALE_LOCK|5.031011||Viu ENV_LOCALE_READ_LOCK|5.031011||Viu ENV_LOCALE_READ_UNLOCK|5.031011||Viu ENV_LOCALE_UNLOCK|5.031011||Viu ENV_LOCK|5.031011||Viu ENV_READ_LOCK|5.033005||Viu ENV_READ_UNLOCK|5.033005||Viu ENV_TERM|5.031011||Viu ENV_UNLOCK|5.031011||Viu EOF|5.003007||Viu EOF_NONBLOCK|5.003007|5.003007|Vn EOL|5.003007||Viu EOL_t8|5.035004||Viu EOL_t8_p8|5.033003||Viu EOL_t8_pb|5.033003||Viu EOL_tb|5.035004||Viu EOL_tb_p8|5.033003||Viu EOL_tb_pb|5.033003||Viu EOS|5.005000||Viu EOS_t8|5.035004||Viu EOS_t8_p8|5.033003||Viu EOS_t8_pb|5.033003||Viu EOS_tb|5.035004||Viu EOS_tb_p8|5.033003||Viu EOS_tb_pb|5.033003||Viu ERA|5.027010||Viu ERA_D_FMT|5.027010||Viu ERA_D_T_FMT|5.027010||Viu ERA_T_FMT|5.027010||Viu ERRSV|5.004005|5.003007|p ESC_NATIVE|5.021004||Viu EVAL|5.005000||Viu EVAL_B|5.025010||Viu EVAL_B_fail|5.025010||Viu EVAL_B_fail_t8|5.035004||Viu EVAL_B_fail_t8_p8|5.033003||Viu EVAL_B_fail_t8_pb|5.033003||Viu EVAL_B_fail_tb|5.035004||Viu EVAL_B_fail_tb_p8|5.033003||Viu EVAL_B_fail_tb_pb|5.033003||Viu EVAL_B_t8|5.035004||Viu EVAL_B_t8_p8|5.033003||Viu EVAL_B_t8_pb|5.033003||Viu EVAL_B_tb|5.035004||Viu EVAL_B_tb_p8|5.033003||Viu EVAL_B_tb_pb|5.033003||Viu EVAL_INEVAL|5.006000||Viu EVAL_INREQUIRE|5.007001||Viu EVAL_KEEPERR|5.006000||Viu EVAL_NULL|5.006000||Viu EVAL_postponed_AB|5.025010||Viu EVAL_postponed_AB_fail|5.025010||Viu EVAL_postponed_AB_fail_t8|5.035004||Viu EVAL_postponed_AB_fail_t8_p8|5.033003||Viu EVAL_postponed_AB_fail_t8_pb|5.033003||Viu EVAL_postponed_AB_fail_tb|5.035004||Viu EVAL_postponed_AB_fail_tb_p8|5.033003||Viu EVAL_postponed_AB_fail_tb_pb|5.033003||Viu EVAL_postponed_AB_t8|5.035004||Viu EVAL_postponed_AB_t8_p8|5.033003||Viu EVAL_postponed_AB_t8_pb|5.033003||Viu EVAL_postponed_AB_tb|5.035004||Viu EVAL_postponed_AB_tb_p8|5.033003||Viu EVAL_postponed_AB_tb_pb|5.033003||Viu eval_pv|5.006000|5.003007|p EVAL_RE_REPARSING|5.017011||Viu eval_sv|5.006000|5.003007|p EVAL_t8|5.035004||Viu EVAL_t8_p8|5.033003||Viu EVAL_t8_pb|5.033003||Viu EVAL_tb|5.035004||Viu EVAL_tb_p8|5.033003||Viu EVAL_tb_pb|5.033003||Viu EVAL_WARNONLY|5.006000||Viu EXACT|5.004000||Viu EXACTF|5.004000||Viu EXACTFAA|5.027009||Viu EXACTFAA_NO_TRIE|5.027009||Viu EXACTFAA_NO_TRIE_t8|5.035004||Viu EXACTFAA_NO_TRIE_t8_p8|5.033003||Viu EXACTFAA_NO_TRIE_t8_pb|5.033003||Viu EXACTFAA_NO_TRIE_tb|5.035004||Viu EXACTFAA_NO_TRIE_tb_p8|5.033003||Viu EXACTFAA_NO_TRIE_tb_pb|5.033003||Viu EXACTFAA_t8|5.035004||Viu EXACTFAA_t8_p8|5.033003||Viu EXACTFAA_t8_pb|5.033003||Viu EXACTFAA_tb|5.035004||Viu EXACTFAA_tb_p8|5.033003||Viu EXACTFAA_tb_pb|5.033003||Viu EXACTFL|5.004000||Viu EXACTFL_t8|5.035004||Viu EXACTFL_t8_p8|5.033003||Viu EXACTFL_t8_pb|5.033003||Viu EXACTFL_tb|5.035004||Viu EXACTFL_tb_p8|5.033003||Viu EXACTFL_tb_pb|5.033003||Viu EXACTFLU8|5.021008||Viu EXACTFLU8_t8|5.035004||Viu EXACTFLU8_t8_p8|5.033003||Viu EXACTFLU8_t8_pb|5.033003||Viu EXACTFLU8_tb|5.035004||Viu EXACTFLU8_tb_p8|5.033003||Viu EXACTFLU8_tb_pb|5.033003||Viu EXACTF_t8|5.035004||Viu EXACTF_t8_p8|5.033003||Viu EXACTF_t8_pb|5.033003||Viu EXACTF_tb|5.035004||Viu EXACTF_tb_p8|5.033003||Viu EXACTF_tb_pb|5.033003||Viu EXACTFU|5.013008||Viu EXACTFUP|5.029007||Viu EXACTFUP_t8|5.035004||Viu EXACTFUP_t8_p8|5.033003||Viu EXACTFUP_t8_pb|5.033003||Viu EXACTFUP_tb|5.035004||Viu EXACTFUP_tb_p8|5.033003||Viu EXACTFUP_tb_pb|5.033003||Viu EXACTFU_REQ8|5.031006||Viu EXACTFU_REQ8_t8|5.035004||Viu EXACTFU_REQ8_t8_p8|5.033003||Viu EXACTFU_REQ8_t8_pb|5.033003||Viu EXACTFU_REQ8_tb|5.035004||Viu EXACTFU_REQ8_tb_p8|5.033003||Viu EXACTFU_REQ8_tb_pb|5.033003||Viu EXACTFU_S_EDGE|5.029007||Viu EXACTFU_S_EDGE_t8|5.035004||Viu EXACTFU_S_EDGE_t8_p8|5.033003||Viu EXACTFU_S_EDGE_t8_pb|5.033003||Viu EXACTFU_S_EDGE_tb|5.035004||Viu EXACTFU_S_EDGE_tb_p8|5.033003||Viu EXACTFU_S_EDGE_tb_pb|5.033003||Viu EXACTFU_t8|5.035004||Viu EXACTFU_t8_p8|5.033003||Viu EXACTFU_t8_pb|5.033003||Viu EXACTFU_tb|5.035004||Viu EXACTFU_tb_p8|5.033003||Viu EXACTFU_tb_pb|5.033003||Viu EXACTL|5.021008||Viu EXACTL_t8|5.035004||Viu EXACTL_t8_p8|5.033003||Viu EXACTL_t8_pb|5.033003||Viu EXACTL_tb|5.035004||Viu EXACTL_tb_p8|5.033003||Viu EXACTL_tb_pb|5.033003||Viu EXACT_REQ8|5.031006||Viu EXACT_REQ8_t8|5.035004||Viu EXACT_REQ8_t8_p8|5.033003||Viu EXACT_REQ8_t8_pb|5.033003||Viu EXACT_REQ8_tb|5.035004||Viu EXACT_REQ8_tb_p8|5.033003||Viu EXACT_REQ8_tb_pb|5.033003||Viu EXACT_t8|5.035004||Viu EXACT_t8_p8|5.033003||Viu EXACT_t8_pb|5.033003||Viu EXACT_tb|5.035004||Viu EXACT_tb_p8|5.033003||Viu EXACT_tb_pb|5.033003||Viu EXEC_ARGV_CAST|5.007001||Viu exec_failed|5.009004||Viu execl|5.005000||Viu EXEC_PAT_MOD|5.009005||Viu EXEC_PAT_MODS|5.009005||Viu execute_wildcard|5.031010||Viu execv|5.005000||Viu execvp|5.005000||Viu exit|5.005000||Viu EXPECT|5.009004||Viu expect_number|5.007001||Viu EXT|5.003007||Viu EXTCONST|5.004000||Viu EXTEND|5.003007|5.003007| EXTEND_HWM_SET|5.027002||Viu EXTEND_MORTAL|5.004000||Viu EXTEND_SKIP|5.027002||Viu EXTERN_C|5.005000|5.003007|pV EXT_MGVTBL|5.009004||Viu EXT_PAT_MODS|5.009005||Viu EXTRA_SIZE|5.005000||Viu EXTRA_STEP_2ARGS|5.005000||Viu F0convert|5.009003||Vniu FAKE_BIT_BUCKET|5.009005||Viu FAKE_DEFAULT_SIGNAL_HANDLERS|5.009003||Viu FAKE_PERSISTENT_SIGNAL_HANDLERS|5.009003||Viu FALSE|5.003007||Viu FATAL_ABOVE_FF_MSG|5.027010||Viu F_atan2_amg|5.004000||Viu FBMcf_TAIL|5.006000||Viu FBMcf_TAIL_DOLLAR|5.006000||Viu FBMcf_TAIL_DOLLARM|5.006000||Viu FBMcf_TAIL_Z|5.006000||Viu FBMcf_TAIL_z|5.006000||Viu fbm_compile|5.005000|5.005000| fbm_instr|5.005000|5.005000| FBMrf_MULTILINE|5.006000||Viu fclose|5.003007||Viu fcntl|5.006000||Viu FCNTL_CAN_LOCK|5.007001|5.007001|Vn F_cos_amg|5.004000||Viu FD_CLR|5.008000||Viu FD_ISSET|5.008000||Viu fdopen|5.003007||Viu FD_SET|5.008000||Viu fd_set|5.008000||Viu FD_ZERO|5.008000||Viu FEATURE_BAREWORD_FILEHANDLES_BIT|5.033006||Viu FEATURE_BAREWORD_FILEHANDLES_IS_ENABLED|5.033006||Viu FEATURE_BITWISE_BIT|5.031006||Viu FEATURE_BITWISE_IS_ENABLED|5.021009||Viu FEATURE_BUNDLE_510|5.015007||Viu FEATURE_BUNDLE_511|5.015007||Viu FEATURE_BUNDLE_515|5.015007||Viu FEATURE_BUNDLE_523|5.023001||Viu FEATURE_BUNDLE_527|5.027008||Viu FEATURE_BUNDLE_535|5.035003||Viu FEATURE_BUNDLE_CUSTOM|5.015007||Viu FEATURE_BUNDLE_DEFAULT|5.015007||Viu FEATURE_DEFER_BIT|5.035004||Viu FEATURE_DEFER_IS_ENABLED|5.035004||Viu FEATURE_EVALBYTES_BIT|5.031006||Viu FEATURE_EVALBYTES_IS_ENABLED|5.015007||Viu FEATURE_FC_BIT|5.031006||Viu FEATURE_FC_IS_ENABLED|5.015008||Viu FEATURE_INDIRECT_BIT|5.031010||Viu FEATURE_INDIRECT_IS_ENABLED|5.031010||Viu FEATURE_ISA_BIT|5.031007||Viu FEATURE_ISA_IS_ENABLED|5.031007||Viu FEATURE_IS_ENABLED_MASK|5.031006||Viu FEATURE_MULTIDIMENSIONAL_BIT|5.033001||Viu FEATURE_MULTIDIMENSIONAL_IS_ENABLED|5.033001||Viu FEATURE_MYREF_BIT|5.031006||Viu FEATURE_MYREF_IS_ENABLED|5.025003||Viu FEATURE_POSTDEREF_QQ_BIT|5.031006||Viu FEATURE_POSTDEREF_QQ_IS_ENABLED|5.019005||Viu FEATURE_REFALIASING_BIT|5.031006||Viu FEATURE_REFALIASING_IS_ENABLED|5.021005||Viu FEATURE_SAY_BIT|5.031006||Viu FEATURE_SAY_IS_ENABLED|5.015007||Viu FEATURE_SIGNATURES_BIT|5.031006||Viu FEATURE_SIGNATURES_IS_ENABLED|5.019009||Viu FEATURE_STATE_BIT|5.031006||Viu FEATURE_STATE_IS_ENABLED|5.015007||Viu FEATURE___SUB___BIT|5.031006||Viu FEATURE___SUB___IS_ENABLED|5.015007||Viu FEATURE_SWITCH_BIT|5.031006||Viu FEATURE_SWITCH_IS_ENABLED|5.015007||Viu FEATURE_TRY_BIT|5.033007||Viu FEATURE_TRY_IS_ENABLED|5.033007||Viu FEATURE_UNICODE_BIT|5.031006||Viu FEATURE_UNICODE_IS_ENABLED|5.015007||Viu FEATURE_UNIEVAL_BIT|5.031006||Viu FEATURE_UNIEVAL_IS_ENABLED|5.015007||Viu feof|5.003007||Viu ferror|5.003007||Viu FETCHFEATUREBITSHH|5.031006||Viu F_exp_amg|5.004000||Viu FF_0DECIMAL|5.007001||Viu FF_BLANK|5.003007||Viu FF_CHECKCHOP|5.003007||Viu FF_CHECKNL|5.003007||Viu FF_CHOP|5.003007||Viu FF_DECIMAL|5.003007||Viu FF_END|5.003007||Viu FF_FETCH|5.003007||Viu FF_HALFSPACE|5.003007||Viu FF_ITEM|5.003007||Viu FF_LINEGLOB|5.003007||Viu FF_LINEMARK|5.003007||Viu FF_LINESNGL|5.009001||Viu FF_LITERAL|5.003007||Viu Fflush|5.003007||Viu fflush|5.003007||Viu FFLUSH_NULL|5.006000|5.006000|Vn FF_MORE|5.003007||Viu FF_NEWLINE|5.003007||Viu FF_SKIP|5.003007||Viu FF_SPACE|5.003007||Viu fgetc|5.003007||Viu fgetpos|5.003007||Viu fgets|5.003007||Viu FILE|5.003007||Viu FILE_base|5.007000|5.007000| FILE_bufsiz|5.007000|5.007000| FILE_cnt|5.007000|5.007000| fileno|5.003007||Viu FILE_ptr|5.007000|5.007000| FILL_ADVANCE_NODE_2L_ARG|5.021005||Viu FILL_ADVANCE_NODE|5.005000||Viu FILL_ADVANCE_NODE_ARG|5.005000||Viu FILL_ADVANCE_NODE_ARGp|5.031010||Viu FILL_NODE|5.029004||Viu filter_add|5.003007|5.003007| FILTER_DATA|5.003007||Viu filter_del|5.003007|5.003007|u filter_gets|5.005000||Viu FILTER_ISREADER|5.003007||Viu filter_read|5.003007|5.003007| FILTER_READ|5.003007||Viu finalize_op|5.015002||Viu finalize_optree|5.015002||Vi find_and_forget_pmops|5.009005||Viu find_array_subscript|5.009004||Viu find_beginning|5.005000||Viu find_byclass|5.006000||Viu find_default_stash|5.019004||Viu find_first_differing_byte_pos|5.031007||Vniu find_hash_subscript|5.009004||Viu find_in_my_stash|5.006001||Viu find_lexical_cv|5.019001||Viu find_next_masked|5.027009||Vniu find_runcv|5.009005|5.009005| FIND_RUNCV_level_eq|5.017002||Viu FIND_RUNCV_padid_eq|5.017004||Viu find_runcv_where|5.017002||Viu find_rundefsv|5.013002|5.013002| find_rundefsvoffset|5.009002|5.009002|d find_script|5.004005||Viu find_span_end|5.027009||Vniu find_span_end_mask|5.027009||Vniu find_uninit_var|5.009002||xVi FIRST_NON_ASCII_DECIMAL_DIGIT|5.027007||Viu first_symbol|5.009003||Vniu FIT_ARENA0|||Viu FIT_ARENAn|||Viu FIT_ARENA|||Viu FITS_IN_8_BITS|5.013005||Viu fixup_errno_string|5.019007||Viu FLAGS|5.013006||Viu FLEXFILENAMES|5.003007|5.003007|Vn float_end_shift|5.009005||Viu float_max_offset|5.005000||Viu float_min_offset|5.005000||Viu float_substr|5.005000||Viu float_utf8|5.008000||Viu flock|5.005000||Viu flockfile|5.003007||Viu F_log_amg|5.004000||Viu FmLINES|5.003007||Viu fold_constants|5.003007||Viu foldEQ|5.013002|5.013002|n foldEQ_latin1|5.013008||cVnu foldEQ_latin1_s2_folded|5.029007||Vniu foldEQ_locale|5.013002|5.013002|n FOLDEQ_LOCALE|5.019009||cV FOLDEQ_S1_ALREADY_FOLDED|5.015004||cV FOLDEQ_S1_FOLDS_SANE|5.021008||cV FOLDEQ_S2_ALREADY_FOLDED|5.015004||cV FOLDEQ_S2_FOLDS_SANE|5.021008||cV foldEQ_utf8|5.013002|5.007003|p foldEQ_utf8_flags|5.013010||cVu FOLDEQ_UTF8_NOMIX_ASCII|5.013010||cV FOLD_FLAGS_FULL|5.015006||Viu FOLD_FLAGS_LOCALE|5.015006||Viu FOLD_FLAGS_NOMIX_ASCII|5.017000||Viu fopen|5.003007||Viu forbid_setid|5.005000||Viu force_ident|5.003007||Viu force_ident_maybe_lex|5.017004||Viu force_list|5.003007||Viu force_next|5.003007||Viu _force_out_malformed_utf8_message|5.025009||cVu force_strict_version|5.011004||Viu force_version|5.005000||Viu force_word|5.003007||Viu forget_pmop|5.017007||Viu form|5.004000||vV form_alien_digit_msg|5.031009||cViu form_cp_too_large_msg|5.031009||cViu form_nocontext|5.006000||vVn fp_dup|5.007003|5.007003|u Fpos_t|5.003007|5.003007|Vn F_pow_amg|5.004000||Viu FP_PINF|5.021004||Viu FP_QNAN|5.021004||Viu fprintf|5.003007||Viu fprintf_nocontext|5.006000||vdVnu FPTR2DPTR|5.009003||Viu fputc|5.003007||Viu fputs|5.003007||Viu fread|5.003007||Viu free|5.003007||Viu free_and_set_cop_warnings|5.031011||Viu free_c_backtrace|5.021001||Vi FreeOp|5.008001||Viu Free_t|5.003007|5.003007|Vn FREE_THREAD_KEY|5.006001||Viu free_tied_hv_pool|5.008001||Viu FREETMPS|5.003007|5.003007| free_tmps|5.003007||cVu freopen|5.003007||Viu frewind|5.005000||Viu FROM_INTERNAL_SIZE|5.023002||Viu fscanf|5.003007||Viu fseek|5.003007||Viu FSEEKSIZE|5.006000||Viu fsetpos|5.003007||Viu F_sin_amg|5.004000||Viu F_sqrt_amg|5.004000||Viu Fstat|5.003007||Viu fstat|5.005000||Viu ftell|5.003007||Viu ftruncate|5.006000||Viu ftrylockfile|5.003007||Viu FUNCTION|5.009003||Viu funlockfile|5.003007||Viu fwrite1|5.003007||Viu fwrite|5.003007||Viu G_ARRAY|5.003007||Viu GCB_BREAKABLE|5.025003||Viu GCB_EX_then_EM|5.025003||Viu GCB_Maybe_Emoji_NonBreak|5.029002||Viu GCB_NOBREAK|5.025003||Viu GCB_RI_then_RI|5.025003||Viu GCC_DIAG_IGNORE|5.019007||Viu GCC_DIAG_IGNORE_DECL|5.027007||Viu GCC_DIAG_IGNORE_STMT|5.027007||Viu GCC_DIAG_PRAGMA|5.021001||Viu GCC_DIAG_RESTORE|5.019007||Viu GCC_DIAG_RESTORE_DECL|5.027007||Viu GCC_DIAG_RESTORE_STMT|5.027007||Viu Gconvert|5.003007|5.003007| GDBMNDBM_H_USES_PROTOTYPES|5.032001|5.032001|Vn G_DISCARD|5.003007|5.003007| gen_constant_list|5.003007||Viu get_and_check_backslash_N_name|5.017006||cViu get_and_check_backslash_N_name_wrapper|5.029009||Viu get_ANYOF_cp_list_for_ssc|5.019005||Viu get_ANYOFM_contents|5.027009||Viu GETATARGET|5.003007||Viu get_aux_mg|5.011000||Viu get_av|5.006000|5.003007|p getc|5.003007||Viu get_c_backtrace|5.021001||Vi get_c_backtrace_dump|5.021001||V get_context|5.006000|5.006000|nu getc_unlocked|5.003007||Viu get_cv|5.006000|5.003007|p get_cvn_flags|5.009005|5.003007|p get_cvs|5.011000|5.003007|p getcwd_sv|5.007002|5.007002| get_db_sub|||iu get_debug_opts|5.008001||Viu get_deprecated_property_msg|5.031011||cVniu getegid|5.005000||Viu getenv|5.005000||Viu getenv_len|5.006000||Viu GETENV_LOCK|5.033005||Viu GETENV_PRESERVES_OTHER_THREAD|5.033005|5.033005|Vn GETENV_UNLOCK|5.033005||Viu geteuid|5.005000||Viu getgid|5.005000||Viu getgrent|5.009000||Viu GETGRENT_R_HAS_BUFFER|5.008000||Viu GETGRENT_R_HAS_FPTR|5.008000||Viu GETGRENT_R_HAS_PTR|5.008000||Viu GETGRENT_R_PROTO|5.008000|5.008000|Vn getgrgid|5.009000||Viu GETGRGID_R_HAS_BUFFER|5.008000||Viu GETGRGID_R_HAS_PTR|5.008000||Viu GETGRGID_R_PROTO|5.008000|5.008000|Vn getgrnam|5.009000||Viu GETGRNAM_R_HAS_BUFFER|5.008000||Viu GETGRNAM_R_HAS_PTR|5.008000||Viu GETGRNAM_R_PROTO|5.008000|5.008000|Vn get_hash_seed|5.008001||Viu gethostbyaddr|5.005000||Viu GETHOSTBYADDR_R_HAS_BUFFER|5.008000||Viu GETHOSTBYADDR_R_HAS_ERRNO|5.008000||Viu GETHOSTBYADDR_R_HAS_PTR|5.008000||Viu GETHOSTBYADDR_R_PROTO|5.008000|5.008000|Vn gethostbyname|5.005000||Viu GETHOSTBYNAME_R_HAS_BUFFER|5.008000||Viu GETHOSTBYNAME_R_HAS_ERRNO|5.008000||Viu GETHOSTBYNAME_R_HAS_PTR|5.008000||Viu GETHOSTBYNAME_R_PROTO|5.008000|5.008000|Vn gethostent|5.005000||Viu GETHOSTENT_R_HAS_BUFFER|5.008000||Viu GETHOSTENT_R_HAS_ERRNO|5.008000||Viu GETHOSTENT_R_HAS_PTR|5.008000||Viu GETHOSTENT_R_PROTO|5.008000|5.008000|Vn gethostname|5.005000||Viu get_hv|5.006000|5.003007|p get_invlist_iter_addr|5.015001||Vniu get_invlist_offset_addr|5.019002||Vniu get_invlist_previous_index_addr|5.017004||Vniu getlogin|5.005000||Viu GETLOGIN_R_PROTO|5.008000|5.008000|Vn get_mstats|5.006000||Vu getnetbyaddr|5.005000||Viu GETNETBYADDR_R_HAS_BUFFER|5.008000||Viu GETNETBYADDR_R_HAS_ERRNO|5.008000||Viu GETNETBYADDR_R_HAS_PTR|5.008000||Viu GETNETBYADDR_R_PROTO|5.008000|5.008000|Vn getnetbyname|5.005000||Viu GETNETBYNAME_R_HAS_BUFFER|5.008000||Viu GETNETBYNAME_R_HAS_ERRNO|5.008000||Viu GETNETBYNAME_R_HAS_PTR|5.008000||Viu GETNETBYNAME_R_PROTO|5.008000|5.008000|Vn getnetent|5.005000||Viu GETNETENT_R_HAS_BUFFER|5.008000||Viu GETNETENT_R_HAS_ERRNO|5.008000||Viu GETNETENT_R_HAS_PTR|5.008000||Viu GETNETENT_R_PROTO|5.008000|5.008000|Vn get_no_modify|5.005000||Viu get_num|5.008001||Viu get_opargs|5.005000||Viu get_op_descs|5.005000|5.005000|u get_op_names|5.005000|5.005000|u getpeername|5.005000||Viu getpid|5.006000||Viu get_ppaddr|5.006000|5.006000|u get_prop_definition|5.031011||cViu get_prop_values|5.031011||cVniu getprotobyname|5.005000||Viu GETPROTOBYNAME_R_HAS_BUFFER|5.008000||Viu GETPROTOBYNAME_R_HAS_PTR|5.008000||Viu GETPROTOBYNAME_R_PROTO|5.008000|5.008000|Vn getprotobynumber|5.005000||Viu GETPROTOBYNUMBER_R_HAS_BUFFER|5.008000||Viu GETPROTOBYNUMBER_R_HAS_PTR|5.008000||Viu GETPROTOBYNUMBER_R_PROTO|5.008000|5.008000|Vn getprotoent|5.005000||Viu GETPROTOENT_R_HAS_BUFFER|5.008000||Viu GETPROTOENT_R_HAS_PTR|5.008000||Viu GETPROTOENT_R_PROTO|5.008000|5.008000|Vn getpwent|5.009000||Viu GETPWENT_R_HAS_BUFFER|5.008000||Viu GETPWENT_R_HAS_FPTR|5.008000||Viu GETPWENT_R_HAS_PTR|5.008000||Viu GETPWENT_R_PROTO|5.008000|5.008000|Vn getpwnam|5.009000||Viu GETPWNAM_R_HAS_BUFFER|5.008000||Viu GETPWNAM_R_HAS_PTR|5.008000||Viu GETPWNAM_R_PROTO|5.008000|5.008000|Vn getpwuid|5.009000||Viu GETPWUID_R_HAS_PTR|5.008000||Viu GETPWUID_R_PROTO|5.008000|5.008000|Vn get_quantifier_value|5.033006||Viu get_re_arg|||xciu get_re_gclass_nonbitmap_data|5.031011||Viu get_regclass_nonbitmap_data|5.031011||Viu get_regex_charset_name|5.031004||Vniu getservbyname|5.005000||Viu GETSERVBYNAME_R_HAS_BUFFER|5.008000||Viu GETSERVBYNAME_R_HAS_PTR|5.008000||Viu GETSERVBYNAME_R_PROTO|5.008000|5.008000|Vn getservbyport|5.005000||Viu GETSERVBYPORT_R_HAS_BUFFER|5.008000||Viu GETSERVBYPORT_R_HAS_PTR|5.008000||Viu GETSERVBYPORT_R_PROTO|5.008000|5.008000|Vn getservent|5.005000||Viu GETSERVENT_R_HAS_BUFFER|5.008000||Viu GETSERVENT_R_HAS_PTR|5.008000||Viu GETSERVENT_R_PROTO|5.008000|5.008000|Vn getsockname|5.005000||Viu getsockopt|5.005000||Viu getspnam|5.009000||Viu GETSPNAM_R_HAS_BUFFER|5.031011||Viu GETSPNAM_R_HAS_PTR|5.008000||Viu GETSPNAM_R_PROTO|5.008000|5.008000|Vn get_sv|5.006000|5.003007|p GETTARGET|5.003007||Viu GETTARGETSTACKED|5.003007||Viu gettimeofday|5.008000||Viu getuid|5.005000||Viu get_vtbl|5.005003|5.005003|u getw|5.003007||Viu G_EVAL|5.003007|5.003007| G_FAKINGEVAL|5.009004||Viu Gid_t|5.003007|5.003007|Vn Gid_t_f|5.006000|5.006000|Vn Gid_t_sign|5.006000|5.006000|Vn Gid_t_size|5.006000|5.006000|Vn GIMME|5.003007|5.003007|d GIMME_V|5.004000|5.004000| gimme_V|5.031005||xcVu G_KEEPERR|5.003007|5.003007| G_LIST|5.035001|5.003007| glob_2number|5.009004||Viu GLOBAL_PAT_MOD|5.009005||Viu glob_assign_glob|5.009004||Viu G_METHOD|5.006001|5.003007|p G_METHOD_NAMED|5.019002|5.019002| gmtime|5.031011||Viu GMTIME_MAX|5.010001|5.010001|Vn GMTIME_MIN|5.010001|5.010001|Vn GMTIME_R_PROTO|5.008000|5.008000|Vn G_NOARGS|5.003007|5.003007| G_NODEBUG|5.004005||Viu GOSUB|5.009005||Viu GOSUB_t8|5.035004||Viu GOSUB_t8_p8|5.033003||Viu GOSUB_t8_pb|5.033003||Viu GOSUB_tb|5.035004||Viu GOSUB_tb_p8|5.033003||Viu GOSUB_tb_pb|5.033003||Viu gp_dup|5.007003|5.007003|u gp_free|5.003007|5.003007|u GPOS|5.004000||Viu GPOS_t8|5.035004||Viu GPOS_t8_p8|5.033003||Viu GPOS_t8_pb|5.033003||Viu GPOS_tb|5.035004||Viu GPOS_tb_p8|5.033003||Viu GPOS_tb_pb|5.033003||Viu gp_ref|5.003007|5.003007|u GREEK_CAPITAL_LETTER_MU|5.013011||Viu GREEK_SMALL_LETTER_MU|5.013008||Viu G_RE_REPARSING|5.017011||Viu G_RETHROW|5.031002|5.003007|p grok_atoUV|5.021010||cVni grok_bin|5.007003|5.003007|p grok_bin_oct_hex|5.031008||cVu grok_bslash_c|5.013001||cViu grok_bslash_N|5.017003||Viu grok_bslash_o|5.013003||cViu grok_bslash_x|5.017002||cViu grok_hex|5.007003|5.003007|p grok_infnan|5.021004|5.021004| grok_number|5.007002|5.003007|p grok_number_flags|5.021002|5.021002| GROK_NUMERIC_RADIX|5.007002|5.003007|p grok_numeric_radix|5.007002|5.003007|p grok_oct|5.007003|5.003007|p group_end|5.007003||Viu GROUPP|5.005000||Viu GROUPPN|5.031001||Viu GROUPPN_t8|5.035004||Viu GROUPPN_t8_p8|5.033003||Viu GROUPPN_t8_pb|5.033003||Viu GROUPPN_tb|5.035004||Viu GROUPPN_tb_p8|5.033003||Viu GROUPPN_tb_pb|5.033003||Viu GROUPP_t8|5.035004||Viu GROUPP_t8_p8|5.033003||Viu GROUPP_t8_pb|5.033003||Viu GROUPP_tb|5.035004||Viu GROUPP_tb_p8|5.033003||Viu GROUPP_tb_pb|5.033003||Viu Groups_t|5.003007|5.003007|Vn GRPASSWD|5.005000|5.005000|Vn G_SCALAR|5.003007|5.003007| G_UNDEF_FILL|5.013001||Viu GV_ADD|5.003007|5.003007| gv_add_by_type|5.011000|5.011000|u GV_ADDMG|5.015003|5.015003| GV_ADDMULTI|5.003007|5.003007| GV_ADDWARN|5.003007|5.003007| Gv_AMG|5.003007||Viu Gv_AMupdate|5.011000|5.011000|u GvASSUMECV|5.003007||Viu GvASSUMECV_off|5.003007||Viu GvASSUMECV_on|5.003007||Viu gv_autoload4|5.004000|5.004000| GV_AUTOLOAD|5.011000||Viu GV_AUTOLOAD_ISMETHOD|5.015004||Viu gv_autoload_pv|5.015004|5.015004|u gv_autoload_pvn|5.015004|5.015004|u gv_autoload_sv|5.015004|5.015004|u GvAV|5.003007|5.003007| gv_AVadd|5.003007|5.003007|u GvAVn|5.003007||Viu GV_CACHE_ONLY|5.021004||Vi gv_check|5.003007||cVu gv_const_sv|5.009003|5.009003| GV_CROAK|5.011000||Viu GvCV|5.003007|5.003007| GvCVGEN|5.003007||Viu GvCV_set|5.013010||Viu GvCVu|5.004000||Viu gv_dump|5.006000|5.006000|u gv_efullname3|5.003007|5.003007|u gv_efullname4|5.006001|5.006001|u gv_efullname|5.003007|5.003007|du GvEGV|5.003007||Viu GvEGVx|5.013000||Viu GvENAME|5.003007||Viu GvENAME_HEK|5.015004||Viu GvENAMELEN|5.015004||Viu GvENAMEUTF8|5.015004||Viu GvESTASH|5.003007||Viu GVf_ASSUMECV|5.003007||Viu gv_fetchfile|5.003007|5.003007| gv_fetchfile_flags|5.009005|5.009005| gv_fetchmeth|5.003007|5.003007| gv_fetchmeth_autoload|5.007003|5.007003| gv_fetchmeth_internal|5.021007||Viu gv_fetchmethod|5.003007|5.003007| gv_fetchmethod_autoload|5.004000|5.004000| gv_fetchmethod_flags|5.015004||Viu gv_fetchmethod_pv_flags|5.015004|5.015004|xu gv_fetchmethod_pvn_flags|5.015004|5.015004|xu gv_fetchmethod_sv_flags|5.015004|5.015004|xu gv_fetchmeth_pv|5.015004|5.015004| gv_fetchmeth_pv_autoload|5.015004|5.015004| gv_fetchmeth_pvn|5.015004|5.015004| gv_fetchmeth_pvn_autoload|5.015004|5.015004| gv_fetchmeth_sv|5.015004|5.015004| gv_fetchmeth_sv_autoload|5.015004|5.015004| gv_fetchpv|5.003007|5.003007| gv_fetchpvn|5.013006|5.013006| gv_fetchpvn_flags|5.009002|5.003007|p gv_fetchpvs|5.009004|5.003007|p gv_fetchsv|5.009002|5.003007|p gv_fetchsv_nomg|5.015003|5.015003| GvFILE|5.006000||Viu GvFILEGV|5.003007||Viu GvFILE_HEK|5.009004||Viu GvFILEx|5.019006||Viu GVf_IMPORTED|5.003007||Viu GVf_IMPORTED_AV|5.003007||Viu GVf_IMPORTED_CV|5.003007||Viu GVf_IMPORTED_HV|5.003007||Viu GVf_IMPORTED_SV|5.003007||Viu GVf_INTRO|5.003007||Viu GvFLAGS|5.003007||Viu GVf_MULTI|5.003007||Viu GVF_NOADD|5.035006||Viu GvFORM|5.003007||Viu gv_fullname3|5.003007|5.003007|u gv_fullname4|5.006001|5.006001|u gv_fullname|5.003007|5.003007|du GvGP|5.003007||Viu GvGPFLAGS|5.021004||Viu GvGP_set|5.013010||Viu gv_handler|5.007001|5.007001|u GvHV|5.003007|5.003007| gv_HVadd|5.003007|5.003007|u GvHVn|5.003007||Viu GvIMPORTED|5.003007||Viu GvIMPORTED_AV|5.003007||Viu GvIMPORTED_AV_off|5.003007||Viu GvIMPORTED_AV_on|5.003007||Viu GvIMPORTED_CV|5.003007||Viu GvIMPORTED_CV_off|5.003007||Viu GvIMPORTED_CV_on|5.003007||Viu GvIMPORTED_HV|5.003007||Viu GvIMPORTED_HV_off|5.003007||Viu GvIMPORTED_HV_on|5.003007||Viu GvIMPORTED_off|5.003007||Viu GvIMPORTED_on|5.003007||Viu GvIMPORTED_SV|5.003007||Viu GvIMPORTED_SV_off|5.003007||Viu GvIMPORTED_SV_on|5.003007||Viu gv_init|5.003007|5.003007| gv_init_pv|5.015004|5.015004| gv_init_pvn|5.015004|5.003007|p gv_init_sv|5.015004|5.015004| gv_init_svtype|5.015004||Viu GvIN_PAD|5.006000||Viu GvIN_PAD_off|5.006000||Viu GvIN_PAD_on|5.006000||Viu GvINTRO|5.003007||Viu GvINTRO_off|5.003007||Viu GvINTRO_on|5.003007||Viu GvIO|5.003007||Viu gv_IOadd|5.003007|5.003007|u GvIOn|5.003007||Viu GvIOp|5.003007||Viu gv_is_in_main|5.019004||Viu GvLINE|5.003007||Viu gv_magicalize|5.019004||Viu gv_magicalize_isa|5.013005||Viu gv_method_changed|5.017007||Viu GvMULTI|5.003007||Viu GvMULTI_off|5.003007||Viu GvMULTI_on|5.003007||Viu GvNAME|5.003007||Viu GvNAME_get|5.009004||Viu GvNAME_HEK|5.009004||Viu GvNAMELEN|5.003007||Viu GvNAMELEN_get|5.009004||Viu gv_name_set|5.009004|5.009004|u GvNAMEUTF8|5.015004||Viu GV_NOADD_MASK|5.009005||Viu GV_NOADD_NOINIT|5.009003|5.009003| GV_NOEXPAND|5.009003|5.009003| GV_NOINIT|5.004005|5.004005| GV_NO_SVGMAGIC|5.015003|5.015003| GV_NOTQUAL|5.009004|5.009004| GV_NOUNIVERSAL|5.033009||Viu G_VOID|5.004000|5.004000| gv_override|5.019006||Viu GvREFCNT|5.003007||Viu gv_setref|5.021005||Viu GvSTASH|5.003007||Viu gv_stashpv|5.003007|5.003007| gv_stashpvn|5.003007|5.003007|p gv_stashpvn_internal|5.021004||Viu gv_stashpvs|5.009003|5.003007|p gv_stashsv|5.003007|5.003007| gv_stashsvpvn_cached|5.021004||Vi GV_SUPER|5.017004|5.017004| GvSV|5.003007|5.003007| gv_SVadd|5.011000||Vu GvSVn|5.009003|5.003007|p gv_try_downgrade|5.011002||xcVi GvXPVGV|5.003007||Viu G_WANT|5.010001||Viu G_WARN_ALL_MASK|5.006000||Viu G_WARN_ALL_OFF|5.006000||Viu G_WARN_ALL_ON|5.006000||Viu G_WARN_OFF|5.006000||Viu G_WARN_ON|5.006000||Viu G_WARN_ONCE|5.006000||Viu G_WRITING_TO_STDERR|5.013009||Viu HADNV|||Viu handle_named_backref|5.023008||Viu handle_names_wildcard|5.031011||Viu handle_possible_posix|5.023008||Viu handle_regex_sets|5.017009||Viu handle_user_defined_property|5.029008||Viu HAS_ACCEPT4|5.027008|5.027008|Vn HAS_ACCESS|5.006000|5.006000|Vn HAS_ACOSH|5.021004|5.021004|Vn HAS_ALARM|5.003007|5.003007|Vn HASARENA|||Viu HAS_ASCTIME_R|5.010000|5.010000|Vn HAS_ASINH|5.021006|5.021006|Vn HAS_ATANH|5.021006|5.021006|Vn HAS_ATOLL|5.006000|5.006000|Vn HASATTRIBUTE_ALWAYS_INLINE|5.031007|5.031007|Vn HASATTRIBUTE_DEPRECATED|5.010001|5.010001|Vn HASATTRIBUTE_FORMAT|5.009003|5.009003|Vn HASATTRIBUTE_MALLOC|5.009003|5.009003|Vn HASATTRIBUTE_NONNULL|5.009003|5.009003|Vn HASATTRIBUTE_NORETURN|5.009003|5.009003|Vn HASATTRIBUTE_PURE|5.009003|5.009003|Vn HASATTRIBUTE_UNUSED|5.009003|5.009003|Vn HASATTRIBUTE_WARN_UNUSED_RESULT|5.009003|5.009003|Vn HAS_BACKTRACE|5.021001|5.021001|Vn HAS_BUILTIN_CHOOSE_EXPR|5.009004|5.009004|Vn HAS_BUILTIN_EXPECT|5.010001|5.010001|Vn HAS_BUILTIN_UNREACHABLE|5.033003||Viu HAS_C99|5.021004||Viu HAS_C99_VARIADIC_MACROS|5.009004|5.009004|Vn HAS_CBRT|5.021006|5.021006|Vn HAS_CF_AUX_TABLES|5.027011||Viu HAS_CHOWN|5.003007|5.003007|Vn HAS_CHROOT|5.003007|5.003007|Vn HAS_CHSIZE|5.004005|5.004005|Vn HAS_CLEARENV|5.009003|5.009003|Vn HAS_COPYSIGN|5.021006|5.021006|Vn HAS_COPYSIGNL|5.008001|5.008001|Vn HAS_CRYPT|5.003007|5.003007|Vn HAS_CRYPT_R|5.010000|5.010000|Vn HAS_CSH|5.005000|5.005000|Vn HAS_CTERMID|5.009005|5.009005|Vn HAS_CTIME_R|5.010000|5.010000|Vn HAS_CUSERID|5.003007|5.003007|Vn HAS_DBMINIT_PROTO|5.032001|5.032001|Vn HAS_DIFFTIME|5.003007|5.003007|Vn HAS_DIRFD|5.007003|5.007003|Vn HAS_DLADDR|5.021001|5.021001|Vn HAS_DLERROR|5.003007|5.003007|Vn HAS_DRAND48_PROTO|5.006000|5.006000|Vn HAS_DRAND48_R|5.010000|5.010000|Vn HAS_DUP2|5.003007|5.003007|Vn HAS_DUP3|5.027008|5.027008|Vn HAS_DUPLOCALE|5.027011|5.027011|Vn HAS_EACCESS|5.006000|5.006000|Vn HAS_ENDGRENT|5.005000|5.005000|Vn HAS_ENDHOSTENT|5.005000|5.005000|Vn HAS_ENDNETENT|5.005000|5.005000|Vn HAS_ENDPROTOENT|5.005000|5.005000|Vn HAS_ENDPWENT|5.005000|5.005000|Vn HAS_ENDSERVENT|5.005000|5.005000|Vn HAS_ERF|5.021006|5.021006|Vn HAS_ERFC|5.021006|5.021006|Vn HAS_EXP2|5.021006|5.021006|Vn HAS_EXPM1|5.021006|5.021006|Vn HAS_EXTRA_LONG_UTF8|5.035004||Viu HAS_FAST_STDIO|5.008001|5.008001|Vn HAS_FCHDIR|5.007002|5.007002|Vn HAS_FCHMOD|5.003007|5.003007|Vn HAS_FCHMODAT|5.027004|5.027004|Vn HAS_FCHOWN|5.003007|5.003007|Vn HAS_FCNTL|5.003007|5.003007|Vn HAS_FDIM|5.021006|5.021006|Vn HAS_FD_SET|5.006000|5.006000|Vn HAS_FEGETROUND|5.021004|5.021004|Vn HAS_FFS|5.035001|5.035001|Vn HAS_FFSL|5.035001|5.035001|Vn HAS_FGETPOS|5.003007|5.003007|Vn HAS_FINITE|5.007003|5.007003|Vn HAS_FINITEL|5.007003|5.007003|Vn HAS_FLOCK|5.003007|5.003007|Vn HAS_FLOCK_PROTO|5.007002|5.007002|Vn HAS_FMA|5.021006|5.021006|Vn HAS_FMAX|5.021006|5.021006|Vn HAS_FMIN|5.021006|5.021006|Vn HAS_FORK|5.003007|5.003007|Vn HAS_FPATHCONF|5.003007|5.003007|Vn HAS_FPCLASSIFY|5.021004|5.021004|Vn HAS_FREELOCALE|5.023009|5.023009|Vn HAS_FREXPL|5.006001|5.006001|Vn HAS_FSEEKO|5.006000|5.006000|Vn HAS_FSETPOS|5.003007|5.003007|Vn HAS_FSTATFS|5.023005|5.023005|Vn HAS_FSTATVFS|5.023005|5.023005|Vn HAS_FSYNC|5.007001|5.007001|Vn HAS_FTELLO|5.006000|5.006000|Vn HAS_FUTIMES|5.009003|5.009003|Vn HAS_GAI_STRERROR|5.025004|5.025004|Vn HAS_GETADDRINFO|5.010001|5.010001|Vn HAS_GETCWD|5.006000|5.006000|Vn HAS_GETGRENT|5.005000|5.005000|Vn HAS_GETGRENT_R|5.010000|5.010000|Vn HAS_GETGRGID_R|5.010000|5.010000|Vn HAS_GETGRNAM_R|5.010000|5.010000|Vn HAS_GETGROUPS|5.003007|5.003007|Vn HAS_GETHOSTBYADDR|5.005000|5.005000|Vn HAS_GETHOSTBYADDR_R|5.010000|5.010000|Vn HAS_GETHOSTBYNAME|5.005000|5.005000|Vn HAS_GETHOSTBYNAME_R|5.010000|5.010000|Vn HAS_GETHOSTENT|5.003007|5.003007|Vn HAS_GETHOSTENT_R|5.010000|5.010000|Vn HAS_GETHOSTNAME|5.006000|5.006000|Vn HAS_GETHOST_PROTOS|5.005000|5.005000|Vn HAS_GETITIMER|5.007001|5.007001|Vn HAS_GETLOGIN|5.003007|5.003007|Vn HAS_GETLOGIN_R|5.010000|5.010000|Vn HAS_GETMNTENT|5.023005|5.023005|Vn HAS_GETNAMEINFO|5.010001|5.010001|Vn HAS_GETNETBYADDR|5.005000|5.005000|Vn HAS_GETNETBYADDR_R|5.010000|5.010000|Vn HAS_GETNETBYNAME|5.005000|5.005000|Vn HAS_GETNETBYNAME_R|5.010000|5.010000|Vn HAS_GETNETENT|5.005000|5.005000|Vn HAS_GETNETENT_R|5.010000|5.010000|Vn HAS_GETNET_PROTOS|5.005000|5.005000|Vn HAS_GETPAGESIZE|5.007001|5.007001|Vn HAS_GETPGID|5.003007|5.003007|Vn HAS_GETPGRP|5.003007|5.003007|Vn HAS_GETPPID|5.003007|5.003007|Vn HAS_GETPRIORITY|5.003007|5.003007|Vn HAS_GETPROTOBYNAME|5.005000|5.005000|Vn HAS_GETPROTOBYNAME_R|5.010000|5.010000|Vn HAS_GETPROTOBYNUMBER|5.005000|5.005000|Vn HAS_GETPROTOBYNUMBER_R|5.010000|5.010000|Vn HAS_GETPROTOENT|5.005000|5.005000|Vn HAS_GETPROTOENT_R|5.010000|5.010000|Vn HAS_GETPROTO_PROTOS|5.005000|5.005000|Vn HAS_GETPWENT|5.005000|5.005000|Vn HAS_GETPWENT_R|5.010000|5.010000|Vn HAS_GETPWNAM_R|5.010000|5.010000|Vn HAS_GETPWUID_R|5.010000|5.010000|Vn HAS_GETSERVBYNAME|5.005000|5.005000|Vn HAS_GETSERVBYNAME_R|5.010000|5.010000|Vn HAS_GETSERVBYPORT|5.005000|5.005000|Vn HAS_GETSERVBYPORT_R|5.010000|5.010000|Vn HAS_GETSERVENT|5.005000|5.005000|Vn HAS_GETSERVENT_R|5.010000|5.010000|Vn HAS_GETSERV_PROTOS|5.005000|5.005000|Vn HAS_GETSPNAM|5.006000|5.006000|Vn HAS_GETSPNAM_R|5.010000|5.010000|Vn HAS_GETTIMEOFDAY|5.004000|5.004000|Vn HAS_GMTIME_R|5.010000|5.010000|Vn HAS_GNULIBC|5.004005|5.004005|Vn HAS_GROUP|5.003007||Viu HAS_HASMNTOPT|5.023005|5.023005|Vn HAS_HTONL|5.003007|5.003007|Vn HAS_HTONS|5.003007|5.003007|Vn HAS_HYPOT|5.021006|5.021006|Vn HAS_ILOGB|5.021006|5.021006|Vn HAS_ILOGBL|5.008001|5.008001|Vn HAS_INET_ATON|5.004000|5.004000|Vn HAS_INETNTOP|5.010001|5.010001|Vn HAS_INETPTON|5.010001|5.010001|Vn HAS_INT64_T|5.006000|5.006000|Vn HAS_IOCTL|5.003007||Viu HAS_IP_MREQ|5.017002|5.017002|Vn HAS_IP_MREQ_SOURCE|5.017004|5.017004|Vn HAS_IPV6_MREQ|5.015008|5.015008|Vn HAS_ISASCII|5.003007|5.003007|Vn HAS_ISBLANK|5.015007|5.015007|Vn HAS_ISFINITE|5.021004|5.021004|Vn HAS_ISINF|5.007003|5.007003|Vn HAS_ISINFL|5.021004|5.021004|Vn HAS_ISLESS|5.031007|5.031007|Vn HAS_ISNAN|5.006001|5.006001|Vn HAS_ISNANL|5.006001|5.006001|Vn HAS_ISNORMAL|5.021006|5.021006|Vn HAS_IVCF_AUX_TABLES|5.027011||Viu HAS_J0|5.021004|5.021004|Vn HAS_J0L|5.021004|5.021004|Vn HAS_KILL|5.003007||Viu HAS_KILLPG|5.003007|5.003007|Vn HAS_LC_AUX_TABLES|5.027011||Viu HAS_LCHOWN|5.005000|5.005000|Vn HAS_LC_MONETARY_2008|5.021005|5.021005|Vn HAS_LDBL_DIG|5.006000|5.006000|Vn HAS_LDEXPL|5.021003|5.021003|Vn HAS_LGAMMA|5.021006|5.021006|Vn HAS_LGAMMA_R|5.021006|5.021006|Vn HAS_LINK|5.003007|5.003007|Vn HAS_LINKAT|5.027004|5.027004|Vn HAS_LLRINT|5.021006|5.021006|Vn HAS_LLRINTL|5.021009|5.021009|Vn HAS_LLROUND|5.021006|5.021006|Vn HAS_LLROUNDL|5.021009|5.021009|Vn HAS_LOCALECONV|5.003007|5.003007|Vn HAS_LOCALTIME_R|5.010000|5.010000|Vn HAS_LOCKF|5.003007|5.003007|Vn HAS_LOG1P|5.021006|5.021006|Vn HAS_LOG2|5.021006|5.021006|Vn HAS_LOGB|5.021006|5.021006|Vn HAS_LONG_DOUBLE|5.005000|5.005000|Vn HAS_LONG_LONG|5.005000|5.005000|Vn HAS_LRINT|5.021006|5.021006|Vn HAS_LRINTL|5.021009|5.021009|Vn HAS_LROUND|5.021006|5.021006|Vn HAS_LROUNDL|5.021009|5.021009|Vn HAS_LSEEK_PROTO|5.006000|5.006000|Vn HAS_LSTAT|5.003007|5.003007|Vn HAS_MADVISE|5.006000|5.006000|Vn HAS_MBLEN|5.003007|5.003007|Vn HAS_MBRLEN|5.027006|5.027006|Vn HAS_MBRTOWC|5.027006|5.027006|Vn HAS_MBSTOWCS|5.003007|5.003007|Vn HAS_MBTOWC|5.003007|5.003007|Vn HAS_MEMMEM|5.024000|5.024000|Vn HAS_MEMRCHR|5.027005|5.027005|Vn HAS_MKDIR|5.003007|5.003007|Vn HAS_MKDTEMP|5.006000|5.006000|Vn HAS_MKFIFO|5.003007|5.003007|Vn HAS_MKOSTEMP|5.027008|5.027008|Vn HAS_MKSTEMP|5.006000|5.006000|Vn HAS_MKSTEMPS|5.006000|5.006000|Vn HAS_MKTIME|5.003007|5.003007|Vn HAS_MMAP|5.006000|5.006000|Vn HAS_MODFL|5.006001|5.006001|Vn HAS_MODFL_PROTO|5.009003|5.009003|Vn HAS_MPROTECT|5.006000|5.006000|Vn HAS_MSG|5.003007|5.003007|Vn HAS_MSYNC|5.006000|5.006000|Vn HAS_MUNMAP|5.006000|5.006000|Vn HAS_NAN|5.021006|5.021006|Vn HAS_NANOSLEEP|5.027006|5.027006|Vn HAS_NEARBYINT|5.021006|5.021006|Vn HAS_NEWLOCALE|5.023009|5.023009|Vn HAS_NEXTAFTER|5.021006|5.021006|Vn HAS_NEXTTOWARD|5.021006|5.021006|Vn HAS_NICE|5.003007|5.003007|Vn HAS_NL_LANGINFO|5.007002|5.007002|Vn HAS_NL_LANGINFO_L|5.035001|5.035001|Vn HAS_NON_INT_BITFIELDS|5.035001|5.035001|Vn HAS_NONLATIN1_FOLD_CLOSURE|5.033005||Viu HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE|5.033005||Viu HAS_NTOHL|5.003007|5.003007|Vn HAS_NTOHS|5.003007|5.003007|Vn HAS_OFF64_T|5.010000|5.010000|Vn HAS_OPEN3|5.003007|5.003007|Vn HAS_OPENAT|5.027004|5.027004|Vn HAS_PASSWD|5.003007||Viu HAS_PATHCONF|5.003007|5.003007|Vn HAS_PAUSE|5.003007|5.003007|Vn HAS_PIPE2|5.027008|5.027008|Vn HAS_PIPE|5.003007|5.003007|Vn HAS_POLL|5.003007|5.003007|Vn HAS_POSIX_2008_LOCALE|5.027003||Viu HAS_PRCTL|5.013000|5.013000|Vn HAS_PRCTL_SET_NAME|5.013000|5.013000|Vn HAS_PROCSELFEXE|5.007003|5.007003|Vn HAS_PTHREAD_ATFORK|5.010000|5.010000|Vn HAS_PTHREAD_ATTR_SETSCOPE|5.008001|5.008001|Vn HAS_PTHREAD_UNCHECKED_GETSPECIFIC_NP|5.007002||Viu HAS_PTHREAD_YIELD|5.009005|5.009005|Vn HAS_PTRDIFF_T|5.021001|5.021001|Vn HAS_QUAD|5.003007|5.003007|Vn HAS_RANDOM_R|5.010000|5.010000|Vn HAS_READDIR|5.003007|5.003007|Vn HAS_READDIR64_R|5.010000|5.010000|Vn HAS_READDIR_R|5.010000|5.010000|Vn HAS_READLINK|5.003007|5.003007|Vn HAS_READV|5.007001|5.007001|Vn HAS_RECVMSG|5.007001|5.007001|Vn HAS_REGCOMP|5.021007|5.021007|Vn HAS_REMAINDER|5.021006|5.021006|Vn HAS_REMQUO|5.021006|5.021006|Vn HAS_RENAME|5.003007|5.003007|Vn HAS_RENAMEAT|5.027004|5.027004|Vn HAS_REWINDDIR|5.003007|5.003007|Vn HAS_RINT|5.021006|5.021006|Vn HAS_RMDIR|5.003007|5.003007|Vn HAS_ROUND|5.021006|5.021006|Vn HAS_SBRK_PROTO|5.007001|5.007001|Vn HAS_SCALBN|5.021006|5.021006|Vn HAS_SCALBNL|5.008001|5.008001|Vn HAS_SCHED_YIELD|5.005000|5.005000|Vn HAS_SCX_AUX_TABLES|5.027008||Viu HAS_SEEKDIR|5.003007|5.003007|Vn HAS_SELECT|5.003007|5.003007|Vn HAS_SEM|5.003007|5.003007|Vn HAS_SENDMSG|5.007001|5.007001|Vn HAS_SETEGID|5.003007|5.003007|Vn HAS_SETEUID|5.003007|5.003007|Vn HAS_SETGRENT|5.005000|5.005000|Vn HAS_SETGROUPS|5.004000|5.004000|Vn HAS_SETHOSTENT|5.005000|5.005000|Vn HAS_SETITIMER|5.007001|5.007001|Vn HAS_SETLINEBUF|5.003007|5.003007|Vn HAS_SETLOCALE|5.003007|5.003007|Vn HAS_SETNETENT|5.005000|5.005000|Vn HAS_SETPGID|5.003007|5.003007|Vn HAS_SETPGRP|5.003007|5.003007|Vn HAS_SETPRIORITY|5.003007|5.003007|Vn HAS_SETPROTOENT|5.005000|5.005000|Vn HAS_SETPWENT|5.005000|5.005000|Vn HAS_SETREGID|5.003007|5.003007|Vn HAS_SETRESGID|5.003007|5.003007|Vn HAS_SETRESGID_PROTO|5.010000|5.010000|Vn HAS_SETRESUID|5.003007|5.003007|Vn HAS_SETRESUID_PROTO|5.010000|5.010000|Vn HAS_SETREUID|5.003007|5.003007|Vn HAS_SETSERVENT|5.005000|5.005000|Vn HAS_SETSID|5.003007|5.003007|Vn HAS_SETVBUF|5.005000|5.005000|Vn HAS_SHM|5.003007|5.003007|Vn HAS_SHMAT_PROTOTYPE|5.003007|5.003007|Vn HAS_SIGACTION|5.003007|5.003007|Vn HAS_SIGINFO_SI_ADDR|5.023008|5.023008|Vn HAS_SIGINFO_SI_BAND|5.023008|5.023008|Vn HAS_SIGINFO_SI_ERRNO|5.023008|5.023008|Vn HAS_SIGINFO_SI_PID|5.023008|5.023008|Vn HAS_SIGINFO_SI_STATUS|5.023008|5.023008|Vn HAS_SIGINFO_SI_UID|5.023008|5.023008|Vn HAS_SIGINFO_SI_VALUE|5.023008|5.023008|Vn HAS_SIGNBIT|5.009005|5.009005|Vn HAS_SIGPROCMASK|5.007001|5.007001|Vn HAS_SIGSETJMP|5.003007|5.003007|Vn HAS_SIN6_SCOPE_ID|5.013009|5.013009|Vn HAS_SKIP_LOCALE_INIT|5.019002||Viu HAS_SNPRINTF|5.009003|5.009003|Vn HAS_SOCKADDR_IN6|5.015008|5.015008|Vn HAS_SOCKADDR_STORAGE|5.032001|5.032001|Vn HAS_SOCKATMARK|5.007001|5.007001|Vn HAS_SOCKATMARK_PROTO|5.007002|5.007002|Vn HAS_SOCKET|5.003007|5.003007|Vn HAS_SOCKETPAIR|5.003007|5.003007|Vn HAS_SQRTL|5.006000|5.006000|Vn HAS_SRAND48_R|5.010000|5.010000|Vn HAS_SRANDOM_R|5.010000|5.010000|Vn HAS_STAT|5.021007|5.021007|Vn HAS_STATIC_INLINE|5.013004|5.013004|Vn HAS_STRCOLL|5.003007|5.003007|Vn HAS_STRERROR_L|5.025002|5.025002|Vn HAS_STRERROR_R|5.010000|5.010000|Vn HAS_STRFTIME|5.007002|5.007002|Vn HAS_STRNLEN|5.027006|5.027006|Vn HAS_STRTOD|5.004000|5.004000|Vn HAS_STRTOD_L|5.027011|5.027011|Vn HAS_STRTOL|5.004000|5.004000|Vn HAS_STRTOLD|5.006000|5.006000|Vn HAS_STRTOLD_L|5.027006|5.027006|Vn HAS_STRTOLL|5.006000|5.006000|Vn HAS_STRTOQ|5.007001|5.007001|Vn HAS_STRTOUL|5.004000|5.004000|Vn HAS_STRTOULL|5.006000|5.006000|Vn HAS_STRTOUQ|5.006000|5.006000|Vn HAS_STRUCT_CMSGHDR|5.007001|5.007001|Vn HAS_STRUCT_MSGHDR|5.007001|5.007001|Vn HAS_STRUCT_STATFS|5.023005|5.023005|Vn HAS_STRUCT_STATFS_F_FLAGS|5.023005|5.023005|Vn HAS_STRXFRM|5.003007|5.003007|Vn HAS_STRXFRM_L|5.035001|5.035001|Vn HAS_SYMLINK|5.003007|5.003007|Vn HAS_SYSCALL|5.003007|5.003007|Vn HAS_SYSCALL_PROTO|5.007002|5.007002|Vn HAS_SYSCONF|5.003007|5.003007|Vn HAS_SYS_ERRLIST|5.003007|5.003007|Vn HAS_SYSTEM|5.003007|5.003007|Vn HAS_TC_AUX_TABLES|5.027011||Viu HAS_TCGETPGRP|5.003007|5.003007|Vn HAS_TCSETPGRP|5.003007|5.003007|Vn HAS_TELLDIR|5.003007|5.003007|Vn HAS_TELLDIR_PROTO|5.006000|5.006000|Vn HAS_TGAMMA|5.021006|5.021006|Vn HAS_THREAD_SAFE_NL_LANGINFO_L|5.027006|5.027006|Vn HAS_TIME|5.008000|5.008000|Vn HAS_TIMEGM|5.010001|5.010001|Vn HAS_TIMES|5.003007|5.003007|Vn HAS_TMPNAM_R|5.010000|5.010000|Vn HAS_TM_TM_GMTOFF|5.008001|5.008001|Vn HAS_TM_TM_ZONE|5.008000|5.008000|Vn HAS_TOWLOWER|5.029009|5.029009|Vn HAS_TOWUPPER|5.029009|5.029009|Vn HAS_TRUNC|5.021006|5.021006|Vn HAS_TRUNCATE|5.003007|5.003007|Vn HAS_TRUNCL|5.021004|5.021004|Vn HAS_TTYNAME_R|5.010000|5.010000|Vn HAS_TZNAME|5.003007|5.003007|Vn HAS_UALARM|5.007001|5.007001|Vn HAS_UC_AUX_TABLES|5.027011||Viu HAS_UMASK|5.003007|5.003007|Vn HAS_UNAME|5.003007|5.003007|Vn HAS_UNLINKAT|5.027004|5.027004|Vn HAS_UNSETENV|5.009003|5.009003|Vn HAS_USELOCALE|5.023009|5.023009|Vn HAS_USLEEP|5.007001|5.007001|Vn HAS_USLEEP_PROTO|5.007002|5.007002|Vn HAS_USTAT|5.023005|5.023005|Vn HAS_UTIME|5.003007||Viu HAS_VSNPRINTF|5.009003|5.009003|Vn HAS_WAIT4|5.003007|5.003007|Vn HAS_WAIT|5.003007||Viu HAS_WAITPID|5.003007|5.003007|Vn HAS_WCRTOMB|5.031007|5.031007|Vn HAS_WCSCMP|5.021001|5.021001|Vn HAS_WCSTOMBS|5.003007|5.003007|Vn HAS_WCSXFRM|5.021001|5.021001|Vn HAS_WCTOMB|5.003007|5.003007|Vn HAS_WRITEV|5.007001|5.007001|Vn HE_ARENA_ROOT_IX|5.035005||Viu he_dup|5.007003|5.007003|u HEf_SVKEY|5.003007|5.003007|p HeHASH|5.003007|5.003007| HEK_BASESIZE|5.004000||Viu hek_dup|5.009000|5.009000|u HeKEY|5.003007|5.003007| HeKEY_hek|5.004000||Viu HeKEY_sv|5.004000||Viu HEKf256|5.015004||Viu HEKf|5.015004||Viu HEKfARG|5.015004||Viu HEK_FLAGS|5.008000||Viu HeKFLAGS|5.008000||Viu HEK_HASH|5.004000||Viu HEK_KEY|5.004000||Viu HeKLEN|5.003007|5.003007| HEK_LEN|5.004000||Viu HeKLEN_UTF8|5.007001||Viu HEK_UTF8|5.007001||Viu HeKUTF8|5.007001||Viu HEK_UTF8_off|5.008000||Viu HEK_UTF8_on|5.008000||Viu HEK_WASUTF8|5.008000||Viu HeKWASUTF8|5.008000||Viu HEK_WASUTF8_off|5.008000||Viu HEK_WASUTF8_on|5.008000||Viu HeNEXT|5.003007||Viu HePV|5.004000|5.004000| HeSVKEY|5.003007|5.003007| HeSVKEY_force|5.003007|5.003007| HeSVKEY_set|5.004000|5.004000| HeUTF8|5.010001|5.008000|p HeVAL|5.003007|5.003007| hfree_next_entry|||iu HIGHEST_ANYOF_HRx_BYTE|5.031002||Viu HIGHEST_CASE_CHANGING_CP|5.033005||Viu HINT_ALL_STRICT|5.033002||Viu HINT_BLOCK_SCOPE|5.003007||Viu HINT_BYTES|5.007002||Viu HINT_EXPLICIT_STRICT_REFS|5.016000||Viu HINT_EXPLICIT_STRICT_SUBS|5.016000||Viu HINT_EXPLICIT_STRICT_VARS|5.016000||Viu HINT_FEATURE_MASK|5.015007||Viu HINT_FEATURE_SHIFT|5.015007||Viu HINT_FILETEST_ACCESS|5.006000||Viu HINT_INTEGER|5.003007||Viu HINT_LEXICAL_IO_IN|5.009005||Viu HINT_LEXICAL_IO_OUT|5.009005||Viu HINT_LOCALE|5.004000||Viu HINT_LOCALE_PARTIAL|5.021001||Viu HINT_LOCALIZE_HH|5.005000||Viu HINT_NEW_BINARY|5.005000||Viu HINT_NEW_FLOAT|5.005000||Viu HINT_NEW_INTEGER|5.005000||Viu HINT_NEW_RE|5.005000||Viu HINT_NEW_STRING|5.005000||Viu HINT_NO_AMAGIC|5.010001||Viu HINT_RE_EVAL|5.005000||Viu HINT_RE_FLAGS|5.013007||Viu HINT_RE_TAINT|5.004005||Viu HINTS_DEFAULT|5.033002||Viu HINTS_REFCNT_INIT|5.009004||Viu HINTS_REFCNT_LOCK|5.009004||Viu HINTS_REFCNT_TERM|5.009004||Viu HINTS_REFCNT_UNLOCK|5.009004||Viu HINT_STRICT_REFS|5.003007||Viu HINT_STRICT_SUBS|5.003007||Viu HINT_STRICT_VARS|5.003007||Viu HINT_UNI_8_BIT|5.011002||Viu HINT_UTF8|5.006000||Viu H_PERL|5.003007||Viu HS_APIVERLEN_MAX|5.021006||Viu HS_CXT|5.021006||Viu HSf_IMP_CXT|5.021006||Viu HSf_NOCHK|5.021006||Viu HSf_POPMARK|5.021006||Viu HSf_SETXSUBFN|5.021006||Viu HS_GETAPIVERLEN|5.021006||Viu HS_GETINTERPSIZE|5.021006||Viu HS_GETXSVERLEN|5.021006||Viu HS_KEY|5.021006||Viu HS_KEYp|5.021006||Viu HSm_APIVERLEN|5.021006||Viu HSm_INTRPSIZE|5.021006||Viu HSm_KEY_MATCH|5.021006||Viu HSm_XSVERLEN|5.021006||Viu hsplit|5.005000||Viu HS_XSVERLEN_MAX|5.021006||Viu htoni|5.003007||Viu htonl|5.003007||Viu htons|5.003007||Viu htovl|5.003007||Viu htovs|5.003007||Viu HvAMAGIC|5.017000||Viu HvAMAGIC_off|5.017000||Viu HvAMAGIC_on|5.017000||Viu HvARRAY|5.003007||Viu hv_assert||| HvAUX|5.009003||Viu hv_auxalloc|||iu HVAUX_ARENA_ROOT_IX|5.035005||Viu HvAUXf_NO_DEREF|5.019010||Viu HvAUXf_SCAN_STASH|5.019010||Viu hv_auxinit|5.009003||Viu hv_backreferences_p|||xiu hv_bucket_ratio|5.025003|5.025003|x hv_clear|5.003007|5.003007| hv_clear_placeholders|5.009001|5.009001| hv_common|5.010000||cVu hv_common_key_len|5.010000||cVu hv_copy_hints_hv|5.013005|5.013005| hv_delayfree_ent|5.004000|5.004000|u hv_delete|5.003007|5.003007| HV_DELETE|5.009005||Viu hv_delete_common|5.009001||xViu hv_delete_ent|5.003007|5.003007| hv_deletehek|5.019006||Viu hv_deletes|5.025006||Viu HV_DISABLE_UVAR_XKEY|5.010000||Viu HvEITER|5.003007||Viu HvEITER_get|5.009003||Viu hv_eiter_p|||u HvEITER_set|5.009003||Viu hv_eiter_set|||u HvENAME|5.013007|5.013007| hv_ename_add|5.013007||Vi hv_ename_delete|5.013007||Vi HvENAME_get|5.013007||Viu HvENAME_HEK|5.013007||Viu HvENAME_HEK_NN|5.013007||Viu HvENAMELEN|5.015004|5.015004| HvENAMELEN_get|5.013007||Viu HvENAMEUTF8|5.015004|5.015004| hv_exists|5.003007|5.003007| hv_exists_ent|5.003007|5.003007| hv_existshek|5.035003||Viu hv_existss|5.025006||Viu hv_fetch|5.003007|5.003007| HV_FETCH_EMPTY_HE|5.013007||Viu hv_fetch_ent|5.003007|5.003007| hv_fetchhek|5.019006||Viu HV_FETCH_ISEXISTS|5.009005||Viu HV_FETCH_ISSTORE|5.009005||Viu HV_FETCH_JUST_SV|5.009005||Viu HV_FETCH_LVALUE|5.009005||Viu hv_fetchs|5.009003|5.003007|p hv_fill||| HvFILL|5.003007|5.003007| hv_free_ent|5.004000|5.004000|u hv_free_ent_ret|5.015000||Viu hv_free_entries|5.027002||Viu HvHASKFLAGS|5.008000||Viu HvHASKFLAGS_off|5.008000||Viu HvHASKFLAGS_on|5.008000||Viu HVhek_ENABLEHVKFLAGS|5.008002||Viu HVhek_FREEKEY|5.008000||Viu HVhek_KEYCANONICAL|5.010001||Viu HVhek_MASK|5.008000||Viu HVhek_PLACEHOLD|5.008000||Viu HVhek_UNSHARED|5.009004||Viu HVhek_UTF8|5.008000||Viu HVhek_WASUTF8|5.008000||Viu hv_iterinit|5.003007|5.003007| hv_iterkey|5.003007|5.003007| hv_iterkeysv|5.003007|5.003007| hv_iternext|5.003007|5.003007| hv_iternext_flags|5.008000|5.008000|x hv_iternextsv|5.003007|5.003007| HV_ITERNEXT_WANTPLACEHOLDERS|5.008000|5.008000| hv_iterval|5.003007|5.003007| HvKEYS|5.003007||Viu hv_kill_backrefs|||xiu hv_ksplit|5.003007|5.003007|u HvLASTRAND_get|5.017011||Viu HvLAZYDEL|5.003007||Viu HvLAZYDEL_off|5.003007||Viu HvLAZYDEL_on|5.003007||Viu hv_magic|5.003007|5.003007| hv_magic_check|5.006000||Vniu HvMAX|5.003007||Viu HvMROMETA|5.010001|5.010001| HvNAME|5.003007|5.003007| HvNAME_get|5.009003||pcV HvNAME_HEK|5.009003||Viu HvNAME_HEK_NN|5.013007||Viu HvNAMELEN|5.015004|5.015004| HvNAMELEN_get|5.009003|5.003007|p hv_name_set|5.009003|5.009003|u HV_NAME_SETALL|5.013008||Viu hv_name_sets|5.025006||Viu HvNAMEUTF8|5.015004|5.015004| hv_notallowed|5.008000||Viu HvPLACEHOLDERS|5.007003||Viu HvPLACEHOLDERS_get|5.009003||Viu hv_placeholders_get|||u hv_placeholders_p|||ciu HvPLACEHOLDERS_set|5.009003||Viu hv_placeholders_set|||u hv_pushkv|5.027003||Viu HvRAND_get|5.017011||Viu hv_rand_set|5.018000|5.018000|u HVrhek_delete|5.009004||Viu HVrhek_IV|5.009004||Viu HVrhek_PV|5.009004||Viu HVrhek_PV_UTF8|5.009005||Viu HVrhek_typemask|5.009004||Viu HVrhek_undef|5.009004||Viu HVrhek_UV|5.009004||Viu HvRITER|5.003007||Viu HvRITER_get|5.009003||Viu hv_riter_p|||u HvRITER_set|5.009003||Viu hv_riter_set|||u hv_scalar|5.009001|5.009001| HvSHAREKEYS|5.003007||Viu HvSHAREKEYS_off|5.003007||Viu HvSHAREKEYS_on|5.003007||Viu hv_store|5.003007|5.003007| hv_store_ent|5.003007|5.003007| hv_store_flags|5.008000|5.008000|xu hv_storehek|5.019006||Viu hv_stores|5.009004|5.003007|p HvTOTALKEYS|5.007003||Viu hv_undef|5.003007|5.003007| hv_undef_flags|||ciu HvUSEDKEYS|5.007003||Viu HYPHEN_UTF8|5.017004||Viu I16_MAX|5.003007||Viu I16_MIN|5.003007||Viu I16SIZE|5.006000|5.006000|Vn I16TYPE|5.006000|5.006000|Vn I_32|5.006000|5.003007| I32_MAX|5.003007||Viu I32_MAX_P1|5.007002||Viu I32_MIN|5.003007||Viu I32SIZE|5.006000|5.006000|Vn I32TYPE|5.006000|5.006000|Vn I64SIZE|5.006000|5.006000|Vn I64TYPE|5.006000|5.006000|Vn I8SIZE|5.006000|5.006000|Vn I8_TO_NATIVE|5.015006||Viu I8_TO_NATIVE_UTF8|5.019004||Viu I8TYPE|5.006000|5.006000|Vn I_ARPA_INET|5.005000|5.005000|Vn ibcmp|5.003007|5.003007| ibcmp_locale|5.004000|5.004000| ibcmp_utf8|5.007003|5.007003| I_CRYPT|5.008000|5.008000|Vn I_DBM|5.032001|5.032001|Vn I_DIRENT|5.003007|5.003007|Vn I_DLFCN|5.003007|5.003007|Vn I_EXECINFO|5.021001|5.021001|Vn I_FENV|5.021004|5.021004|Vn IFMATCH|5.003007||Viu IFMATCH_A|5.009005||Viu IFMATCH_A_fail|5.009005||Viu IFMATCH_A_fail_t8|5.035004||Viu IFMATCH_A_fail_t8_p8|5.033003||Viu IFMATCH_A_fail_t8_pb|5.033003||Viu IFMATCH_A_fail_tb|5.035004||Viu IFMATCH_A_fail_tb_p8|5.033003||Viu IFMATCH_A_fail_tb_pb|5.033003||Viu IFMATCH_A_t8|5.035004||Viu IFMATCH_A_t8_p8|5.033003||Viu IFMATCH_A_t8_pb|5.033003||Viu IFMATCH_A_tb|5.035004||Viu IFMATCH_A_tb_p8|5.033003||Viu IFMATCH_A_tb_pb|5.033003||Viu IFMATCH_t8|5.035004||Viu IFMATCH_t8_p8|5.033003||Viu IFMATCH_t8_pb|5.033003||Viu IFMATCH_tb|5.035004||Viu IFMATCH_tb_p8|5.033003||Viu IFMATCH_tb_pb|5.033003||Viu IFTHEN|5.005000||Viu IFTHEN_t8|5.035004||Viu IFTHEN_t8_p8|5.033003||Viu IFTHEN_t8_pb|5.033003||Viu IFTHEN_tb|5.035004||Viu IFTHEN_tb_p8|5.033003||Viu IFTHEN_tb_pb|5.033003||Viu I_GDBM|5.021007|5.021007|Vn I_GDBMNDBM|5.021007|5.021007|Vn IGNORE_PAT_MOD|5.009005||Viu I_GRP|5.003007|5.003007|Vn I_INTTYPES|5.006000|5.006000|Vn I_LANGINFO|5.007002|5.007002|Vn I_LIMITS|5.003007||Viu ILLEGAL_UTF8_BYTE|5.019004||Viu I_LOCALE|5.003007|5.003007|Vn I_MNTENT|5.023005|5.023005|Vn IN_BYTES|5.007002||Viu incline|5.005000||Viu INCLUDE_PROTOTYPES|5.007001||Viu INCMARK|5.023005||Viu incpush|5.005000||Viu INCPUSH_APPLLIB_EXP|5.027006||Viu INCPUSH_APPLLIB_OLD_EXP|5.027006||Viu INCPUSH_ARCHLIB_EXP|5.027006||Viu incpush_if_exists|5.009003||Viu INCPUSH_PERL5LIB|5.027006||Viu INCPUSH_PERL_OTHERLIBDIRS|5.027006||Viu INCPUSH_PERL_OTHERLIBDIRS_ARCHONLY|5.027006||Viu INCPUSH_PERL_VENDORARCH_EXP|5.027006||Viu INCPUSH_PERL_VENDORLIB_EXP|5.027006||Viu INCPUSH_PERL_VENDORLIB_STEM|5.027006||Viu INCPUSH_PRIVLIB_EXP|5.027006||Viu INCPUSH_SITEARCH_EXP|5.027006||Viu INCPUSH_SITELIB_EXP|5.027006||Viu INCPUSH_SITELIB_STEM|5.027006||Viu incpush_use_sep|5.011000||Viu I_NDBM|5.032001|5.032001|Vn inet_addr|5.005000||Viu I_NETDB|5.005000|5.005000|Vn I_NETINET_IN|5.003007|5.003007|Vn I_NETINET_TCP|5.006000|5.006000|Vn inet_ntoa|5.005000||Viu INFNAN_NV_U8_DECL|5.023000||Viu INFNAN_U8_NV_DECL|5.023000||Viu ingroup|5.003007||Viu INIT|5.003007||Viu init_argv_symbols|5.007003||Viu init_constants|5.017003||Viu init_dbargs|||iu init_debugger|5.005000||Viu init_i18nl10n|5.006000||cVu init_i18nl14n|5.006000||dcVu initialize_invlist_guts|5.029002||Viu init_ids|5.005000||Viu init_interp|5.005000||Viu init_main_stash|5.005000||Viu init_named_cv|5.027010||cViu init_os_extras|5.005000||Viu init_perllib|5.005000||Viu init_postdump_symbols|5.005000||Viu init_predump_symbols|5.005000||Viu init_stacks|5.005000|5.005000|u INIT_THREADS|5.005000||Viu init_tm|5.007002|5.007002|u INIT_TRACK_MEMPOOL|5.009004||Viu init_uniprops|5.027011||Viu IN_LC|5.021001||Viu IN_LC_ALL_COMPILETIME|5.021001||Viu IN_LC_ALL_RUNTIME|5.021001||Viu IN_LC_COMPILETIME|5.021001||Viu IN_LC_PARTIAL_COMPILETIME|5.021001||Viu IN_LC_PARTIAL_RUNTIME|5.021001||Viu IN_LC_RUNTIME|5.021001||Viu IN_LOCALE|5.007002|5.004000|p IN_LOCALE_COMPILETIME|5.007002|5.004000|p IN_LOCALE_RUNTIME|5.007002|5.004000|p IN_PERL_COMPILETIME|5.008001|5.003007|p IN_PERL_RUNTIME|5.008001|5.008001| inplace_aassign|5.015003||Viu inRANGE|5.029010||Viu inRANGE_helper|5.033005||Viu IN_SOME_LOCALE_FORM|5.015008||Viu IN_SOME_LOCALE_FORM_COMPILETIME|5.015008||Viu IN_SOME_LOCALE_FORM_RUNTIME|5.015008||Viu instr|5.003007|5.003007|n INSUBP|5.009005||Viu INSUBP_t8|5.035004||Viu INSUBP_t8_p8|5.033003||Viu INSUBP_t8_pb|5.033003||Viu INSUBP_tb|5.035004||Viu INSUBP_tb_p8|5.033003||Viu INSUBP_tb_pb|5.033003||Viu INT16_C|5.003007|5.003007| INT2PTR|5.006000|5.003007|p INT32_C|5.003007|5.003007| INT32_MIN|5.007002||Viu INT64_C|5.023002|5.023002| INT64_MIN|5.007002||Viu INT_64_T|5.011000||Viu INTMAX_C|5.003007|5.003007| INT_PAT_MODS|5.009005||Viu intro_my|5.021006|5.021006| INTSIZE|5.003007|5.003007|Vn intuit_method|5.005000||Viu intuit_more|5.003007||Viu IN_UNI_8_BIT|5.011002||Viu IN_UTF8_CTYPE_LOCALE|5.019009||Viu _inverse_folds|5.027011||cViu invert|5.003007||Viu invlist_array|5.013010||Vniu _invlist_array_init|5.015001||Vniu invlist_clear|5.023009||Viu invlist_clone|5.015001||cViu _invlist_contains_cp|5.017003||Vniu invlist_contents|5.023008||Viu _invlist_dump|5.019003||cViu _invlistEQ|5.023006||cViu invlist_extend|5.013010||Viu invlist_highest|5.017002||Vniu _invlist_intersection|5.015001||Viu _invlist_intersection_maybe_complement_2nd|5.015008||cViu _invlist_invert|5.015001||cViu invlist_is_iterating|5.017008||Vniu invlist_iterfinish|5.017008||Vniu invlist_iterinit|5.015001||Vniu invlist_iternext|5.015001||Vniu _invlist_len|5.017004||Vniu invlist_lowest|5.031007||xVniu invlist_max|5.013010||Vniu invlist_previous_index|5.017004||Vniu invlist_replace_list_destroys_src|5.023009||Viu _invlist_search|5.017003||cVniu invlist_set_len|5.013010||Viu invlist_set_previous_index|5.017004||Vniu _invlist_subtract|5.015001||Viu invlist_trim|5.013010||Vniu _invlist_union|5.015001||cVu _invlist_union_maybe_complement_2nd|5.015008||cViu invmap_dump|5.031006||Viu invoke_exception_hook|5.013001||Viu IoANY|5.006001||Viu IoBOTTOM_GV|5.003007||Viu IoBOTTOM_NAME|5.003007||Viu io_close|5.003007||Viu IOCPARM_LEN|5.003007||Viu ioctl|5.005000||Viu IoDIRP|5.003007||Viu IOf_ARGV|5.003007||Viu IOf_DIDTOP|5.003007||Viu IOf_FAKE_DIRP|5.006000||Viu IOf_FLUSH|5.003007||Viu IoFLAGS|5.003007||Viu IoFMT_GV|5.003007||Viu IoFMT_NAME|5.003007||Viu IOf_NOLINE|5.005003||Viu IOf_START|5.003007||Viu IOf_UNTAINT|5.003007||Viu IoIFP|5.003007||Viu IoLINES|5.003007||Viu IoLINES_LEFT|5.003007||Viu IoOFP|5.003007||Viu IoPAGE|5.003007||Viu IoPAGE_LEN|5.003007||Viu IoTOP_GV|5.003007||Viu IoTOP_NAME|5.003007||Viu IoTYPE|5.003007||Viu IoTYPE_APPEND|5.006001||Viu IoTYPE_CLOSED|5.006001||Viu IoTYPE_IMPLICIT|5.008001||Viu IoTYPE_NUMERIC|5.008001||Viu IoTYPE_PIPE|5.006001||Viu IoTYPE_RDONLY|5.006001||Viu IoTYPE_RDWR|5.006001||Viu IoTYPE_SOCKET|5.006001||Viu IoTYPE_STD|5.006001||Viu IoTYPE_WRONLY|5.006001||Viu I_POLL|5.006000|5.006000|Vn I_PTHREAD|5.005003|5.005003|Vn I_PWD|5.003007|5.003007|Vn isALNUM|5.003007|5.003007|p isALNUM_A|5.031003|5.003007|p isALNUMC|5.006000|5.003007|p isALNUMC_A|5.013006|5.003007|p isALNUMC_L1|5.013006|5.003007|p isALNUMC_LC|5.006000|5.006000| isALNUMC_LC_utf8_safe|5.031007||Viu isALNUMC_LC_uvchr|5.017007|5.017007| isALNUMC_uni|5.017007||Viu isALNUMC_utf8|5.017007||Viu isALNUMC_utf8_safe|5.031007||Viu isALNUM_lazy_if_safe|5.031007||Viu isALNUM_LC|5.004000|5.004000| isALNUM_LC_utf8|5.006000||Viu isALNUM_LC_utf8_safe|5.031007||Viu isALNUM_LC_uvchr|5.007001|5.007001| isALNUMU|5.011005||Viu isALNUM_uni|5.006000||Viu isALNUM_utf8|5.006000||Viu isALNUM_utf8_safe|5.031007||Viu isa_lookup|5.005000||Viu isALPHA|5.003007|5.003007|p isALPHA_A|5.013006|5.003007|p isALPHA_FOLD_EQ|5.021004||Viu isALPHA_FOLD_NE|5.021004||Viu isALPHA_L1|5.013006|5.003007|p isALPHA_LC|5.004000|5.004000| isALPHA_LC_utf8|5.006000||Viu isALPHA_LC_utf8_safe|5.025009|5.006000|p isALPHA_LC_uvchr|5.007001|5.007001| isALPHANUMERIC|5.017008|5.003007|p isALPHANUMERIC_A|5.017008|5.003007|p isALPHANUMERIC_L1|5.017008|5.003007|p isALPHANUMERIC_LC|5.017008|5.004000|p isALPHANUMERIC_LC_utf8|5.017008||Viu isALPHANUMERIC_LC_utf8_safe|5.025009|5.006000|p isALPHANUMERIC_LC_uvchr|5.017008|5.017008| isALPHANUMERIC_uni|5.017008||Viu isALPHANUMERIC_utf8|5.031005|5.031005| isALPHANUMERIC_utf8_safe|5.025009|5.006000|p isALPHANUMERIC_uvchr|5.023009|5.006000|p isALPHAU|5.011005||Viu isALPHA_uni|5.006000||Viu isALPHA_utf8|5.031005|5.031005| isALPHA_utf8_safe|5.025009|5.006000|p isALPHA_uvchr|5.023009|5.006000|p is_an_int|5.005000||Viu is_ANYOF_SYNTHETIC|5.019009||Viu IS_ANYOF_TRIE|5.009005||Viu isASCII|5.006000|5.003007|p isASCII_A|5.013006|5.003007|p isASCII_L1|5.015004|5.003007|p isASCII_LC|5.015008|5.003007|p isASCII_LC_utf8|5.017007||Viu isASCII_LC_utf8_safe|5.025009|5.025009| isASCII_LC_uvchr|5.017007|5.017007| is_ascii_string|5.011000|5.011000|n isASCII_uni|5.006000||Viu isASCII_utf8|5.031005|5.031005| isASCII_utf8_safe|5.025009|5.003007|p isASCII_uvchr|5.023009|5.003007|p isatty|5.005000||Viu ISA_VERSION_OBJ|5.019008||Viu isBLANK|5.006001|5.003007|p isBLANK_A|5.013006|5.003007|p isBLANK_L1|5.013006|5.003007|p isBLANK_LC|5.006001|5.003007|p isBLANK_LC_uni|5.006001||Viu isBLANK_LC_utf8|5.006001||Viu isBLANK_LC_utf8_safe|5.025009|5.006000|p isBLANK_LC_uvchr|5.017007|5.017007| isBLANK_uni|5.006001||Viu isBLANK_utf8|5.031005|5.031005| isBLANK_utf8_safe|5.025009|5.006000|p isBLANK_uvchr|5.023009|5.006000|p isC9_STRICT_UTF8_CHAR|5.025005|5.025005|n is_c9strict_utf8_string|5.025006|5.025006|n is_c9strict_utf8_string_loc|5.025006|5.025006|n is_c9strict_utf8_string_loclen|5.025006|5.025006|n isCHARNAME_CONT|5.011005||Viu isCNTRL|5.006000|5.003007|p isCNTRL_A|5.013006|5.003007|p isCNTRL_L1|5.013006|5.003007|p isCNTRL_LC|5.006000|5.006000| isCNTRL_LC_utf8|5.006000||Viu isCNTRL_LC_utf8_safe|5.025009|5.006000|p isCNTRL_LC_uvchr|5.007001|5.007001| isCNTRL_uni|5.006000||Viu isCNTRL_utf8|5.031005|5.031005| isCNTRL_utf8_safe|5.025009|5.006000|p isCNTRL_uvchr|5.023009|5.006000|p _is_cur_LC_category_utf8|5.021001||cVu isDEBUG_WILDCARD|5.031011||Viu isDIGIT|5.003007|5.003007|p isDIGIT_A|5.013006|5.003007|p isDIGIT_L1|5.013006|5.003007|p isDIGIT_LC|5.004000|5.004000| isDIGIT_LC_utf8|5.006000||Viu isDIGIT_LC_utf8_safe|5.025009|5.006000|p isDIGIT_LC_uvchr|5.007001|5.007001| isDIGIT_uni|5.006000||Viu isDIGIT_utf8|5.031005|5.031005| isDIGIT_utf8_safe|5.025009|5.006000|p isDIGIT_uvchr|5.023009|5.006000|p isEXACTFish|5.033003||Viu isEXACT_REQ8|5.033003||Viu isFF_overlong|5.035004||Vniu is_FOLDS_TO_MULTI_utf8|5.019009||Viu isFOO_lc|5.017007||Viu isFOO_utf8_lc|5.017008||Viu isGCB|5.021009||Viu isGRAPH|5.006000|5.003007|p isGRAPH_A|5.013006|5.003007|p is_grapheme|5.031007||Viu isGRAPH_L1|5.013006|5.003007|p isGRAPH_LC|5.006000|5.006000| isGRAPH_LC_utf8|5.006000||Viu isGRAPH_LC_utf8_safe|5.025009|5.006000|p isGRAPH_LC_uvchr|5.007001|5.007001| isGRAPH_uni|5.006000||Viu isGRAPH_utf8|5.031005|5.031005| isGRAPH_utf8_safe|5.025009|5.006000|p isGRAPH_uvchr|5.023009|5.006000|p isGV|5.003007||Viu isGV_or_RVCV|5.027005||Viu isGV_with_GP|5.009004|5.003007|p isGV_with_GP_off|5.009005||Viu isGV_with_GP_on|5.009005||Viu I_SHADOW|5.006000|5.006000|Vn is_handle_constructor|5.006000||Vniu is_HANGUL_ED_utf8_safe|5.029001||Viu is_HORIZWS_cp_high|5.017006||Viu is_HORIZWS_high|5.017006||Viu isIDCONT|5.017008|5.003007|p isIDCONT_A|5.017008|5.003007|p isIDCONT_L1|5.017008|5.003007|p isIDCONT_LC|5.017008|5.004000|p isIDCONT_LC_utf8|5.017008||Viu isIDCONT_LC_utf8_safe|5.025009|5.006000|p isIDCONT_LC_uvchr|5.017008|5.017008| isIDCONT_uni|5.017008||Viu isIDCONT_utf8|5.031005|5.031005| isIDCONT_utf8_safe|5.025009|5.006000|p isIDCONT_uvchr|5.023009|5.006000|p isIDFIRST|5.003007|5.003007|p isIDFIRST_A|5.013006|5.003007|p isIDFIRST_L1|5.013006|5.003007|p isIDFIRST_lazy_if_safe|5.025009||Viu isIDFIRST_LC|5.004000|5.004000|p isIDFIRST_LC_utf8|5.006000||Viu isIDFIRST_LC_utf8_safe|5.025009|5.006000|p isIDFIRST_LC_uvchr|5.007001|5.007001| isIDFIRST_uni|5.006000||Viu isIDFIRST_utf8|5.031005|5.031005| isIDFIRST_utf8_safe|5.025009|5.006000|p isIDFIRST_uvchr|5.023009|5.006000|p isinfnan|5.021004|5.021004|n isinfnansv|5.021005||Vi _is_in_locale_category|5.021001||cViu IS_IN_SOME_FOLD_L1|5.033005||Viu is_invariant_string|5.021007|5.011000|pn is_invlist|5.029002||Vniu is_LARGER_NON_CHARS_utf8|5.035003||Viu is_LAX_VERSION|5.011004||Viu isLB|5.023007||Viu isLEXWARN_off|5.006000||Viu isLEXWARN_on|5.006000||Viu is_LNBREAK_latin1_safe|5.009005||Viu is_LNBREAK_safe|5.009005||Viu is_LNBREAK_utf8_safe|5.009005||Viu isLOWER|5.003007|5.003007|p isLOWER_A|5.013006|5.003007|p isLOWER_L1|5.013006|5.003007|p isLOWER_LC|5.004000|5.004000| isLOWER_LC_utf8|5.006000||Viu isLOWER_LC_utf8_safe|5.025009|5.006000|p isLOWER_LC_uvchr|5.007001|5.007001| isLOWER_uni|5.006000||Viu isLOWER_utf8|5.031005|5.031005| isLOWER_utf8_safe|5.025009|5.006000|p isLOWER_uvchr|5.023009|5.006000|p is_lvalue_sub|5.007001|5.007001|u isMNEMONIC_CNTRL|5.031009||Viu is_MULTI_CHAR_FOLD_latin1_safe|5.019010||Viu is_MULTI_CHAR_FOLD_utf8_safe|5.019010||Viu is_MULTI_CHAR_FOLD_utf8_safe_part0|5.019010||Viu is_MULTI_CHAR_FOLD_utf8_safe_part1|5.019010||Viu is_MULTI_CHAR_FOLD_utf8_safe_part2|5.025008||Viu is_MULTI_CHAR_FOLD_utf8_safe_part3|5.025008||Viu is_NONCHAR_utf8_safe|5.025005||Viu IS_NON_FINAL_FOLD|5.033005||Viu isnormal|5.021004||Viu IS_NUMBER_GREATER_THAN_UV_MAX|5.007002|5.003007|p IS_NUMBER_INFINITY|5.007002|5.003007|p IS_NUMBER_IN_UV|5.007002|5.003007|p IS_NUMBER_NAN|5.007003|5.003007|p IS_NUMBER_NEG|5.007002|5.003007|p IS_NUMBER_NOT_INT|5.007002|5.003007|p IS_NUMBER_TRAILING|5.021002||Viu IS_NUMERIC_RADIX|5.006000||Viu isOCTAL|5.013005|5.003007|p isOCTAL_A|5.013006|5.003007|p isOCTAL_L1|5.013006|5.003007|p IS_PADCONST|5.006000||Viu IS_PADGV|5.006000||Viu is_PATWS_safe|5.017008||Viu isPOWER_OF_2|5.029006||Viu isPRINT|5.004000|5.003007|p isPRINT_A|5.013006|5.003007|p isPRINT_L1|5.013006|5.003007|p isPRINT_LC|5.004000|5.004000| isPRINT_LC_utf8|5.006000||Viu isPRINT_LC_utf8_safe|5.025009|5.006000|p isPRINT_LC_uvchr|5.007001|5.007001| isPRINT_uni|5.006000||Viu isPRINT_utf8|5.031005|5.031005| isPRINT_utf8_safe|5.025009|5.006000|p isPRINT_uvchr|5.023009|5.006000|p is_PROBLEMATIC_LOCALE_FOLD_cp|5.019009||Viu is_PROBLEMATIC_LOCALE_FOLDEDS_START_cp|5.019009||Viu is_PROBLEMATIC_LOCALE_FOLDEDS_START_utf8|5.019009||Viu is_PROBLEMATIC_LOCALE_FOLD_utf8|5.019009||Viu isPSXSPC|5.006001|5.003007|p isPSXSPC_A|5.013006|5.003007|p isPSXSPC_L1|5.013006|5.003007|p isPSXSPC_LC|5.006001|5.006001| isPSXSPC_LC_utf8|5.006001||Viu isPSXSPC_LC_utf8_safe|5.025009|5.006000|p isPSXSPC_LC_uvchr|5.017007|5.017007| isPSXSPC_uni|5.006001||Viu isPSXSPC_utf8|5.031005|5.031005| isPSXSPC_utf8_safe|5.025009|5.006000|p isPSXSPC_uvchr|5.023009|5.006000|p isPUNCT|5.006000|5.003007|p isPUNCT_A|5.013006|5.003007|p isPUNCT_L1|5.013006|5.003007|p isPUNCT_LC|5.006000|5.006000| isPUNCT_LC_utf8|5.006000||Viu isPUNCT_LC_utf8_safe|5.025009|5.006000|p isPUNCT_LC_uvchr|5.007001|5.007001| isPUNCT_uni|5.006000||Viu isPUNCT_utf8|5.031005|5.031005| isPUNCT_utf8_safe|5.025009|5.006000|p isPUNCT_uvchr|5.023009|5.006000|p is_QUOTEMETA_high|5.017004||Viu isREGEXP|5.017006||Viu IS_SAFE_PATHNAME|5.019004||Viu IS_SAFE_SYSCALL|5.019004|5.019004| is_safe_syscall|5.019004|5.019004| isSB|5.021009||Viu isSCRIPT_RUN|5.027008||cVi is_SHORTER_NON_CHARS_utf8|5.035003||Viu isSPACE|5.003007|5.003007|p isSPACE_A|5.013006|5.003007|p isSPACE_L1|5.013006|5.003007|p isSPACE_LC|5.004000|5.004000| isSPACE_LC_utf8|5.006000||Viu isSPACE_LC_utf8_safe|5.025009|5.006000|p isSPACE_LC_uvchr|5.007001|5.007001| isSPACE_uni|5.006000||Viu isSPACE_utf8|5.031005|5.031005| isSPACE_utf8_safe|5.025009|5.006000|p isSPACE_uvchr|5.023009|5.006000|p is_ssc_worth_it|5.021005||Vniu isSTRICT_UTF8_CHAR|5.025005|5.025005|n is_strict_utf8_string|5.025006|5.025006|n is_strict_utf8_string_loc|5.025006|5.025006|n is_strict_utf8_string_loclen|5.025006|5.025006|n is_STRICT_VERSION|5.011004||Viu is_SURROGATE_utf8|5.035004||Viu is_SURROGATE_utf8_safe|5.025005||Viu I_STDARG|5.003007||Viu I_STDBOOL|5.015003|5.015003|Vn I_STDINT|5.021004|5.021004|Vn is_THREE_CHAR_FOLD_HEAD_latin1_safe|5.031007||Viu is_THREE_CHAR_FOLD_HEAD_utf8_safe|5.031007||Viu is_THREE_CHAR_FOLD_latin1_safe|5.031007||Viu is_THREE_CHAR_FOLD_utf8_safe|5.031007||Viu IS_TRIE_AC|5.009005||Viu isUNICODE_POSSIBLY_PROBLEMATIC|5.035004||Viu _is_uni_FOO|5.017008||cVu _is_uni_perl_idcont|5.017008||cVu _is_uni_perl_idstart|5.017007||cVu isUPPER|5.003007|5.003007|p isUPPER_A|5.013006|5.003007|p isUPPER_L1|5.013006|5.003007|p isUPPER_LC|5.004000|5.004000| isUPPER_LC_utf8|5.006000||Viu isUPPER_LC_utf8_safe|5.025009|5.006000|p isUPPER_LC_uvchr|5.007001|5.007001| isUPPER_uni|5.006000||Viu isUPPER_utf8|5.031005|5.031005| isUPPER_utf8_safe|5.025009|5.006000|p isUPPER_uvchr|5.023009|5.006000|p is_utf8_char|5.006000|5.006000|dn IS_UTF8_CHAR|5.009003||Viu isUTF8_CHAR|5.021001|5.006001|pn is_utf8_char_buf|5.015008|5.015008|n isUTF8_CHAR_flags|5.025005|5.025005|n is_utf8_char_helper_|5.035004||cVnu is_utf8_common|5.009003||Viu is_utf8_FF_helper_|5.035004||cVnu is_utf8_fixed_width_buf_flags|5.025006|5.025006|n is_utf8_fixed_width_buf_loc_flags|5.025006|5.025006|n is_utf8_fixed_width_buf_loclen_flags|5.025006|5.025006|n _is_utf8_FOO|5.031006||cVu is_utf8_invariant_string|5.025005|5.011000|pn is_utf8_invariant_string_loc|5.027001|5.027001|n is_utf8_non_invariant_string|5.027007||cVni is_utf8_overlong|5.035004||Vniu _is_utf8_perl_idcont|5.031006||cVu _is_utf8_perl_idstart|5.031006||cVu isUTF8_POSSIBLY_PROBLEMATIC|5.023003||Viu is_utf8_string|5.006001|5.006001|n is_utf8_string_flags|5.025006|5.025006|n is_utf8_string_loc|5.008001|5.008001|n is_utf8_string_loc_flags|5.025006|5.025006|n is_utf8_string_loclen|5.009003|5.009003|n is_utf8_string_loclen_flags|5.025006|5.025006|n is_utf8_valid_partial_char|5.025005|5.025005|n is_utf8_valid_partial_char_flags|5.025005|5.025005|n is_VERTWS_cp_high|5.017006||Viu is_VERTWS_high|5.017006||Viu isVERTWS_uni|5.017006||Viu isVERTWS_utf8|5.017006||Viu isVERTWS_utf8_safe|5.025009||Viu isVERTWS_uvchr|5.023009||Viu isWARNf_on|5.006001||Viu isWARN_on|5.006000||Viu isWARN_ONCE|5.006000||Viu isWB|5.021009||Viu isWORDCHAR|5.013006|5.003007|p isWORDCHAR_A|5.013006|5.003007|p isWORDCHAR_L1|5.013006|5.003007|p isWORDCHAR_lazy_if_safe|5.025009||Viu isWORDCHAR_LC|5.017007|5.004000|p isWORDCHAR_LC_utf8|5.017007||Viu isWORDCHAR_LC_utf8_safe|5.025009|5.006000|p isWORDCHAR_LC_uvchr|5.017007|5.017007| isWORDCHAR_uni|5.017006||Viu isWORDCHAR_utf8|5.031005|5.031005| isWORDCHAR_utf8_safe|5.025009|5.006000|p isWORDCHAR_uvchr|5.023009|5.006000|p isXDIGIT|5.006000|5.003007|p isXDIGIT_A|5.013006|5.003007|p is_XDIGIT_cp_high|5.017006||Viu is_XDIGIT_high|5.017006||Viu isXDIGIT_L1|5.013006|5.003007|p isXDIGIT_LC|5.017007|5.003007|p isXDIGIT_LC_utf8|5.017007||Viu isXDIGIT_LC_utf8_safe|5.025009|5.006000|p isXDIGIT_LC_uvchr|5.017007|5.017007| isXDIGIT_uni|5.006000||Viu isXDIGIT_utf8|5.031005|5.031005| isXDIGIT_utf8_safe|5.025009|5.006000|p isXDIGIT_uvchr|5.023009|5.006000|p is_XPERLSPACE_cp_high|5.017006||Viu is_XPERLSPACE_high|5.017006||Viu I_SYS_DIR|5.003007|5.003007|Vn I_SYS_FILE|5.003007|5.003007|Vn I_SYS_IOCTL|5.003007|5.003007|Vn I_SYSLOG|5.006000|5.006000|Vn I_SYS_MOUNT|5.023005|5.023005|Vn I_SYS_PARAM|5.003007|5.003007|Vn I_SYS_POLL|5.010001|5.010001|Vn I_SYS_RESOURCE|5.003007|5.003007|Vn I_SYS_SELECT|5.003007|5.003007|Vn I_SYS_STAT|5.003007|5.003007|Vn I_SYS_STATFS|5.023005|5.023005|Vn I_SYS_STATVFS|5.023005|5.023005|Vn I_SYS_TIME|5.003007|5.003007|Vn I_SYS_TIMES|5.003007|5.003007|Vn I_SYS_TYPES|5.003007|5.003007|Vn I_SYSUIO|5.006000|5.006000|Vn I_SYS_UN|5.003007|5.003007|Vn I_SYSUTSNAME|5.006000|5.006000|Vn I_SYS_VFS|5.023005|5.023005|Vn I_SYS_WAIT|5.003007|5.003007|Vn items||5.003007| I_TERMIOS|5.003007|5.003007|Vn I_TIME|5.003007|5.003007|Vn I_UNISTD|5.003007|5.003007|Vn I_USTAT|5.023005|5.023005|Vn I_UTIME|5.003007|5.003007|Vn I_V|5.006000|5.003007| IVdf|5.006000|5.003007|poVn IV_DIG|5.006000||Viu IV_IS_QUAD|5.006000||Viu IV_MAX|5.003007|5.003007| IV_MAX_P1|5.007002||Viu IV_MIN|5.003007|5.003007| IVSIZE|5.006000|5.003007|poVn IVTYPE|5.006000|5.003007|poVn I_WCHAR|5.027006|5.027006|Vn I_WCTYPE|5.029009|5.029009|Vn ix||5.003007| I_XLOCALE|5.025004|5.025004|Vn JE_OLD_STACK_HWM_restore|5.027002||Viu JE_OLD_STACK_HWM_save|5.027002||Viu JE_OLD_STACK_HWM_zero|5.027002||Viu jmaybe|5.003007||Viu JMPENV_BOOTSTRAP|5.006000||Viu JMPENV_JUMP|5.004000|5.004000| JMPENV_POP|5.004000||Viu JMPENV_PUSH|5.004000||Viu JOIN|5.005000||Viu join_exact|5.009004||Viu kBINOP|5.003007||Viu kCOP|5.003007||Viu KEEPCOPY_PAT_MOD|5.009005||Viu KEEPCOPY_PAT_MODS|5.009005||Viu KEEPS|5.009005||Viu KEEPS_next|5.009005||Viu KEEPS_next_fail|5.009005||Viu KEEPS_next_fail_t8|5.035004||Viu KEEPS_next_fail_t8_p8|5.033003||Viu KEEPS_next_fail_t8_pb|5.033003||Viu KEEPS_next_fail_tb|5.035004||Viu KEEPS_next_fail_tb_p8|5.033003||Viu KEEPS_next_fail_tb_pb|5.033003||Viu KEEPS_next_t8|5.035004||Viu KEEPS_next_t8_p8|5.033003||Viu KEEPS_next_t8_pb|5.033003||Viu KEEPS_next_tb|5.035004||Viu KEEPS_next_tb_p8|5.033003||Viu KEEPS_next_tb_pb|5.033003||Viu KEEPS_t8|5.035004||Viu KEEPS_t8_p8|5.033003||Viu KEEPS_t8_pb|5.033003||Viu KEEPS_tb|5.035004||Viu KEEPS_tb_p8|5.033003||Viu KEEPS_tb_pb|5.033003||Viu KELVIN_SIGN|5.017003||Viu KERNEL|5.003007||Viu KEY_abs|5.003007||Viu KEY_accept|5.003007||Viu KEY_alarm|5.003007||Viu KEY_and|5.003007||Viu KEY_atan2|5.003007||Viu KEY_AUTOLOAD|5.003007||Viu KEY_BEGIN|5.003007||Viu KEY_bind|5.003007||Viu KEY_binmode|5.003007||Viu KEY_bless|5.003007||Viu KEY_break|5.027008||Viu KEY_caller|5.003007||Viu KEY_catch|5.033007||Viu KEY_chdir|5.003007||Viu KEY_CHECK|5.006000||Viu KEY_chmod|5.003007||Viu KEY_chomp|5.003007||Viu KEY_chop|5.003007||Viu KEY_chown|5.003007||Viu KEY_chr|5.003007||Viu KEY_chroot|5.003007||Viu KEY_close|5.003007||Viu KEY_closedir|5.003007||Viu KEY_cmp|5.003007||Viu KEY_connect|5.003007||Viu KEY_continue|5.003007||Viu KEY_cos|5.003007||Viu KEY_crypt|5.003007||Viu KEY___DATA|5.003007||Viu KEY_dbmclose|5.003007||Viu KEY_dbmopen|5.003007||Viu KEY_default|5.027008||Viu KEY_defer|5.035004||Viu KEY_defined|5.003007||Viu KEY_delete|5.003007||Viu KEY_DESTROY|5.003007||Viu KEY_die|5.003007||Viu KEY_do|5.003007||Viu KEY_dump|5.003007||Viu KEY_each|5.003007||Viu KEY_else|5.003007||Viu KEY_elsif|5.003007||Viu KEY___END|5.003007||Viu KEY_END|5.003007||Viu KEY_endgrent|5.003007||Viu KEY_endhostent|5.003007||Viu KEY_endnetent|5.003007||Viu KEY_endprotoent|5.003007||Viu KEY_endpwent|5.003007||Viu KEY_endservent|5.003007||Viu KEY_eof|5.003007||Viu KEY_eq|5.003007||Viu KEY_eval|5.003007||Viu KEY_evalbytes|5.015005||Viu KEY_exec|5.003007||Viu KEY_exists|5.003007||Viu KEY_exit|5.003007||Viu KEY_exp|5.003007||Viu KEY_fc|5.015008||Viu KEY_fcntl|5.003007||Viu KEY___FILE|5.003007||Viu KEY_fileno|5.003007||Viu KEY_finally|5.035008||Viu KEY_flock|5.003007||Viu KEY_for|5.003007||Viu KEY_foreach|5.003007||Viu KEY_fork|5.003007||Viu KEY_format|5.003007||Viu KEY_formline|5.003007||Viu KEY_ge|5.003007||Viu KEY_getc|5.003007||Viu KEY_getgrent|5.003007||Viu KEY_getgrgid|5.003007||Viu KEY_getgrnam|5.003007||Viu KEY_gethostbyaddr|5.003007||Viu KEY_gethostbyname|5.003007||Viu KEY_gethostent|5.003007||Viu KEY_getlogin|5.003007||Viu KEY_getnetbyaddr|5.003007||Viu KEY_getnetbyname|5.003007||Viu KEY_getnetent|5.003007||Viu KEY_getpeername|5.003007||Viu KEY_getpgrp|5.003007||Viu KEY_getppid|5.003007||Viu KEY_getpriority|5.003007||Viu KEY_getprotobyname|5.003007||Viu KEY_getprotobynumber|5.003007||Viu KEY_getprotoent|5.003007||Viu KEY_getpwent|5.003007||Viu KEY_getpwnam|5.003007||Viu KEY_getpwuid|5.003007||Viu KEY_getservbyname|5.003007||Viu KEY_getservbyport|5.003007||Viu KEY_getservent|5.003007||Viu KEY_getsockname|5.003007||Viu KEY_getsockopt|5.003007||Viu KEY_getspnam|5.031011||Viu KEY_given|5.009003||Viu KEY_glob|5.003007||Viu KEY_gmtime|5.003007||Viu KEY_goto|5.003007||Viu KEY_grep|5.003007||Viu KEY_gt|5.003007||Viu KEY_hex|5.003007||Viu KEY_if|5.003007||Viu KEY_index|5.003007||Viu KEY_INIT|5.005000||Viu KEY_int|5.003007||Viu KEY_ioctl|5.003007||Viu KEY_isa|5.031007||Viu KEY_join|5.003007||Viu KEY_keys|5.003007||Viu KEY_kill|5.003007||Viu KEY_last|5.003007||Viu KEY_lc|5.003007||Viu KEY_lcfirst|5.003007||Viu KEY_le|5.003007||Viu KEY_length|5.003007||Viu KEY___LINE|5.003007||Viu KEY_link|5.003007||Viu KEY_listen|5.003007||Viu KEY_local|5.003007||Viu KEY_localtime|5.003007||Viu KEY_lock|5.005000||Viu KEY_log|5.003007||Viu KEY_lstat|5.003007||Viu KEY_lt|5.003007||Viu KEY_m|5.003007||Viu KEY_map|5.003007||Viu KEY_mkdir|5.003007||Viu KEY_msgctl|5.003007||Viu KEY_msgget|5.003007||Viu KEY_msgrcv|5.003007||Viu KEY_msgsnd|5.003007||Viu KEY_my|5.003007||Viu KEY_ne|5.003007||Viu KEY_next|5.003007||Viu KEY_no|5.003007||Viu KEY_not|5.003007||Viu KEY_NULL|5.003007||Viu KEY_oct|5.003007||Viu KEY_open|5.003007||Viu KEY_opendir|5.003007||Viu KEY_or|5.003007||Viu KEY_ord|5.003007||Viu KEY_our|5.006000||Viu KEY_pack|5.003007||Viu KEY_package|5.003007||Viu KEY___PACKAGE|5.004000||Viu KEY_pipe|5.003007||Viu KEY_pop|5.003007||Viu KEY_pos|5.003007||Viu KEY_print|5.003007||Viu KEY_printf|5.003007||Viu KEY_prototype|5.003007||Viu KEY_push|5.003007||Viu KEY_q|5.003007||Viu KEY_qq|5.003007||Viu KEY_qr|5.005000||Viu KEY_quotemeta|5.003007||Viu KEY_qw|5.003007||Viu KEY_qx|5.003007||Viu KEY_rand|5.003007||Viu KEY_read|5.003007||Viu KEY_readdir|5.003007||Viu KEY_readline|5.003007||Viu KEY_readlink|5.003007||Viu KEY_readpipe|5.003007||Viu KEY_recv|5.003007||Viu KEY_redo|5.003007||Viu KEY_ref|5.003007||Viu KEY_rename|5.003007||Viu KEY_require|5.003007||Viu KEY_reset|5.003007||Viu KEY_return|5.003007||Viu KEY_reverse|5.003007||Viu KEY_rewinddir|5.003007||Viu KEY_rindex|5.003007||Viu KEY_rmdir|5.003007||Viu KEY_s|5.003007||Viu KEY_say|5.009003||Viu KEY_scalar|5.003007||Viu KEY_seek|5.003007||Viu KEY_seekdir|5.003007||Viu KEY_select|5.003007||Viu KEY_semctl|5.003007||Viu KEY_semget|5.003007||Viu KEY_semop|5.003007||Viu KEY_send|5.003007||Viu KEY_setgrent|5.003007||Viu KEY_sethostent|5.003007||Viu KEY_setnetent|5.003007||Viu KEY_setpgrp|5.003007||Viu KEY_setpriority|5.003007||Viu KEY_setprotoent|5.003007||Viu KEY_setpwent|5.003007||Viu KEY_setservent|5.003007||Viu KEY_setsockopt|5.003007||Viu KEY_shift|5.003007||Viu KEY_shmctl|5.003007||Viu KEY_shmget|5.003007||Viu KEY_shmread|5.003007||Viu KEY_shmwrite|5.003007||Viu KEY_shutdown|5.003007||Viu KEY_sigvar|5.025004||Viu KEY_sin|5.003007||Viu KEY_sleep|5.003007||Viu KEY_socket|5.003007||Viu KEY_socketpair|5.003007||Viu KEY_sort|5.003007||Viu KEY_splice|5.003007||Viu KEY_split|5.003007||Viu KEY_sprintf|5.003007||Viu KEY_sqrt|5.003007||Viu KEY_srand|5.003007||Viu KEY_stat|5.003007||Viu KEY_state|5.009004||Viu KEY_study|5.003007||Viu KEY_sub|5.003007||Viu KEY___SUB|5.015006||Viu KEY_substr|5.003007||Viu KEY_symlink|5.003007||Viu KEY_syscall|5.003007||Viu KEY_sysopen|5.003007||Viu KEY_sysread|5.003007||Viu KEY_sysseek|5.004000||Viu KEY_system|5.003007||Viu KEY_syswrite|5.003007||Viu KEY_tell|5.003007||Viu KEY_telldir|5.003007||Viu KEY_tie|5.003007||Viu KEY_tied|5.003007||Viu KEY_time|5.003007||Viu KEY_times|5.003007||Viu KEY_tr|5.003007||Viu KEY_truncate|5.003007||Viu KEY_try|5.033007||Viu KEY_uc|5.003007||Viu KEY_ucfirst|5.003007||Viu KEY_umask|5.003007||Viu KEY_undef|5.003007||Viu KEY_UNITCHECK|5.009005||Viu KEY_unless|5.003007||Viu KEY_unlink|5.003007||Viu KEY_unpack|5.003007||Viu KEY_unshift|5.003007||Viu KEY_untie|5.003007||Viu KEY_until|5.003007||Viu KEY_use|5.003007||Viu KEY_utime|5.003007||Viu KEY_values|5.003007||Viu KEY_vec|5.003007||Viu KEY_wait|5.003007||Viu KEY_waitpid|5.003007||Viu KEY_wantarray|5.003007||Viu KEY_warn|5.003007||Viu KEY_when|5.027008||Viu KEY_while|5.003007||Viu keyword|5.003007||Viu KEYWORD_PLUGIN_DECLINE|5.011002||Viu KEYWORD_PLUGIN_EXPR|5.011002||Viu KEYWORD_PLUGIN_MUTEX_INIT|5.027006||Viu KEYWORD_PLUGIN_MUTEX_LOCK|5.027006||Viu KEYWORD_PLUGIN_MUTEX_TERM|5.027006||Viu KEYWORD_PLUGIN_MUTEX_UNLOCK|5.027006||Viu keyword_plugin_standard|||iu KEYWORD_PLUGIN_STMT|5.011002||Viu KEY_write|5.003007||Viu KEY_x|5.003007||Viu KEY_xor|5.003007||Viu KEY_y|5.003007||Viu kGVOP_gv|5.006000||Viu kill|5.005000||Viu killpg|5.005000||Viu kLISTOP|5.003007||Viu kLOGOP|5.003007||Viu kLOOP|5.003007||Viu kPADOP|5.006000||Viu kPMOP|5.003007||Viu kPVOP|5.003007||Viu kSVOP|5.003007||Viu kSVOP_sv|5.006000||Viu kUNOP|5.003007||Viu kUNOP_AUX|5.021007||Viu LATIN1_TO_NATIVE|5.019004|5.003007|p LATIN_CAPITAL_LETTER_A_WITH_RING_ABOVE|5.013011||Viu LATIN_CAPITAL_LETTER_A_WITH_RING_ABOVE_NATIVE|5.017004||Viu LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE|5.023002||Viu LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE_UTF8|5.023002||Viu LATIN_CAPITAL_LETTER_SHARP_S|5.014000||Viu LATIN_CAPITAL_LETTER_SHARP_S_UTF8|5.019001||Viu LATIN_CAPITAL_LETTER_Y_WITH_DIAERESIS|5.013011||Viu LATIN_SMALL_LETTER_A_WITH_RING_ABOVE|5.013011||Viu LATIN_SMALL_LETTER_A_WITH_RING_ABOVE_NATIVE|5.017004||Viu LATIN_SMALL_LETTER_DOTLESS_I|5.023002||Viu LATIN_SMALL_LETTER_DOTLESS_I_UTF8|5.023002||Viu LATIN_SMALL_LETTER_LONG_S|5.017003||Viu LATIN_SMALL_LETTER_LONG_S_UTF8|5.019001||Viu LATIN_SMALL_LETTER_SHARP_S|5.011002||Viu LATIN_SMALL_LETTER_SHARP_S_NATIVE|5.017004||Viu LATIN_SMALL_LETTER_SHARP_S_UTF8|5.033003||Viu LATIN_SMALL_LETTER_Y_WITH_DIAERESIS|5.011002||Viu LATIN_SMALL_LETTER_Y_WITH_DIAERESIS_NATIVE|5.017004||Viu LATIN_SMALL_LIGATURE_LONG_S_T|5.019004||Viu LATIN_SMALL_LIGATURE_LONG_S_T_UTF8|5.019004||Viu LATIN_SMALL_LIGATURE_ST|5.019004||Viu LATIN_SMALL_LIGATURE_ST_UTF8|5.019004||Viu LB_BREAKABLE|5.023007||Viu LB_CM_ZWJ_foo|5.025003||Viu LB_HY_or_BA_then_foo|5.023007||Viu LB_NOBREAK|5.023007||Viu LB_NOBREAK_EVEN_WITH_SP_BETWEEN|5.023007||Viu LB_PR_or_PO_then_OP_or_HY|5.023007||Viu LB_RI_then_RI|5.025003||Viu LB_SP_foo|5.023007||Viu LB_SY_or_IS_then_various|5.023007||Viu LB_various_then_PO_or_PR|5.023007||Viu LC_NUMERIC_LOCK|5.027009||pVu LC_NUMERIC_UNLOCK|5.027009||pVu LDBL_DIG|5.006000||Viu LEAVE|5.003007|5.003007| leave_adjust_stacks|5.023008|5.023008|xu leave_scope|5.003007|5.003007|u LEAVE_SCOPE|5.003007||Viu LEAVE_with_name|5.011002|5.011002| LEXACT|5.031005||Viu LEXACT_REQ8|5.031006||Viu LEXACT_REQ8_t8|5.035004||Viu LEXACT_REQ8_t8_p8|5.033003||Viu LEXACT_REQ8_t8_pb|5.033003||Viu LEXACT_REQ8_tb|5.035004||Viu LEXACT_REQ8_tb_p8|5.033003||Viu LEXACT_REQ8_tb_pb|5.033003||Viu LEXACT_t8|5.035004||Viu LEXACT_t8_p8|5.033003||Viu LEXACT_t8_pb|5.033003||Viu LEXACT_tb|5.035004||Viu LEXACT_tb_p8|5.033003||Viu LEXACT_tb_pb|5.033003||Viu lex_bufutf8|5.011002|5.011002|x lex_discard_to|5.011002|5.011002|x LEX_DONT_CLOSE_RSFP|5.015009||Viu LEX_EVALBYTES|5.015005||Viu lex_grow_linestr|5.011002|5.011002|x LEX_IGNORE_UTF8_HINTS|5.015005||Viu LEX_KEEP_PREVIOUS|5.011002|5.011002| lex_next_chunk|5.011002|5.011002|x LEX_NOTPARSING|5.004004||Viu lex_peek_unichar|5.011002|5.011002|x lex_read_space|5.011002|5.011002|x lex_read_to|5.011002|5.011002|x lex_read_unichar|5.011002|5.011002|x lex_start|5.013007|5.013007|x LEX_START_COPIED|5.015005||Viu LEX_START_FLAGS|5.015005||Viu LEX_START_SAME_FILTER|5.014000||Viu lex_stuff_pv|5.013006|5.013006|x lex_stuff_pvn|5.011002|5.011002|x lex_stuff_pvs|5.013005|5.013005|x lex_stuff_sv|5.011002|5.011002|x LEX_STUFF_UTF8|5.011002|5.011002| lex_unstuff|5.011002|5.011002|x LF_NATIVE|5.019004||Viu LIB_INVARG|5.008001||Viu LIBM_LIB_VERSION|5.009003|5.009003|Vn LIKELY|5.009004|5.003007|p link|5.006000||Viu LINKLIST|5.013006|5.013006| list|5.003007||Viu listen|5.005000||Viu listkids|5.003007||Viu LNBREAK|5.009005||Viu LNBREAK_t8|5.035004||Viu LNBREAK_t8_p8|5.033003||Viu LNBREAK_t8_pb|5.033003||Viu LNBREAK_tb|5.035004||Viu LNBREAK_tb_p8|5.033003||Viu LNBREAK_tb_pb|5.033003||Viu load_charnames|5.031010||cViu load_module|5.006000|5.003007|pv load_module_nocontext|5.013006|5.013006|vn LOCALECONV_LOCK|5.033005||Viu LOCALECONV_UNLOCK|5.033005||Viu LOCALE_INIT|5.024000||Viu LOCALE_INIT_LC_NUMERIC|5.033005||Viu LOCALE_LOCK|5.024000||Viu LOCALE_PAT_MOD|5.013006||Viu LOCALE_PAT_MODS|5.013006||Viu LOCALE_READ_LOCK|5.033005||Viu LOCALE_READ_UNLOCK|5.033005||Viu LOCALE_TERM|5.024000||Viu LOCALE_TERM_LC_NUMERIC|5.033005||Viu LOCALE_TERM_POSIX_2008|5.033005||Viu LOCALE_UNLOCK|5.024000||Viu localize|5.003007||Viu LOCAL_PATCH_COUNT|5.003007||Viu localtime|5.031011||Viu LOCALTIME_MAX|5.010001|5.010001|Vn LOCALTIME_MIN|5.010001|5.010001|Vn LOCALTIME_R_NEEDS_TZSET|5.010000|5.010000|Vn LOCALTIME_R_PROTO|5.008000|5.008000|Vn LOCK_DOLLARZERO_MUTEX|5.008001||Viu lockf|5.006000||Viu LOCK_LC_NUMERIC_STANDARD|5.021010||poVnu LOCK_NUMERIC_STANDARD|||piu LOC_SED|5.003007|5.003007|Vn LOGICAL|5.005000||Viu LOGICAL_t8|5.035004||Viu LOGICAL_t8_p8|5.033003||Viu LOGICAL_t8_pb|5.033003||Viu LOGICAL_tb|5.035004||Viu LOGICAL_tb_p8|5.033003||Viu LOGICAL_tb_pb|5.033003||Viu LONGDBLINFBYTES|5.023000|5.023000|Vn LONGDBLMANTBITS|5.023000|5.023000|Vn LONGDBLNANBYTES|5.023000|5.023000|Vn LONGDOUBLE_BIG_ENDIAN|5.021009||Viu LONGDOUBLE_DOUBLEDOUBLE|5.021009||Viu LONG_DOUBLE_EQUALS_DOUBLE|5.007001||Viu LONG_DOUBLE_IS_DOUBLE|5.021003|5.021003|Vn LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE|5.023006|5.023006|Vn LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE|5.023006|5.023006|Vn LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN|5.021003|5.021003|Vn LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE|5.023006|5.023006|Vn LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE|5.023006|5.023006|Vn LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN|5.021003|5.021003|Vn LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN|5.021003|5.021003|Vn LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN|5.021003|5.021003|Vn LONG_DOUBLE_IS_UNKNOWN_FORMAT|5.021003|5.021003|Vn LONG_DOUBLE_IS_VAX_H_FLOAT|5.025004|5.025004|Vn LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN|5.021003|5.021003|Vn LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN|5.021003|5.021003|Vn LONG_DOUBLEKIND|5.021003|5.021003|Vn LONGDOUBLE_LITTLE_ENDIAN|5.021009||Viu LONGDOUBLE_MIX_ENDIAN|5.023006||Viu LONG_DOUBLESIZE|5.005000|5.005000|Vn LONG_DOUBLE_STYLE_IEEE|5.025007|5.025007|Vn LONG_DOUBLE_STYLE_IEEE_EXTENDED|5.025007|5.025007|Vn LONGDOUBLE_VAX_ENDIAN|5.025004||Viu LONGDOUBLE_X86_80_BIT|5.021009||Viu LONGJMP|5.005000||Viu longjmp|5.005000||Viu LONGJMP_t8|5.035004||Viu LONGJMP_t8_p8|5.033003||Viu LONGJMP_t8_pb|5.033003||Viu LONGJMP_tb|5.035004||Viu LONGJMP_tb_p8|5.033003||Viu LONGJMP_tb_pb|5.033003||Viu LONGLONGSIZE|5.005000|5.005000|Vn LONGSIZE|5.004000|5.003007|oVn LOOKBEHIND_END_t8_p8|||Viu LOOKBEHIND_END_t8_pb|||Viu LOOKBEHIND_END_t8|||Viu LOOKBEHIND_END_tb_p8|||Viu LOOKBEHIND_END_tb_pb|||Viu LOOKBEHIND_END_tb|||Viu LOOKBEHIND_END|||Viu looks_like_bool|5.027008||Viu looks_like_number|5.003007|5.003007| LOOP_PAT_MODS|5.009005||Viu lop|5.005000||Viu lossless_NV_to_IV|5.031001||Vniu LOWEST_ANYOF_HRx_BYTE|5.031002||Viu L_R_TZSET|5.009005|5.009005|Vn lsbit_pos32|5.035003||cVnu lsbit_pos|5.035004||Viu lsbit_pos64|5.035003||cVnu lsbit_pos_uintmax|5.035003||Viu lseek|5.005000||Viu LSEEKSIZE|5.006000|5.006000|Vn lstat|5.005000||Viu LvFLAGS|5.015006||Viu LVf_NEG_LEN|5.027001||Viu LVf_NEG_OFF|5.027001||Viu LVf_OUT_OF_RANGE|5.027001||Viu LVRET|5.007001||Vi LvSTARGOFF|5.019004||Viu LvTARG|5.003007||Viu LvTARGLEN|5.003007||Viu LvTARGOFF|5.003007||Viu LvTYPE|5.003007||Viu LZC_TO_MSBIT_POS|5.035003||Viu magic_clear_all_env|5.004001||Viu magic_cleararylen_p|5.017002||Viu magic_clearenv|5.003007||Viu magic_clearhint|5.009004||Vi magic_clearhints|5.011000||Vi magic_clearisa|5.010001||Viu magic_clearpack|5.003007||Viu magic_clearsig|5.003007||Viu magic_copycallchecker|5.017000||Viu magic_dump|5.006000|5.006000|u magic_existspack|5.003007||Viu magic_freearylen_p|5.009003||Viu magic_freecollxfrm|5.033004||Viu magic_freemglob|5.033004||Viu magic_freeovrld|5.007001||Viu magic_freeutf8|5.033004||Viu magic_get|5.003007||Viu magic_getarylen|5.003007||Viu magic_getdebugvar|5.021005||Viu magic_getdefelem|5.004000||Viu magic_getnkeys|5.004005||Viu magic_getpack|5.003007||Viu magic_getpos|5.003007||Viu magic_getsig|5.003007||Viu magic_getsubstr|5.004005||Viu magic_gettaint|5.003007||Viu magic_getuvar|5.003007||Viu magic_getvec|5.004005||Viu magic_killbackrefs|5.006000||Viu magic_methcall1|5.013001||Viu magic_methcall|||vi magic_methpack|5.005000||Viu magic_nextpack|5.003007||Viu magic_regdata_cnt|5.006000||Viu magic_regdatum_get|5.006000||Viu magic_regdatum_set|5.006001||Viu magic_scalarpack|5.009001||Viu magic_set|5.003007||Viu magic_set_all_env|5.004004||Viu magic_setarylen|5.003007||Viu magic_setcollxfrm|5.004000||Viu magic_setdbline|5.003007||Viu magic_setdebugvar|5.021005||Viu magic_setdefelem|5.004000||Viu magic_setenv|5.003007||Viu magic_sethint|5.009004||Vi magic_sethint_feature|5.031007||Viu magic_setisa|5.003007||Viu magic_setlvref|5.021005||Viu magic_setmglob|5.003007||Viu magic_setnkeys|5.003007||Viu magic_setnonelem|5.027009||Viu magic_setpack|5.003007||Viu magic_setpos|5.003007||Viu magic_setregexp|5.008001||Viu magic_setsig|5.003007||Viu magic_setsigall|5.035001||Viu magic_setsubstr|5.003007||Viu magic_settaint|5.003007||Viu magic_setutf8|5.008001||Viu magic_setuvar|5.003007||Viu magic_setvec|5.003007||Viu magic_sizepack|5.005000||Viu magic_wipepack|5.003007||Viu make_exactf_invlist|5.031006||Viu make_matcher|5.027008||Viu make_trie|5.009002||Viu malloc|5.003007||Vn MALLOC_CHECK_TAINT2|5.008001||Viu MALLOC_CHECK_TAINT|5.008001||Viu malloced_size|5.005000||Vniu malloc_good_size|5.010001||Vniu MALLOC_INIT|5.005000||Viu MALLOC_OVERHEAD|5.006000||Viu Malloc_t|5.003007|5.003007|Vn MALLOC_TERM|5.005000||Viu MALLOC_TOO_LATE_FOR|5.008001||Viu MARK|5.003007|5.003007| MARKPOINT|5.009005||Viu MARKPOINT_next|5.009005||Viu MARKPOINT_next_fail|5.009005||Viu MARKPOINT_next_fail_t8|5.035004||Viu MARKPOINT_next_fail_t8_p8|5.033003||Viu MARKPOINT_next_fail_t8_pb|5.033003||Viu MARKPOINT_next_fail_tb|5.035004||Viu MARKPOINT_next_fail_tb_p8|5.033003||Viu MARKPOINT_next_fail_tb_pb|5.033003||Viu MARKPOINT_next_t8|5.035004||Viu MARKPOINT_next_t8_p8|5.033003||Viu MARKPOINT_next_t8_pb|5.033003||Viu MARKPOINT_next_tb|5.035004||Viu MARKPOINT_next_tb_p8|5.033003||Viu MARKPOINT_next_tb_pb|5.033003||Viu MARKPOINT_t8|5.035004||Viu MARKPOINT_t8_p8|5.033003||Viu MARKPOINT_t8_pb|5.033003||Viu MARKPOINT_tb|5.035004||Viu MARKPOINT_tb_p8|5.033003||Viu MARKPOINT_tb_pb|5.033003||Viu markstack_grow|5.021001|5.021001|u matcher_matches_sv|5.027008||Viu MAX|5.025006||Viu MAX_ANYOF_HRx_BYTE|5.031002||Viu MAXARG|5.003007||Viu MAX_CHARSET_NAME_LENGTH|5.013009||Viu MAX_FEATURE_LEN|5.013010||Viu MAX_FOLD_FROMS|5.029006||Viu MAX_LEGAL_CP|5.029002||Viu MAX_MATCHES|5.033005||Viu MAXO|5.003007||Viu MAXPATHLEN|5.006000||Viu MAX_PORTABLE_UTF8_TWO_BYTE|5.011002||Viu MAX_PRINT_A|5.033005||Viu MAX_RECURSE_EVAL_NOCHANGE_DEPTH|5.009005||Viu MAXSYSFD|5.003007||Viu MAX_UNICODE_UTF8|5.027006||Viu MAX_UNI_KEYWORD_INDEX|5.027011||Viu MAX_UTF8_TWO_BYTE|5.019004||Viu MAYBE_DEREF_GV|5.015003||Viu MAYBE_DEREF_GV_flags|5.015003||Viu MAYBE_DEREF_GV_nomg|5.015003||Viu maybe_multimagic_gv|5.019004||Viu mayberelocate|5.015006||Viu MBLEN_LOCK|5.033005||Viu MBLEN_UNLOCK|5.033005||Viu MBOL|5.003007||Viu MBOL_t8|5.035004||Viu MBOL_t8_p8|5.033003||Viu MBOL_t8_pb|5.033003||Viu MBOL_tb|5.035004||Viu MBOL_tb_p8|5.033003||Viu MBOL_tb_pb|5.033003||Viu MBTOWC_LOCK|5.033005||Viu MBTOWC_UNLOCK|5.033005||Viu MDEREF_ACTION_MASK|5.021007||Viu MDEREF_AV_gvav_aelem|5.021007||Viu MDEREF_AV_gvsv_vivify_rv2av_aelem|5.021007||Viu MDEREF_AV_padav_aelem|5.021007||Viu MDEREF_AV_padsv_vivify_rv2av_aelem|5.021007||Viu MDEREF_AV_pop_rv2av_aelem|5.021007||Viu MDEREF_AV_vivify_rv2av_aelem|5.021007||Viu MDEREF_FLAG_last|5.021007||Viu MDEREF_HV_gvhv_helem|5.021007||Viu MDEREF_HV_gvsv_vivify_rv2hv_helem|5.021007||Viu MDEREF_HV_padhv_helem|5.021007||Viu MDEREF_HV_padsv_vivify_rv2hv_helem|5.021007||Viu MDEREF_HV_pop_rv2hv_helem|5.021007||Viu MDEREF_HV_vivify_rv2hv_helem|5.021007||Viu MDEREF_INDEX_const|5.021007||Viu MDEREF_INDEX_gvsv|5.021007||Viu MDEREF_INDEX_MASK|5.021007||Viu MDEREF_INDEX_none|5.021007||Viu MDEREF_INDEX_padsv|5.021007||Viu MDEREF_MASK|5.021007||Viu MDEREF_reload|5.021007||Viu MDEREF_SHIFT|5.021007||Viu measure_struct|5.007003||Viu MEM_ALIGNBYTES|5.003007|5.003007|Vn memBEGINPs|5.027006||Viu memBEGINs|5.027006||Viu MEMBER_TO_FPTR|5.006000||Viu memCHRs|5.031008|5.003007|p mem_collxfrm|5.003007||dViu _mem_collxfrm|5.025002||Viu memENDPs|5.027006||Viu memENDs|5.027006||Viu memEQ|5.004000|5.003007|p memEQs|5.009005|5.003007|p memGE|5.025005||Viu memGT|5.025005||Viu memLE|5.025005||Viu MEM_LOG_ALLOC|5.009003||Viu mem_log_alloc|5.024000||Vniu mem_log_common|5.010001||Vniu MEM_LOG_DEL_SV|||Viu MEM_LOG_FREE|5.009003||Viu mem_log_free|5.024000||Vniu MEM_LOG_NEW_SV|||Viu MEM_LOG_REALLOC|5.009003||Viu mem_log_realloc|5.024000||Vniu memLT|5.025005||Viu memNE|5.004000|5.003007|p memNEs|5.009005|5.003007|p MEM_SIZE|5.003007||Viu MEM_SIZE_MAX|5.009005||Viu MEM_WRAP_CHECK_1|5.009002||Viu MEM_WRAP_CHECK|5.009002||Viu MEM_WRAP_CHECK_s|5.027010||Viu memzero|5.003007|5.003007| MEOL|5.003007||Viu MEOL_t8|5.035004||Viu MEOL_t8_p8|5.033003||Viu MEOL_t8_pb|5.033003||Viu MEOL_tb|5.035004||Viu MEOL_tb_p8|5.033003||Viu MEOL_tb_pb|5.033003||Viu mess|5.003007||pvV mess_alloc|5.005000||Viu mess_nocontext|5.006000||pvVn mess_sv|5.013001|5.004000|p MEXTEND|5.003007||Viu mfree|||nu MgBYTEPOS|5.019004||Viu MgBYTEPOS_set|5.019004||Viu mg_clear|5.003007|5.003007| mg_copy|5.003007|5.003007| mg_dup|5.007003|5.007003|u MGf_BYTES|5.019004||Viu MGf_COPY|5.007003||Viu MGf_DUP|5.007003||Viu MGf_GSKIP|5.003007||Viu mg_find|5.003007|5.003007|n mg_findext|5.013008|5.003007|pn mg_find_mglob|5.019002||cViu MGf_LOCAL|5.009003||Viu MGf_MINMATCH|5.003007||Viu MGf_PERSIST|5.021005||Viu mg_free|5.003007|5.003007| mg_freeext|5.027004|5.027004| mg_free_type|5.013006|5.013006| MGf_REFCOUNTED|5.003007||Viu MGf_REQUIRE_GV|5.021004||Viu MGf_TAINTEDDIR|5.003007||Viu mg_get|5.003007|5.003007| mg_length|5.005000|5.005000|d mg_localize|5.009003||Vi mg_magical|5.003007|5.003007|n MgPV|5.003007||Viu MgPV_const|5.009003||Viu MgPV_nolen_const|5.009003||Viu mg_set|5.003007|5.003007| mg_size|5.005000|5.005000|u MgSV|5.033009||Viu MgTAINTEDDIR|5.003007||Viu MgTAINTEDDIR_off|5.004000||Viu MgTAINTEDDIR_on|5.003007||Viu MICRO_SIGN|5.011002||Viu MICRO_SIGN_NATIVE|5.017004||Viu MICRO_SIGN_UTF8|5.033003||Viu MIN|5.025006||Viu mini_mktime|5.007002|5.007002|n MINMOD|5.003007||Viu MINMOD_t8|5.035004||Viu MINMOD_t8_p8|5.033003||Viu MINMOD_t8_pb|5.033003||Viu MINMOD_tb|5.035004||Viu MINMOD_tb_p8|5.033003||Viu MINMOD_tb_pb|5.033003||Viu minus_v|5.015006||Viu missingterm|5.005000||Viu Mkdir|5.004000||Viu mkdir|5.005000||Viu mktemp|5.005000||Viu Mmap_t|5.006000|5.006000|Vn mode_from_discipline|5.006000||Viu Mode_t|5.003007|5.003007|Vn modkids|5.003007||Viu MON_10|5.027010||Viu MON_11|5.027010||Viu MON_12|5.027010||Viu MON_1|5.027010||Viu MON_2|5.027010||Viu MON_3|5.027010||Viu MON_4|5.027010||Viu MON_5|5.027010||Viu MON_6|5.027010||Viu MON_7|5.027010||Viu MON_8|5.027010||Viu MON_9|5.027010||Viu more_bodies|||cu more_sv|5.009004||cVu moreswitches|5.003007||cVu mortal_getenv|5.031011||cVnu Move|5.003007|5.003007| MoveD|5.009002|5.003007|p move_proto_attr|5.019005||Viu M_PAT_MODS|5.009005||Viu MPH_BUCKETS|5.027011||Viu MPH_RSHIFT|5.027011||Viu MPH_VALt|5.027011||Viu mPUSHi|5.009002|5.003007|p mPUSHn|5.009002|5.003007|p mPUSHp|5.009002|5.003007|p mPUSHs|5.010001|5.003007|p mPUSHu|5.009002|5.003007|p mro_clean_isarev|5.013007||Viu mro_gather_and_rename|5.013007||Viu mro_get_from_name|||u mro_get_linear_isa|5.009005|5.009005| mro_get_linear_isa_c3|||i mro_get_linear_isa_dfs|5.009005||Vi MRO_GET_PRIVATE_DATA|5.010001|5.010001| mro_get_private_data|||cu mro_isa_changed_in|5.009005||Vi mro_meta_dup|5.009005||Viu mro_meta_init|||ciu mro_method_changed_in|5.009005|5.009005| mro_package_moved|5.013006||Vi mro_register||| mro_set_mro|||u mro_set_private_data||| msbit_pos32|5.035003||cVnu msbit_pos|5.035004||Viu msbit_pos64|5.035003||cVnu msbit_pos_uintmax|5.035003||Viu MSPAGAIN|5.003007||Viu MSVC_DIAG_IGNORE|5.029010||Viu MSVC_DIAG_IGNORE_DECL|5.029010||Viu MSVC_DIAG_IGNORE_STMT|5.029010||Viu MSVC_DIAG_RESTORE|5.029010||Viu MSVC_DIAG_RESTORE_DECL|5.029010||Viu MSVC_DIAG_RESTORE_STMT|5.029010||Viu mul128|5.005000||Viu MULTICALL|5.009003|5.009003| multiconcat_stringify|5.027006||cViu multideref_stringify|5.021009||cViu MULTILINE_PAT_MOD|5.009005||Viu MULTIPLICITY|5.006000|5.006000|Vn MUTABLE_AV|5.010001|5.003007|p MUTABLE_CV|5.010001|5.003007|p MUTABLE_GV|5.010001|5.003007|p MUTABLE_HV|5.010001|5.003007|p MUTABLE_IO|5.010001|5.003007|p MUTABLE_PTR|5.010001|5.003007|p MUTABLE_SV|5.010001|5.003007|p MUTEX_DESTROY|5.005000||Viu MUTEX_INIT|5.005000||Viu MUTEX_INIT_NEEDS_MUTEX_ZEROED|5.005003||Viu MUTEX_LOCK|5.005000||Viu MUTEX_UNLOCK|5.005000||Viu mXPUSHi|5.009002|5.003007|p mXPUSHn|5.009002|5.003007|p mXPUSHp|5.009002|5.003007|p mXPUSHs|5.010001|5.003007|p mXPUSHu|5.009002|5.003007|p my|5.011000||Viu my_atof2|5.029000||cVu my_atof3|5.029000||cVu my_atof|5.006000|5.006000| my_attrs|5.006000||Viu my_binmode|5.006000||Viu my_bytes_to_utf8|5.021009||Vniu my_chsize|5.003007||Vu my_clearenv|5.009003||Viu MY_CXT|5.009000|5.009000|p MY_CXT_CLONE|5.009002|5.009000|p MY_CXT_INDEX|5.009005||Viu MY_CXT_INIT|5.009000|5.009000|p MY_CXT_INIT_ARG|5.013005||Viu MY_CXT_INIT_INTERP|5.009003||Viu my_cxt_init|||u my_dirfd|5.009005|5.009005|nu my_exit|5.003007|5.003007| my_exit_jump|5.005000||Viu my_failure_exit|5.004000|5.004000|u my_fflush_all|5.006000|5.006000|u my_fork|5.007003|5.007003|nu my_kid|5.006000||Viu my_lstat|5.013003||Viu my_lstat_flags|5.013003||cViu my_memrchr|5.027006||Vniu my_mkostemp_cloexec|||niu my_mkostemp|||niu my_mkstemp_cloexec|||niu my_mkstemp|||niu my_nl_langinfo|5.027006||Vniu my_pclose|5.003007|5.003007|u my_popen|5.003007|5.003007|u my_popen_list|5.007001|5.007001|u my_setenv|5.003007|5.003007| my_snprintf|5.009004||pvVn my_socketpair|5.007003|5.007003|nu my_sprintf|5.009003|5.003007|pdn my_stat|5.013003||Viu my_stat_flags|5.013003||cViu my_strerror|5.021001||Viu my_strftime|5.007002||V my_strlcat|5.009004|5.003007|pn my_strlcpy|5.009004|5.003007|pn my_strnlen|5.027006|5.003007|pn my_strtod|5.029010|5.029010|n my_unexec|5.003007||Viu my_vsnprintf|5.009004|5.009004|n N0|5.029001||Viu N10|5.029001||Viu N11|5.029001||Viu N1|5.029001||Viu N2|5.029001||Viu N3|5.029001||Viu N4|5.029001||Viu N5|5.029001||Viu N6|5.029001||Viu N7|5.029001||Viu N8|5.029001||Viu N9|5.029001||Viu NAN_COMPARE_BROKEN|5.021005||Viu NANYOFM|5.029005||Viu NANYOFM_t8|5.035004||Viu NANYOFM_t8_p8|5.033003||Viu NANYOFM_t8_pb|5.033003||Viu NANYOFM_tb|5.035004||Viu NANYOFM_tb_p8|5.033003||Viu NANYOFM_tb_pb|5.033003||Viu NATIVE8_TO_UNI|5.011000||Viu NATIVE_BYTE_IS_INVARIANT|5.019004||Viu NATIVE_SKIP|5.019004||Viu NATIVE_TO_ASCII|5.007001||Viu NATIVE_TO_I8|5.015006||Viu NATIVE_TO_LATIN1|5.019004|5.003007|p NATIVE_TO_NEED|5.019004||dcVnu NATIVE_TO_UNI|5.007001|5.003007|p NATIVE_TO_UTF|5.007001||Viu NATIVE_UTF8_TO_I8|5.019004||Viu nBIT_MASK|5.033001||Viu nBIT_UMAX|5.033001||Viu NBOUND|5.003007||Viu NBOUNDA|5.013009||Viu NBOUNDA_t8|5.035004||Viu NBOUNDA_t8_p8|5.033003||Viu NBOUNDA_t8_pb|5.033003||Viu NBOUNDA_tb|5.035004||Viu NBOUNDA_tb_p8|5.033003||Viu NBOUNDA_tb_pb|5.033003||Viu NBOUNDL|5.004000||Viu NBOUNDL_t8|5.035004||Viu NBOUNDL_t8_p8|5.033003||Viu NBOUNDL_t8_pb|5.033003||Viu NBOUNDL_tb|5.035004||Viu NBOUNDL_tb_p8|5.033003||Viu NBOUNDL_tb_pb|5.033003||Viu NBOUND_t8|5.035004||Viu NBOUND_t8_p8|5.033003||Viu NBOUND_t8_pb|5.033003||Viu NBOUND_tb|5.035004||Viu NBOUND_tb_p8|5.033003||Viu NBOUND_tb_pb|5.033003||Viu NBOUNDU|5.013009||Viu NBOUNDU_t8|5.035004||Viu NBOUNDU_t8_p8|5.033003||Viu NBOUNDU_t8_pb|5.033003||Viu NBOUNDU_tb|5.035004||Viu NBOUNDU_tb_p8|5.033003||Viu NBOUNDU_tb_pb|5.033003||Viu NBSP_NATIVE|5.021001||Viu NBSP_UTF8|5.021001||Viu NDBM_H_USES_PROTOTYPES|5.032001|5.032001|Vn NDEBUG|5.021007||Viu need_utf8|5.009003||Vniu NEED_VA_COPY|5.007001|5.007001|Vn NEGATIVE_INDICES_VAR|5.008001||Viu Netdb_hlen_t|5.005000|5.005000|Vn Netdb_host_t|5.005000|5.005000|Vn Netdb_name_t|5.005000|5.005000|Vn Netdb_net_t|5.005000|5.005000|Vn NETDB_R_OBSOLETE|5.008000||Viu New|5.003007||Viu newANONATTRSUB|5.006000|5.006000|u newANONHASH|5.003007|5.003007|u newANONLIST|5.003007|5.003007|u newANONSUB|5.003007|5.003007|u newASSIGNOP|5.003007|5.003007| newATTRSUB|5.006000|5.006000| newATTRSUB_x|5.019008||cVi newAV|5.003007|5.003007| newAV_alloc_x|5.035001|5.035001| newAV_alloc_xz|5.035001|5.035001| newAVREF|5.003007|5.003007|u newBINOP|5.003007|5.003007| new_body_allocated|||Viu new_body_from_arena|||Viu Newc|5.003007||Viu new_collate|5.006000||Viu newCONDOP|5.003007|5.003007| new_constant|||iu newCONSTSUB|5.004005|5.003007|p newCONSTSUB_flags|5.015006|5.015006| new_ctype|5.006000||Viu newCVREF|5.003007|5.003007|u newDEFEROP|5.035004|5.035004|x newDEFSVOP|5.021006|5.021006| newFORM|5.003007|5.003007|u newFOROP|5.013007|5.013007| newGIVENOP|5.009003|5.009003| newGIVWHENOP|5.027008||Viu newGP|||xiu newGVgen|5.003007|5.003007|u newGVgen_flags|5.015004|5.015004|u newGVOP|5.003007|5.003007| newGVREF|5.003007|5.003007|u new_he|5.005000||Viu newHV|5.003007|5.003007| newHVhv|5.005000|5.005000|u newHVREF|5.003007|5.003007|u _new_invlist|5.013010||cViu _new_invlist_C_array|5.015008||cViu newIO|5.003007|5.003007|u newLISTOP|5.003007|5.003007| newLOGOP|5.003007|5.003007| new_logop|5.005000||Viu newLOOPEX|5.003007|5.003007| newLOOPOP|5.003007|5.003007| newMETHOP|5.021005|5.021005| newMETHOP_internal|5.021005||Viu newMETHOP_named|5.021005|5.021005| new_msg_hv|5.027009||Viu newMYSUB|5.017004|5.017004|u new_NOARENA|||Viu new_NOARENAZ|||Viu newNULLLIST|5.003007|5.003007| new_numeric|5.006000||Viu newOP|5.003007|5.003007| NewOp|5.008001||Viu newPADNAMELIST|5.021007|5.021007|xn newPADNAMEouter|5.021007|5.021007|xn newPADNAMEpvn|5.021007|5.021007|xn newPADOP|5.006000||V newPMOP|5.003007|5.003007| newPROG|5.003007|5.003007|u newPVOP|5.003007|5.003007| newRANGE|5.003007|5.003007| newRV|5.003007|5.003007| newRV_inc|5.004000|5.003007|p newRV_noinc|5.004000|5.003007|p newSLICEOP|5.003007|5.003007| new_stackinfo|5.005000|5.005000|u newSTATEOP|5.003007|5.003007| newSTUB|5.017001||Viu newSUB|5.003007|5.003007| newSV|5.003007|5.003007| NEWSV|5.003007||Viu newSVavdefelem|5.019004||Viu newSVhek|5.009003|5.009003| newSViv|5.003007|5.003007| newSVnv|5.006000|5.003007| newSVOP|5.003007|5.003007| newSVpadname|5.017004|5.017004|x newSVpv|5.003007|5.003007| newSVpvf|5.004000||vV newSVpvf_nocontext|5.006000||vVn newSVpvn|5.004005|5.003007|p newSVpvn_flags|5.010001|5.003007|p newSVpvn_share|5.007001|5.003007|p newSVpvn_utf8|5.010001|5.003007|p newSVpvs|5.009003|5.003007|p newSVpvs_flags|5.010001|5.003007|p newSVpv_share|5.013006|5.013006| newSVpvs_share|5.009003|5.003007|p newSVREF|5.003007|5.003007|u newSVrv|5.003007|5.003007| newSVsv|5.003007|5.003007| newSVsv_flags|5.029009|5.003007|p newSVsv_nomg|5.029009|5.003007|p newSV_type|5.009005|5.003007|p newSV_type_mortal||| newSVuv|5.006000|5.003007|p new_SV|||Viu newTRYCATCHOP|5.033007|5.033007|x newUNOP|5.003007|5.003007| newUNOP_AUX|5.021007|5.021007| new_version|5.009000|5.009000| NEW_VERSION|5.019008||Viu new_warnings_bitfield|||xciu newWHENOP|5.027008|5.027008| newWHILEOP|5.013007|5.013007| Newx|5.009003|5.003007|p Newxc|5.009003|5.003007|p new_XNV|||Viu new_XPVMG|||Viu new_XPVNV|||Viu newXS|5.006000|5.006000| newXS_deffile|5.021006||cViu newXS_flags|5.009004|5.009004|xu newXS_len_flags|5.015006||Vi newXSproto|5.006000|5.006000| Newxz|5.009003|5.003007|p Newz|5.003007||Viu nextargv|5.003007||Viu nextchar|5.005000||Viu NEXT_LINE_CHAR|5.007003||Viu NEXT_OFF|5.005000||Viu next_symbol|5.007003||Viu ninstr|5.003007|5.003007|n NL_LANGINFO_LOCK|5.033005||Viu NL_LANGINFO_UNLOCK|5.033005||Viu NOARENA|||Viu no_bareword_allowed|5.005004||Viu no_bareword_filehandle|5.033006||Viu NOCAPTURE_PAT_MOD|5.021008||Viu NOCAPTURE_PAT_MODS|5.021008||Viu NODE_ALIGN|5.005000||Viu NODE_ALIGN_FILL|5.005000||Viu NODE_STEP_REGNODE|5.005000||Viu NODE_SZ_STR|5.006000||Viu NO_ENV_ARRAY_IN_MAIN|5.009004||Viu NOEXPR|5.027010||Viu NofAMmeth|5.003007||Viu no_fh_allowed|5.003007||Viu NOLINE|5.003007||Viu NO_LOCALE|5.007000||Viu NONDESTRUCT_PAT_MOD|5.013002||Viu NONDESTRUCT_PAT_MODS|5.013002||Viu NON_OTHER_COUNT|5.033005||Viu NONV|||Viu no_op|5.003007||Viu NOOP|5.005000|5.003007|p noperl_die|5.021006||vVniu NORETURN_FUNCTION_END|5.009003||Viu NORMAL|5.003007||Viu NOSTR|5.027010||Viu NO_TAINT_SUPPORT|5.017006||Viu not_a_number|5.005000||Viu NOTE3|5.027001||Viu NOTHING|5.003007||Viu NOTHING_t8|5.035004||Viu NOTHING_t8_p8|5.033003||Viu NOTHING_t8_pb|5.033003||Viu NOTHING_tb|5.035004||Viu NOTHING_tb_p8|5.033003||Viu NOTHING_tb_pb|5.033003||Viu nothreadhook|5.008000|5.008000| notify_parser_that_changed_to_utf8|5.025010||Viu not_incrementable|5.021002||Viu NOT_IN_PAD|5.005000||Viu NOT_REACHED|5.019006|5.003007|poVnu NPOSIXA|5.017003||Viu NPOSIXA_t8|5.035004||Viu NPOSIXA_t8_p8|5.033003||Viu NPOSIXA_t8_pb|5.033003||Viu NPOSIXA_tb|5.035004||Viu NPOSIXA_tb_p8|5.033003||Viu NPOSIXA_tb_pb|5.033003||Viu NPOSIXD|5.017003||Viu NPOSIXD_t8|5.035004||Viu NPOSIXD_t8_p8|5.033003||Viu NPOSIXD_t8_pb|5.033003||Viu NPOSIXD_tb|5.035004||Viu NPOSIXD_tb_p8|5.033003||Viu NPOSIXD_tb_pb|5.033003||Viu NPOSIXL|5.017003||Viu NPOSIXL_t8|5.035004||Viu NPOSIXL_t8_p8|5.033003||Viu NPOSIXL_t8_pb|5.033003||Viu NPOSIXL_tb|5.035004||Viu NPOSIXL_tb_p8|5.033003||Viu NPOSIXL_tb_pb|5.033003||Viu NPOSIXU|5.017003||Viu NPOSIXU_t8|5.035004||Viu NPOSIXU_t8_p8|5.033003||Viu NPOSIXU_t8_pb|5.033003||Viu NPOSIXU_tb|5.035004||Viu NPOSIXU_tb_p8|5.033003||Viu NPOSIXU_tb_pb|5.033003||Viu NSIG|5.009003||Viu ntohi|5.003007||Viu ntohl|5.003007||Viu ntohs|5.003007||Viu nuke_stacks|5.005000||Viu Null|5.003007||Viu Nullav|5.003007|5.003007|d Nullch|5.003007|5.003007| Nullcv|5.003007|5.003007|d Nullfp|5.003007||Viu Nullgv|5.003007||Viu Nullhe|5.003007||Viu Nullhek|5.004000||Viu Nullhv|5.003007|5.003007|d Nullop|5.003007||Viu Nullsv|5.003007|5.003007| NUM2PTR|5.006000||pVu NUM_ANYOF_CODE_POINTS|5.021004||Viu NUM_CLASSES|5.029001||Viu num_overflow|5.009001||Vniu NV_BIG_ENDIAN|5.021009||Viu NV_DIG|5.006000||Viu NVef|5.006001|5.003007|poVn NV_EPSILON|5.007003||Viu NVff|5.006001|5.003007|poVn NVgf|5.006001|5.003007|poVn NV_IMPLICIT_BIT|5.021009||Viu NV_INF|5.007003||Viu NV_LITTLE_ENDIAN|5.021009||Viu NVMANTBITS|5.023000|5.023000|Vn NV_MANT_DIG|5.006001||Viu NV_MAX_10_EXP|5.007003||Viu NV_MAX|5.006001||Viu NV_MAX_EXP|5.021003||Viu NV_MIN_10_EXP|5.007003||Viu NV_MIN|5.006001||Viu NV_MIN_EXP|5.021003||Viu NV_MIX_ENDIAN|5.021009||Viu NV_NAN|5.007003||Viu NV_NAN_BITS|5.023000||Viu NV_NAN_IS_QUIET|5.023000||Viu NV_NAN_IS_SIGNALING|5.023000||Viu NV_NAN_PAYLOAD_MASK|5.023000||Viu NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE|5.023000||Viu NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE|5.023000||Viu NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE|5.023000||Viu NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE|5.023000||Viu NV_NAN_PAYLOAD_MASK_SKIP_EIGHT|5.023006||Viu NV_NAN_PAYLOAD_PERM_0_TO_7|5.023000||Viu NV_NAN_PAYLOAD_PERM|5.023000||Viu NV_NAN_PAYLOAD_PERM_7_TO_0|5.023000||Viu NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE|5.023000||Viu NV_NAN_PAYLOAD_PERM_IEEE_754_128_LE|5.023000||Viu NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE|5.023000||Viu NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE|5.023000||Viu NV_NAN_PAYLOAD_PERM_SKIP_EIGHT|5.023006||Viu NV_NAN_QS_BIT|5.023000||Viu NV_NAN_QS_BIT_OFFSET|5.023000||Viu NV_NAN_QS_BIT_SHIFT|5.023000||Viu NV_NAN_QS_BYTE|5.023000||Viu NV_NAN_QS_BYTE_OFFSET|5.023000||Viu NV_NAN_QS_QUIET|5.023000||Viu NV_NAN_QS_SIGNALING|5.023000||Viu NV_NAN_QS_TEST|5.023000||Viu NV_NAN_QS_XOR|5.023000||Viu NV_NAN_SET_QUIET|5.023000||Viu NV_NAN_SET_SIGNALING|5.023000||Viu NV_OVERFLOWS_INTEGERS_AT|5.010001|5.010001|Vn NV_PRESERVES_UV_BITS|5.006001|5.006001|Vn NVSIZE|5.006001|5.006001|Vn NVTYPE|5.006000|5.003007|poVn NV_VAX_ENDIAN|5.025003||Viu NV_WITHIN_IV|5.006000||Viu NV_WITHIN_UV|5.006000||Viu NV_X86_80_BIT|5.025004||Viu NV_ZERO_IS_ALLBITS_ZERO|5.035009|5.035009|Vn OA_AVREF|5.003007||Viu OA_BASEOP|5.005000||Viu OA_BASEOP_OR_UNOP|5.005000||Viu OA_BINOP|5.005000||Viu OA_CLASS_MASK|5.005000||Viu OA_COP|5.005000||Viu OA_CVREF|5.003007||Viu OA_DANGEROUS|5.003007||Viu OA_DEFGV|5.003007||Viu OA_FILEREF|5.003007||Viu OA_FILESTATOP|5.005000||Viu OA_FOLDCONST|5.003007||Viu OA_HVREF|5.003007||Viu OA_LIST|5.003007||Viu OA_LISTOP|5.005000||Viu OA_LOGOP|5.005000||Viu OA_LOOP|5.005000||Viu OA_LOOPEXOP|5.005000||Viu OA_MARK|5.003007||Viu OA_METHOP|5.021005||Viu OA_OPTIONAL|5.003007||Viu OA_OTHERINT|5.003007||Viu OA_PADOP|5.006000||Viu OA_PMOP|5.005000||Viu OA_PVOP_OR_SVOP|5.006000||Viu OA_RETSCALAR|5.003007||Viu OA_SCALAR|5.003007||Viu OA_SCALARREF|5.003007||Viu OASHIFT|5.003007||Viu OA_SVOP|5.005000||Viu OA_TARGET|5.003007||Viu OA_TARGLEX|5.006000||Viu OA_UNOP|5.005000||Viu OA_UNOP_AUX|5.021007||Viu O_BINARY|5.006000||Viu O_CREAT|5.006000||Viu OCSHIFT|5.006000||Viu OCTAL_VALUE|5.019008||Viu Off_t|5.003007|5.003007|Vn Off_t_size|5.006000|5.006000|Vn OFFUNI_IS_INVARIANT|5.023003||Viu OFFUNISKIP|5.019004||Viu OFFUNISKIP_helper|5.035004||Viu ONCE_PAT_MOD|5.009005||Viu ONCE_PAT_MODS|5.009005||Viu ONE_IF_EBCDIC_ZERO_IF_NOT|5.035004||Viu oopsAV|5.003007||Viu oopsHV|5.003007||Viu OP|5.003007||Viu op_append_elem|5.013006|5.013006| op_append_list|5.013006|5.013006| opASSIGN|5.003007||Viu OP_CHECK_MUTEX_INIT|5.015008||Viu OP_CHECK_MUTEX_LOCK|5.015008||Viu OP_CHECK_MUTEX_TERM|5.015008||Viu OP_CHECK_MUTEX_UNLOCK|5.015008||Viu OP_CLASS|5.013007|5.013007| op_class|5.025010|5.025010| op_clear|5.006000||cViu OPCODE|5.003007||Viu op_contextualize|5.013006|5.013006| op_convert_list|5.021006|5.021006| OP_DESC|5.007003|5.007003| op_dump|5.006000|5.006000| OPEN|5.003007||Viu open|5.005000||Viu opendir|5.005000||Viu openn_cleanup|5.019010||Viu openn_setup|5.019010||Viu open_script|5.005000||Viu OPEN_t8|5.035004||Viu OPEN_t8_p8|5.033003||Viu OPEN_t8_pb|5.033003||Viu OPEN_tb|5.035004||Viu OPEN_tb_p8|5.033003||Viu OPEN_tb_pb|5.033003||Viu OPERAND|5.003007||Viu OPERANDl|5.031005||Viu OPERANDs|5.031005||Viu OPFAIL|5.009005||Viu OPFAIL_t8|5.035004||Viu OPFAIL_t8_p8|5.033003||Viu OPFAIL_t8_pb|5.033003||Viu OPFAIL_tb|5.035004||Viu OPFAIL_tb_p8|5.033003||Viu OPFAIL_tb_pb|5.033003||Viu OPf_FOLDED|5.021007||Viu OPf_KIDS|5.003007|5.003007| OPf_KNOW|5.003007||Viu OPf_LIST|5.003007||Viu OPf_MOD|5.003007||Viu OPf_PARENS|5.003007||Viu op_free|5.003007|5.003007| OP_FREED|5.017002||Viu OPf_REF|5.003007||Viu OPf_SPECIAL|5.003007||Viu OPf_STACKED|5.003007||Viu OPf_WANT|5.004000||Viu OPf_WANT_LIST|5.004000||Viu OPf_WANT_SCALAR|5.004000||Viu OPf_WANT_VOID|5.004000||Viu OP_GIMME|5.004000||Viu OP_GIMME_REVERSE|5.010001||Viu OpHAS_SIBLING|5.021007|5.003007|p op_integerize|5.015003||Viu OP_IS_DIRHOP|5.015003||Viu OP_IS_FILETEST|5.006001||Viu OP_IS_FILETEST_ACCESS|5.008001||Viu OP_IS_INFIX_BIT|5.021009||Viu OP_IS_NUMCOMPARE|5.015003||Viu OP_IS_SOCKET|5.006001||Viu OP_IS_STAT|5.031001||Viu OpLASTSIB_set|5.021011|5.003007|p op_linklist|5.013006|5.013006| op_lvalue|5.013007|5.013007|x op_lvalue_flags|||ciu OP_LVALUE_NO_CROAK|5.015001||Viu OpMAYBESIB_set|5.021011|5.003007|p opmethod_stash|5.021007||Viu OpMORESIB_set|5.021011|5.003007|p OP_NAME|5.007003|5.007003| op_null|5.007002|5.007002| OPpALLOW_FAKE|5.015006||Viu op_parent|5.025001|5.025001|n OPpARG1_MASK|5.021004||Viu OPpARG2_MASK|5.021004||Viu OPpARG3_MASK|5.021004||Viu OPpARG4_MASK|5.021004||Viu OPpARGELEM_AV|5.025004||Viu OPpARGELEM_HV|5.025004||Viu OPpARGELEM_MASK|5.025004||Viu OPpARGELEM_SV|5.025004||Viu OPpASSIGN_BACKWARDS|5.003007||Viu OPpASSIGN_COMMON_AGG|5.023002||Viu OPpASSIGN_COMMON_RC1|5.023002||Viu OPpASSIGN_COMMON_SCALAR|5.023002||Viu OPpASSIGN_CV_TO_GV|5.009003||Viu OPpASSIGN_TRUEBOOL|5.027003||Viu OPpAVHVSWITCH_MASK|5.025006||Viu OPpCONCAT_NESTED|5.027007||Viu OPpCONST_BARE|5.003007||Viu OPpCONST_ENTERED|5.003007||Viu OPpCONST_NOVER|5.009003||Viu OPpCONST_SHORTCIRCUIT|5.009001||Viu OPpCONST_STRICT|5.005004||Viu OPpCOREARGS_DEREF1|5.015003||Viu OPpCOREARGS_DEREF2|5.015003||Viu OPpCOREARGS_PUSHMARK|5.015003||Viu OPpCOREARGS_SCALARMOD|5.015003||Viu OPpDEFER_FINALLY|5.035008||Viu OPpDEREF|5.004000||Viu OPpDEREF_AV|5.003007||Viu OPpDEREF_HV|5.003007||Viu OPpDEREF_SV|5.004000||Viu OPpDONT_INIT_GV|5.009003||Viu OPpEARLY_CV|5.006000|5.006000| OPpENTERSUB_AMPER|5.003007|5.003007| OPpENTERSUB_DB|5.003007||Viu OPpENTERSUB_HASTARG|5.006000||Viu OPpENTERSUB_INARGS|5.006000||Viu OPpENTERSUB_LVAL_MASK|5.015001||Viu OPpENTERSUB_NOPAREN|5.005004||Viu OPpEVAL_BYTES|5.015005||Viu OPpEVAL_COPHH|5.015005||Viu OPpEVAL_HAS_HH|5.009003||Viu OPpEVAL_RE_REPARSING|5.017011||Viu OPpEVAL_UNICODE|5.015005||Viu OPpEXISTS_SUB|5.006000||Viu OPpFLIP_LINENUM|5.003007||Viu OPpFT_ACCESS|5.008001||Viu OPpFT_AFTER_t|5.015008||Viu OPpFT_STACKED|5.009001||Viu OPpFT_STACKING|5.015001||Viu OPpHINT_STRICT_REFS|5.021004||Viu OPpHUSH_VMSISH|5.007003||Viu OPpINDEX_BOOLNEG|5.027003||Viu OPpITER_DEF|5.027008||Viu OPpITER_REVERSED|5.009002||Viu OPpKVSLICE|5.027001||Viu OPpLIST_GUESSED|5.003007||Viu OPpLVAL_DEFER|5.004000||Viu OPpLVAL_INTRO|5.003007||Viu OPpLVALUE|5.019006||Viu OPpLVREF_AV|5.021005||Viu OPpLVREF_CV|5.021005||Viu OPpLVREF_ELEM|5.021005||Viu OPpLVREF_HV|5.021005||Viu OPpLVREF_ITER|5.021005||Viu OPpLVREF_SV|5.021005||Viu OPpLVREF_TYPE|5.021005||Viu OPpMAYBE_LVSUB|5.007001||Viu OPpMAYBE_TRUEBOOL|5.017004||Viu OPpMAY_RETURN_CONSTANT|5.009003||Viu OPpMULTICONCAT_APPEND|5.027006||Viu OPpMULTICONCAT_FAKE|5.027006||Viu OPpMULTICONCAT_STRINGIFY|5.027006||Viu OPpMULTIDEREF_DELETE|5.021007||Viu OPpMULTIDEREF_EXISTS|5.021007||Viu OPpOFFBYONE|5.015002||Viu OPpOPEN_IN_CRLF|5.006000||Viu OPpOPEN_IN_RAW|5.006000||Viu OPpOPEN_OUT_CRLF|5.006000||Viu OPpOPEN_OUT_RAW|5.006000||Viu OPpOUR_INTRO|5.006000||Viu OPpPADHV_ISKEYS|5.027003||Viu OPpPADRANGE_COUNTMASK|5.017006||Viu OPpPADRANGE_COUNTSHIFT|5.017006||Viu OPpPAD_STATE|5.009004||Viu OPpPV_IS_UTF8|5.016000||Viu OPpREFCOUNTED|5.006000||Viu OPpREPEAT_DOLIST|5.003007||Viu op_prepend_elem|5.013006|5.013006| OPpREVERSE_INPLACE|5.011002||Viu OPpRV2HV_ISKEYS|5.027003||Viu OPpSLICE|5.004000||Viu OPpSLICEWARNING|5.019004||Viu OPpSORT_DESCEND|5.009002||Viu OPpSORT_INPLACE|5.009001||Viu OPpSORT_INTEGER|5.006000||Viu OPpSORT_NUMERIC|5.006000||Viu OPpSORT_REVERSE|5.006000||Viu OPpSPLIT_ASSIGN|5.025006||Viu OPpSPLIT_IMPLIM|5.019002||Viu OPpSPLIT_LEX|5.025006||Viu OPpSUBSTR_REPL_FIRST|5.015006||Viu OPpTARGET_MY|5.006000||Viu OPpTRANS_ALL|5.009001||Viu OPpTRANS_CAN_FORCE_UTF8|5.031006||Viu OPpTRANS_COMPLEMENT|5.003007||Viu OPpTRANS_DELETE|5.003007||Viu OPpTRANS_FROM_UTF|5.006000||Viu OPpTRANS_GROWS|5.006000||Viu OPpTRANS_IDENTICAL|5.006000||Viu OPpTRANS_SQUASH|5.003007||Viu OPpTRANS_TO_UTF|5.006000||Viu OPpTRANS_USE_SVOP|5.031006||Viu OPpTRUEBOOL|5.017004||Viu OPpUSEINT|5.035005||Viu OpREFCNT_dec|5.006000||Viu op_refcnt_dec|||xiu OpREFCNT_inc|5.006000||Viu op_refcnt_inc|||xiu OP_REFCNT_INIT|5.006000||Viu OP_REFCNT_LOCK|5.006000||Viu op_refcnt_lock|5.009002|5.009002|u OpREFCNT_set|5.006000||Viu OP_REFCNT_TERM|5.006000||Viu OP_REFCNT_UNLOCK|5.006000||Viu op_refcnt_unlock|5.009002|5.009002|u op_relocate_sv|5.021005||Viu op_scope|5.013007|5.013007|x OP_SIBLING|5.021002||Viu OpSIBLING|5.021007|5.003007|p op_sibling_splice|5.021002|5.021002|n OpSLAB|5.017002||Viu opslab_force_free|5.017002||Viu opslab_free|5.017002||Viu opslab_free_nopad|5.017002||Viu OpslabREFCNT_dec|5.017002||Viu OpslabREFCNT_dec_padok|5.017002||Viu OpSLOT|5.017002||Viu OPSLOT_HEADER|5.017002||Viu OpSLOToff|5.033001||Viu op_std_init|5.015003||Viu OPTIMIZED|5.005000||Viu OPTIMIZED_t8|5.035004||Viu OPTIMIZED_t8_p8|5.033003||Viu OPTIMIZED_t8_pb|5.033003||Viu OPTIMIZED_tb|5.035004||Viu OPTIMIZED_tb_p8|5.033003||Viu OPTIMIZED_tb_pb|5.033003||Viu optimize_op|5.027006||Viu optimize_optree|5.027006||Vi optimize_regclass|5.035001||Viu OP_TYPE_IS|5.019007|5.019007| OP_TYPE_IS_NN|5.019010||Viu OP_TYPE_ISNT|5.019010||Viu OP_TYPE_ISNT_AND_WASNT|5.019010||Viu OP_TYPE_ISNT_AND_WASNT_NN|5.019010||Viu OP_TYPE_ISNT_NN|5.019010||Viu OP_TYPE_IS_OR_WAS|5.019010|5.019010| OP_TYPE_IS_OR_WAS_NN|5.019010||Viu op_unscope|5.017003||xViu op_wrap_finally|5.035008|5.035008|x O_RDONLY|5.006000||Viu O_RDWR|5.006000||Viu ORIGMARK|5.003007|5.003007| OSNAME|5.003007|5.003007|Vn OSVERS|5.007002|5.007002|Vn O_TEXT|5.006000||Viu OutCopFILE|5.007003||Viu output_non_portable|5.031008||Viu output_posix_warnings|5.029005||Viu O_VMS_DELETEONCLOSE|5.031002||Viu O_WRONLY|5.006000||Viu package|5.003007||Viu package_version|5.011001||Viu pack_cat|5.033002|5.033002|d packlist|5.008001|5.008001| pack_rec|5.008001||Viu packWARN2|5.007003|5.003007|p packWARN3|5.007003|5.003007|p packWARN4|5.007003|5.003007|p packWARN|5.007003|5.003007|p pad_add_anon|5.015001|5.015001| pad_add_name_pv|5.015001|5.015001| pad_add_name_pvn|5.015001|5.015001| pad_add_name_pvs|5.015001|5.015001| pad_add_name_sv|5.015001|5.015001| padadd_NO_DUP_CHECK|5.011002||Viu padadd_OUR|5.011002||Viu padadd_STALEOK|5.017003||Viu padadd_STATE|5.011002||Viu pad_add_weakref|5.021007||Viu pad_alloc|5.015001|5.015001|x pad_alloc_name|5.015001||Vi PadARRAY|5.017004|5.017004|x PAD_BASE_SV|5.008001||Vi pad_block_start|5.008001||Vi pad_check_dup|5.008001||Vi PAD_CLONE_VARS|5.008001||Vi PAD_COMPNAME|5.017004||Viu PAD_COMPNAME_FLAGS|5.008001||Vi PAD_COMPNAME_FLAGS_isOUR|5.009004||Viu PAD_COMPNAME_GEN|5.008001||Vi PAD_COMPNAME_GEN_set|5.009003||Vi PAD_COMPNAME_OURSTASH|5.008001||Vi PAD_COMPNAME_PV|5.008001||Vi PAD_COMPNAME_SV|5.009005||Viu PAD_COMPNAME_TYPE|5.008001||Vi pad_compname_type|5.033005|5.033005|d PAD_FAKELEX_ANON|5.009005||Viu PAD_FAKELEX_MULTI|5.009005||Viu pad_findlex|5.005000||Vi pad_findmy_pv|5.015001|5.015001| pad_findmy_pvn|5.015001|5.015001| pad_findmy_pvs|5.015001|5.015001| pad_findmy_sv|5.015001|5.015001| pad_fixup_inner_anons|5.008001||Vi pad_free|5.003007||Vi pad_leavemy|5.003007||Vi PadlistARRAY|5.017004|5.017004|x padlist_dup|5.013002||Vi PadlistMAX|5.017004|5.017004|x PadlistNAMES|5.017004|5.017004|x PadlistNAMESARRAY|5.017004|5.017004|x PadlistNAMESMAX|5.017004|5.017004|x PadlistREFCNT|5.017004|5.017004|x padlist_store|5.017004||Viu PadMAX|5.017004|5.017004|x padname_dup|5.021007||Vi PadnameFLAGS|5.021007||Viu padname_free|||ciu PADNAME_FROM_PV|5.021007||Viu PadnameIN_SCOPE|5.031004||Vniu PadnameIsOUR|5.017004||Vi PadnameIsSTATE|5.017004||Vi PadnameIsSTATE_on|5.021007||Viu PadnameLEN|5.017004|5.017004|x PadnamelistARRAY|5.017004|5.017004|x padnamelist_dup|5.021007||Vi padnamelist_fetch|5.021007|5.021007|xn padnamelist_free|||ciu PadnamelistMAX|5.017004|5.017004|x PadnamelistMAXNAMED|5.019003||Viu PadnamelistREFCNT|5.021007|5.021007|x PadnamelistREFCNT_dec|5.021007|5.021007|x padnamelist_store|5.021007|5.021007|x PadnameLVALUE|5.021006||Viu PadnameLVALUE_on|5.021006||Viu PadnameOURSTASH|5.017004||Vi PadnameOURSTASH_set|5.021007||Viu PadnameOUTER|5.017004||Vi PadnamePROTOCV|5.021007||Viu PadnamePV|5.017004|5.017004|x PadnameREFCNT|5.021007|5.021007|x PadnameREFCNT_dec|5.021007|5.021007|x PadnameSV|5.017004|5.017004|x PADNAMEt_LVALUE|5.021007||Viu PADNAMEt_OUR|5.021007||Viu PADNAMEt_OUTER|5.021007|5.021007| PADNAMEt_STATE|5.021007||Viu PADNAMEt_TYPED|5.021007||Viu PadnameTYPE|5.017004||Vi PadnameTYPE_set|5.021007||Viu PadnameUTF8|5.017004|5.017004|x pad_new|5.015001|5.015001| padnew_CLONE|5.008001||Viu padnew_SAVE|5.008001||Viu padnew_SAVESUB|5.008001||Viu pad_peg|5.009004||Viu pad_push|5.008001||cVi pad_reset|5.003007||Vi PAD_RESTORE_LOCAL|5.008001||Vi PAD_SAVE_LOCAL|5.008001||Vi PAD_SAVE_SETNULLPAD|5.008001||Vi PAD_SET_CUR|5.008001||Vi PAD_SET_CUR_NOSAVE|5.008002||Vi pad_setsv|5.008001||cV PAD_SETSV|5.008001||Vi pad_sv|5.003007||cV PAD_SV|5.003007||Vi PAD_SVl|5.008001||Vi pad_swipe|5.003007||Vi pad_tidy|5.015001|5.015001|x panic_write2|5.008001||Viu PARENT_FAKELEX_FLAGS|5.009005||Viu PARENT_PAD_INDEX|5.009005||Viu parse_arithexpr|5.013008|5.013008|x parse_barestmt|5.013007|5.013007|x parse_block|5.013007|5.013007|x parse_body|5.006000||Viu parse_fullexpr|5.013008|5.013008|x parse_fullstmt|5.013005|5.013005|x parse_gv_stash_name|5.019004||Viu parse_ident|5.017010||Viu parse_label|5.013007|5.013007|x parse_listexpr|5.013008|5.013008|x parse_lparen_question_flags|5.017009||Viu PARSE_OPTIONAL|5.013007|5.013007| parser_dup|5.009000|5.009000|u parser_free|5.009005||Viu parser_free_nexttoke_ops|5.017006||Viu parse_stmtseq|5.013006|5.013006|x parse_subsignature|5.031003|5.031003|x parse_termexpr|5.013008|5.013008|x parse_unicode_opts|5.008001||Viu parse_uniprop_string|5.027011||Viu PATCHLEVEL|5.003007||Viu path_is_searchable|5.019001||Vniu Pause|5.003007||Viu pause|5.005000||Viu pclose|5.003007||Viu peep|5.003007||Viu pending_ident|5.017004||Viu PERL_ABS|5.008001|5.003007|p Perl_acos|5.021004|5.021004|n perl_alloc|5.003007|5.003007|n PERL_ALLOC_CHECK|5.006000||Viu perl_alloc_using|5.006000||Vnu PERL_ANY_COW|5.017007||Viu PERL_API_REVISION|5.006000||Viu PERL_API_SUBVERSION|5.006000||Viu PERL_API_VERSION|5.006000||Viu PERL_API_VERSION_STRING|5.013004||Viu PERL_ARENA_ROOTS_SIZE|5.009004||Viu PERL_ARENA_SIZE|5.009003||Viu PERL_ARGS_ASSERT_CROAK_XS_USAGE|||ponu Perl_asin|5.021004|5.021004|n Perl_assert|5.011000||Viu perl_assert_ptr|5.027004||Viu PERL_ASYNC_CHECK|5.006000|5.006000| Perl_atan2|5.006000|5.006000|n Perl_atan|5.021004|5.021004|n Perl_atof2|5.006001||Viu Perl_atof|5.006000||Viu PERL_BCDVERSION||5.003007|onu PERL_BISON_VERSION|5.023008||Viu PERL_BITFIELD16|5.010001||Viu PERL_BITFIELD32|5.010001||Viu PERL_BITFIELD8|5.010001||Viu PERL_CALLCONV|5.005002||Viu PERL_CALLCONV_NO_RET|5.017002||Viu Perl_ceil|5.009001|5.009001|n PERL_CKDEF|5.006000||Viu perl_clone|5.006000||Vn perl_clone_using|5.006000||Vnu PERL_CLZ_32|5.035003||Viu PERL_CLZ_64|5.035003||Viu perl_construct|5.003007|5.003007|n PERL_COP_SEQMAX|5.013010||Viu PERL_COPY_ON_WRITE|5.023001||Viu Perl_cos|5.006000|5.006000|n Perl_cosh|5.021004|5.021004|n PERL_COUNT_MULTIPLIER|5.027007||Viu PERL_CTZ_32|5.035003||Viu PERL_CTZ_64|5.035003||Viu Perl_custom_op_xop|5.019006||V PERLDB_ALL|5.004002||Viu PERLDBf_GOTO|5.004005||Viu PERLDBf_INTER|5.004002||Viu PERLDBf_LINE|5.004002||Viu PERLDBf_NAMEANON|5.006000||Viu PERLDBf_NAMEEVAL|5.006000||Viu PERLDBf_NONAME|5.004005||Viu PERLDBf_NOOPT|5.004002||Viu PERLDBf_SAVESRC|5.010001||Viu PERLDBf_SAVESRC_INVALID|5.010001||Viu PERLDBf_SAVESRC_NOSUBS|5.010001||Viu PERLDBf_SINGLE|5.004002||Viu PERLDBf_SUB|5.004002||Viu PERLDBf_SUBLINE|5.004002||Viu PERLDB_GOTO|5.004005||Viu PERLDB_INTER|5.004002||Viu PERLDB_LINE|5.004002||Viu PERLDB_LINE_OR_SAVESRC|5.023002||Viu PERLDB_NAMEANON|5.006000||Viu PERLDB_NAMEEVAL|5.006000||Viu PERLDB_NOOPT|5.004002||Viu PERLDB_SAVESRC|5.010001||Viu PERLDB_SAVESRC_INVALID|5.010001||Viu PERLDB_SAVESRC_NOSUBS|5.010001||Viu PERLDB_SINGLE|5.004002||Viu PERLDB_SUB|5.004002||Viu PERLDB_SUBLINE|5.004002||Viu PERLDB_SUB_NN|5.004005||Viu PERL_DEB2|5.021007||Viu PERL_DEB|5.008001||Viu PERL_deBruijnMagic32|5.035003||Viu PERL_deBruijnMagic64|5.035003||Viu PERL_deBruijnShift32|5.035003||Viu PERL_deBruijnShift64|5.035003||Viu PERL_DEBUG|5.008001||Viu Perl_debug_log|5.003007||Viu PERL_DEBUG_PAD|5.007003||Viu PERL_DEBUG_PAD_ZERO|5.007003||Viu PERL_DECIMAL_VERSION|5.019008||Viu PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION|5.009003||Viu perl_destruct|5.007003|5.007003|n PerlDir_chdir|5.005000||Viu PerlDir_close|5.005000||Viu PerlDir_mapA|5.006000||Viu PerlDir_mapW|5.006000||Viu PerlDir_mkdir|5.005000||Viu PerlDir_open|5.005000||Viu PerlDir_read|5.005000||Viu PerlDir_rewind|5.005000||Viu PerlDir_rmdir|5.005000||Viu PerlDir_seek|5.005000||Viu PerlDir_tell|5.005000||Viu PERL_DONT_CREATE_GVSV|5.009003||Viu Perl_drand48|5.019004||Viu Perl_drand48_init|5.019004||Viu PERL_DRAND48_QUAD|5.019004||Viu PERL_DTRACE_PROBE_ENTRY|5.023009||Viu PERL_DTRACE_PROBE_FILE_LOADED|5.023009||Viu PERL_DTRACE_PROBE_FILE_LOADING|5.023009||Viu PERL_DTRACE_PROBE_OP|5.023009||Viu PERL_DTRACE_PROBE_PHASE|5.023009||Viu PERL_DTRACE_PROBE_RETURN|5.023009||Viu PERL_EBCDIC_TABLES_H|5.027001||Viu PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS|5.009004||Viu PERL_ENABLE_EXTENDED_TRIE_OPTIMISATION|5.009004||Viu PERL_ENABLE_POSITIVE_ASSERTION_STUDY|5.009005||Viu PERL_ENABLE_TRIE_OPTIMISATION|5.009004||Viu PerlEnv_clearenv|5.006000||Viu PerlEnv_ENVgetenv|5.006000||Viu PerlEnv_ENVgetenv_len|5.006000||Viu PerlEnv_free_childdir|5.006000||Viu PerlEnv_free_childenv|5.006000||Viu PerlEnv_get_childdir|5.006000||Viu PerlEnv_get_childenv|5.006000||Viu PerlEnv_get_child_IO|5.006000||Viu PerlEnv_getenv|5.005000||Viu PerlEnv_getenv_len|5.006000||Viu PerlEnv_lib_path|5.005000||Viu PerlEnv_os_id|5.006000||Viu PerlEnv_putenv|5.005000||Viu PerlEnv_sitelib_path|5.005000||Viu PerlEnv_uname|5.005004||Viu PerlEnv_vendorlib_path|5.006000||Viu Perl_error_log|5.006000||Viu Perl_eval_pv||5.003007|onu Perl_eval_sv||5.003007|onu PERL_EXIT_ABORT|5.019003|5.019003| PERL_EXIT_DESTRUCT_END|5.007003|5.007003| PERL_EXIT_EXPECTED|5.006000|5.006000| PERL_EXIT_WARN|5.019003|5.019003| Perl_exp|5.006000|5.006000|n Perl_fabs|5.035005||Viu PERL_FEATURE_H|5.029006||Viu PERL_FILE_IS_ABSOLUTE|5.006000||Viu PERL_FILTER_EXISTS|5.009005||Viu Perl_floor|5.006000|5.006000|n PERL_FLUSHALL_FOR_CHILD|5.006000||Viu Perl_fmod|5.006000|5.006000|n Perl_fp_class|5.007003||Viu Perl_fp_class_denorm|5.007003||Viu Perl_fp_class_inf|5.007003||Viu Perl_fp_class_nan|5.007003||Viu Perl_fp_class_ndenorm|5.007003||Viu Perl_fp_class_ninf|5.007003||Viu Perl_fp_class_nnorm|5.007003||Viu Perl_fp_class_norm|5.007003||Viu Perl_fp_class_nzero|5.007003||Viu Perl_fp_class_pdenorm|5.007003||Viu Perl_fp_class_pinf|5.007003||Viu Perl_fp_class_pnorm|5.007003||Viu Perl_fp_class_pzero|5.007003||Viu Perl_fp_class_qnan|5.007003||Viu Perl_fp_class_snan|5.007003||Viu Perl_fp_class_zero|5.007003||Viu PERL_FPU_INIT|5.007002||Viu PERL_FPU_POST_EXEC|5.008001||Viu PERL_FPU_PRE_EXEC|5.008001||Viu perl_free|5.003007|5.003007|n Perl_free_c_backtrace|5.021001||Viu Perl_frexp|5.006000|5.006000|n PERL_FS_VER_FMT|5.006000||Viu PERL_FS_VERSION|5.010001||Viu PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||Viu PERL_GCC_VERSION_GE|5.035003||Viu PERL_GCC_VERSION_GT|5.035003||Viu PERL_GCC_VERSION_LE|5.035003||Viu PERL_GCC_VERSION_LT|5.035003||Viu PERL_GET_CONTEXT|5.006000||Viu PERL_GET_INTERP|5.006000||Viu PERL_GET_THX|5.006000||Viu PERL_GIT_UNPUSHED_COMMITS|5.010001||Viu PERL_GPROF_MONCONTROL|5.007002||Viu PERL_HANDY_H|5.027001||Viu PERL_HAS_FAST_GET_LSB_POS32|5.035003||Viu PERL_HAS_FAST_GET_LSB_POS64|5.035003||Viu PERL_HAS_FAST_GET_MSB_POS32|5.035003||Viu PERL_HAS_FAST_GET_MSB_POS64|5.035003||Viu PERL_HASH|5.003007|5.003007|p PERL_HASH_DEFAULT_HvMAX|5.017011||Viu PERL_HASH_FUNC|5.017006||Viu PERL_HASH_FUNC_SIPHASH13|5.033007||Viu PERL_HASH_FUNC_ZAPHOD32|5.027001||Viu PERL_HASH_INTERNAL|5.008002||Viu PERL_HASH_ITER_BUCKET|5.018000||Viu PERL_HASH_RANDOMIZE_KEYS|5.018000||Viu PERL_HASH_SEED|5.008001||Viu PERL_HASH_SEED_BYTES|5.017006||Viu PERL_HASH_SEED_STATE|5.027001||Viu PERL_HASH_SEED_WORDS|5.033007||Viu PERL_HASH_STATE_BYTES|5.027001||Viu PERL_HASH_STATE_WORDS|5.033007||Viu PERL_HASH_USE_SBOX32_ALSO|5.027001||Viu PERL_HASH_WITH_SEED|5.021001||Viu PERL_HASH_WITH_STATE|5.027001||Viu PERL_HV_ARRAY_ALLOC_BYTES|5.006000||Viu PERL___I|5.009005||Viu PERL_IMPLICIT_CONTEXT|5.006000||Viu PERL_INC_VERSION_LIST|5.035009|5.035009|Vn Perl_internal_drand48|5.027004||Viu PERL_INTERPRETER_SIZE_UPTO_MEMBER|5.010000||Viu PERL_INT_MAX|5.003007|5.003007|p PERL_INT_MIN|5.003007|5.003007|p PERL_INVLIST_INLINE_H|5.029006||Viu PerlIO|5.003007||Viu PerlIO_apply_layers|5.007001|5.007001| PerlIOArg|5.007001||Viu PerlIOBase|5.007001||Viu PerlIO_binmode|5.007001|5.007001| PERLIOBUF_DEFAULT_BUFSIZ|5.013007||Viu PerlIO_canset_cnt|5.003007|5.003007|n PerlIO_clearerr|5.007003|5.007003| PerlIO_close|5.007003|5.007003| PerlIO_context_layers|||u PerlIO_debug|5.007001|5.007001| PERLIO_DUP_CLONE|5.007003||Viu PERLIO_DUP_FD|5.007003||Viu PerlIO_eof|5.007003|5.007003| PerlIO_error|5.007003|5.007003| PerlIO_exportFILE|5.003007|5.003007|n PERLIO_F_APPEND|5.007001|5.007001| PerlIO_fast_gets|5.003007|5.003007|n PERLIO_F_CANREAD|5.007001|5.007001| PERLIO_F_CANWRITE|5.007001|5.007001| PERLIO_F_CLEARED|5.013008||Viu PERLIO_F_CRLF|5.007001|5.007001| PerlIO_fdopen|5.003007|5.003007|n PERLIO_F_EOF|5.007001|5.007001| PERLIO_F_ERROR|5.007001|5.007001| PERLIO_F_FASTGETS|5.007001|5.007001| PerlIO_fileno|5.007003|5.007003| PerlIO_fill|5.007000|5.007000|u PerlIO_findFILE|5.003007|5.003007|n PERLIO_F_LINEBUF|5.007001|5.007001| PerlIO_flush|5.007003|5.007003| PERLIO_F_NOTREG|5.008001||Viu PERLIO_F_OPEN|5.007001|5.007001| PERLIO_F_RDBUF|5.007001|5.007001| PERLIO_F_TEMP|5.007001|5.007001| PERLIO_F_TRUNCATE|5.007001|5.007001| PERLIO_F_TTY|5.007001||Viu PERLIO_F_UNBUF|5.007001|5.007001| PERLIO_FUNCS_CAST|5.009003||pVu PERLIO_FUNCS_DECL|5.009003|5.009003|pVu PERLIO_F_UTF8|5.007001|5.007001| PERLIO_F_WRBUF|5.007001|5.007001| PerlIO_get_base|5.007003|5.007003| PerlIO_get_bufsiz|5.007003|5.007003| PerlIO_getc|5.003007|5.003007|n PerlIO_get_cnt|5.007003|5.007003| PerlIO_getpos|5.003007|5.003007|n PerlIO_get_ptr|5.007003|5.007003| PERLIO_H|5.027001||Viu PerlIO_has_base|5.003007|5.003007|n PerlIO_has_cntptr|5.003007|5.003007|n PerlIO_importFILE|5.003007|5.003007|n PERLIO_INIT|5.009005||Viu PERLIO_K_BUFFERED|5.007001|5.007001| PERLIO_K_CANCRLF|5.007001|5.007001| PERLIO_K_DESTRUCT|5.007001||Viu PERLIO_K_DUMMY|5.007001||Viu PERLIO_K_FASTGETS|5.007001|5.007001| PERLIO_K_MULTIARG|5.007003|5.007003| PERLIO_K_RAW|5.007001|5.007001| PERLIO_K_UTF8|5.007001||Viu PERLIO_LAYERS|5.007001||Viu PERLIOL_H|5.027001||Viu PerlIONext|5.007001||Viu PERLIO_NOT_STDIO|5.003007||Viu PerlIO_open|5.003007|5.003007|n PerlIO_printf|5.006000|5.003007| PerlIO_putc|5.003007|5.003007|n PerlIO_puts|5.003007|5.003007|n PerlIO_read|5.007003|5.007003| PerlIO_releaseFILE|5.003007|5.003007|n PerlIO_reopen|5.003007|5.003007|n PerlIO_restore_errno|5.021006||cViu PerlIO_rewind|5.003007|5.003007|n PerlIO_save_errno|5.021006||cViu PerlIO_seek|5.007003|5.007003| PerlIOSelf|5.007001||Viu PerlIO_set_cnt|5.007003|5.007003| PerlIO_setlinebuf|5.007003|5.007003| PerlIO_setpos|5.003007|5.003007|n PerlIO_set_ptrcnt|5.007003|5.007003| PerlIO_stderr|5.007003|5.007003| PerlIO_stdin|5.007003|5.007003| PerlIO_stdout|5.007003|5.007003| PerlIO_stdoutf|5.006000|5.003007| PERLIO_STDTEXT|5.007001||Viu PerlIO_tell|5.007003|5.007003| PERLIO_TERM|5.009005||Viu PerlIO_ungetc|5.003007|5.003007|n PerlIO_unread|5.007003|5.007003|u PERLIO_USING_CRLF|5.007003||Viu PerlIOValid|5.007003||Viu PerlIO_vprintf|5.003007|5.003007|n PerlIO_write|5.007003|5.007003| Perl_isfinite|5.007003|5.007003|n Perl_isfinitel|5.021004||Viu PERL_IS_GCC|5.032001||Viu Perl_isinf|5.007003|5.007003|n Perl_isnan|5.006001|5.006001|n PERL_IS_SUBWORD_ADDR|5.027007||Viu PERL_IS_UTF8_CHAR_DFA|5.035004||Viu PERL_JNP_TO_DECIMAL|5.033001||Viu Perl_langinfo|5.027004|5.027004|n PERL_LANGINFO_H|5.027004||Viu PERL_LAST_5_18_0_INTERP_MEMBER|5.017009||Viu Perl_ldexp|5.021003|5.021003|n PerlLIO_access|5.005000||Viu PerlLIO_chmod|5.005000||Viu PerlLIO_chown|5.005000||Viu PerlLIO_chsize|5.005000||Viu PerlLIO_close|5.005000||Viu PerlLIO_dup2|5.005000||Viu PerlLIO_dup2_cloexec|5.027008||Viu PerlLIO_dup|5.005000||Viu PerlLIO_dup_cloexec|5.027008||Viu PerlLIO_flock|5.005000||Viu PerlLIO_fstat|5.005000||Viu PerlLIO_ioctl|5.005000||Viu PerlLIO_isatty|5.005000||Viu PerlLIO_link|5.006000||Viu PerlLIO_lseek|5.005000||Viu PerlLIO_lstat|5.005000||Viu PerlLIO_mktemp|5.005000||Viu PerlLIO_open3|5.005000||Viu PerlLIO_open3_cloexec|5.027008||Viu PerlLIO_open|5.005000||Viu PerlLIO_open_cloexec|5.027008||Viu PerlLIO_read|5.005000||Viu PerlLIO_readlink|5.033005||Viu PerlLIO_rename|5.005000||Viu PerlLIO_setmode|5.005000||Viu PerlLIO_stat|5.005000||Viu PerlLIO_symlink|5.033005||Viu PerlLIO_tmpnam|5.005000||Viu PerlLIO_umask|5.005000||Viu PerlLIO_unlink|5.005000||Viu PerlLIO_utime|5.005000||Viu PerlLIO_write|5.005000||Viu PERL_LOADMOD_DENY|5.006000|5.003007| PERL_LOADMOD_IMPORT_OPS|5.006000|5.003007| PERL_LOADMOD_NOIMPORT|5.006000|5.003007| Perl_log10|5.021004|5.021004|n Perl_log|5.006000|5.006000|n PERL_LONG_MAX|5.003007|5.003007|p PERL_LONG_MIN|5.003007|5.003007|p PERL_MAGIC_arylen|5.007002|5.003007|p PERL_MAGIC_arylen_p|5.009003|5.009003| PERL_MAGIC_backref|5.007002|5.003007|p PERL_MAGIC_bm|5.007002|5.003007|p PERL_MAGIC_checkcall|5.013006|5.013006| PERL_MAGIC_collxfrm|5.007002|5.003007|p PERL_MAGIC_dbfile|5.007002|5.003007|p PERL_MAGIC_dbline|5.007002|5.003007|p PERL_MAGIC_debugvar|5.021005|5.021005| PERL_MAGIC_defelem|5.007002|5.003007|p PERL_MAGIC_env|5.007002|5.003007|p PERL_MAGIC_envelem|5.007002|5.003007|p PERL_MAGIC_ext|5.007002|5.003007|p PERL_MAGIC_fm|5.007002|5.003007|p PERL_MAGIC_glob||5.003007|ponu PERL_MAGIC_hints|5.009004|5.009004| PERL_MAGIC_hintselem|5.009004|5.009004| PERL_MAGIC_isa|5.007002|5.003007|p PERL_MAGIC_isaelem|5.007002|5.003007|p PERL_MAGIC_lvref|5.021005|5.021005| PERL_MAGIC_mutex||5.003007|ponu PERL_MAGIC_nkeys|5.007002|5.003007|p PERL_MAGIC_nonelem|5.027009|5.027009| PERL_MAGIC_overload||5.003007|ponu PERL_MAGIC_overload_elem||5.003007|ponu PERL_MAGIC_overload_table|5.007002|5.003007|p PERL_MAGIC_pos|5.007002|5.003007|p PERL_MAGIC_qr|5.007002|5.003007|p PERL_MAGIC_READONLY_ACCEPTABLE|5.015000||Viu PERL_MAGIC_regdata|5.007002|5.003007|p PERL_MAGIC_regdatum|5.007002|5.003007|p PERL_MAGIC_regex_global|5.007002|5.003007|p PERL_MAGIC_rhash|5.009003|5.009003| PERL_MAGIC_shared|5.007003|5.003007|p PERL_MAGIC_shared_scalar|5.007003|5.003007|p PERL_MAGIC_sig|5.007002|5.003007|p PERL_MAGIC_sigelem|5.007002|5.003007|p PERL_MAGIC_substr|5.007002|5.003007|p PERL_MAGIC_sv|5.007002|5.003007|p PERL_MAGIC_symtab|5.009003|5.009003| PERL_MAGIC_taint|5.007002|5.003007|p PERL_MAGIC_tied|5.007002|5.003007|p PERL_MAGIC_tiedelem|5.007002|5.003007|p PERL_MAGIC_tiedscalar|5.007002|5.003007|p PERL_MAGIC_TYPE_IS_VALUE_MAGIC|5.015000||Viu PERL_MAGIC_TYPE_READONLY_ACCEPTABLE|5.015000||Viu PERL_MAGIC_utf8|5.008001|5.003007|p PERL_MAGIC_UTF8_CACHESIZE|5.008001||Viu PERL_MAGIC_uvar|5.007002|5.003007|p PERL_MAGIC_uvar_elem|5.007003|5.003007|p PERL_MAGIC_VALUE_MAGIC|5.015000||Viu PERL_MAGIC_vec|5.007002|5.003007|p PERL_MAGIC_vstring|5.008001|5.003007|p PERL_MAGIC_VTABLE_MASK|5.015000||Viu PERL_MALLOC_CTL_H|5.027001||Viu Perl_malloc_good_size|5.010001||Viu PERL_MALLOC_WRAP|5.009002|5.009002|Vn PerlMem_calloc|5.006000||Viu PerlMem_free|5.005000||Viu PerlMem_free_lock|5.006000||Viu PerlMem_get_lock|5.006000||Viu PerlMem_is_locked|5.006000||Viu PerlMem_malloc|5.005000||Viu PERL_MEMORY_DEBUG_HEADER_SIZE|5.019009||Viu PerlMemParse_calloc|5.006000||Viu PerlMemParse_free|5.006000||Viu PerlMemParse_free_lock|5.006000||Viu PerlMemParse_get_lock|5.006000||Viu PerlMemParse_is_locked|5.006000||Viu PerlMemParse_malloc|5.006000||Viu PerlMemParse_realloc|5.006000||Viu PerlMem_realloc|5.005000||Viu PerlMemShared_calloc|5.006000||Viu PerlMemShared_free|5.006000||Viu PerlMemShared_free_lock|5.006000||Viu PerlMemShared_get_lock|5.006000||Viu PerlMemShared_is_locked|5.006000||Viu PerlMemShared_malloc|5.006000||Viu PerlMemShared_realloc|5.006000||Viu PERL_MG_UFUNC|5.007001||Viu Perl_modf|5.006000|5.006000|n PERL_MULTICONCAT_HEADER_SIZE|5.027006||Viu PERL_MULTICONCAT_IX_LENGTHS|5.027006||Viu PERL_MULTICONCAT_IX_NARGS|5.027006||Viu PERL_MULTICONCAT_IX_PLAIN_LEN|5.027006||Viu PERL_MULTICONCAT_IX_PLAIN_PV|5.027006||Viu PERL_MULTICONCAT_IX_UTF8_LEN|5.027006||Viu PERL_MULTICONCAT_IX_UTF8_PV|5.027006||Viu PERL_MULTICONCAT_MAXARG|5.027006||Viu Perl_my_mkostemp|5.027008||Viu Perl_my_mkstemp|5.027004||Viu PERL_MY_SNPRINTF_GUARDED|5.009004||Viu PERL_MY_SNPRINTF_POST_GUARD|5.021002||Viu PERL_MY_VSNPRINTF_GUARDED|5.009004||Viu PERL_MY_VSNPRINTF_POST_GUARD|5.021002||Viu PERL_NO_DEV_RANDOM|5.009004||Viu PERL_NON_CORE_CHECK_EMPTY|5.035004||Viu PERL_OBJECT_THIS|5.005000||Viu PERL_OP_PARENT|5.025001||Viu PERL_PADNAME_MINIMAL|5.021007||Viu PERL_PADSEQ_INTRO|5.013010||Viu perl_parse|5.006000|5.006000|n PERL_PATCHLEVEL_H_IMPLICIT|5.006000||Viu PERL_PATCHNUM|5.010001||Viu PERL_POISON_EXPR|5.019006||Viu Perl_pow|5.006000|5.006000|n Perl_pp_accept|5.013009||Viu Perl_pp_aelemfast_lex|5.015000||Viu Perl_pp_andassign|5.013009||Viu Perl_pp_avalues|5.013009||Viu Perl_pp_bind|5.013009||Viu Perl_pp_bit_xor|5.013009||Viu Perl_pp_chmod|5.013009||Viu Perl_pp_chomp|5.013009||Viu Perl_pp_connect|5.013009||Viu Perl_pp_cos|5.013009||Viu Perl_pp_custom|5.013009||Viu Perl_pp_dbmclose|5.013009||Viu PERL_PPDEF|5.006000||Viu Perl_pp_dofile|5.013009||Viu Perl_pp_dor|5.013009||Viu Perl_pp_dorassign|5.013009||Viu Perl_pp_dump|5.013009||Viu Perl_pp_egrent|5.013009||Viu Perl_pp_enetent|5.013009||Viu Perl_pp_eprotoent|5.013009||Viu Perl_pp_epwent|5.013009||Viu Perl_pp_eservent|5.013009||Viu Perl_pp_exp|5.013009||Viu Perl_pp_fcntl|5.013009||Viu Perl_pp_ftatime|5.013009||Viu Perl_pp_ftbinary|5.013009||Viu Perl_pp_ftblk|5.013009||Viu Perl_pp_ftchr|5.013009||Viu Perl_pp_ftctime|5.013009||Viu Perl_pp_ftdir|5.013009||Viu Perl_pp_fteexec|5.013009||Viu Perl_pp_fteowned|5.013009||Viu Perl_pp_fteread|5.013009||Viu Perl_pp_ftewrite|5.013009||Viu Perl_pp_ftfile|5.013009||Viu Perl_pp_ftmtime|5.013009||Viu Perl_pp_ftpipe|5.013009||Viu Perl_pp_ftrexec|5.013009||Viu Perl_pp_ftrwrite|5.013009||Viu Perl_pp_ftsgid|5.013009||Viu Perl_pp_ftsize|5.013009||Viu Perl_pp_ftsock|5.013009||Viu Perl_pp_ftsuid|5.013009||Viu Perl_pp_ftsvtx|5.013009||Viu Perl_pp_ftzero|5.013009||Viu Perl_pp_getpeername|5.013009||Viu Perl_pp_getsockname|5.013009||Viu Perl_pp_ggrgid|5.013009||Viu Perl_pp_ggrnam|5.013009||Viu Perl_pp_ghbyaddr|5.013009||Viu Perl_pp_ghbyname|5.013009||Viu Perl_pp_gnbyaddr|5.013009||Viu Perl_pp_gnbyname|5.013009||Viu Perl_pp_gpbyname|5.013009||Viu Perl_pp_gpbynumber|5.013009||Viu Perl_pp_gpwnam|5.013009||Viu Perl_pp_gpwuid|5.013009||Viu Perl_pp_gsbyname|5.013009||Viu Perl_pp_gsbyport|5.013009||Viu Perl_pp_gsockopt|5.013009||Viu Perl_pp_hex|5.013009||Viu Perl_pp_i_postdec|5.006000||Viu Perl_pp_i_postinc|5.006000||Viu Perl_pp_i_predec|5.006000||Viu Perl_pp_i_preinc|5.006000||Viu Perl_pp_keys|5.013009||Viu Perl_pp_kill|5.013009||Viu Perl_pp_lcfirst|5.013009||Viu Perl_pp_lineseq|5.013009||Viu Perl_pp_listen|5.013009||Viu Perl_pp_localtime|5.013009||Viu Perl_pp_log|5.013009||Viu Perl_pp_lstat|5.013009||Viu Perl_pp_mapstart|5.013009||Viu Perl_pp_msgctl|5.013009||Viu Perl_pp_msgget|5.013009||Viu Perl_pp_msgrcv|5.013009||Viu Perl_pp_msgsnd|5.013009||Viu Perl_pp_nbit_xor|5.021009||Viu Perl_pp_orassign|5.013009||Viu Perl_pp_padany|5.013009||Viu Perl_pp_pop|5.013009||Viu Perl_pp_read|5.013009||Viu Perl_pp_recv|5.013009||Viu Perl_pp_regcmaybe|5.013009||Viu Perl_pp_rindex|5.013009||Viu Perl_pp_rv2hv|5.013009||Viu Perl_pp_say|5.013009||Viu Perl_pp_sbit_xor|5.021009||Viu Perl_pp_scalar|5.013009||Viu Perl_pp_schomp|5.013009||Viu Perl_pp_scope|5.013009||Viu Perl_pp_seek|5.013009||Viu Perl_pp_semop|5.013009||Viu Perl_pp_send|5.013009||Viu Perl_pp_sge|5.013009||Viu Perl_pp_sgrent|5.013009||Viu Perl_pp_sgt|5.013009||Viu Perl_pp_shmctl|5.013009||Viu Perl_pp_shmget|5.013009||Viu Perl_pp_shmread|5.013009||Viu Perl_pp_shutdown|5.013009||Viu Perl_pp_slt|5.013009||Viu Perl_pp_snetent|5.013009||Viu Perl_pp_socket|5.013009||Viu Perl_pp_sprotoent|5.013009||Viu Perl_pp_spwent|5.013009||Viu Perl_pp_sqrt|5.013009||Viu Perl_pp_sservent|5.013009||Viu Perl_pp_ssockopt|5.013009||Viu Perl_pp_symlink|5.013009||Viu Perl_pp_transr|5.013009||Viu Perl_pp_unlink|5.013009||Viu Perl_pp_utime|5.013009||Viu Perl_pp_values|5.013009||Viu PERL_PRESERVE_IVUV|5.007001||Viu PERL_PRIeldbl|5.006001|5.006001|Vn PERL_PRIfldbl|5.006000|5.006000|Vn PERL_PRIgldbl|5.006000|5.006000|Vn PerlProc_abort|5.005000||Viu PerlProc_crypt|5.005000||Viu PerlProc_DynaLoad|5.006000||Viu PerlProc_execl|5.005000||Viu PerlProc_execv|5.005000||Viu PerlProc_execvp|5.005000||Viu PerlProc__exit|5.005000||Viu PerlProc_exit|5.005000||Viu PerlProc_fork|5.006000||Viu PerlProc_getegid|5.005000||Viu PerlProc_geteuid|5.005000||Viu PerlProc_getgid|5.005000||Viu PerlProc_getlogin|5.005000||Viu PerlProc_GetOSError|5.006000||Viu PerlProc_getpid|5.006000||Viu PerlProc_gettimeofday|5.008000||Viu PerlProc_getuid|5.005000||Viu PerlProc_kill|5.005000||Viu PerlProc_killpg|5.005000||Viu PerlProc_lasthost|5.007001||Viu PerlProc_longjmp|5.005000||Viu PerlProc_pause|5.005000||Viu PerlProc_pclose|5.005000||Viu PerlProc_pipe|5.005000||Viu PerlProc_pipe_cloexec|5.027008||Viu PerlProc_popen|5.005000||Viu PerlProc_popen_list|5.007001||Viu PerlProc_setgid|5.005000||Viu PerlProc_setjmp|5.005000||Viu PerlProc_setuid|5.005000||Viu PerlProc_signal|5.005000||Viu PerlProc_sleep|5.005000||Viu PerlProc_spawnvp|5.008000||Viu PerlProc_times|5.005000||Viu PerlProc_wait|5.005000||Viu PerlProc_waitpid|5.005000||Viu perl_pthread_mutex_lock|5.023006||Viu perl_pthread_mutex_unlock|5.023006||Viu PERL_PV_ESCAPE_ALL|5.009004|5.003007|p PERL_PV_ESCAPE_DWIM|5.019008||Viu PERL_PV_ESCAPE_DWIM_ALL_HEX|||Viu PERL_PV_ESCAPE_FIRSTCHAR|5.009004|5.003007|p PERL_PV_ESCAPE_NOBACKSLASH|5.009004|5.003007|p PERL_PV_ESCAPE_NOCLEAR|5.009004|5.003007|p PERL_PV_ESCAPE_NONASCII|5.013009|5.013009| PERL_PV_ESCAPE_QUOTE|5.009004|5.003007|p PERL_PV_ESCAPE_RE|5.009005|5.003007|p PERL_PV_ESCAPE_UNI|5.009004|5.003007|p PERL_PV_ESCAPE_UNI_DETECT|5.009004|5.003007|p PERL_PV_PRETTY_DUMP|5.009004||pcV PERL_PV_PRETTY_ELLIPSES|5.010000|5.003007|p PERL_PV_PRETTY_EXACTSIZE|5.021005||Viu PERL_PV_PRETTY_LTGT|5.009004|5.003007|p PERL_PV_PRETTY_NOCLEAR|5.010000||pcV PERL_PV_PRETTY_QUOTE|5.009004|5.003007|p PERL_PV_PRETTY_REGPROP|5.009004||pcV PERL_QUAD_MAX|5.003007|5.003007|p PERL_QUAD_MIN|5.003007|5.003007|p PERL_READ_LOCK|5.033005||Viu PERL_READ_UNLOCK|5.033005||Viu PERL_REENTR_API|5.009005||Viu PERL_REENTR_H|5.027001||Viu PERL_REENTR_USING_ASCTIME_R|5.031011||Viu PERL_REENTR_USING_CRYPT_R|5.031011||Viu PERL_REENTR_USING_CTERMID_R|5.031011||Viu PERL_REENTR_USING_CTIME_R|5.031011||Viu PERL_REENTR_USING_ENDGRENT_R|5.031011||Viu PERL_REENTR_USING_ENDHOSTENT_R|5.031011||Viu PERL_REENTR_USING_ENDNETENT_R|5.031011||Viu PERL_REENTR_USING_ENDPROTOENT_R|5.031011||Viu PERL_REENTR_USING_ENDPWENT_R|5.031011||Viu PERL_REENTR_USING_ENDSERVENT_R|5.031011||Viu PERL_REENTR_USING_GETGRENT_R|5.031011||Viu PERL_REENTR_USING_GETGRGID_R|5.031011||Viu PERL_REENTR_USING_GETGRNAM_R|5.031011||Viu PERL_REENTR_USING_GETHOSTBYADDR_R|5.031011||Viu PERL_REENTR_USING_GETHOSTBYNAME_R|5.031011||Viu PERL_REENTR_USING_GETHOSTENT_R|5.031011||Viu PERL_REENTR_USING_GETLOGIN_R|5.031011||Viu PERL_REENTR_USING_GETNETBYADDR_R|5.031011||Viu PERL_REENTR_USING_GETNETBYNAME_R|5.031011||Viu PERL_REENTR_USING_GETNETENT_R|5.031011||Viu PERL_REENTR_USING_GETPROTOBYNAME_R|5.031011||Viu PERL_REENTR_USING_GETPROTOBYNUMBER_R|5.031011||Viu PERL_REENTR_USING_GETPROTOENT_R|5.031011||Viu PERL_REENTR_USING_GETPWENT_R|5.031011||Viu PERL_REENTR_USING_GETPWNAM_R|5.031011||Viu PERL_REENTR_USING_GETPWUID_R|5.031011||Viu PERL_REENTR_USING_GETSERVBYNAME_R|5.031011||Viu PERL_REENTR_USING_GETSERVBYPORT_R|5.031011||Viu PERL_REENTR_USING_GETSERVENT_R|5.031011||Viu PERL_REENTR_USING_GETSPNAM_R|5.031011||Viu PERL_REENTR_USING_GMTIME_R|5.031011||Viu PERL_REENTR_USING_LOCALTIME_R|5.031011||Viu PERL_REENTR_USING_READDIR64_R|5.031011||Viu PERL_REENTR_USING_READDIR_R|5.031011||Viu PERL_REENTR_USING_SETGRENT_R|5.031011||Viu PERL_REENTR_USING_SETHOSTENT_R|5.031011||Viu PERL_REENTR_USING_SETLOCALE_R|5.031011||Viu PERL_REENTR_USING_SETNETENT_R|5.031011||Viu PERL_REENTR_USING_SETPROTOENT_R|5.031011||Viu PERL_REENTR_USING_SETPWENT_R|5.031011||Viu PERL_REENTR_USING_SETSERVENT_R|5.031011||Viu PERL_REENTR_USING_STRERROR_R|5.031011||Viu PERL_REENTR_USING_TMPNAM_R|5.031011||Viu PERL_REENTR_USING_TTYNAME_R|5.031011||Viu PERL_REGCHARCLASS_H|5.027001||Viu PERL_REGCOMP_H|5.029006||Viu PERL_REGMATCH_SLAB_SLOTS|5.009004||Viu PERL_RELOCATABLE_INC|5.017002|5.017002|Vn PERL_REVISION|5.006000|5.006000|d perl_run|5.003007|5.003007|n PERL_RW_MUTEX_DESTROY|5.033005||Viu PERL_RW_MUTEX_INIT|5.033005||Viu Perl_safesysmalloc_size|5.010001||Viu PERL_SAWAMPERSAND|5.017010||Viu PERL_SCAN_ALLOW_MEDIAL_UNDERSCORES|5.031009||Viu PERL_SCAN_ALLOW_UNDERSCORES|5.007003|5.003007|p PERL_SCAN_DISALLOW_PREFIX|5.007003|5.003007|p PERL_SCAN_GREATER_THAN_UV_MAX|5.007003|5.003007|p PERL_SCAN_NOTIFY_ILLDIGIT|5.031008||Viu PERL_SCAN_SILENT_ILLDIGIT|5.008001|5.003007|p PERL_SCAN_SILENT_NON_PORTABLE|5.015001||Viu PERL_SCAN_SILENT_OVERFLOW|5.031009||Viu PERL_SCAN_TRAILING|5.021002|5.021002| PERL_SCNfldbl|5.006001|5.006001|Vn PERL_SCRIPT_MODE|5.004005||Viu PERL_SEEN_HV_FUNC_H|5.017010||Viu PERL_SEEN_HV_MACRO_H|5.027001||Viu PERL_SET_CONTEXT|5.006000||Viu PERL_SET_INTERP|5.006000||Viu Perl_setlocale|5.027002|5.027002|n PERL_SET_PHASE|5.015001||Viu PERL_SET_THX|5.006000||Viu Perl_sharepvn|5.006000||Viu PERL_SHORT_MAX|5.003007|5.003007|p PERL_SHORT_MIN|5.003007|5.003007|p PERLSI_DESTROY|5.005000||Viu PERLSI_DIEHOOK|5.005000||Viu PERL_SIGNALS_UNSAFE_FLAG|5.008001|5.003007|p Perl_signbit|5.009005|5.009005|xn PERLSI_MAGIC|5.005000||Viu PERLSI_MAIN|5.005000||Viu PERLSI_MULTICALL|5.023000||Viu Perl_sin|5.006000|5.006000|n Perl_sinh|5.021004|5.021004|n PerlSIO_canset_cnt|5.007001||Viu PerlSIO_clearerr|5.007001||Viu PerlSIO_fast_gets|5.007001||Viu PerlSIO_fclose|5.007001||Viu PerlSIO_fdopen|5.007001||Viu PerlSIO_fdupopen|5.007001||Viu PerlSIO_feof|5.007001||Viu PerlSIO_ferror|5.007001||Viu PerlSIO_fflush|5.007001||Viu PerlSIO_fgetc|5.007001||Viu PerlSIO_fgetpos|5.007001||Viu PerlSIO_fgets|5.007001||Viu PerlSIO_fileno|5.007001||Viu PerlSIO_fopen|5.007001||Viu PerlSIO_fputc|5.007001||Viu PerlSIO_fputs|5.007001||Viu PerlSIO_fread|5.007001||Viu PerlSIO_freopen|5.007001||Viu PerlSIO_fseek|5.007001||Viu PerlSIO_fsetpos|5.007001||Viu PerlSIO_ftell|5.007001||Viu PerlSIO_fwrite|5.007001||Viu PerlSIO_get_base|5.007001||Viu PerlSIO_get_bufsiz|5.007001||Viu PerlSIO_get_cnt|5.007001||Viu PerlSIO_get_ptr|5.007001||Viu PerlSIO_has_base|5.007001||Viu PerlSIO_has_cntptr|5.007001||Viu PerlSIO_init|5.007001||Viu PerlSIO_printf|5.007001||Viu PerlSIO_rewind|5.007001||Viu PerlSIO_setbuf|5.007001||Viu PerlSIO_set_cnt|5.007001||Viu PerlSIO_setlinebuf|5.007001||Viu PerlSIO_set_ptr|5.007001||Viu PerlSIO_setvbuf|5.007001||Viu PerlSIO_stderr|5.007001||Viu PerlSIO_stdin|5.007001||Viu PerlSIO_stdout|5.007001||Viu PerlSIO_stdoutf|5.007001||Viu PerlSIO_tmpfile|5.007001||Viu PerlSIO_ungetc|5.007001||Viu PERLSI_OVERLOAD|5.005000||Viu PerlSIO_vprintf|5.007001||Viu PERL_SIPHASH_FNC|5.025008||Viu PERLSI_REGCOMP|5.031011||Viu PERLSI_REQUIRE|5.005000||Viu PERLSI_SIGNAL|5.005000||Viu PERLSI_SORT|5.005000||Viu PERLSI_UNDEF|5.005000||Viu PERLSI_UNKNOWN|5.005000||Viu PERLSI_WARNHOOK|5.005000||Viu PERL_SNPRINTF_CHECK|5.021002||Viu PerlSock_accept|5.005000||Viu PerlSock_accept_cloexec|5.027008||Viu PerlSock_bind|5.005000||Viu PerlSock_closesocket|5.006000||Viu PerlSock_connect|5.005000||Viu PerlSock_endhostent|5.005000||Viu PerlSock_endnetent|5.005000||Viu PerlSock_endprotoent|5.005000||Viu PerlSock_endservent|5.005000||Viu PerlSock_gethostbyaddr|5.005000||Viu PerlSock_gethostbyname|5.005000||Viu PerlSock_gethostent|5.005000||Viu PerlSock_gethostname|5.005000||Viu PerlSock_getnetbyaddr|5.005000||Viu PerlSock_getnetbyname|5.005000||Viu PerlSock_getnetent|5.005000||Viu PerlSock_getpeername|5.005000||Viu PerlSock_getprotobyname|5.005000||Viu PerlSock_getprotobynumber|5.005000||Viu PerlSock_getprotoent|5.005000||Viu PerlSock_getservbyname|5.005000||Viu PerlSock_getservbyport|5.005000||Viu PerlSock_getservent|5.005000||Viu PerlSock_getsockname|5.005000||Viu PerlSock_getsockopt|5.005000||Viu PerlSock_htonl|5.005000||Viu PerlSock_htons|5.005000||Viu PerlSock_inet_addr|5.005000||Viu PerlSock_inet_ntoa|5.005000||Viu PerlSock_listen|5.005000||Viu PerlSock_ntohl|5.005000||Viu PerlSock_ntohs|5.005000||Viu PerlSock_recv|5.005000||Viu PerlSock_recvfrom|5.005000||Viu PerlSock_select|5.005000||Viu PerlSock_send|5.005000||Viu PerlSock_sendto|5.005000||Viu PerlSock_sethostent|5.005000||Viu PerlSock_setnetent|5.005000||Viu PerlSock_setprotoent|5.005000||Viu PerlSock_setservent|5.005000||Viu PerlSock_setsockopt|5.005000||Viu PerlSock_shutdown|5.005000||Viu PERL_SOCKS_NEED_PROTOTYPES|5.007001||Viu PerlSock_socket|5.005000||Viu PerlSock_socket_cloexec|5.027008||Viu PerlSock_socketpair|5.005000||Viu PerlSock_socketpair_cloexec|5.027008||Viu Perl_sqrt|5.006000|5.006000|n PERL_STACK_OFFSET_DEFINED|||piu PERL_STACK_OVERFLOW_CHECK|5.006000||Viu PERL_STACK_REALIGN|||piu PERL_STATIC_FORCE_INLINE|5.031011||Viu PERL_STATIC_FORCE_INLINE_NO_RET|5.031011||Viu PERL_STATIC_INLINE|5.013004|5.013004|poVn PERL_STATIC_INLINE_NO_RET|5.017005||Viu PERL_STATIC_NO_RET|5.017005||Viu PERL_STRLEN_EXPAND_SHIFT|5.013004||Viu PERL_STRLEN_ROUNDUP|5.009003||Viu PERL_STRLEN_ROUNDUP_QUANTUM|5.009003||Viu Perl_strtod|5.021004||Viu PERL_SUB_DEPTH_WARN|5.010001||Viu PERL_SUBVERSION|5.006000|5.003007|d PERL_SYS_FPU_INIT|5.021005||Viu PERL_SYS_INIT3|5.006000|5.006000| PERL_SYS_INIT3_BODY|5.010000||Viu PERL_SYS_INIT|5.003007|5.003007| PERL_SYS_INIT_BODY|5.010000||Viu PERL_SYS_TERM|5.003007|5.003007| PERL_SYS_TERM_BODY|5.010000||Viu Perl_tan|5.021004|5.021004|n Perl_tanh|5.021004|5.021004|n PERL_TARGETARCH|5.007002|5.007002|Vn PERL_THREAD_LOCAL|5.035004|5.035004|Vn PERL_TIME64_CONFIG_H|5.027001||Viu PERL_TIME64_H|5.027001||Viu PERL_TRACK_MEMPOOL|5.009003||Viu PERL_TSA|5.023006||Viu PERL_TSA_ACQUIRE|5.023006||Viu PERL_TSA_ACTIVE|5.023006||Viu PERL_TSA_CAPABILITY|5.023006||Viu PERL_TSA_EXCLUDES|5.023006||Viu PERL_TSA_GUARDED_BY|5.023006||Viu PERL_TSA_NO_TSA|5.023006||Viu PERL_TSA_PT_GUARDED_BY|5.023006||Viu PERL_TSA_RELEASE|5.023006||Viu PERL_TSA_REQUIRES|5.023006||Viu PERL_UCHAR_MAX|5.003007|5.003007|p PERL_UCHAR_MIN|5.003007|5.003007|p PERL_UINT_MAX|5.003007|5.003007|p PERL_UINT_MIN|5.003007|5.003007|p PERL_ULONG_MAX|5.003007|5.003007|p PERL_ULONG_MIN|5.003007|5.003007|p PERL_UNICODE_ALL_FLAGS|5.008001||Viu PERL_UNICODE_ARGV|5.008001||Viu PERL_UNICODE_ARGV_FLAG|5.008001||Viu PERL_UNICODE_CONSTANTS_H|5.027001||Viu PERL_UNICODE_DEFAULT_FLAGS|5.008001||Viu PERL_UNICODE_IN|5.008001||Viu PERL_UNICODE_IN_FLAG|5.008001||Viu PERL_UNICODE_INOUT|5.008001||Viu PERL_UNICODE_INOUT_FLAG|5.008001||Viu PERL_UNICODE_LOCALE|5.008001||Viu PERL_UNICODE_LOCALE_FLAG|5.008001||Viu PERL_UNICODE_MAX|5.007003||Viu PERL_UNICODE_OUT|5.008001||Viu PERL_UNICODE_OUT_FLAG|5.008001||Viu PERL_UNICODE_STD|5.008001||Viu PERL_UNICODE_STDERR|5.008001||Viu PERL_UNICODE_STDERR_FLAG|5.008001||Viu PERL_UNICODE_STD_FLAG|5.008001||Viu PERL_UNICODE_STDIN|5.008001||Viu PERL_UNICODE_STDIN_FLAG|5.008001||Viu PERL_UNICODE_STDOUT|5.008001||Viu PERL_UNICODE_STDOUT_FLAG|5.008001||Viu PERL_UNICODE_UTF8CACHEASSERT|5.009004||Viu PERL_UNICODE_UTF8CACHEASSERT_FLAG|5.009004||Viu PERL_UNICODE_WIDESYSCALLS|5.008001||Viu PERL_UNICODE_WIDESYSCALLS_FLAG|5.008001||Viu PERL_UNLOCK_HOOK|5.009004||Viu PERL_UNUSED_ARG|5.009003|5.003007|p PERL_UNUSED_CONTEXT|5.009004|5.003007|p PERL_UNUSED_DECL|5.007002|5.003007|p PERL_UNUSED_RESULT|5.021001|5.003007|p PERL_UNUSED_VAR|5.007002|5.003007|p PERL_UQUAD_MAX|5.003007|5.003007|p PERL_UQUAD_MIN|5.003007|5.003007|p PERL_USE_DEVEL|5.010001|5.010001|Vn PERL_USE_GCC_BRACE_GROUPS|5.009004|5.003007|pV PERL_USES_PL_PIDSTATUS|5.009003||Viu PERL_USE_THREAD_LOCAL|5.035004||Viu PERL_USHORT_MAX|5.003007|5.003007|p PERL_USHORT_MIN|5.003007|5.003007|p PERL_UTF8_H|5.027001||Viu PERL_UTIL_H|5.025012||Viu Perl_va_copy|5.007001||Viu PERLVAR|5.005000||Viu PERLVARA|5.006000||Viu PERLVARI|5.005000||Viu PERL_VARIANTS_WORD_MASK|5.027007||Viu PERLVARIC|5.005000||Viu PERL_VERSION|5.006000|5.003007|d PERL_VERSION_EQ|5.033001||p PERL_VERSION_GE|5.033001|5.003007|p PERL_VERSION_GT|5.033001|5.003007|p PERL_VERSION_LE|5.033001|5.003007|p PERL_VERSION_LT|5.033001|5.003007|p PERL_VERSION_MAJOR|5.033001||Viu PERL_VERSION_MINOR|5.033001||Viu PERL_VERSION_NE|5.033001||p PERL_VERSION_PATCH|5.033001||Viu PERL_VERSION_STRING|5.010001||Viu PERL_WAIT_FOR_CHILDREN|5.006000||Viu Perl_Warn_Bit|5.033003||Viu Perl_warner_nocontext||5.004000|ponu PERL_WARNHOOK_FATAL|5.009004||Viu Perl_Warn_Off|5.033003||Viu PERL_WORD_BOUNDARY_MASK|5.027007||Viu PERL_WORDSIZE|5.027007||Viu PERL_WRITE_LOCK|5.033005||Viu PERL_WRITE_MSG_TO_CONSOLE|5.007003||Viu PERL_WRITE_UNLOCK|5.033005||Viu PERL_XSUB_H|5.027001||Viu perly_sighandler|5.031007||cVnu phase_name|5.035007|5.035007| PHOSTNAME|5.006000|5.006000|Vn pidgone|5.003007||Viu Pid_t|5.005000|5.005000|Vn pipe|5.005000||Viu PIPE_OPEN_MODE|5.008002||Viu PIPESOCK_MODE|5.008001||Viu PL_AboveLatin1|5.015008||Viu PL_amagic_generation|5.005000||Viu PL_an|5.005000||Viu PL_argvgv|5.005000||Viu PL_argvoutgv|5.005000||Viu PL_argvout_stack|5.006000||Viu PL_Assigned_invlist|5.025009||Viu PL_basetime|5.005000||Viu PL_beginav|5.005000||Viu PL_beginav_save|5.006001||Viu PL_blockhooks|5.013003||Viu PL_body_arenas|5.009004||Viu PL_body_roots|5.009003||Viu PL_bodytarget|5.005000||Viu PL_breakable_sub_gen|5.010001||Viu PL_bufend||5.003007|ponu PL_bufptr||5.003007|ponu PL_CCC_non0_non230|5.029008||Viu PL_check|5.009003|5.006000| PL_checkav|5.006000||Viu PL_checkav_save|5.008001||Viu PL_chopset|5.005000||Viu PL_clocktick|5.008001||Viu PL_collation_ix|5.005000||Viu PL_collation_name|5.005000||Viu PL_collation_standard|5.005000||Viu PL_collxfrm_base|5.005000||Viu PL_collxfrm_mult|5.005000||Viu PL_colors|5.005000||Viu PL_colorset|5.005000||Viu PL_compcv|5.005000||Viu PL_compiling|5.005000|5.003007|poVnu PL_comppad|5.008001|5.008001|x PL_comppad_name|5.017004|5.017004|x PL_comppad_name_fill|5.005000||Viu PL_comppad_name_floor|5.005000||Viu PL_constpadix|5.021004||Viu PL_copline||5.003007|ponu PL_cop_seqmax|5.005000||Viu PL_cshlen|5.005000||Viu PL_curcop|5.004005|5.003007|p PL_curcopdb|5.005000||Viu PL_curlocales|5.027009||Viu PL_curpad|5.005000|5.005000|x PL_curpm|5.005000||Viu PL_curpm_under|5.025007||Viu PL_curstack|5.005000||Viu PL_curstackinfo|5.005000||Viu PL_curstash|5.004005|5.003007|p PL_curstname|5.005000||Viu PL_custom_op_descs|5.007003||Viu PL_custom_op_names|5.007003||Viu PL_custom_ops|5.013007||Viu PL_cv_has_eval|5.009000||Viu PL_dbargs|5.005000||Viu PL_DBcontrol|5.021005||Viu PL_DBcv|5.005000||Viu PL_DBgv|5.005000||Viu PL_DBline|5.005000||Viu PL_DBsignal|5.005000|5.003007|poVnu PL_DBsignal_iv|5.021005||Viu PL_DBsingle|5.005000||pV PL_DBsingle_iv|5.021005||Viu PL_DBsub|5.005000||pV PL_DBtrace|5.005000||pV PL_DBtrace_iv|5.021005||Viu PL_debstash|5.005000|5.003007|poVnu PL_debug|5.005000||Viu PL_debug_pad|5.007003||Viu PL_defgv|5.004005|5.003007|p PL_def_layerlist|5.007003||Viu PL_defoutgv|5.005000||Viu PL_defstash|5.005000||Viu PL_delaymagic|5.005000||Viu PL_delaymagic_egid|5.015008||Viu PL_delaymagic_euid|5.015008||Viu PL_delaymagic_gid|5.015008||Viu PL_delaymagic_uid|5.015008||Viu PL_destroyhook|5.010000||Viu PL_diehook|5.005000|5.003007|poVnu PL_Dir|5.006000||Viu PL_dirty|5.005000|5.003007|poVnu PL_doswitches|5.005000||Viu PL_dowarn|5.005000||pV PL_dumper_fd|5.009003||Viu PL_dumpindent|5.006000||Viu PL_dump_re_max_len|5.023008||Viu PL_efloatbuf|5.006000||Viu PL_efloatsize|5.006000||Viu PL_E_FORMAT_PRECISION|5.029000||Viu PL_encoding|5.007003||Viu PL_endav|5.005000||Viu PL_Env|5.006000||Viu PL_envgv|5.005000||Viu PL_errgv|5.004005|5.003007|p PL_error_count||5.003007|ponu PL_errors|5.006000||Viu PL_e_script|5.005000||Viu PL_eval_root|5.005000||Viu PL_evalseq|5.005000||Viu PL_eval_start|5.005000||Viu PL_exit_flags|5.006000|5.006000| PL_exitlist|5.005000||Viu PL_exitlistlen|5.005000||Viu PL_expect||5.003007|ponu PL_fdpid|5.005000||Viu PL_filemode|5.005000||Viu PL_firstgv|5.005000||Viu PL_forkprocess|5.005000||Viu PL_formtarget|5.005000||Viu PL_GCB_invlist|5.021009||Viu PL_generation|5.005000||Viu PL_gensym|5.005000||Viu PL_globalstash|5.005000||Viu PL_globhook|5.015005||Viu PL_hash_rand_bits|5.017010||Viu PL_HASH_RAND_BITS_ENABLED|5.018000||Viu PL_hash_rand_bits_enabled|5.018000||Viu PL_hash_seed|5.033007||Viu PL_hash_state|5.033007||Viu PL_HasMultiCharFold|5.017005||Viu PL_hexdigit||5.003007|pn PL_hintgv|5.005000||Viu PL_hints|5.005000|5.003007|poVnu PL_hv_fetch_ent_mh|5.005000||Viu PL_incgv|5.005000||Viu PL_in_clean_all|5.005000||Viu PL_in_clean_objs|5.005000||Viu PL_in_eval|5.005000||Viu PL_initav|5.005000||Viu PL_in_load_module|5.008001||Viu PL_in_my||5.003007|ponu PL_in_my_stash||5.005000|ponu PL_inplace|5.005000||Viu PL_in_some_fold|5.029007||Viu PL_internal_random_state|5.027004||Viu PL_in_utf8_COLLATE_locale|5.025002||Viu PL_in_utf8_CTYPE_locale|5.019009||Viu PL_in_utf8_turkic_locale|5.029008||Viu PL_isarev|5.009005||Viu PL_keyword_plugin|5.011002|5.011002|x PL_known_layers|5.007003||Viu PL_langinfo_buf|5.027004||Viu PL_langinfo_bufsize|5.027004||Viu PL_lastfd|5.005000||Viu PL_lastgotoprobe|5.005000||Viu PL_last_in_gv|5.005000||Vi PL_laststatval|5.005000|5.003007|poVnu PL_laststype|5.005000||Viu PL_Latin1|5.015008||Viu PL_LB_invlist|5.023007||Viu PL_lc_numeric_mutex_depth|5.027009||Viu PL_lex_state||5.003007|ponu PL_lex_stuff||5.003007|ponu PL_linestr||5.003007|ponu PL_LIO|5.006000||Viu PL_locale_utf8ness|5.027009||Viu PL_localizing|5.005000||Viu PL_localpatches|5.005000||Viu PL_lockhook|5.007003||Viu PL_main_cv|5.005000||Viu PL_main_root|5.005000||Viu PL_mainstack|5.005000||Viu PL_main_start|5.005000||Viu PL_markstack|5.005000||Viu PL_markstack_max|5.005000||Viu PL_markstack_ptr|5.005000||Viu PL_max_intro_pending|5.005000||Viu PL_maxo|5.005000||Viu PL_maxsysfd|5.005000|5.005000| PL_mbrlen_ps|5.031010||Viu PL_mbrtowc_ps|5.031010||Viu PL_Mem|5.006000||Viu PL_mem_log|5.033005||Viu PL_memory_debug_header|5.009004||Viu PL_MemParse|5.006000||Viu PL_MemShared|5.006000||Viu PL_mess_sv|5.005000|5.004000|poVnu PL_min_intro_pending|5.005000||Viu PL_minus_a|5.005000||Viu PL_minus_c|5.005000||Viu PL_minus_E|5.009003||Viu PL_minus_F|5.005000||Viu PL_minus_l|5.005000||Viu PL_minus_n|5.005000||Viu PL_minus_p|5.005000||Viu PL_modcount|5.005000||Viu PL_modglobal|5.005000|5.005000| PL_multideref_pc|5.021007||Viu PL_my_cxt_list|5.009003||Viu PL_my_cxt_size|5.009003||Viu PL_na|5.004005|5.003007|p PL_nomemok|5.005000||Viu PL_no_modify||5.003007|ponu PL_numeric_name|5.005000||Viu PL_numeric_radix_sv|5.007002||Viu PL_numeric_standard|5.005000||Viu PL_numeric_underlying|5.027006||Viu PL_numeric_underlying_is_standard|5.027009||Viu PL_ofsgv|5.011000||Vi PL_oldname|5.005000||Viu PL_op|5.005000||Viu PL_op_exec_cnt|5.019002||Viu PL_opfreehook|5.011000|5.011000| PL_op_mask|5.005000||Viu PL_origalen|5.005000||Viu PL_origargc|5.005000||Viu PL_origargv|5.005000||Viu PL_origenviron|5.005000||Viu PL_origfilename|5.005000||Viu PL_ors_sv|5.007001||Viu PL_osname|5.005000||Viu PL_padix|5.005000||Viu PL_padix_floor|5.005000||Viu PL_padlist_generation|5.021007||Viu PL_padname_const|5.021007||Viu PL_padname_undef|5.021007||Viu PL_pad_reset_pending|5.005000||Viu PL_parser|5.009005|5.003007|p PL_patchlevel|5.005000||Viu PL_peepp|5.007003|5.007003| PL_perldb|5.005000|5.003007|poVnu PL_perl_destruct_level|5.004005|5.003007|p PL_perlio|5.007003||Viu PL_phase|5.013007|5.013007| PL_pidstatus|5.005000||Viu PL_Posix_ptrs|5.029000||Viu PL_ppaddr||5.003007|ponu PL_preambleav|5.005000||Viu PL_prevailing_version|5.035009||Viu PL_Private_Use|5.029009||Viu PL_Proc|5.006000||Viu PL_profiledata|5.005000||Viu PL_psig_name|5.006000||Viu PL_psig_pend|5.007001||Viu PL_psig_ptr|5.006000||Viu PL_ptr_table|5.006000||Viu PL_random_state|5.019004||Viu PL_RANDOM_STATE_TYPE|5.019004||Viu PL_reentrant_buffer|5.007002||Viu PL_reentrant_retint|5.008001||Viu PL_reg_curpm|5.006000||Viu PL_regex_pad|5.007002||Viu PL_regex_padav|5.007002||Viu PL_registered_mros|5.010001||Viu PL_regmatch_slab|5.009004||Viu PL_regmatch_state|5.009004||Viu PL_replgv|5.005000||Viu PL_restartjmpenv|5.013001||Viu PL_restartop|5.005000|5.005000| PL_rpeepp|5.013005|5.013005| PL_rs|5.005000||Vi PL_rsfp||5.003007|ponu PL_rsfp_filters||5.003007|ponu PL_runops|5.006000|5.006000| PL_savebegin|5.007003||Viu PL_savestack|5.005000||Viu PL_savestack_ix|5.005000||Viu PL_savestack_max|5.005000||Viu PL_sawampersand|5.005000||Viu PL_SB_invlist|5.021009||Viu PL_scopestack|5.005000||Viu PL_scopestack_ix|5.005000||Viu PL_scopestack_max|5.005000||Viu PL_scopestack_name|5.011002||Viu PL_SCX_invlist|5.027008||Viu PL_secondgv|5.005000||Viu PL_setlocale_buf|5.027009||Viu PL_setlocale_bufsize|5.027009||Viu PL_sharehook|5.007003||Viu PL_sighandler1p|5.031007||Viu PL_sighandler3p|5.031007||Viu PL_sighandlerp|5.005000||Viu PL_signalhook|5.013002||Viu PL_signals|5.008001|5.003007|poVnu PL_sig_pending|5.007001||Viu PL_Sock|5.006000||Viu PL_sortcop|5.005000||Viu PL_sortstash|5.005000||Viu PL_splitstr|5.005000||Viu PL_srand_called|5.006000||Viu PL_stack_base|5.005000|5.003007|poVnu PL_stack_max|5.005000||Viu PL_stack_sp|5.005000|5.003007|poVnu PL_start_env|5.005000||Viu PL_stashcache|5.008001||Viu PL_stashpad|5.017001||Viu PL_stashpadix|5.017001||Viu PL_stashpadmax|5.017001||Viu PL_statcache|5.005000|5.003007|poVnu PL_statgv|5.005000||Viu PL_statname|5.005000||Viu PL_statusvalue|5.005000||Viu PL_statusvalue_posix|5.009003||Viu PL_statusvalue_vms|5.005000||Viu PL_stderrgv|5.006000||Viu PL_stdingv|5.005000|5.003007|poVnu PL_StdIO|5.006000||Viu PL_strtab|5.005000||Viu PL_strxfrm_is_behaved|5.025002||Viu PL_strxfrm_max_cp|5.025002||Viu PL_strxfrm_NUL_replacement|5.025008||Viu PL_sub_generation|5.005000||Viu PL_subline|5.005000||Viu PL_subname|5.005000||Viu PL_Sv|5.005000||pcV PL_sv_arenaroot|5.005000|5.003007|poVnu PL_sv_consts|5.019002||Viu PL_sv_count|5.005000||Viu PL_sv_immortals|5.027003||Viu PL_sv_no|5.004005|5.003007|p PL_sv_root|5.005000||Viu PL_sv_serial|5.010001||Viu PL_sv_undef|5.004005|5.003007|p PL_sv_yes|5.004005|5.003007|p PL_sv_zero|5.027003|5.027003| PL_sys_intern|5.005000||Viu PL_tainted|5.005000|5.003007|poVnu PL_tainting|5.005000|5.003007|poVnu PL_taint_warn|5.007003||Viu PL_threadhook|5.008000||Viu PL_tmps_floor|5.005000||Viu PL_tmps_ix|5.005000||Viu PL_tmps_max|5.005000||Viu PL_tmps_stack|5.005000||Viu PL_tokenbuf||5.003007|ponu PL_top_env|5.005000||Viu PL_toptarget|5.005000||Viu PL_TR_SPECIAL_HANDLING_UTF8|5.031006||Viu PL_underlying_numeric_obj|5.027009||Viu PL_unicode|5.008001||Viu PL_unitcheckav|5.009005||Viu PL_unitcheckav_save|5.009005||Viu PL_unlockhook|5.007003||Viu PL_unsafe|5.005000||Viu PL_UpperLatin1|5.019005||Viu PLUS|5.003007||Viu PLUS_t8|5.035004||Viu PLUS_t8_p8|5.033003||Viu PLUS_t8_pb|5.033003||Viu PLUS_tb|5.035004||Viu PLUS_tb_p8|5.033003||Viu PLUS_tb_pb|5.033003||Viu PL_utf8cache|5.009004||Viu PL_utf8_charname_begin|5.017006||Viu PL_utf8_charname_continue|5.017006||Viu PL_utf8_foldclosures|5.013007||Viu PL_utf8_idcont|5.008000||Viu PL_utf8_idstart|5.008000||Viu PL_utf8locale|5.008001||Viu PL_utf8_mark|5.006000||Viu PL_utf8_perl_idcont|5.017008||Viu PL_utf8_perl_idstart|5.015004||Viu PL_utf8_tofold|5.007003||Viu PL_utf8_tolower|5.006000||Viu PL_utf8_tosimplefold|5.027011||Viu PL_utf8_totitle|5.006000||Viu PL_utf8_toupper|5.006000||Viu PL_utf8_xidcont|5.013010||Viu PL_utf8_xidstart|5.013010||Viu PL_vtbl_arylen|5.015000||Viu PL_vtbl_arylen_p|5.015000||Viu PL_vtbl_backref|5.015000||Viu PL_vtbl_bm|5.015000||Viu PL_vtbl_checkcall|5.017000||Viu PL_vtbl_collxfrm|5.015000||Viu PL_vtbl_dbline|5.015000||Viu PL_vtbl_debugvar|5.021005||Viu PL_vtbl_defelem|5.015000||Viu PL_vtbl_env|5.015000||Viu PL_vtbl_envelem|5.015000||Viu PL_vtbl_fm|5.015000||Viu PL_vtbl_hints|5.015000||Viu PL_vtbl_hintselem|5.015000||Viu PL_vtbl_isa|5.015000||Viu PL_vtbl_isaelem|5.015000||Viu PL_vtbl_lvref|5.021005||Viu PL_vtbl_mglob|5.015000||Viu PL_vtbl_nkeys|5.015000||Viu PL_vtbl_nonelem|5.027009||Viu PL_vtbl_ovrld|5.015000||Viu PL_vtbl_pack|5.015000||Viu PL_vtbl_packelem|5.015000||Viu PL_vtbl_pos|5.015000||Viu PL_vtbl_regdata|5.015000||Viu PL_vtbl_regdatum|5.015000||Viu PL_vtbl_regexp|5.015000||Viu PL_vtbl_sig|5.035001||Viu PL_vtbl_sigelem|5.015000||Viu PL_vtbl_substr|5.015000||Viu PL_vtbl_sv|5.015000||Viu PL_vtbl_taint|5.015000||Viu PL_vtbl_utf8|5.015000||Viu PL_vtbl_uvar|5.015000||Viu PL_vtbl_vec|5.015000||Viu PL_warnhook|5.005000||Viu PL_warn_locale|5.021008||Viu PL_watchaddr|5.006000||Viu PL_watchok|5.006000||Viu PL_WB_invlist|5.021009||Viu PL_wcrtomb_ps|5.031010||Viu PL_XPosix_ptrs|5.017008||Viu PL_Xpv|5.005000|5.003007|poVnu PL_xsubfilename|5.021006||Viu pm_description|5.009004||Viu PMf_BASE_SHIFT|5.013004||Viu PMf_CHARSET|5.017011||Viu PMf_CODELIST_PRIVATE|5.017001||Viu PMf_CONST|5.003007||Viu PMf_CONTINUE|5.004000||Viu PMf_EVAL|5.003007||Viu PMf_EXTENDED|5.003007||Viu PMf_EXTENDED_MORE|5.021005||Viu PMf_FOLD|5.003007||Viu PMf_GLOBAL|5.003007||Viu PMf_HAS_CV|5.017001||Viu PMf_HAS_ERROR|5.025010||Viu PMf_IS_QR|5.017001||Viu PMf_KEEP|5.003007||Viu PMf_KEEPCOPY|5.009005||Viu PMf_MULTILINE|5.003007||Viu PMf_NOCAPTURE|5.021008||Viu PMf_NONDESTRUCT|5.013002||Viu PMf_ONCE|5.003007||Viu PMf_RETAINT|5.004005||Viu PMf_SINGLELINE|5.003007||Viu PMf_SPLIT|5.017011||Viu PMf_STRICT|5.021008||Viu PMf_USED|5.009005||Viu PMf_USE_RE_EVAL|5.017001||Viu PMf_WILDCARD|5.031010||Viu PM_GETRE|5.007002||Viu pmop_dump|5.006000|5.006000|u PmopSTASH|5.007001||Viu PmopSTASHPV|5.007001||Viu PmopSTASHPV_set|5.007001||Viu PmopSTASH_set|5.007001||Viu pmruntime|5.003007||Viu PM_SETRE|5.007002||Viu PM_STR|5.027010||Viu pmtrans|5.003007||Viu pMY_CXT|5.009000|5.009000|p _pMY_CXT||5.009000|p pMY_CXT_||5.009000|p PNf|5.021007||Viu PNfARG|5.021007||Viu Poison|5.008000|5.003007|p PoisonFree|5.009004|5.003007|p PoisonNew|5.009004|5.003007|p PoisonPADLIST|5.021006||Viu POISON_SV_HEAD|||Viu PoisonWith|5.009004|5.003007|p popen|5.003007||Viu POPi|5.003007|5.003007| POPl|5.003007|5.003007| POPMARK|5.003007||cViu POP_MULTICALL|5.009003|5.009003| POPn|5.006000|5.003007| POPp|5.003007|5.003007| POPpbytex|5.007001|5.007001| POPpconstx|5.009003||Viu POPpx|5.005003|5.005003| POPs|5.003007|5.003007| pop_scope|5.003007|5.003007|u POPSTACK|5.005000||Viu POPSTACK_TO|5.005000||Viu POPu|5.004000|5.004000| POPul|5.006000|5.006000| populate_ANYOF_from_invlist|5.019005||Viu populate_isa|||viu POSIXA|5.017003||Viu POSIXA_t8|5.035004||Viu POSIXA_t8_p8|5.033003||Viu POSIXA_t8_pb|5.033003||Viu POSIXA_tb|5.035004||Viu POSIXA_tb_p8|5.033003||Viu POSIXA_tb_pb|5.033003||Viu POSIX_CC_COUNT|5.017008||Viu POSIXD|5.017003||Viu POSIXD_t8|5.035004||Viu POSIXD_t8_p8|5.033003||Viu POSIXD_t8_pb|5.033003||Viu POSIXD_tb|5.035004||Viu POSIXD_tb_p8|5.033003||Viu POSIXD_tb_pb|5.033003||Viu POSIXL|5.017003||Viu POSIXL_CLEAR|5.029004||Viu POSIXL_SET|5.029004||Viu POSIXL_t8|5.035004||Viu POSIXL_t8_p8|5.033003||Viu POSIXL_t8_pb|5.033003||Viu POSIXL_tb|5.035004||Viu POSIXL_tb_p8|5.033003||Viu POSIXL_tb_pb|5.033003||Viu POSIXL_TEST|5.029004||Viu POSIXL_ZERO|5.029004||Viu POSIXU|5.017003||Viu POSIXU_t8|5.035004||Viu POSIXU_t8_p8|5.033003||Viu POSIXU_t8_pb|5.033003||Viu POSIXU_tb|5.035004||Viu POSIXU_tb_p8|5.033003||Viu POSIXU_tb_pb|5.033003||Viu PP|5.003007||Viu pregcomp|5.009005|5.009005| pregexec|5.003007|5.003007| PREGf_ANCH|5.019009||Viu PREGf_ANCH_GPOS|5.019009||Viu PREGf_ANCH_MBOL|5.019009||Viu PREGf_ANCH_SBOL|5.019009||Viu PREGf_CUTGROUP_SEEN|5.009005||Viu PREGf_GPOS_FLOAT|5.019009||Viu PREGf_GPOS_SEEN|5.019009||Viu PREGf_IMPLICIT|5.009005||Viu PREGf_NAUGHTY|5.009005||Viu PREGf_NOSCAN|5.019009||Viu PREGf_RECURSE_SEEN|5.023009||Viu pregfree2|5.011000||cVu pregfree|5.003007|5.003007|u PREGf_SKIP|5.009005||Viu PREGf_USE_RE_EVAL|5.017001||Viu PREGf_VERBARG_SEEN|5.009005||Viu prepare_SV_for_RV|5.010001||Viu prescan_version|5.011004|5.011004| PRESCAN_VERSION|5.019008||Viu PREV_RANGE_MATCHES_INVLIST|5.023002||Viu printbuf|5.009004||Viu print_bytes_for_locale|5.027002||Viu print_collxfrm_input_and_return|5.025004||Viu printf|5.003007||Viu PRINTF_FORMAT_NULL_OK|5.009005|5.009005|Vn printf_nocontext|5.007001||vdVnu PRIVLIB|5.003007|5.003007|Vn PRIVLIB_EXP|5.003007|5.003007|Vn PRIVSHIFT|5.003007||Viu process_special_blocks|5.009005||Viu PROCSELFEXE_PATH|5.007003|5.007003|Vn PRUNE|5.009005||Viu PRUNE_t8|5.035004||Viu PRUNE_t8_p8|5.033003||Viu PRUNE_t8_pb|5.033003||Viu PRUNE_tb|5.035004||Viu PRUNE_tb_p8|5.033003||Viu PRUNE_tb_pb|5.033003||Viu PSEUDO|5.009004||Viu PSEUDO_t8|5.035004||Viu PSEUDO_t8_p8|5.033003||Viu PSEUDO_t8_pb|5.033003||Viu PSEUDO_tb|5.035004||Viu PSEUDO_tb_p8|5.033003||Viu PSEUDO_tb_pb|5.033003||Viu pthread_addr_t|5.005000||Viu PTHREAD_ATFORK|5.007002||Viu pthread_attr_init|5.006000||Viu PTHREAD_ATTR_SETDETACHSTATE|5.006000||Viu pthread_condattr_default|5.005000||Viu PTHREAD_CREATE|5.006000||Viu pthread_create|5.008001||Viu PTHREAD_CREATE_JOINABLE|5.005000||Viu PTHREAD_GETSPECIFIC|5.007002||Viu PTHREAD_GETSPECIFIC_INT|5.006000||Viu pthread_key_create|5.005000||Viu pthread_keycreate|5.008001||Viu pthread_mutexattr_default|5.005000||Viu pthread_mutexattr_init|5.005000||Viu pthread_mutexattr_settype|5.005000||Viu pTHX_12|5.019010||Viu pTHX_1|5.006000||Viu pTHX_2|5.006000||Viu pTHX_3|5.006000||Viu pTHX_4|5.006000||Viu pTHX|5.006000|5.003007|p pTHX_5|5.009003||Viu pTHX_6|5.009003||Viu pTHX_7|5.009003||Viu pTHX_8|5.009003||Viu pTHX_9|5.009003||Viu pTHX_||5.003007|p pTHX__FORMAT|5.009002||Viu pTHX_FORMAT|5.009002||Viu pTHXo|5.006000||Viu pTHX__VALUE|5.009002||Viu pTHX_VALUE|5.009002||Viu pTHXx|5.006000||Viu PTR2IV|5.006000|5.003007|p PTR2nat|5.009003|5.003007|p PTR2NV|5.006000|5.003007|p PTR2ul|5.007001|5.003007|p PTR2UV|5.006000|5.003007|p Ptrdiff_t|5.029003||Viu ptr_hash|5.017010||Vniu PTRSIZE|5.005000|5.005000|Vn ptr_table_fetch|5.009005|5.009005|u ptr_table_find|5.009004||Vniu ptr_table_free|5.009005|5.009005|u ptr_table_new|5.009005|5.009005|u ptr_table_split|5.009005|5.009005|u ptr_table_store|5.009005|5.009005|u PTRV|5.006000|5.003007|poVnu PUSHi|5.003007|5.003007| PUSHMARK|5.003007|5.003007| PUSHmortal|5.009002|5.003007|p PUSH_MULTICALL|5.011000|5.011000| PUSH_MULTICALL_FLAGS|5.018000||Viu PUSHn|5.006000|5.003007| PUSHp|5.003007|5.003007| PUSHs|5.003007|5.003007| push_scope|5.003007|5.003007|u PUSHSTACK|5.005000||Viu PUSHSTACKi|5.005000||Viu PUSHSTACK_INIT_HWM|5.027002||Viu PUSHTARG|5.003007||Viu PUSHu|5.004000|5.003007|p PUTBACK|5.003007|5.003007| putc|5.003007||Viu put_charclass_bitmap_innards|5.021004||Viu put_charclass_bitmap_innards_common|5.023008||Viu put_charclass_bitmap_innards_invlist|5.023008||Viu put_code_point|5.021004||Viu putc_unlocked|5.003007||Viu putenv|5.005000||Viu put_range|5.019009||Viu putw|5.003007||Viu pv_display|5.006000|5.003007|p pv_escape|5.009004|5.003007|p pv_pretty|5.009004|5.003007|p pv_uni_display|5.007003|5.007003| pWARN_ALL|5.006000||Viu pWARN_NONE|5.006000||Viu pWARN_STD|5.006000||Viu PWGECOS|5.004005|5.004005|Vn PWPASSWD|5.005000|5.005000|Vn qerror|5.006000||cViu QR_PAT_MODS|5.009005||Viu QUAD_IS_INT|5.006000|5.006000|Vn QUAD_IS___INT64|5.015003|5.015003|Vn QUAD_IS_INT64_T|5.006000|5.006000|Vn QUAD_IS_LONG|5.006000|5.006000|Vn QUAD_IS_LONG_LONG|5.006000|5.006000|Vn QUADKIND|5.006000|5.006000|Vn quadmath_format_needed|5.021004||Vni quadmath_format_valid|5.031007||Vni Quad_t|5.003007|5.003007|Vn QUESTION_MARK_CTRL|5.021001||Viu RADIXCHAR|5.027010||Viu RANDBITS|5.003007|5.003007|Vn RANDOM_R_PROTO|5.008000|5.008000|Vn Rand_seed_t|5.006000|5.006000|Vn RANGE_INDICATOR|5.031006||Viu rck_elide_nothing|5.032001||Viu RD_NODATA|5.003007|5.003007|Vn read|5.005000||Viu readdir|5.005000||Viu readdir64|5.009000||Viu READDIR64_R_PROTO|5.008000|5.008000|Vn READDIR_R_PROTO|5.008000|5.008000|Vn READ_XDIGIT|5.017006|5.017006| realloc|5.003007||Vn ReANY|5.017006||cVnu re_compile|5.009005|5.009005|u RE_COMPILE_RECURSION_INIT|5.029009||Viu RE_COMPILE_RECURSION_LIMIT|5.029009||Viu re_croak|||iu recv|5.006000||Viu recvfrom|5.005000||Viu RE_DEBUG_COMPILE_DUMP|5.009004||Viu RE_DEBUG_COMPILE_FLAGS|5.009005||Viu RE_DEBUG_COMPILE_MASK|5.009004||Viu RE_DEBUG_COMPILE_OPTIMISE|5.009004||Viu RE_DEBUG_COMPILE_PARSE|5.009004||Viu RE_DEBUG_COMPILE_TEST|5.021005||Viu RE_DEBUG_COMPILE_TRIE|5.009004||Viu RE_DEBUG_EXECUTE_INTUIT|5.009004||Viu RE_DEBUG_EXECUTE_MASK|5.009004||Viu RE_DEBUG_EXECUTE_MATCH|5.009004||Viu RE_DEBUG_EXECUTE_TRIE|5.009004||Viu RE_DEBUG_EXTRA_BUFFERS|5.009005||Viu RE_DEBUG_EXTRA_DUMP_PRE_OPTIMIZE|5.031004||Viu RE_DEBUG_EXTRA_GPOS|5.011000||Viu RE_DEBUG_EXTRA_MASK|5.009004||Viu RE_DEBUG_EXTRA_OPTIMISE|5.009005||Viu RE_DEBUG_EXTRA_STACK|5.009005||Viu RE_DEBUG_EXTRA_STATE|5.009004||Viu RE_DEBUG_EXTRA_TRIE|5.009004||Viu RE_DEBUG_EXTRA_WILDCARD|5.031011||Viu RE_DEBUG_FLAG|5.009004||Viu RE_DEBUG_FLAGS|5.009002||Viu re_dup_guts|5.011000|5.011000| reentrant_free|5.008000||cVu reentrant_init|5.008000||cVu REENTRANT_PROTO_B_B|5.008000||Viu REENTRANT_PROTO_B_BI|5.008000||Viu REENTRANT_PROTO_B_BW|5.008000||Viu REENTRANT_PROTO_B_CCD|5.008000||Viu REENTRANT_PROTO_B_CCS|5.008000||Viu REENTRANT_PROTO_B_IBI|5.008000||Viu REENTRANT_PROTO_B_IBW|5.008000||Viu REENTRANT_PROTO_B_SB|5.008000||Viu REENTRANT_PROTO_B_SBI|5.008000||Viu REENTRANT_PROTO_I_BI|5.008000||Viu REENTRANT_PROTO_I_BW|5.008000||Viu REENTRANT_PROTO_I_CCSBWR|5.008000||Viu REENTRANT_PROTO_I_CCSD|5.008000||Viu REENTRANT_PROTO_I_CII|5.008000||Viu REENTRANT_PROTO_I_CIISD|5.008000||Viu REENTRANT_PROTO_I_CSBI|5.008000||Viu REENTRANT_PROTO_I_CSBIR|5.008000||Viu REENTRANT_PROTO_I_CSBWR|5.008000||Viu REENTRANT_PROTO_I_CSBWRE|5.008000||Viu REENTRANT_PROTO_I_CSD|5.008000||Viu REENTRANT_PROTO_I_CWISBWRE|5.008000||Viu REENTRANT_PROTO_I_CWISD|5.008000||Viu REENTRANT_PROTO_I_D|5.008000||Viu REENTRANT_PROTO_I_H|5.008000||Viu REENTRANT_PROTO_I_IBI|5.008000||Viu REENTRANT_PROTO_I_IBW|5.008000||Viu REENTRANT_PROTO_I_ICBI|5.008000||Viu REENTRANT_PROTO_I_ICSBWR|5.008000||Viu REENTRANT_PROTO_I_ICSD|5.008000||Viu REENTRANT_PROTO_I_ID|5.008000||Viu REENTRANT_PROTO_I_IISD|5.008000||Viu REENTRANT_PROTO_I_ISBWR|5.008000||Viu REENTRANT_PROTO_I_ISD|5.008000||Viu REENTRANT_PROTO_I_LISBI|5.008000||Viu REENTRANT_PROTO_I_LISD|5.008000||Viu REENTRANT_PROTO_I_SB|5.008000||Viu REENTRANT_PROTO_I_SBI|5.008000||Viu REENTRANT_PROTO_I_SBIE|5.008000||Viu REENTRANT_PROTO_I_SBIH|5.008000||Viu REENTRANT_PROTO_I_SBIR|5.008000||Viu REENTRANT_PROTO_I_SBWR|5.008000||Viu REENTRANT_PROTO_I_SBWRE|5.008000||Viu REENTRANT_PROTO_I_SD|5.008000||Viu REENTRANT_PROTO_I_TISD|5.008000||Viu REENTRANT_PROTO_I_TS|5.008000||Viu REENTRANT_PROTO_I_TSBI|5.008000||Viu REENTRANT_PROTO_I_TSBIR|5.008000||Viu REENTRANT_PROTO_I_TSBWR|5.008000||Viu REENTRANT_PROTO_I_TsISBWRE|5.008001||Viu REENTRANT_PROTO_I_TSR|5.008000||Viu REENTRANT_PROTO_I_UISBWRE|5.008000||Viu REENTRANT_PROTO_I_uISBWRE|5.008001||Viu REENTRANT_PROTO_S_CBI|5.008000||Viu REENTRANT_PROTO_S_CCSBI|5.008000||Viu REENTRANT_PROTO_S_CIISBIE|5.008000||Viu REENTRANT_PROTO_S_CSBI|5.008000||Viu REENTRANT_PROTO_S_CSBIE|5.008000||Viu REENTRANT_PROTO_S_CWISBIE|5.008000||Viu REENTRANT_PROTO_S_CWISBWIE|5.008000||Viu REENTRANT_PROTO_S_ICSBI|5.008000||Viu REENTRANT_PROTO_S_ISBI|5.008000||Viu REENTRANT_PROTO_S_LISBI|5.008000||Viu REENTRANT_PROTO_S_SBI|5.008000||Viu REENTRANT_PROTO_S_SBIE|5.008000||Viu REENTRANT_PROTO_S_SBW|5.008000||Viu REENTRANT_PROTO_S_TISBI|5.008000||Viu REENTRANT_PROTO_S_TS|5.031011||Viu REENTRANT_PROTO_S_TSBI|5.008000||Viu REENTRANT_PROTO_S_TSBIE|5.008000||Viu REENTRANT_PROTO_S_TWISBIE|5.008000||Viu REENTRANT_PROTO_V_D|5.008000||Viu REENTRANT_PROTO_V_H|5.008000||Viu REENTRANT_PROTO_V_ID|5.008000||Viu reentrant_retry|5.008000||vcVnu reentrant_size|5.008000||cVu REENTR_MEMZERO|5.009003||Viu re_exec_indentf|5.023009||vViu REF|5.003007||Viu ref|5.009003||Viu ref_array_or_hash|5.027008||Viu refcounted_he_chain_2hv|5.013007||cVi REFCOUNTED_HE_EXISTS|5.015007||Viu refcounted_he_fetch_pv|5.013007||cVi refcounted_he_fetch_pvn|5.013007||cVi refcounted_he_fetch_pvs|5.013007||Vi refcounted_he_fetch_sv|5.013007||cVi refcounted_he_free|5.013007||cVi refcounted_he_inc|5.013007||cVi REFCOUNTED_HE_KEY_UTF8|5.013007||Viu refcounted_he_new_pv|5.013007||cVi refcounted_he_new_pvn|5.013007||cVi refcounted_he_new_pvs|5.013007||Vi refcounted_he_new_sv|5.013007||cVi refcounted_he_value|5.009004||Viu REFF|5.004001||Viu REFFA|5.013010||Viu REFFAN|5.031001||Viu REFFAN_t8|5.035004||Viu REFFAN_t8_p8|5.033003||Viu REFFAN_t8_pb|5.033003||Viu REFFAN_tb|5.035004||Viu REFFAN_tb_p8|5.033003||Viu REFFAN_tb_pb|5.033003||Viu REFFA_t8|5.035004||Viu REFFA_t8_p8|5.033003||Viu REFFA_t8_pb|5.033003||Viu REFFA_tb|5.035004||Viu REFFA_tb_p8|5.033003||Viu REFFA_tb_pb|5.033003||Viu REFFL|5.004001||Viu REFFLN|5.031001||Viu REFFLN_t8|5.035004||Viu REFFLN_t8_p8|5.033003||Viu REFFLN_t8_pb|5.033003||Viu REFFLN_tb|5.035004||Viu REFFLN_tb_p8|5.033003||Viu REFFLN_tb_pb|5.033003||Viu REFFL_t8|5.035004||Viu REFFL_t8_p8|5.033003||Viu REFFL_t8_pb|5.033003||Viu REFFL_tb|5.035004||Viu REFFL_tb_p8|5.033003||Viu REFFL_tb_pb|5.033003||Viu REFFN|5.031001||Viu REFFN_t8|5.035004||Viu REFFN_t8_p8|5.033003||Viu REFFN_t8_pb|5.033003||Viu REFFN_tb|5.035004||Viu REFFN_tb_p8|5.033003||Viu REFFN_tb_pb|5.033003||Viu REFF_t8|5.035004||Viu REFF_t8_p8|5.033003||Viu REFF_t8_pb|5.033003||Viu REFF_tb|5.035004||Viu REFF_tb_p8|5.033003||Viu REFF_tb_pb|5.033003||Viu REFFU|5.013008||Viu REFFUN|5.031001||Viu REFFUN_t8|5.035004||Viu REFFUN_t8_p8|5.033003||Viu REFFUN_t8_pb|5.033003||Viu REFFUN_tb|5.035004||Viu REFFUN_tb_p8|5.033003||Viu REFFUN_tb_pb|5.033003||Viu REFFU_t8|5.035004||Viu REFFU_t8_p8|5.033003||Viu REFFU_t8_pb|5.033003||Viu REFFU_tb|5.035004||Viu REFFU_tb_p8|5.033003||Viu REFFU_tb_pb|5.033003||Viu REF_HE_KEY|5.009005||Viu refkids|5.003007||Viu REFN|5.031001||Viu REFN_t8|5.035004||Viu REFN_t8_p8|5.033003||Viu REFN_t8_pb|5.033003||Viu REFN_tb|5.035004||Viu REFN_tb_p8|5.033003||Viu REFN_tb_pb|5.033003||Viu REF_t8|5.035004||Viu REF_t8_p8|5.033003||Viu REF_t8_pb|5.033003||Viu REF_tb|5.035004||Viu REF_tb_p8|5.033003||Viu REF_tb_pb|5.033003||Viu refto|5.005000||Viu reg2Lanode|5.021005||Viu reg|5.005000||Viu reganode|5.005000||Viu REG_ANY|5.006000||Viu REG_ANY_t8|5.035004||Viu REG_ANY_t8_p8|5.033003||Viu REG_ANY_t8_pb|5.033003||Viu REG_ANY_tb|5.035004||Viu REG_ANY_tb_p8|5.033003||Viu REG_ANY_tb_pb|5.033003||Viu regatom|5.005000||Viu regbranch|5.005000||Viu reg_check_named_buff_matched|5.009005||Vniu regclass|5.005000||Viu regcppop|5.005000||Viu regcppush|5.005000||Viu regcp_restore|5.025006||Viu regcurly|5.013010||cVniu REG_CUTGROUP_SEEN|5.019009||Viu regdump|5.005000|5.005000|u regdump_extflags|5.009005||Viu regdump_intflags|5.019002||Viu regdupe_internal|5.009005||cVu regexec_flags|5.005000||cVu REGEX_SET|5.031010||Viu regex_set_precedence|5.021010||Vniu REGEX_SET_t8|5.035004||Viu REGEX_SET_t8_p8|5.033003||Viu REGEX_SET_t8_pb|5.033003||Viu REGEX_SET_tb|5.035004||Viu REGEX_SET_tb_p8|5.033003||Viu REGEX_SET_tb_pb|5.033003||Viu REG_EXTFLAGS_NAME_SIZE|5.020000||Viu regfree_internal|5.009005||cVu REG_GPOS_SEEN|5.019009||Viu reghop3|5.007001||Vniu reghop4|5.009005||Vniu reghopmaybe3|5.007001||Vniu reginclass|5.005000||Viu REG_INFTY|5.004005||Viu reginitcolors|5.006000||cVu reginsert|5.005000||Viu REG_INTFLAGS_NAME_SIZE|5.020000||Viu register|5.003007||Viu reg_la_NOTHING|||Viu reg_la_OPFAIL|||Viu REG_LB_SEEN|||Viu REG_LOOKBEHIND_SEEN|5.019009||Viu REG_MAGIC|5.006000||Viu regmatch|5.005000||Viu REGMATCH_STATE_MAX|5.009005||Viu reg_named_buff|5.009005||cViu reg_named_buff_all|5.009005||cVu reg_named_buff_exists|5.009005||cVu reg_named_buff_fetch|5.009005||cVu reg_named_buff_firstkey|5.009005||cVu reg_named_buff_iter|5.009005||cViu reg_named_buff_nextkey|5.009005||cVu reg_named_buff_scalar|5.009005||cVu regnext|5.003007||cVu reg_node|5.005000||Viu REGNODE_AFTER|5.003007||Viu REGNODE_BEFORE|5.003007||Viu regnode_guts|5.021005||Viu regnode_guts_debug|||Viu REGNODE_MAX|5.009004||Viu REGNODE_SIMPLE|5.013002||Viu REGNODE_VARIES|5.013002||Viu reg_numbered_buff_fetch|5.009005||cViu reg_numbered_buff_length|5.009005||cViu reg_numbered_buff_store|5.009005||cViu regpiece|5.005000||Viu regpnode|5.031010||Viu regprop|5.003007||Viu reg_qr_package|5.009005||cViu REG_RECURSE_SEEN|5.019009||Viu regrepeat|5.005000||Viu REG_RUN_ON_COMMENT_SEEN|5.019009||Viu reg_scan_name|5.009005||Viu reg_skipcomment|5.009005||Vniu regtail|5.005000||Viu regtail_study|5.009004||Viu reg_temp_copy|5.009005||cViu REG_TOP_LEVEL_BRANCHES_SEEN|5.019009||Viu regtry|5.005000||Viu REG_UNBOUNDED_QUANTIFIER_SEEN|5.019009||Viu REG_UNFOLDED_MULTI_SEEN|5.019009||Viu REG_VERBARG_SEEN|5.019009||Viu REG_ZERO_LEN_SEEN|5.019009||Viu re_indentf|5.023009||vViu re_intuit_start|5.006000||cVu re_intuit_string|5.006000||cVu rename|5.005000||Viu Renew|5.003007|5.003007| Renewc|5.003007|5.003007| RENUM|5.005000||Viu RENUM_t8|5.035004||Viu RENUM_t8_p8|5.033003||Viu RENUM_t8_pb|5.033003||Viu RENUM_tb|5.035004||Viu RENUM_tb_p8|5.033003||Viu RENUM_tb_pb|5.033003||Viu re_op_compile|5.017001||Viu repeatcpy|5.003007|5.003007|nu REPLACEMENT_CHARACTER_UTF8|5.025005|5.003007|p report_evil_fh|5.006001||Viu report_redefined_cv|5.015006||Viu report_uninit|5.006000||cVi report_wrongway_fh|5.013009||Viu re_printf|5.023009||vViu RE_PV_COLOR_DECL|5.009004||Viu RE_PV_QUOTED_DECL|5.009004||Viu require_pv|5.006000|5.006000| require_tie_mod|5.009005||Viu ReREFCNT_dec|5.005000||Viu ReREFCNT_inc|5.005000||Viu RESTORE_ERRNO|5.010001||Vi RESTORE_LC_NUMERIC|5.021010|5.021010|p restore_magic|5.009003||Viu restore_switched_locale|5.027009||Viu RE_SV_DUMPLEN|5.009004||Viu RE_SV_ESCAPE|5.009004||Viu RE_SV_TAIL|5.009004||Viu RETPUSHNO|5.003007||Viu RETPUSHUNDEF|5.003007||Viu RETPUSHYES|5.003007||Viu RE_TRIE_MAXBUF_INIT|5.009002||Viu RE_TRIE_MAXBUF_NAME|5.009002||Viu RETSETNO|5.003007||Viu RETSETTARG|5.021009||Viu RETSETUNDEF|5.003007||Viu RETSETYES|5.003007||Viu RETURN|5.003007||Viu RETURNOP|5.003007||Viu RETURNX|5.003007||Viu RETVAL|5.003007|5.003007|V rewind|5.003007||Viu rewinddir|5.005000||Viu REXEC_CHECKED|5.005000||Viu REXEC_COPY_SKIP_POST|5.017004||Viu REXEC_COPY_SKIP_PRE|5.017004||Viu REXEC_COPY_STR|5.005000||Viu REXEC_FAIL_ON_UNDERFLOW|5.019003||Viu REXEC_IGNOREPOS|5.006000||Viu REXEC_NOT_FIRST|5.006000||Viu REXEC_SCREAM|5.006000||Viu rmdir|5.005000||Viu RMS_DIR|5.008001||Viu RMS_FAC|5.008001||Viu RMS_FEX|5.008001||Viu RMS_FNF|5.008001||Viu RMS_IFI|5.008001||Viu RMS_ISI|5.008001||Viu RMS_PRV|5.008001||Viu rninstr|5.003007|5.003007|n ROTL32|5.017010||Viu ROTL64|5.017010||Viu ROTL_UV|5.017010||Viu ROTR32|5.027001||Viu ROTR64|5.027001||Viu ROTR_UV|5.027001||Viu rpeep|5.013005||Viu rsignal|5.004000|5.004000| rsignal_restore|5.004000||Viu rsignal_save|5.004000||Viu rsignal_state|5.004000|5.004000|u RsPARA|5.003007||Viu RsRECORD|5.005000||Viu RsSIMPLE|5.003007||Viu RsSNARF|5.003007||Viu run_body|5.006000||Viu runops_debug|5.005000||cVu RUNOPS_DEFAULT|5.005000||Viu runops_standard|5.005000||cVu run_user_filter|5.009003||Viu rv2cv_op_cv|5.013006|5.013006| RV2CVOPCV_FLAG_MASK|5.021004||Viu RV2CVOPCV_MARK_EARLY|5.013006|5.013006| RV2CVOPCV_MAYBE_NAME_GV|5.021004||Viu RV2CVOPCV_RETURN_NAME_GV|5.013006|5.013006| RV2CVOPCV_RETURN_STUB|5.021004||Viu rvpv_dup|5.008008|5.008008|u RX_ANCHORED_SUBSTR|5.010001||Viu RX_ANCHORED_UTF8|5.010001||Viu RXapif_ALL|5.009005||Viu RXapif_CLEAR|5.009005||Viu RXapif_DELETE|5.009005||Viu RXapif_EXISTS|5.009005||Viu RXapif_FETCH|5.009005||Viu RXapif_FIRSTKEY|5.009005||Viu RXapif_NEXTKEY|5.009005||Viu RXapif_ONE|5.009005||Viu RXapif_REGNAME|5.009005||Viu RXapif_REGNAMES|5.009005||Viu RXapif_REGNAMES_COUNT|5.009005||Viu RXapif_SCALAR|5.009005||Viu RXapif_STORE|5.009005||Viu RX_BUFF_IDX_CARET_FULLMATCH|5.017004||Viu RX_BUFF_IDX_CARET_POSTMATCH|5.017004||Viu RX_BUFF_IDX_CARET_PREMATCH|5.017004||Viu RX_BUFF_IDX_FULLMATCH|5.009005||Viu RX_BUFF_IDX_POSTMATCH|5.009005||Viu RX_BUFF_IDX_PREMATCH|5.009005||Viu RX_CHECK_SUBSTR|5.010001||Viu RX_COMPFLAGS|5.017011||Viu RX_ENGINE|5.010001||Viu RX_EXTFLAGS|5.010001||Viu RXf_BASE_SHIFT|5.013004||Viu RXf_CHECK_ALL|5.009005||Viu RXf_COPY_DONE|5.009005||Viu RXf_EVAL_SEEN|5.009005||Viu RXf_INTUIT_TAIL|5.009005||Viu RXf_IS_ANCHORED|5.019009||Viu RX_FLOAT_SUBSTR|5.010001||Viu RX_FLOAT_UTF8|5.010001||Viu RXf_MATCH_UTF8|5.009005||Viu RXf_NO_INPLACE_SUBST|5.017011||Viu RXf_NULL|5.010000||Viu RXf_PMf_CHARSET|5.013009||Viu RXf_PMf_COMPILETIME|5.009005||Viu RXf_PMf_EXTENDED|5.009005||Viu RXf_PMf_EXTENDED_MORE|5.021005||Viu RXf_PMf_FLAGCOPYMASK|5.017011||Viu RXf_PMf_FOLD|5.009005||Viu RXf_PMf_KEEPCOPY|5.009005||Viu RXf_PMf_MULTILINE|5.009005||Viu RXf_PMf_NOCAPTURE|5.021008||Viu RXf_PMf_SINGLELINE|5.009005||Viu RXf_PMf_SPLIT|5.017011||Viu RXf_PMf_STD_PMMOD|5.009005||Viu RXf_PMf_STD_PMMOD_SHIFT|5.010001||Viu RXf_PMf_STRICT|5.021008||Viu RXf_SKIPWHITE|5.009005||Viu RXf_SPLIT|5.009005||Viu RXf_START_ONLY|5.009005||Viu RXf_TAINTED|5.009005||Viu RXf_TAINTED_SEEN|5.009005||Viu RXf_UNBOUNDED_QUANTIFIER_SEEN|5.019009||Viu RXf_USE_INTUIT|5.009005||Viu RXf_USE_INTUIT_ML|5.009005||Viu RXf_USE_INTUIT_NOML|5.009005||Viu RXf_WHITE|5.009005||Viu RX_GOFS|5.010001||Viu RXi_GET|5.009005||Viu RXi_GET_DECL|5.009005||Viu RX_INTFLAGS|5.019009||Viu RXi_SET|5.009005||Viu RX_ISTAINTED|5.017006||Viu RX_LASTCLOSEPAREN|5.010001||Viu RX_LASTPAREN|5.010001||Viu RX_MATCH_COPIED|5.006000||Viu RX_MATCH_COPIED_off|5.006000||Viu RX_MATCH_COPIED_on|5.006000||Viu RX_MATCH_COPIED_set|5.006000||Viu RX_MATCH_COPY_FREE|5.009000||Viu RX_MATCH_TAINTED|5.005000||Viu RX_MATCH_TAINTED_off|5.005000||Viu RX_MATCH_TAINTED_on|5.005000||Viu RX_MATCH_TAINTED_set|5.005000||Viu RX_MATCH_UTF8|5.008001||Viu RX_MATCH_UTF8_off|5.008001||Viu RX_MATCH_UTF8_on|5.008001||Viu RX_MATCH_UTF8_set|5.008001||Viu RX_MINLEN|5.010001||Viu RX_MINLENRET|5.010001||Viu RX_NPARENS|5.010001||Viu RX_OFFS|5.010001||Viu RXp_COMPFLAGS|5.017011||Viu RXp_ENGINE|5.027003||Viu RXp_EXTFLAGS|5.010001||Viu RXp_GOFS|5.027003||Viu RXp_HAS_CUTGROUP|5.027003||Viu RXp_INTFLAGS|5.019009||Viu RXp_ISTAINTED|5.027003||Viu RXp_MATCH_COPIED|5.010001||Viu RXp_MATCH_COPIED_off|5.010001||Viu RXp_MATCH_COPIED_on|5.010001||Viu RXp_MATCH_COPY_FREE|5.027003||Viu RXp_MATCH_TAINTED|5.010001||Viu RXp_MATCH_TAINTED_off|5.027003||Viu RXp_MATCH_TAINTED_on|5.017008||Viu RXp_MATCH_UTF8|5.010001||Viu RXp_MATCH_UTF8_off|5.027003||Viu RXp_MATCH_UTF8_on|5.027003||Viu RXp_MATCH_UTF8_set|5.027003||Viu RXp_MINLEN|5.027003||Viu RXp_MINLENRET|5.027003||Viu RXp_NPARENS|5.027003||Viu RXp_OFFS|5.027003||Viu RXp_PAREN_NAMES|5.010001||Viu RX_PRECOMP|5.010001||Viu RX_PRECOMP_const|5.010001||Viu RX_PRELEN|5.010001||Viu RXp_SAVED_COPY|5.027003||Viu RXp_SUBBEG|5.027003||Viu RXp_SUBOFFSET|5.027003||Viu RXp_ZERO_LEN|5.027003||Viu RX_REFCNT|5.010001||Viu rxres_free|5.004000||Viu rxres_restore|5.004000||Viu rxres_save|5.004000||Viu RX_SAVED_COPY|5.011000||Viu RX_SUBBEG|5.010001||Viu RX_SUBCOFFSET|5.017004||Viu RX_SUBLEN|5.010001||Viu RX_SUBOFFSET|5.017004||Viu RX_TAINT_on|5.017006||Viu RX_UTF8|5.010001||Viu RX_WRAPLEN|5.010001||Viu RX_WRAPPED|5.010001||Viu RX_WRAPPED_const|5.011000||Viu RX_ZERO_LEN|5.019003||Viu safecalloc|5.003007||Viu Safefree|5.003007|5.003007| safefree|5.003007||Viu safemalloc|5.003007||Viu saferealloc|5.003007||Viu safesyscalloc|5.006000|5.006000|n safesysfree|5.006000|5.006000|n safesysmalloc|5.006000|5.006000|n safesysrealloc|5.006000|5.006000|n SAFE_TRIE_NODENUM|5.009002||Viu same_dirent|5.003007||Viu SANE_ERRSV|5.031003|5.031003| SANY|5.003007||Viu SANY_t8|5.035004||Viu SANY_t8_p8|5.033003||Viu SANY_t8_pb|5.033003||Viu SANY_tb|5.035004||Viu SANY_tb_p8|5.033003||Viu SANY_tb_pb|5.033003||Viu save_adelete|5.011000|5.011000|u SAVEADELETE|5.011000||Viu save_aelem|5.004005|5.004005|u save_aelem_flags|5.011000|5.011000|u save_alloc|5.006000|5.006000|u save_aptr|5.003007|5.003007| save_ary|5.003007|5.003007| SAVEBOOL|5.008001|5.008001| save_bool|5.008001||cVu save_clearsv|5.003007||cVu SAVECLEARSV|5.003007||Vi SAVECOMPILEWARNINGS|5.009004||Viu SAVECOMPPAD|5.006000||Vi SAVECOPFILE|5.006000||Viu SAVECOPFILE_FREE|5.006001||Viu SAVECOPLINE|5.006000||Viu SAVECOPSTASH_FREE|5.006001||Viu SAVE_DEFSV|5.004005|5.003007|p SAVEDELETE|5.003007|5.003007| save_delete|5.003007||cVu save_destructor|5.003007||cVu SAVEDESTRUCTOR|5.006000|5.006000| SAVEDESTRUCTOR_X|5.006000|5.006000| save_destructor_x|5.006000||cVu SAVE_ERRNO|5.010001||Vi SAVEFEATUREBITS|5.031006||Viu SAVEf_KEEPOLDELEM|5.011000||Viu SAVEFREECOPHH|5.013007||Viu SAVEFREEOP|5.010001|5.010001| save_freeop|5.010001||cVu SAVEFREEPADNAME|5.021007||Viu SAVEFREEPV|5.003007|5.003007| save_freepv|5.010001||cVu SAVEFREESV|5.003007|5.003007| save_freesv|5.010001||cVu SAVEf_SETMAGIC|5.011000||Viu SAVEGENERICPV|5.006001||Viu save_generic_pvref|5.006001|5.006001|u SAVEGENERICSV|5.005003||Viu save_generic_svref|5.005003|5.005003|u save_gp|5.004000|5.004000| save_hash|5.003007|5.003007| save_hdelete|5.011000|5.011000|u SAVEHDELETE|5.011000||Viu save_hek_flags|5.008000||Vniu save_helem|5.004005|5.004005|u save_helem_flags|5.011000|5.011000|u SAVEHINTS|5.005000||Viu save_hints|5.013005|5.013005|u save_hptr|5.003007|5.003007| SAVEI16|5.004000|5.004000| save_I16|5.004000||cVu SAVEI32|5.003007|5.003007| save_I32|5.003007||cVu SAVEI8|5.006000|5.006000| save_I8|5.006000||cVu SAVEINT|5.003007|5.003007| save_int|5.003007||cVu save_item|5.003007|5.003007| SAVEIV|5.003007|5.003007| save_iv|5.004000||cVu save_lines|5.005000||Viu save_list|5.003007|5.003007|d SAVELONG|5.003007|5.003007| save_long|5.003007||dcVu save_magic_flags|5.019002||Viu SAVE_MASK|5.013001||Viu SAVEMORTALIZESV|5.007001|5.007001| save_mortalizesv|5.010001||cVu save_nogv|5.003007|5.003007|du SAVEOP|5.005000||Viu save_op|5.010001|5.010001|u save_padsv_and_mortalize|5.010001|5.010001|u SAVEPADSVANDMORTALIZE|5.010001||Viu SAVEPADSV|||i SAVEPARSER|5.009005||Viu SAVEPPTR|5.003007|5.003007| save_pptr|5.003007||cVu save_pushi32ptr|5.013006|5.013006|u save_pushptr|5.010001|5.010001|u save_pushptri32ptr|5.010001||Viu save_pushptrptr|5.013006|5.013006|u savepv|5.003007|5.003007| savepvn|5.003007|5.003007| savepvs|5.009003|5.009003| save_re_context|5.006000||cVu save_scalar|5.003007|5.003007| save_scalar_at|5.005000||Viu save_set_svflags|5.009000|5.009000|u SAVESETSVFLAGS|5.009000||Viu savesharedpv|5.007003|5.007003| SAVESHAREDPV|5.007003||Viu savesharedpvn|5.009005|5.009005| save_shared_pvref|5.007003|5.007003|u savesharedpvs|5.013006|5.013006| savesharedsvpv|5.013006|5.013006| SAVESPTR|5.003007|5.003007| save_sptr|5.003007||cVu savestack_grow|5.003007|5.003007|u savestack_grow_cnt|5.008001|5.008001|u SAVESTACK_POS|5.004000|5.004000| save_strlen|5.019004||cViu SAVESTRLEN|5.035005|5.035005| savesvpv|5.009002|5.009002| save_svref|5.003007|5.003007| SAVESWITCHSTACK|5.009002||Viu SAVEt_ADELETE|5.011000||Viu SAVEt_AELEM|5.004005||Viu SAVEt_ALLOC|5.006000||Viu SAVEt_APTR|5.003007||Viu SAVEt_AV|5.003007||Viu SAVEt_BOOL|5.008001||Viu SAVEt_CLEARPADRANGE|5.017006||Viu SAVEt_CLEARSV|5.003007||Viu SAVEt_COMPILE_WARNINGS|5.009004||Viu SAVEt_COMPPAD|5.006000||Viu SAVEt_DELETE|5.003007||Viu SAVEt_DESTRUCTOR|5.003007||Viu SAVEt_DESTRUCTOR_X|5.006000||Viu SAVEt_FREECOPHH|5.013007||Viu SAVEt_FREEOP|5.003007||Viu SAVEt_FREEPADNAME|5.021007||Viu SAVEt_FREEPV|5.003007||Viu SAVEt_FREESV|5.003007||Viu SAVEt_GENERIC_PVREF|5.006001||Viu SAVEt_GENERIC_SVREF|5.005003||Viu SAVEt_GP|5.003007||Viu SAVEt_GVSLOT|5.017007||Viu SAVEt_GVSV|5.013005||Viu SAVEt_HELEM|5.004005||Viu SAVEt_HINTS|5.005000||Viu SAVEt_HINTS_HH|5.033001||Viu SAVEt_HPTR|5.003007||Viu SAVEt_HV|5.003007||Viu SAVEt_I16|5.004000||Viu SAVEt_I32|5.003007||Viu SAVEt_I32_SMALL|5.013001||Viu SAVEt_I8|5.006000||Viu SAVE_TIGHT_SHIFT|5.013001||Viu SAVEt_INT|5.003007||Viu SAVEt_INT_SMALL|5.013001||Viu SAVEt_ITEM|5.003007||Viu SAVEt_IV|5.003007||Viu SAVEt_LONG|5.003007||Viu SAVEt_MORTALIZESV|5.007001||Viu SAVETMPS|5.003007|5.003007| savetmps|||xu SAVEt_NSTAB|5.003007||Viu save_to_buffer|5.027004||Vniu SAVEt_OP|5.005000||Viu SAVEt_PADSV_AND_MORTALIZE|5.010001||Viu SAVEt_PARSER|5.009005||Viu SAVEt_PPTR|5.003007||Viu SAVEt_READONLY_OFF|5.019002||Viu SAVEt_REGCONTEXT|5.003007||Viu SAVEt_SAVESWITCHSTACK|5.009002||Viu SAVEt_SET_SVFLAGS|5.009000||Viu SAVEt_SHARED_PVREF|5.007003||Viu SAVEt_SPTR|5.003007||Viu SAVEt_STACK_POS|5.004000||Viu SAVEt_STRLEN|5.019004||Viu SAVEt_STRLEN_SMALL|5.033005||Viu SAVEt_SV|5.003007||Viu SAVEt_SVREF|5.003007||Viu SAVEt_TMPSFLOOR|5.023008||Viu SAVEt_VPTR|5.006000||Viu save_vptr|5.006000|5.006000|u SAVEVPTR|5.006000||Viu SAWAMPERSAND_LEFT|5.017004||Viu SAWAMPERSAND_MIDDLE|5.017004||Viu SAWAMPERSAND_RIGHT|5.017004||Viu sawparens|5.003007||Viu sb_dstr|5.003007||Viu sb_iters|5.003007||Viu sb_m|5.003007||Viu sb_maxiters|5.003007||Viu SBOL|5.003007||Viu SBOL_t8|5.035004||Viu SBOL_t8_p8|5.033003||Viu SBOL_t8_pb|5.033003||Viu SBOL_tb|5.035004||Viu SBOL_tb_p8|5.033003||Viu SBOL_tb_pb|5.033003||Viu sb_orig|5.003007||Viu SBOX32_CHURN_ROUNDS|5.027001||Viu SBOX32_MAX_LEN|5.027001||Viu SBOX32_MIX3|5.027001||Viu SBOX32_MIX4|5.027001||Viu SBOX32_SCRAMBLE32|5.027001||Viu SBOX32_SKIP_MASK|5.027001||Viu SBOX32_STATE_BITS|5.027001||Viu SBOX32_STATE_BYTES|5.027001||Viu SBOX32_STATE_WORDS|5.027001||Viu SBOX32_STATIC_INLINE|5.027001||Viu SBOX32_WARN2|5.027001||Viu SBOX32_WARN3|5.027001||Viu SBOX32_WARN4|5.027001||Viu SBOX32_WARN5|5.027001||Viu SBOX32_WARN6|5.027001||Viu sb_rflags|5.006000||Viu sb_rx|5.003007||Viu sb_rxres|5.004000||Viu sb_rxtainted|5.004000||Viu sb_s|5.003007||Viu sb_strend|5.003007||Viu sb_targ|5.003007||Viu scalar|5.003007||Viu scalarboolean|5.005000||Viu scalarkids|5.003007||Viu scalar_mod_type|5.006000||Vniu scalarvoid|5.003007||Viu scan_bin|5.006000|5.006000| scan_commit|5.005000||Viu scan_const|5.003007||Viu SCAN_DEF|5.003007||Viu scan_formline|5.003007||Viu scan_heredoc|5.003007||Viu scan_hex|5.006000|5.003007| scan_ident|5.003007||Viu scan_inputsymbol|5.003007||Viu scan_num|5.003007||cVu scan_oct|5.006000|5.003007| scan_pat|5.003007||Viu SCAN_REPL|5.003007||Viu scan_str|5.003007||xcViu scan_subst|5.003007||Viu SCAN_TR|5.003007||Viu scan_trans|5.003007||Viu scan_version|5.009001|5.009001| SCAN_VERSION|5.019008||Viu scan_vstring|5.009005|5.009005|u scan_word|5.003007||xcViu SCHED_YIELD|5.006000|5.006000|Vn SCOPE_SAVES_SIGNAL_MASK|5.007001||Viu search_const|5.010001||Viu seed|5.009003|5.009003|u seedDrand01|5.006000|5.006000| SEEK_CUR|5.003007||Viu seekdir|5.005000||Viu SEEK_END|5.003007||Viu SEEK_SET|5.003007||Viu select|5.005000||Viu Select_fd_set_t|5.003007|5.003007|Vn SELECT_MIN_BITS|5.005003|5.005003|Vn Semctl|5.004005||Viu semun|5.006000||Viu send|5.005000||Viu sendto|5.005000||Viu SEOL|5.003007||Viu SEOL_t8|5.035004||Viu SEOL_t8_p8|5.033003||Viu SEOL_t8_pb|5.033003||Viu SEOL_tb|5.035004||Viu SEOL_tb_p8|5.033003||Viu SEOL_tb_pb|5.033003||Viu sequence_num|5.009003||Viu set_ANYOF_arg|5.019005||Viu set_ANYOF_SYNTHETIC|5.019009||Viu setbuf|5.003007||Viu set_caret_X|5.019006||Viu set_context|5.006000|5.006000|nu setdefout|5.011000|5.011000| SETERRNO|5.003007||Vi setfd_cloexec|5.027008||Vniu setfd_cloexec_for_nonsysfd|5.027008||Viu setfd_cloexec_or_inhexec_by_sysfdness|5.027008||Viu setfd_inhexec|5.027008||Vniu setfd_inhexec_for_sysfd|5.027008||Viu setgid|5.005000||Viu setgrent|5.009000||Viu SETGRENT_R_HAS_FPTR|5.008000||Viu SETGRENT_R_PROTO|5.008000|5.008000|Vn sethostent|5.005000||Viu SETHOSTENT_R_PROTO|5.008000|5.008000|Vn SETi|5.003007||Viu setjmp|5.005000||Viu setlinebuf|5.005000||Viu setlocale|5.009000||Viu setlocale_debug_string|5.027002||Vniu SETLOCALE_LOCK|5.033005||Viu SETLOCALE_R_PROTO|5.008000|5.008000|Vn SETLOCALE_UNLOCK|5.033005||Viu SET_MARK_OFFSET|5.006000||Viu setmode|5.005000||Viu SETn|5.003007||Viu setnetent|5.005000||Viu SETNETENT_R_PROTO|5.008000|5.008000|Vn set_numeric_radix|5.006000||Viu SET_NUMERIC_STANDARD|5.004000||Viu set_numeric_standard|5.006000||cViu SET_NUMERIC_UNDERLYING|5.021010||Viu set_numeric_underlying|5.027006||cViu SETp|5.003007||Viu set_padlist|5.021006||cVniu setprotoent|5.005000||Viu SETPROTOENT_R_PROTO|5.008000|5.008000|Vn setpwent|5.009000||Viu SETPWENT_R_HAS_FPTR|5.008000||Viu SETPWENT_R_PROTO|5.008000|5.008000|Vn set_regex_pv|5.029004||Viu setregid|5.003007||Viu setreuid|5.003007||Viu SETs|5.003007||Viu setservent|5.005000||Viu SETSERVENT_R_PROTO|5.008000|5.008000|Vn setsockopt|5.005000||Viu setSTR_LEN|5.031005||Viu SET_SVANY_FOR_BODYLESS_IV|5.023008||Viu SET_SVANY_FOR_BODYLESS_NV|5.023008||Viu SETTARG|5.003007||Viu SET_THR|5.005000||Viu SET_THREAD_SELF|5.005003||Viu SETu|5.004000||Viu setuid|5.005000||Viu _setup_canned_invlist|5.019008||cViu setvbuf|5.003007||Viu share_hek|5.009003|5.009003|u share_hek_flags|5.008000||Viu share_hek_hek|5.009003||Viu sharepvn|5.005000||Viu SHARP_S_SKIP|5.007003||Viu Shmat_t|5.003007|5.003007|Vn SHORTSIZE|5.004000|5.004000|Vn should_warn_nl|5.021001||Vniu should_we_output_Debug_r|5.031011||Viu SH_PATH|5.003007|5.003007|Vn shutdown|5.005000||Viu si_dup|5.007003|5.007003|u S_IEXEC|5.006000||Viu S_IFIFO|5.011000||Viu S_IFMT|5.003007||Viu SIGABRT|5.003007||Viu sighandler1|5.031007||Vniu sighandler3|5.031007||Vniu sighandler|5.003007||Vniu SIGILL|5.003007||Viu Sigjmp_buf|5.003007|5.003007|Vn Siglongjmp|5.003007|5.003007| signal|5.005000||Viu Signal_t|5.003007|5.003007|Vn SIG_NAME|5.003007|5.003007|Vn SIG_NUM|5.003007|5.003007|Vn Sigsetjmp|5.003007|5.003007| SIG_SIZE|5.007001|5.007001|Vn simplify_sort|5.006000||Viu single_1bit_pos32|5.035003||cVnu single_1bit_pos64|5.035003||cVnu SINGLE_PAT_MOD|5.009005||Viu SIPHASH_SEED_STATE|5.027001||Viu SIPROUND|5.017006||Viu S_IREAD|5.006000||Viu S_IRGRP|5.003007||Viu S_IROTH|5.003007||Viu S_IRUSR|5.003007||Viu S_IRWXG|5.006000||Viu S_IRWXO|5.006000||Viu S_IRWXU|5.006000||Viu S_ISBLK|5.003007||Viu S_ISCHR|5.003007||Viu S_ISDIR|5.003007||Viu S_ISFIFO|5.003007||Viu S_ISGID|5.003007||Viu S_ISLNK|5.003007||Viu S_ISREG|5.003007||Viu S_ISSOCK|5.003007||Viu S_ISUID|5.003007||Viu SITEARCH|5.003007|5.003007|Vn SITEARCH_EXP|5.003007|5.003007|Vn SITELIB|5.003007|5.003007|Vn SITELIB_EXP|5.003007|5.003007|Vn SITELIB_STEM|5.006000|5.006000|Vn S_IWGRP|5.003007||Viu S_IWOTH|5.003007||Viu S_IWRITE|5.006000||Viu S_IWUSR|5.003007||Viu S_IXGRP|5.003007||Viu S_IXOTH|5.003007||Viu S_IXUSR|5.003007||Viu SIZE_ALIGN|5.005000||Viu Size_t|5.003007|5.003007|Vn Size_t_MAX|5.021003||Viu Size_t_size|5.006000|5.006000|Vn SKIP|5.009005||Viu SKIP_next|5.009005||Viu SKIP_next_fail|5.009005||Viu SKIP_next_fail_t8|5.035004||Viu SKIP_next_fail_t8_p8|5.033003||Viu SKIP_next_fail_t8_pb|5.033003||Viu SKIP_next_fail_tb|5.035004||Viu SKIP_next_fail_tb_p8|5.033003||Viu SKIP_next_fail_tb_pb|5.033003||Viu SKIP_next_t8|5.035004||Viu SKIP_next_t8_p8|5.033003||Viu SKIP_next_t8_pb|5.033003||Viu SKIP_next_tb|5.035004||Viu SKIP_next_tb_p8|5.033003||Viu SKIP_next_tb_pb|5.033003||Viu skipspace_flags|5.019002||xcViu SKIP_t8|5.035004||Viu SKIP_t8_p8|5.033003||Viu SKIP_t8_pb|5.033003||Viu SKIP_tb|5.035004||Viu SKIP_tb_p8|5.033003||Viu SKIP_tb_pb|5.033003||Viu skip_to_be_ignored_text|5.023004||Viu Slab_Alloc|5.006000||cViu Slab_Free|5.007003||cViu Slab_to_ro|5.017002||Viu Slab_to_rw|5.009005||Viu sleep|5.005000||Viu SLOPPYDIVIDE|5.003007||Viu socket|5.005000||Viu SOCKET_OPEN_MODE|5.008002||Viu socketpair|5.005000||Viu Sock_size_t|5.006000|5.006000|Vn softref2xv|||iu sortcv|5.009003||Viu sortcv_stacked|5.009003||Viu sortcv_xsub|5.009003||Viu sortsv|5.007003|5.007003| sortsv_flags|5.009003|5.009003| sortsv_flags_impl|5.031011||Viu SP|5.003007|5.003007| space_join_names_mortal|5.009004||Viu SPAGAIN|5.003007|5.003007| S_PAT_MODS|5.009005||Viu specialWARN|5.006000||Viu SRAND48_R_PROTO|5.008000|5.008000|Vn SRANDOM_R_PROTO|5.008000|5.008000|Vn SRCLOSE|5.027008||Viu SRCLOSE_t8|5.035004||Viu SRCLOSE_t8_p8|5.033003||Viu SRCLOSE_t8_pb|5.033003||Viu SRCLOSE_tb|5.035004||Viu SRCLOSE_tb_p8|5.033003||Viu SRCLOSE_tb_pb|5.033003||Viu SROPEN|5.027008||Viu SROPEN_t8|5.035004||Viu SROPEN_t8_p8|5.033003||Viu SROPEN_t8_pb|5.033003||Viu SROPEN_tb|5.035004||Viu SROPEN_tb_p8|5.033003||Viu SROPEN_tb_pb|5.033003||Viu SS_ACCVIO|5.008001||Viu SS_ADD_BOOL|5.017007||Viu SS_ADD_DPTR|5.017007||Viu SS_ADD_DXPTR|5.017007||Viu SS_ADD_END|5.017007||Viu SS_ADD_INT|5.017007||Viu SS_ADD_IV|5.017007||Viu SS_ADD_LONG|5.017007||Viu SS_ADD_PTR|5.017007||Viu SS_ADD_UV|5.017007||Viu SS_BUFFEROVF|5.021009||Viu ssc_add_range|5.019005||Viu ssc_and|5.019005||Viu ssc_anything|5.019005||Viu ssc_clear_locale|5.019005||Vniu ssc_cp_and|5.019005||Viu ssc_finalize|5.019005||Viu SSCHECK|5.003007||Viu ssc_init|5.019005||Viu ssc_intersection|5.019005||Viu ssc_is_anything|5.019005||Vniu ssc_is_cp_posixl_init|5.019005||Vniu SSC_MATCHES_EMPTY_STRING|5.021004||Viu ssc_or|5.019005||Viu ssc_union|5.019005||Viu SS_DEVOFFLINE|5.008001||Viu ss_dup|5.007003|5.007003|u SSGROW|5.008001||Viu SS_IVCHAN|5.008001||Viu SSize_t|5.003007|5.003007|Vn SSize_t_MAX|5.019004||Viu SS_MAXPUSH|5.017007||Viu SSNEW|5.006000||Viu SSNEWa|5.006000||Viu SSNEWat|5.007001||Viu SSNEWt|5.007001||Viu SS_NOPRIV|5.021001||Viu SS_NORMAL|5.008001||Viu SSPOPBOOL|5.008001||Viu SSPOPDPTR|5.003007||Viu SSPOPDXPTR|5.006000||Viu SSPOPINT|5.003007||Viu SSPOPIV|5.003007||Viu SSPOPLONG|5.003007||Viu SSPOPPTR|5.003007||Viu SSPOPUV|5.013001||Viu SSPTR|5.006000||Viu SSPTRt|5.007001||Viu SSPUSHBOOL|5.008001||Viu SSPUSHDPTR|5.003007||Viu SSPUSHDXPTR|5.006000||Viu SSPUSHINT|5.003007||Viu SSPUSHIV|5.003007||Viu SSPUSHLONG|5.003007||Viu SSPUSHPTR|5.003007||Viu SSPUSHUV|5.013001||Viu ST|5.003007|5.003007| stack_grow|5.003007||cVu Stack_off_t_MAX|||piu Stack_off_t|||piu STANDARD_C|5.003007||Viu STAR|5.003007||Viu STAR_t8|5.035004||Viu STAR_t8_p8|5.033003||Viu STAR_t8_pb|5.033003||Viu STAR_tb|5.035004||Viu STAR_tb_p8|5.033003||Viu STAR_tb_pb|5.033003||Viu START_EXTERN_C|5.005000|5.003007|pV start_glob|||xi START_MY_CXT|5.010000|5.010000|p STARTPERL|5.003007|5.003007|Vn start_subparse|5.004000|5.003007|pu StashHANDLER|5.007001||Viu Stat|5.003007||Viu stat|5.005000||Viu STATIC|5.005000||Viu STATIC_ASSERT_1|5.021007||Viu STATIC_ASSERT_2|5.021007||Viu STATIC_ASSERT_DECL|5.027001||Viu STATIC_ASSERT_STMT|5.021007||Viu Stat_t|5.004005||Viu STATUS_ALL_FAILURE|5.004000||Viu STATUS_ALL_SUCCESS|5.004000||Viu STATUS_CURRENT|5.004000||Viu STATUS_EXIT|5.009003||Viu STATUS_EXIT_SET|5.009003||Viu STATUS_NATIVE|5.004000||Viu STATUS_NATIVE_CHILD_SET|5.009003||Viu STATUS_UNIX|5.009003||Viu STATUS_UNIX_EXIT_SET|5.009003||Viu STATUS_UNIX_SET|5.009003||Viu STDCHAR|5.003007|5.003007|Vn stderr|5.003007||Viu ST_DEV_SIGN|5.035004|5.035004|Vn ST_DEV_SIZE|5.035004|5.035004|Vn stdin|5.003007||Viu STDIO_PTR_LVAL_SETS_CNT|5.007001|5.007001|Vn STDIO_PTR_LVALUE|5.006000|5.006000|Vn STDIO_STREAM_ARRAY|5.006000|5.006000|Vn stdize_locale|5.007001||Viu stdout|5.003007||Viu stdoutf|5.005000||Viu STD_PAT_MODS|5.009005||Viu STD_PMMOD_FLAGS_CLEAR|5.013006||Viu ST_INO_SIGN|5.015002|5.015002|Vn ST_INO_SIZE|5.015002|5.015002|Vn STMT_END|5.003007|5.003007|pV STMT_START|5.003007|5.003007|pV STOREFEATUREBITSHH|5.031006||Viu STORE_LC_NUMERIC_FORCE_TO_UNDERLYING|5.021010|5.021010| STORE_LC_NUMERIC_SET_STANDARD|5.027009||pVu STORE_LC_NUMERIC_SET_TO_NEEDED|5.021010|5.021010| STORE_LC_NUMERIC_SET_TO_NEEDED_IN|5.031003|5.031003| STORE_NUMERIC_SET_STANDARD|||piu strBEGINs|5.027006||Viu strEQ|5.003007|5.003007| Strerror|5.003007||Viu strerror|5.009000||Viu STRERROR_R_PROTO|5.008000|5.008000|Vn strGE|5.003007|5.003007| strGT|5.003007|5.003007| STRING|5.006000||Viu STRINGIFY|5.003007|5.003007|Vn STRINGl|5.031005||Viu STRINGs|5.031005||Viu strip_return|5.009003||Viu strLE|5.003007|5.003007| STR_LEN|5.006000||Viu STRLEN|5.027001||Viu STR_LENl|5.031005||Viu STR_LENs|5.031005||Viu strLT|5.003007|5.003007| strNE|5.003007|5.003007| strnEQ|5.003007|5.003007| strnNE|5.003007|5.003007| STR_SZ|5.006000||Viu Strtod|5.029010|5.029010|n Strtol|5.006000|5.006000|n strtoll|5.006000||Viu Strtoul|5.006000|5.006000|n strtoull|5.006000||Viu str_to_version|5.006000||cVu StructCopy|5.003007|5.003007|V STRUCT_OFFSET|5.004000||Viu STRUCT_SV|5.007001||Viu STR_WITH_LEN|5.009003|5.003007|pV study_chunk|5.005000||Viu sub_crush_depth|5.004000||Viu sublex_done|5.005000||Viu sublex_push|5.005000||Viu sublex_start|5.005000||Viu SUBST_TAINT_BOOLRET|5.013010||Viu SUBST_TAINT_PAT|5.013010||Viu SUBST_TAINT_REPL|5.013010||Viu SUBST_TAINT_RETAINT|5.013010||Viu SUBST_TAINT_STR|5.013010||Viu SUBVERSION|5.003007||Viu SUCCEED|5.003007||Viu SUCCEED_t8|5.035004||Viu SUCCEED_t8_p8|5.033003||Viu SUCCEED_t8_pb|5.033003||Viu SUCCEED_tb|5.035004||Viu SUCCEED_tb_p8|5.033003||Viu SUCCEED_tb_pb|5.033003||Viu SUSPEND|5.005000||Viu SUSPEND_t8|5.035004||Viu SUSPEND_t8_p8|5.033003||Viu SUSPEND_t8_pb|5.033003||Viu SUSPEND_tb|5.035004||Viu SUSPEND_tb_p8|5.033003||Viu SUSPEND_tb_pb|5.033003||Viu sv_2bool|5.013006||cV sv_2bool_flags|5.013006||cV sv_2bool_nomg|5.017002||Viu sv_2cv|5.003007|5.003007| sv_2io|5.003007|5.003007| sv_2iuv_common|5.009004||Viu sv_2iuv_non_preserve|5.007001||Viu sv_2iv|5.009001||cVu sv_2iv_flags|5.009001|5.009001| sv_2mortal|5.003007|5.003007| sv_2num|5.010000||xVi sv_2nv|5.013001||Viu sv_2nv_flags|5.013001|5.013001| sv_2pv|5.005000||pcVu sv_2pvbyte|5.006000|5.003007|p sv_2pvbyte_flags|5.031004|5.031004|u sv_2pvbyte_nolen|5.009003||pcV sv_2pv_flags|5.007002||pcV sv_2pv_nolen|5.009003||pcV sv_2pv_nomg|5.007002||Viu sv_2pvutf8|5.006000|5.006000| sv_2pvutf8_flags|5.031004|5.031004|u sv_2pvutf8_nolen|5.009003||cV sv_2uv|5.009001||pcVu sv_2uv_flags|5.009001|5.009001| sv_add_arena|5.003007||Vi sv_add_backref|||iu SvAMAGIC|5.003007||Viu SvAMAGIC_off|5.003007|5.003007|nu SvAMAGIC_on|5.003007|5.003007|nu SvANY|5.003007||Viu SvARENA_CHAIN_SET|||Viu SvARENA_CHAIN|||Viu sv_backoff|5.003007|5.003007|n sv_bless|5.003007|5.003007| sv_buf_to_ro|5.019008||Viu sv_buf_to_rw|5.019008||Viu SvCANCOW|5.017007||Viu SvCANEXISTDELETE|5.011000||Viu SV_CATBYTES|5.021005|5.021005| sv_cat_decode|5.008001|5.008001| sv_cathek|5.021004||Viu sv_catpv|5.003007|5.003007| sv_catpvf|5.004000||vV sv_catpv_flags|5.013006|5.013006| sv_catpvf_mg|5.004005||pvV sv_catpvf_mg_nocontext|5.006000||pvVn sv_catpvf_nocontext|5.006000||vVn sv_catpv_mg|5.004005|5.003007|p sv_catpvn|5.003007|5.003007| sv_catpvn_flags|5.007002|5.007002| sv_catpvn_mg|5.004005|5.003007|p sv_catpvn_nomg|5.007002|5.003007|p sv_catpvn_nomg_maybeutf8|5.017005||Viu sv_catpvn_nomg_utf8_upgrade|5.017002||Viu sv_catpv_nomg|5.013006|5.013006| sv_catpvs|5.009003|5.003007|p sv_catpvs_flags|5.013006|5.013006| sv_catpvs_mg|5.013006|5.013006| sv_catpvs_nomg|5.013006|5.013006| sv_catsv|5.003007|5.003007| sv_catsv_flags|5.007002|5.007002| sv_catsv_mg|5.004005|5.003007|p sv_catsv_nomg|5.007002|5.003007|p SV_CATUTF8|5.021005|5.021005| sv_catxmlpvs|5.013006||Viu SV_CHECK_THINKFIRST|5.008001||Viu SV_CHECK_THINKFIRST_COW_DROP|5.009000||Viu sv_chop|5.003007|5.003007| sv_clean_all|5.003007||Vi sv_clean_objs|5.003007||Vi sv_clear|5.003007|5.003007| sv_cmp|5.003007|5.003007| sv_cmp_flags|5.013006|5.013006| sv_cmp_locale|5.004000|5.004000| sv_cmp_locale_flags|5.013006|5.013006| sv_collxfrm|5.013006||V sv_collxfrm_flags|5.013006|5.013006| SvCOMPILED|5.003007||Viu SvCOMPILED_off|5.003007||Viu SvCOMPILED_on|5.003007||Viu SV_CONST|5.019002||Viu SV_CONST_BINMODE|5.019002||Viu SV_CONST_CLEAR|5.019002||Viu SV_CONST_CLOSE|5.019002||Viu SV_CONST_DELETE|5.019002||Viu SV_CONST_DESTROY|5.019002||Viu SV_CONST_EOF|5.019002||Viu SV_CONST_EXISTS|5.019002||Viu SV_CONST_EXTEND|5.019002||Viu SV_CONST_FETCH|5.019002||Viu SV_CONST_FETCHSIZE|5.019002||Viu SV_CONST_FILENO|5.019002||Viu SV_CONST_FIRSTKEY|5.019002||Viu SV_CONST_GETC|5.019002||Viu SV_CONST_NEXTKEY|5.019002||Viu SV_CONST_OPEN|5.019002||Viu SV_CONST_POP|5.019002||Viu SV_CONST_PRINT|5.019002||Viu SV_CONST_PRINTF|5.019002||Viu SV_CONST_PUSH|5.019002||Viu SV_CONST_READ|5.019002||Viu SV_CONST_READLINE|5.019002||Viu SV_CONST_RETURN|5.009003|5.003007|poVnu SV_CONST_SCALAR|5.019002||Viu SV_CONSTS_COUNT|5.019002||Viu SV_CONST_SEEK|5.019002||Viu SV_CONST_SHIFT|5.019002||Viu SV_CONST_SPLICE|5.019002||Viu SV_CONST_STORE|5.019002||Viu SV_CONST_STORESIZE|5.019002||Viu SV_CONST_TELL|5.019002||Viu SV_CONST_TIEARRAY|5.019002||Viu SV_CONST_TIEHANDLE|5.019002||Viu SV_CONST_TIEHASH|5.019002||Viu SV_CONST_TIESCALAR|5.019002||Viu SV_CONST_UNSHIFT|5.019002||Viu SV_CONST_UNTIE|5.019002||Viu SV_CONST_WRITE|5.019002||Viu sv_copypv|5.007003|5.007003| sv_copypv_flags|5.017002|5.017002| sv_copypv_nomg|5.017002|5.017002| SV_COW_DROP_PV|5.008001|5.003007|p SV_COW_OTHER_PVS|5.009005||Viu SV_COW_REFCNT_MAX|5.017007||Viu SV_COW_SHARED_HASH_KEYS|5.009005|5.003007|poVnu SvCUR|5.003007|5.003007| SvCUR_set|5.003007|5.003007| sv_dec|5.003007|5.003007| sv_dec_nomg|5.013002|5.013002| sv_del_backref|5.006000||cViu sv_derived_from|5.004000|5.004000| sv_derived_from_pv|5.015004|5.015004| sv_derived_from_pvn|5.015004|5.015004| sv_derived_from_sv|5.015004|5.015004| sv_derived_from_svpvn|5.031006||Viu sv_destroyable|5.010000|5.010000| SvDESTROYABLE|5.010000||Viu sv_display|5.021002||Viu SV_DO_COW_SVSETSV|5.009005||Viu sv_does|5.009004|5.009004| sv_does_pv|5.015004|5.015004| sv_does_pvn|5.015004|5.015004| sv_does_sv|5.015004|5.015004| sv_dump|5.003007|5.003007| sv_dup|5.007003|5.007003|u sv_dup_common|5.013002||Viu sv_dup_inc|5.013002|5.013002|u sv_dup_inc_multiple|5.011000||Viu SvEND|5.003007|5.003007| SvEND_set|5.003007||Viu SvENDx|5.003007||Viu sv_eq|5.003007|5.003007| sv_eq_flags|5.013006|5.013006| sv_exp_grow|5.009003||Viu SVf256|5.008001||Viu SVf32|5.009002||Viu SVf|5.006000|5.003007|p SvFAKE|5.003007||Viu SvFAKE_off|5.003007||Viu SvFAKE_on|5.003007||Viu SVf_AMAGIC|5.003007||Viu SVfARG|5.009005|5.003007|p SVf_BREAK|5.003007||Viu SVf_FAKE|5.003007||Viu SVf_IOK|5.003007||Viu SVf_IsCOW|5.017006||Viu SVf_IVisUV|5.006000||Viu SvFLAGS|5.003007||Viu SVf_NOK|5.003007||Viu SVf_OK|5.003007||Viu SVf_OOK|5.003007||Viu sv_force_normal|5.006000|5.006000| sv_force_normal_flags|5.007001|5.007001| SV_FORCE_UTF8_UPGRADE|5.011000|5.011000| SVf_POK|5.003007||Viu SVf_PROTECT|5.021005||Viu SVf_READONLY|5.003007||Viu sv_free2|||xciu sv_free|5.003007|5.003007| sv_free_arenas|5.003007||Vi SVf_ROK|5.003007||Viu SVf_THINKFIRST|5.003007||Viu SVf_UTF8|5.006000|5.003007|p SvGAMAGIC|5.006001|5.006001| sv_get_backrefs|5.021008|5.021008|xn SvGETMAGIC|5.004005|5.003007|p sv_gets|5.003007|5.003007| SvGID|5.019001||Viu SV_GMAGIC|5.007002|5.003007|p SvGMAGICAL|5.003007||Viu SvGMAGICAL_off|5.003007||Viu SvGMAGICAL_on|5.003007||Viu SvGROW|5.003007|5.003007| sv_grow|5.003007||cV Sv_Grow|5.003007||Viu sv_grow_fresh|5.035006||cV SvGROW_mutable|5.009003||Viu SV_HAS_TRAILING_NUL|5.009004|5.003007|p SV_IMMEDIATE_UNREF|5.007001|5.003007|p SvIMMORTAL|5.004000||Viu SvIMMORTAL_INTERP|5.027003||Viu SvIMMORTAL_TRUE|5.027003||Viu sv_inc|5.003007|5.003007| sv_i_ncmp|5.009003||Viu sv_i_ncmp_desc|5.031011||Viu sv_inc_nomg|5.013002|5.013002| sv_insert|5.003007|5.003007| sv_insert_flags|5.010001|5.010001| SvIOK|5.003007|5.003007| SvIOK_nog|5.017002||Viu SvIOK_nogthink|5.017002||Viu SvIOK_notUV|5.006000|5.006000| SvIOK_off|5.003007|5.003007| SvIOK_on|5.003007|5.003007| SvIOK_only|5.003007|5.003007| SvIOK_only_UV|5.006000|5.006000| SvIOKp|5.003007|5.003007| SvIOKp_on|5.003007||Viu SvIOK_UV|5.006000|5.006000| sv_isa|5.003007|5.003007| sv_isa_sv|5.031007|5.031007|x SvIsBOOL|5.035004|5.035004| SvIsCOW|5.008003|5.008003| SvIsCOW_shared_hash|5.008003|5.008003| SvIS_FREED|5.009003||Viu sv_isobject|5.003007|5.003007| SvIV|5.003007|5.003007| sv_iv|5.005000||dcV SvIV_nomg|5.009001|5.003007|p SvIV_please|5.007001||Viu SvIV_please_nomg|5.013002||Viu SvIV_set|5.003007|5.003007| SvIVX|5.003007|5.003007| SvIVx|5.003007|5.003007| SvIVXx|5.003007||Viu sv_kill_backrefs|||xiu sv_len|5.003007|5.003007| SvLEN|5.003007|5.003007| SvLEN_set|5.003007|5.003007| sv_len_utf8|5.006000|5.006000|p sv_len_utf8_nomg||5.006000|p SvLENx|5.003007||Viu SvLOCK|5.007003|5.007003| sv_magic|5.003007|5.003007| SvMAGIC|5.003007||Viu SvMAGICAL|5.003007||Viu SvMAGICAL_off|5.003007||Viu SvMAGICAL_on|5.003007||Viu sv_magicext|5.007003|5.007003| sv_magicext_mglob|5.019002||cViu sv_magic_portable||5.004000|pou SvMAGIC_set|5.009003|5.003007|p sv_mortalcopy|5.003007|5.003007| sv_mortalcopy_flags|5.031001|5.003007|p SV_MUTABLE_RETURN|5.009003|5.003007|poVnu sv_ncmp|5.009003||Viu sv_ncmp_desc|5.031011||Viu sv_newmortal|5.003007|5.003007| sv_newref|5.003007||cV SvNIOK|5.003007|5.003007| SvNIOK_nog|5.017002||Viu SvNIOK_nogthink|5.017002||Viu SvNIOK_off|5.003007|5.003007| SvNIOKp|5.003007|5.003007| SvNOK|5.003007|5.003007| SvNOK_nog|5.017002||Viu SvNOK_nogthink|5.017002||Viu SvNOK_off|5.003007|5.003007| SvNOK_on|5.003007|5.003007| SvNOK_only|5.003007|5.003007| SvNOKp|5.003007|5.003007| SvNOKp_on|5.003007||Viu sv_nolocking|5.031004|5.031004|d sv_nosharing|5.007003|5.007003| SV_NOSTEAL|5.009002|5.003007|p sv_nounlocking|5.009004|5.009004|d sv_numeq|5.035009|5.035009| sv_numeq_flags|5.035009|5.035009| sv_nv|5.005000||dcV SvNV|5.006000|5.003007| SvNV_nomg|5.013002|5.003007|p SvNV_set|5.006000|5.003007| SvNVX|5.006000|5.003007| SvNVx|5.006000|5.003007| SvNVXx|5.003007||Viu SvOBJECT|5.003007||Viu SvOBJECT_off|5.003007||Viu SvOBJECT_on|5.003007||Viu SvOK|5.003007|5.003007| SvOK_off|5.003007||Viu SvOK_off_exc_UV|5.006000||Viu SvOKp|5.003007||Viu sv_only_taint_gmagic|5.021010||Vniu SvOOK|5.003007|5.003007| SvOOK_off|5.003007|5.003007| SvOOK_offset|5.011000|5.011000| SvOOK_on|5.003007||Viu sv_or_pv_len_utf8|5.017005||Viu sv_or_pv_pos_u2b|5.019004||Viu SvOURSTASH|5.009005||Viu SvOURSTASH_set|5.009005||Viu SvPADMY|5.003007||Viu SvPADMY_on|5.003007||Viu SVpad_OUR|5.006000||Viu SvPAD_OUR|5.009004||Viu SvPAD_OUR_on|5.009004||Viu SvPADSTALE|5.009000||Viu SvPADSTALE_off|5.009000||Viu SvPADSTALE_on|5.009000||Viu SVpad_STATE|5.009004||Viu SvPAD_STATE|5.009004||Viu SvPAD_STATE_on|5.009004||Viu SvPADTMP|5.003007||Viu SvPADTMP_off|5.003007||Viu SvPADTMP_on|5.003007||Viu SVpad_TYPED|5.007002||Viu SvPAD_TYPED|5.009004||Viu SvPAD_TYPED_on|5.009004||Viu SVpav_REAL|5.009003||Viu SVpav_REIFY|5.009003||Viu SvPCS_IMPORTED|5.009005||Viu SvPCS_IMPORTED_off|5.009005||Viu SvPCS_IMPORTED_on|5.009005||Viu SvPEEK|5.003007||Viu sv_peek|5.005000|5.005000|u SVpgv_GP|5.009005||Viu SVphv_CLONEABLE|5.009003||Viu SVphv_HASKFLAGS|5.008000||Viu SVphv_LAZYDEL|5.003007||Viu SVphv_SHAREKEYS|5.003007||Viu SVp_IOK|5.003007||Viu SVp_NOK|5.003007||Viu SvPOK|5.003007|5.003007| SvPOK_byte_nog|5.017002||Viu SvPOK_byte_nogthink|5.017002||Viu SvPOK_byte_pure_nogthink|5.017003||Viu SvPOK_nog|5.017002||Viu SvPOK_nogthink|5.017002||Viu SvPOK_off|5.003007|5.003007| SvPOK_on|5.003007|5.003007| SvPOK_only|5.003007|5.003007| SvPOK_only_UTF8|5.006000|5.006000| SvPOK_or_cached_IV|||Viu SvPOKp|5.003007|5.003007| SvPOKp_on|5.003007||Viu SvPOK_pure_nogthink|5.017003||Viu SvPOK_utf8_nog|5.017002||Viu SvPOK_utf8_nogthink|5.017002||Viu SvPOK_utf8_pure_nogthink|5.017003||Viu sv_pos_b2u|5.006000|5.006000| sv_pos_b2u_flags|5.019003|5.019003| sv_pos_b2u_midway|5.009004||Viu sv_pos_u2b|5.006000|5.006000| sv_pos_u2b_cached|5.009004||Viu sv_pos_u2b_flags|5.011005|5.011005| sv_pos_u2b_forwards|5.009004||Vniu sv_pos_u2b_midway|5.009004||Vniu SVp_POK|5.003007||Viu SVppv_STATIC|5.035004||Viu SVprv_PCS_IMPORTED|5.009005||Viu SVprv_WEAKREF|5.006000||Viu SVp_SCREAM|5.003007||Viu SvPV|5.003007|5.003007| sv_pv|5.008000||cV SvPVbyte|5.006000|5.003007|p sv_pvbyte|5.008000||cV SvPVbyte_force|5.009002|5.009002| sv_pvbyten|5.006000||dcV sv_pvbyten_force|5.006000||cV SvPVbyte_nolen|5.006000|5.006000| SvPVbyte_nomg|5.031004|5.031004| SvPVbyte_or_null|5.031004|5.031004| SvPVbyte_or_null_nomg|5.031004|5.031004| SvPVbytex|5.006000|5.006000| SvPVbytex_force|5.006000|5.006000| SvPVbytex_nolen|5.009003|5.009003| SvPVCLEAR|5.025006|5.025006|p SvPV_const|5.009003|5.003007|p SvPV_flags|5.007002|5.003007|p SvPV_flags_const|5.009003|5.003007|p SvPV_flags_const_nolen|5.009003||pVu SvPV_flags_mutable|5.009003|5.003007|p SvPV_force|5.003007|5.003007|p SvPV_force_flags|5.007002|5.003007|p SvPV_force_flags_mutable|5.009003|5.003007|p SvPV_force_flags_nolen|5.009003|5.003007|p SvPV_force_mutable|5.009003|5.003007|p SvPV_force_nolen|5.009003|5.003007|p SvPV_force_nomg|5.007002|5.003007|p SvPV_force_nomg_nolen|5.009003|5.003007|p SvPV_free|5.009003|5.009003| SvPV_mutable|5.009003|5.003007|p sv_pvn|5.004000||dcV sv_pvn_force|5.005000||cV sv_pvn_force_flags|5.007002|5.003007|p sv_pvn_force_nomg|5.007002||Viu sv_pvn_nomg|5.007003|5.005000|pdu SvPV_nolen|5.006000|5.003007|p SvPV_nolen_const|5.009003|5.003007|p SvPV_nomg|5.007002|5.003007|p SvPV_nomg_const|5.009003|5.003007|p SvPV_nomg_const_nolen|5.009003|5.003007|p SvPV_nomg_nolen|5.013007|5.003007|p SvPV_renew|5.009003|5.003007|p SvPV_set|5.003007|5.003007| SvPV_shrink_to_cur|5.009003||Viu SvPVutf8|5.006000|5.006000| sv_pvutf8|5.008000||cV SvPVutf8_force|5.006000|5.006000| sv_pvutf8n|5.006000||dcV sv_pvutf8n_force|5.006000||cV SvPVutf8_nolen|5.006000|5.006000| SvPVutf8_nomg|5.031004|5.031004| SvPVutf8_or_null|5.031004|5.031004| SvPVutf8_or_null_nomg|5.031004|5.031004| SvPVutf8x|5.006000|5.006000| SvPVutf8x_force|5.006000|5.006000| SvPVX|5.003007|5.003007| SvPVx|5.003007|5.003007| SvPVX_const|5.009003|5.003007|p SvPVx_const|5.009003|5.009003| SvPVx_force|5.005000|5.005000| SvPVX_mutable|5.009003|5.003007|p SvPVx_nolen|5.009003|5.009003| SvPVx_nolen_const|5.009003|5.003007|p SvPVXtrue|5.017002||Viu SvPVXx|5.003007|5.003007| SvREADONLY|5.003007|5.003007| SvREADONLY_off|5.003007|5.003007| SvREADONLY_on|5.003007|5.003007| sv_recode_to_utf8|5.007003|5.007003| sv_ref|5.023005|5.023005| SvREFCNT|5.003007|5.003007| SvREFCNT_dec|5.003007|5.003007| SvREFCNT_dec_NN|5.017007|5.017007|p SvREFCNT_IMMORTAL|5.017008||Viu SvREFCNT_inc|5.003007|5.003007|pn SvREFCNT_inc_NN|5.009004|5.003007|pn SvREFCNT_inc_simple|5.009004|5.003007|pn SvREFCNT_inc_simple_NN|5.009004|5.003007|pn SvREFCNT_inc_simple_void|5.009004|5.003007|pn SvREFCNT_inc_simple_void_NN|5.009004|5.003007|pn SvREFCNT_inc_void|5.009004|5.003007|pn SvREFCNT_inc_void_NN|5.009004|5.003007|pn sv_reftype|5.003007|5.003007| sv_replace|5.003007|5.003007| sv_report_used|5.003007|5.003007| sv_reset|5.003007|5.003007| sv_resetpvn|5.017005||Viu SvRMAGICAL|5.003007||Viu SvRMAGICAL_off|5.003007||Viu SvRMAGICAL_on|5.003007||Viu SvROK|5.003007|5.003007| SvROK_off|5.003007|5.003007| SvROK_on|5.003007|5.003007| SvRV|5.003007|5.003007| SvRV_const|5.010001||Viu SvRV_set|5.009003|5.003007|p sv_rvunweaken|5.027004|5.027004| sv_rvweaken|5.006000|5.006000| SvRVx|5.003007||Viu SvRX|5.009005|5.003007|p SvRXOK|5.009005|5.003007|p SV_SAVED_COPY|5.009005||Viu SvSCREAM|5.003007||Viu SvSCREAM_off|5.003007||Viu SvSCREAM_on|5.003007||Viu sv_setbool|5.035004|5.035004| sv_setbool_mg|5.035004|5.035004| sv_setgid|5.019001||Viu sv_sethek|5.015004||cViu sv_setiv|5.003007|5.003007| sv_setiv_mg|5.004005|5.003007|p SvSETMAGIC|5.003007|5.003007| SvSetMagicSV|5.004000|5.004000| SvSetMagicSV_nosteal|5.004000|5.004000| sv_setnv|5.006000|5.003007| sv_setnv_mg|5.006000|5.003007|p sv_setpv|5.003007|5.003007| sv_setpv_bufsize|5.025006|5.025006| sv_setpvf|5.004000||vV sv_setpvf_mg|5.004005||pvV sv_setpvf_mg_nocontext|5.006000||pvVn sv_setpvf_nocontext|5.006000||vVn sv_setpviv|5.008001|5.008001|d sv_setpviv_mg|5.008001|5.008001|d sv_setpv_mg|5.004005|5.003007|p sv_setpvn|5.003007|5.003007| sv_setpvn_fresh|5.035006|5.035006| sv_setpvn_mg|5.004005|5.003007|p sv_setpvs|5.009004|5.003007|p sv_setpvs_mg|5.013006|5.013006| sv_setref_iv|5.003007|5.003007| sv_setref_nv|5.006000|5.003007| sv_setref_pv|5.003007|5.003007| sv_setref_pvn|5.003007|5.003007| sv_setref_pvs|5.013006|5.013006| sv_setref_uv|5.007001|5.007001| sv_setrv_inc|5.035004|5.035004| sv_setrv_inc_mg|5.035004|5.035004| sv_setrv_noinc|5.035004|5.035004| sv_setrv_noinc_mg|5.035004|5.035004| sv_setsv|5.003007|5.003007| SvSetSV|5.003007|5.003007| sv_setsv_cow|5.009000||xcViu sv_setsv_flags|5.007002|5.003007|p sv_setsv_mg|5.004005|5.003007|p sv_setsv_nomg|5.007002|5.003007|p SvSetSV_nosteal|5.004000|5.004000| sv_setuid|5.019001||Viu sv_set_undef|5.025008|5.025008| sv_setuv|5.004000|5.003007|p sv_setuv_mg|5.004005|5.003007|p SVs_GMG|5.003007||Viu SvSHARE|5.007003|5.007003| SvSHARED_HASH|5.009003|5.003007|p SvSHARED_HEK_FROM_PV|5.009003||Viu SV_SKIP_OVERLOAD|5.013001||Viu SV_SMAGIC|5.009003|5.003007|p SvSMAGICAL|5.003007||Viu SvSMAGICAL_off|5.003007||Viu SvSMAGICAL_on|5.003007||Viu SVs_OBJECT|5.003007||Viu SVs_PADMY|5.003007||Viu SVs_PADSTALE|5.009000|5.009000| SVs_PADTMP|5.003007||Viu SVs_RMG|5.003007||Viu SVs_SMG|5.003007||Viu SvSTASH|5.003007|5.003007| SvSTASH_set|5.009003|5.003007|p SVs_TEMP|5.003007|5.003007| sv_streq|5.035009|5.035009| sv_streq_flags|5.035009|5.035009| sv_string_from_errnum|5.027003|5.027003| SvTAIL|5.003007||Viu SvTAINT|5.003007|5.003007| sv_taint|5.009003||cV SvTAINTED|5.004000|5.004000| sv_tainted|5.004000||cV SvTAINTED_off|5.004000|5.004000| SvTAINTED_on|5.004000|5.004000| SvTEMP|5.003007||Viu SvTEMP_off|5.003007||Viu SvTEMP_on|5.003007||Viu SVt_FIRST|5.021005||Viu SvTHINKFIRST|5.003007||Vi SvTIED_mg|5.005003||Viu SvTIED_obj|5.005003|5.005003| SVt_INVLIST|||c SVt_IV|5.003007|5.003007| SVt_MASK|5.015001||Viu SVt_NULL|5.003007|5.003007| SVt_NV|5.003007|5.003007| SVt_PV|5.003007|5.003007| SVt_PVAV|5.003007|5.003007| SVt_PVBM|5.009005||Viu SVt_PVCV|5.003007|5.003007| SVt_PVFM|5.003007|5.003007| SVt_PVGV|5.003007|5.003007| SVt_PVHV|5.003007|5.003007| SVt_PVIO|5.003007|5.003007| SVt_PVIV|5.003007|5.003007| SVt_PVLV|5.003007|5.003007| SVt_PVMG|5.003007|5.003007| SVt_PVNV|5.003007|5.003007| SVt_REGEXP|5.011000|5.011000| SvTRUE|5.003007|5.003007| sv_true|5.005000||cV SvTRUE_common|5.033005||cVu SvTRUE_NN|5.017007|5.017007| SvTRUE_nomg|5.013006|5.003007|p SvTRUE_nomg_NN|5.017007|5.017007| SvTRUEx|5.003007|5.003007| SvTRUEx_nomg|5.017002||Viu SVt_RV|5.011000||Viu SvTYPE|5.003007|5.003007| SVTYPEMASK|5.003007||Viu SvUID|5.019001||Viu SV_UNDEF_RETURNS_NULL|5.011000||Viu sv_unglob|5.005000||Viu sv_uni_display|5.007003|5.007003| SvUNLOCK|5.007003|5.007003| sv_unmagic|5.003007|5.003007| sv_unmagicext|5.013008|5.003007|p sv_unref|5.003007|5.003007| sv_unref_flags|5.007001|5.007001| sv_untaint|5.004000||cV SvUOK|5.007001|5.006000|p SvUOK_nog|5.017002||Viu SvUOK_nogthink|5.017002||Viu sv_upgrade|5.003007|5.003007| SvUPGRADE|5.003007|5.003007| sv_usepvn|5.003007|5.003007| sv_usepvn_flags|5.009004|5.009004| sv_usepvn_mg|5.004005|5.003007|p SvUTF8|5.006000|5.003007|p sv_utf8_decode|5.006000|5.006000| sv_utf8_downgrade|5.006000|5.006000| sv_utf8_downgrade_flags|5.031004|5.031004| sv_utf8_downgrade_nomg|5.031004|5.031004| sv_utf8_encode|5.006000|5.006000| SV_UTF8_NO_ENCODING|5.008001|5.003007|pd SvUTF8_off|5.006000|5.006000| SvUTF8_on|5.006000|5.006000| sv_utf8_upgrade|5.007001|5.007001| sv_utf8_upgrade_flags|5.007002|5.007002| sv_utf8_upgrade_flags_grow|5.011000|5.011000| sv_utf8_upgrade_nomg|5.007002|5.007002| SvUV|5.004000|5.003007|p sv_uv|5.005000||pdcV SvUV_nomg|5.009001|5.003007|p SvUV_set|5.009003|5.003007|p SvUVX|5.004000|5.003007|p SvUVx|5.004000|5.003007|p SvUVXx|5.004000|5.003007|pd SvVALID|5.003007||Viu sv_vcatpvf|5.006000|5.004000|p sv_vcatpvf_mg|5.006000|5.004000|p sv_vcatpvfn|5.004000|5.004000| sv_vcatpvfn_flags|5.017002|5.017002| SvVOK|5.008001|5.008001|p sv_vsetpvf|5.006000|5.004000|p sv_vsetpvf_mg|5.006000|5.004000|p sv_vsetpvfn|5.004000|5.004000| sv_vstring_get|||p SvVSTRING_mg|5.009004|5.003007|p SvVSTRING|||piu SvWEAKREF|5.006000||Viu SvWEAKREF_off|5.006000||Viu SvWEAKREF_on|5.006000||Viu swallow_bom|5.006001||Viu switch_category_locale_to_template|5.027009||Viu SWITCHSTACK|5.003007||Viu switch_to_global_locale|5.027009|5.003007|pn sync_locale|5.027009|5.003007|pn sys_init3|||cnu sys_init|||cnu sys_intern_clear|5.006001||Vu sys_intern_dup|5.006000||Vu sys_intern_init|5.006001||Vu SYSTEM_GMTIME_MAX|5.011000||Viu SYSTEM_GMTIME_MIN|5.011000||Viu SYSTEM_LOCALTIME_MAX|5.011000||Viu SYSTEM_LOCALTIME_MIN|5.011000||Viu sys_term|||cnu TAIL|5.005000||Viu TAIL_t8|5.035004||Viu TAIL_t8_p8|5.033003||Viu TAIL_t8_pb|5.033003||Viu TAIL_tb|5.035004||Viu TAIL_tb_p8|5.033003||Viu TAIL_tb_pb|5.033003||Viu TAINT|5.004000||Viu taint_env|5.003007|5.003007|u TAINT_ENV|5.003007||Viu TAINT_get|5.017006||Viu TAINT_IF|5.003007||Viu TAINTING_get|5.017006||Viu TAINTING_set|5.017006||Viu TAINT_NOT|5.003007||Viu taint_proper|5.003007|5.003007|u TAINT_PROPER|5.003007||Viu TAINT_set|5.017006||Viu TAINT_WARN_get|5.017006||Viu TAINT_WARN_set|5.017006||Viu TARG|5.003007|5.003007| TARGi|5.023005||Viu TARGn|5.023005||Viu TARGu|5.023005||Viu telldir|5.005000||Viu T_FMT|5.027010||Viu T_FMT_AMPM|5.027010||Viu THIS|5.003007|5.003007|V THOUSEP|5.027010||Viu THR|5.005000||Viu THREAD_CREATE_NEEDS_STACK|5.007002||Viu thread_locale_init|5.027009|5.027009|xnu thread_locale_term|5.027009|5.027009|xnu THREAD_RET_TYPE|5.005000||Viu tied_method|5.013009||vViu TIED_METHOD_ARGUMENTS_ON_STACK|5.013009||Viu TIED_METHOD_MORTALIZE_NOT_NEEDED|5.013009||Viu TIED_METHOD_SAY|5.013009||Viu times|5.005000||Viu Time_t|5.003007|5.003007|Vn Timeval|5.004000|5.004000|Vn TM|5.011000||Viu tmpfile|5.003007||Viu tmpnam|5.005000||Viu TMPNAM_R_PROTO|5.008000|5.008000|Vn tmps_grow_p|5.021005||cViu to_byte_substr|5.008000||Viu to_case_cp_list|5.035004||Viu toCTRL|5.004000||Viu toFOLD|5.019001|5.019001| toFOLD_A|5.019001|5.019001| _to_fold_latin1|5.015005||cVniu toFOLD_LC|5.019001||Viu toFOLD_uni|5.007003||Viu toFOLD_utf8|5.031005|5.031005| toFOLD_utf8_safe|5.025009|5.006000|p toFOLD_uvchr|5.023009|5.006000|p TO_INTERNAL_SIZE|5.023002||Viu tokenize_use|5.009003||Viu tokeq|5.005000||Viu tokereport|5.007001||Viu toLOWER|5.003007|5.003007| toLOWER_A|5.019001|5.019001| toLOWER_L1|5.019001|5.019001| toLOWER_LATIN1|5.013006|5.011002| to_lower_latin1|5.015005||Vniu toLOWER_LC|5.004000|5.004000| toLOWER_uni|5.006000||Viu toLOWER_utf8|5.031005|5.031005| toLOWER_utf8_safe|5.025009|5.006000|p toLOWER_uvchr|5.023009|5.006000|p too_few_arguments_pv|5.016000||Viu TOO_LATE_FOR|5.008001||Viu too_many_arguments_pv|5.016000||Viu TOPi|5.003007||Viu TOPl|5.003007||Viu TOPm1s|5.007001||Viu TOPMARK|5.003007||cViu TOPn|5.003007||Viu TOPp1s|5.007001||Viu TOPp|5.003007||Viu TOPpx|5.005003||Viu TOPs|5.003007||Viu TOPu|5.004000||Viu TOPul|5.006000||Viu toTITLE|5.019001|5.019001| toTITLE_A|5.019001|5.019001| toTITLE_uni|5.006000||Viu toTITLE_utf8|5.031005|5.031005| toTITLE_utf8_safe|5.025009|5.006000|p toTITLE_uvchr|5.023009|5.006000|p to_uni_fold|5.014000||cVu _to_uni_fold_flags|5.014000||cVu to_uni_lower|5.006000||cVu to_uni_title|5.006000||cVu to_uni_upper|5.006000||cVu toUPPER|5.003007|5.003007| toUPPER_A|5.019001|5.019001| toUPPER_LATIN1_MOD|5.011002||Viu toUPPER_LC|5.004000||Viu _to_upper_title_latin1|5.015005||Viu toUPPER_uni|5.006000||Viu toUPPER_utf8|5.031005|5.031005| toUPPER_utf8_safe|5.025009|5.006000|p toUPPER_uvchr|5.023009|5.006000|p _to_utf8_case|5.023006||Viu _to_utf8_fold_flags|5.014000||cVu _to_utf8_lower_flags|5.015006||cVu to_utf8_substr|5.008000||Viu _to_utf8_title_flags|5.015006||cVu _to_utf8_upper_flags|5.015006||cVu translate_substr_offsets|5.015006||Vniu traverse_op_tree|5.029008||Vi TR_DELETE|5.031006||Viu TRIE|5.009002||Viu TRIE_BITMAP|5.009004||Viu TRIE_BITMAP_BYTE|5.009004||Viu TRIE_BITMAP_CLEAR|5.009004||Viu TRIE_BITMAP_SET|5.009004||Viu TRIE_BITMAP_TEST|5.009004||Viu TRIEC|5.009004||Viu TRIE_CHARCOUNT|5.009004||Viu TRIEC_t8|5.035004||Viu TRIEC_t8_p8|5.033003||Viu TRIEC_t8_pb|5.033003||Viu TRIEC_tb|5.035004||Viu TRIEC_tb_p8|5.033003||Viu TRIEC_tb_pb|5.033003||Viu TRIE_next|5.009005||Viu TRIE_next_fail|5.009005||Viu TRIE_next_fail_t8|5.035004||Viu TRIE_next_fail_t8_p8|5.033003||Viu TRIE_next_fail_t8_pb|5.033003||Viu TRIE_next_fail_tb|5.035004||Viu TRIE_next_fail_tb_p8|5.033003||Viu TRIE_next_fail_tb_pb|5.033003||Viu TRIE_next_t8|5.035004||Viu TRIE_next_t8_p8|5.033003||Viu TRIE_next_t8_pb|5.033003||Viu TRIE_next_tb|5.035004||Viu TRIE_next_tb_p8|5.033003||Viu TRIE_next_tb_pb|5.033003||Viu TRIE_NODEIDX|5.009002||Viu TRIE_NODENUM|5.009002||Viu TRIE_t8|5.035004||Viu TRIE_t8_p8|5.033003||Viu TRIE_t8_pb|5.033003||Viu TRIE_tb|5.035004||Viu TRIE_tb_p8|5.033003||Viu TRIE_tb_pb|5.033003||Viu TRIE_WORDS_OFFSET|5.009005||Viu TR_OOB|5.031006||Viu TR_R_EMPTY|5.031006||Viu TR_SPECIAL_HANDLING|5.031006||Viu TRUE|5.003007||Viu truncate|5.006000||Viu TR_UNLISTED|5.031006||Viu TR_UNMAPPED|5.031006||Viu try_amagic_bin|||ciu tryAMAGICbin_MG|5.013002||Viu try_amagic_un|||ciu tryAMAGICunDEREF|5.006000||Viu tryAMAGICun_MG|5.013002||Viu tryAMAGICunTARGETlist|5.017002||Viu TS_W32_BROKEN_LOCALECONV|5.027010||Viu tTHX|5.009003||Viu ttyname|5.009000||Viu TTYNAME_R_PROTO|5.008000|5.008000|Vn turkic_fc|5.029008||Viu turkic_lc|5.029008||Viu turkic_uc|5.029008||Viu TWO_BYTE_UTF8_TO_NATIVE|5.019004||Viu TWO_BYTE_UTF8_TO_UNI|5.013008||Viu TYPE_CHARS|5.004000||Viu TYPE_DIGITS|5.004000||Viu U16|5.027001||Viu U16_MAX|5.003007||Viu U16_MIN|5.003007||Viu U16SIZE|5.006000|5.006000|Vn U16TYPE|5.006000|5.006000|Vn U_32|5.007002|5.007002| U32|5.027001||Viu U32_ALIGNMENT_REQUIRED|5.007001|5.007001|Vn U32_MAX|5.003007||Viu U32_MAX_P1|5.007002||Viu U32_MAX_P1_HALF|5.007002||Viu U32_MIN|5.003007||Viu U32SIZE|5.006000|5.006000|Vn U32TYPE|5.006000|5.006000|Vn U64|5.023002||Viu U64SIZE|5.006000|5.006000|Vn U64TYPE|5.006000|5.006000|Vn U8|5.027001||Viu U8_MAX|5.003007||Viu U8_MIN|5.003007||Viu U8SIZE|5.006000|5.006000|Vn U8TO16_LE|5.017010||Viu U8TO32_LE|5.017010||Viu U8TO64_LE|5.017006||Viu U8TYPE|5.006000|5.006000|Vn UCHARAT|5.003007||Viu U_I|5.003007||Viu Uid_t|5.003007|5.003007|Vn Uid_t_f|5.006000|5.006000|Vn Uid_t_sign|5.006000|5.006000|Vn Uid_t_size|5.006000|5.006000|Vn UINT16_C|5.003007|5.003007| UINT32_C|5.003007|5.003007| UINT32_MIN|5.006000||Viu UINT64_C|5.023002|5.023002| UINT64_MIN|5.006000||Viu UINTMAX_C|5.003007|5.003007| uiv_2buf|5.009003||Vniu U_L|5.003007||Viu umask|5.005000||Viu uname|5.005004||Viu UNDERBAR|5.009002|5.003007|p unexpected_non_continuation_text|5.025006||Viu ungetc|5.003007||Viu UNI_age_values_index|5.029009||Viu UNI_AHEX|5.029002||Viu UNI_ahex_values_index|5.029009||Viu UNI_ALNUM|5.029002||Viu UNI_ALPHA|5.029002||Viu UNI_ALPHABETIC|5.029002||Viu UNI_alpha_values_index|5.029009||Viu UNI_ASCIIHEXDIGIT|5.029002||Viu UNI_BASICLATIN|5.029002||Viu UNI_bc_values_index|5.029009||Viu UNI_bidic_values_index|5.029009||Viu UNI_bidim_values_index|5.029009||Viu UNI_BLANK|5.029002||Viu UNI_blk_values_index|5.029009||Viu UNI_bpt_values_index|5.029009||Viu UNI_cased_values_index|5.029009||Viu UNI_CC|5.029002||Viu UNI_ccc_values_index|5.029009||Viu UNI_ce_values_index|5.029009||Viu UNI_ci_values_index|5.029009||Viu UNI_CNTRL|5.029002||Viu UNICODE_ALLOW_ABOVE_IV_MAX|5.031006||Viu UNICODE_ALLOW_ANY|5.007003||Viu UNICODE_ALLOW_SUPER|5.007003||Viu UNICODE_ALLOW_SURROGATE|5.007003||Viu UNICODE_BYTE_ORDER_MARK|5.008000||Viu UNICODE_DISALLOW_ABOVE_31_BIT|5.023006|5.023006| UNICODE_DISALLOW_ILLEGAL_C9_INTERCHANGE|5.025005|5.025005| UNICODE_DISALLOW_ILLEGAL_INTERCHANGE|5.013009|5.013009| UNICODE_DISALLOW_NONCHAR|5.013009|5.013009| UNICODE_DISALLOW_PERL_EXTENDED|5.027002|5.027002| UNICODE_DISALLOW_SUPER|5.013009|5.013009| UNICODE_DISALLOW_SURROGATE|5.013009|5.013009| UNICODE_DOT_DOT_VERSION|5.023002||Viu UNICODE_DOT_VERSION|5.023002||Viu UNICODE_GOT_NONCHAR|5.027009||Viu UNICODE_GOT_PERL_EXTENDED|5.027009||Viu UNICODE_GOT_SUPER|5.027009||Viu UNICODE_GOT_SURROGATE|5.027009||Viu UNICODE_GREEK_CAPITAL_LETTER_SIGMA|5.007003||Viu UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA|5.007003||Viu UNICODE_GREEK_SMALL_LETTER_SIGMA|5.007003||Viu UNICODE_IS_32_CONTIGUOUS_NONCHARS|5.023006||Viu UNICODE_IS_BYTE_ORDER_MARK|5.007001||Viu UNICODE_IS_END_PLANE_NONCHAR_GIVEN_NOT_SUPER|5.023006||Viu UNICODE_IS_NONCHAR|5.013009|5.013009| UNICODE_IS_PERL_EXTENDED|5.027002||Viu UNICODE_IS_REPLACEMENT|5.007002|5.007002| UNICODE_IS_SUPER|5.013009|5.013009| UNICODE_IS_SURROGATE|5.007001|5.007001| UNICODE_MAJOR_VERSION|5.023002||Viu UNICODE_PAT_MOD|5.013006||Viu UNICODE_PAT_MODS|5.013006||Viu UNICODE_REPLACEMENT|5.007001|5.003007|p UNICODE_SURROGATE_FIRST|5.007001||Viu UNICODE_SURROGATE_LAST|5.007001||Viu UNICODE_WARN_ABOVE_31_BIT|5.023006|5.023006| UNICODE_WARN_ILLEGAL_C9_INTERCHANGE|5.025005|5.025005| UNICODE_WARN_ILLEGAL_INTERCHANGE|5.013009|5.013009| UNICODE_WARN_NONCHAR|5.013009|5.013009| UNICODE_WARN_PERL_EXTENDED|5.027002|5.027002| UNICODE_WARN_SUPER|5.013009|5.013009| UNICODE_WARN_SURROGATE|5.013009|5.013009| UNI_compex_values_index|5.029009||Viu UNI_CONTROL|5.029002||Viu UNI_cwcf_values_index|5.029009||Viu UNI_cwcm_values_index|5.029009||Viu UNI_cwkcf_values_index|5.029009||Viu UNI_cwl_values_index|5.029009||Viu UNI_cwt_values_index|5.029009||Viu UNI_cwu_values_index|5.029009||Viu UNI_dash_values_index|5.029009||Viu UNI_DECIMALNUMBER|5.029002||Viu UNI_dep_values_index|5.029009||Viu UNI_dia_values_index|5.029009||Viu UNI_DIGIT|5.029002||Viu UNI_DISPLAY_BACKSLASH|5.007003|5.007003| UNI_DISPLAY_BACKSPACE|5.031009|5.031009| UNI_DISPLAY_ISPRINT|5.007003|5.007003| UNI_DISPLAY_QQ|5.007003|5.007003| UNI_DISPLAY_REGEX|5.007003|5.007003| UNI_di_values_index|5.029009||Viu UNI_dt_values_index|5.029009||Viu UNI_ea_values_index|5.029009||Viu UNI_ebase_values_index|5.031010||Viu UNI_ecomp_values_index|5.031010||Viu UNI_emod_values_index|5.031010||Viu UNI_emoji_values_index|5.031010||Viu UNI_epres_values_index|5.031010||Viu UNI_extpict_values_index|5.031010||Viu UNI_ext_values_index|5.029009||Viu UNI_gcb_values_index|5.029009||Viu UNI_gc_values_index|5.029009||Viu UNI_GRAPH|5.029002||Viu UNI_grbase_values_index|5.029009||Viu UNI_grext_values_index|5.029009||Viu UNI_HEX|5.029002||Viu UNI_HEXDIGIT|5.029002||Viu UNI_hex_values_index|5.029009||Viu UNI_HORIZSPACE|5.029002||Viu UNI_hst_values_index|5.029009||Viu UNI_HYPHEN|5.029002||Viu UNI_hyphen_values_index|5.029009||Viu UNI_idc_values_index|5.029009||Viu UNI_identifierstatus_values_index|5.031010||Viu UNI_identifiertype_values_index|5.031010||Viu UNI_ideo_values_index|5.029009||Viu UNI_idsb_values_index|5.029009||Viu UNI_idst_values_index|5.029009||Viu UNI_ids_values_index|5.029009||Viu UNI_inpc_values_index|5.029009||Viu UNI_insc_values_index|5.029009||Viu UNI_in_values_index|5.029009||Viu UNI_IS_INVARIANT|5.007001||Viu UNI_jg_values_index|5.029009||Viu UNI_joinc_values_index|5.029009||Viu UNI_jt_values_index|5.029009||Viu UNI_L|5.029002||Viu UNI_L_AMP|5.029002||Viu UNI_LB__SG|5.029002||Viu UNI_lb_values_index|5.029009||Viu UNI_LC|5.029002||Viu UNI_LL|5.029002||Viu UNI_loe_values_index|5.029009||Viu UNI_LOWER|5.029002||Viu UNI_LOWERCASE|5.029002||Viu UNI_lower_values_index|5.029009||Viu UNI_LT|5.029002||Viu UNI_LU|5.029002||Viu UNI_math_values_index|5.029009||Viu UNI_nchar_values_index|5.029009||Viu UNI_ND|5.029002||Viu UNI_nfcqc_values_index|5.029009||Viu UNI_nfdqc_values_index|5.029009||Viu UNI_nfkcqc_values_index|5.029009||Viu UNI_nfkdqc_values_index|5.029009||Viu UNI_nt_values_index|5.029009||Viu UNI_nv_values_index|5.029009||Viu UNI_patsyn_values_index|5.029009||Viu UNI_patws_values_index|5.029009||Viu UNI_pcm_values_index|5.029009||Viu UNI_PERLSPACE|5.029002||Viu UNI_PERLWORD|5.029002||Viu UNI_PRINT|5.029002||Viu UNI_qmark_values_index|5.029009||Viu UNI_radical_values_index|5.029009||Viu UNI_ri_values_index|5.029009||Viu UNI_sb_values_index|5.029009||Viu UNI_sc_values_index|5.029009||Viu UNI_scx_values_index|5.029009||Viu UNI_sd_values_index|5.029009||Viu UNISKIP|5.007001||Viu UNISKIP_BY_MSB|5.035004||Viu UNI_SPACE|5.029002||Viu UNI_SPACEPERL|5.029002||Viu UNI_sterm_values_index|5.029009||Viu UNI_term_values_index|5.029009||Viu UNI_TITLECASE|5.029002||Viu UNI_TITLECASELETTER|5.029002||Viu UNI_TO_NATIVE|5.007001|5.003007|p UNI_uideo_values_index|5.029009||Viu UNI_UPPER|5.029002||Viu UNI_UPPERCASE|5.029002||Viu UNI_upper_values_index|5.029009||Viu UNI_vo_values_index|5.029009||Viu UNI_vs_values_index|5.029009||Viu UNI_wb_values_index|5.029009||Viu UNI_WHITESPACE|5.029002||Viu UNI_WORD|5.029002||Viu UNI_WSPACE|5.029002||Viu UNI_wspace_values_index|5.029009||Viu UNI_XDIGIT|5.029002||Viu UNI_xidc_values_index|5.029009||Viu UNI_xids_values_index|5.029009||Viu UNI_XPERLSPACE|5.029002||Viu UNKNOWN_ERRNO_MSG|5.019007||Viu UNLESSM|5.003007||Viu UNLESSM_t8|5.035004||Viu UNLESSM_t8_p8|5.033003||Viu UNLESSM_t8_pb|5.033003||Viu UNLESSM_tb|5.035004||Viu UNLESSM_tb_p8|5.033003||Viu UNLESSM_tb_pb|5.033003||Viu UNLIKELY|5.009004|5.003007|p UNLINK|5.003007||Viu unlink|5.005000||Viu unlnk|5.003007||cVu UNLOCK_DOLLARZERO_MUTEX|5.008001||Viu UNLOCK_LC_NUMERIC_STANDARD|5.021010||poVnu UNLOCK_NUMERIC_STANDARD|||piu UNOP_AUX_item_sv|5.021007||Viu unpack_rec|5.008001||Viu unpack_str|5.007003|5.007003|d unpackstring|5.008001|5.008001| unpackWARN1|5.007003||Viu unpackWARN2|5.007003||Viu unpackWARN3|5.007003||Viu unpackWARN4|5.007003||Viu unreferenced_to_tmp_stack|5.013002||Viu unshare_hek|5.004000||Viu unshare_hek_or_pvn|5.008000||Viu unsharepvn|5.003007|5.003007|u unwind_handler_stack|5.009003||Viu update_debugger_info|5.009005||Viu upg_version|5.009005|5.009005| UPG_VERSION|5.019008||Viu uproot_SV|||Viu Uquad_t|5.006000|5.006000|Vn U_S|5.003007||Viu usage|5.005000||Viu USE_64_BIT_ALL|5.006000|5.006000|Vn USE_64_BIT_INT|5.006000|5.006000|Vn USE_64_BIT_RAWIO|5.006000||Viu USE_64_BIT_STDIO|5.006000||Viu USE_BSDPGRP|5.003007||Viu USE_C_BACKTRACE|5.035009|5.035009|Vn USE_DYNAMIC_LOADING|5.003007|5.003007|Vn USE_ENVIRON_ARRAY|5.007001||Viu USE_GRENT_BUFFER|5.008000||Viu USE_GRENT_FPTR|5.008000||Viu USE_GRENT_PTR|5.008000||Viu USE_HASH_SEED|5.008001||Viu USE_HOSTENT_BUFFER|5.008000||Viu USE_HOSTENT_ERRNO|5.008000||Viu USE_HOSTENT_PTR|5.008000||Viu USE_ITHREADS|5.010000|5.010000|Vn USE_LARGE_FILES|5.006000|5.006000|Vn USE_LEFT|5.004000||Viu USE_LOCALE|5.004000||Viu USE_LOCALE_ADDRESS|5.027009||Viu USE_LOCALE_COLLATE|5.004000||Viu USE_LOCALE_CTYPE|5.004000||Viu USE_LOCALE_IDENTIFICATION|5.027009||Viu USE_LOCALE_MEASUREMENT|5.027009||Viu USE_LOCALE_MESSAGES|5.019002||Viu USE_LOCALE_MONETARY|5.019002||Viu USE_LOCALE_NUMERIC|5.004000||Viu USE_LOCALE_PAPER|5.027009||Viu USE_LOCALE_SYNTAX|5.033001||Viu USE_LOCALE_TELEPHONE|5.027009||Viu USE_LOCALE_TIME|5.021002||Viu USE_LOCALE_TOD|5.033001||Viu USEMYBINMODE|5.006000||Viu USE_NETENT_BUFFER|5.008000||Viu USE_NETENT_ERRNO|5.008000||Viu USE_NETENT_PTR|5.008000||Viu USE_PERL_ATOF|5.008000||Viu USE_PERLIO|5.007001|5.007001|Vn USE_PERL_PERTURB_KEYS|5.018000||Viu USE_POSIX_2008_LOCALE|5.027003||Viu USE_PROTOENT_BUFFER|5.008000||Viu USE_PROTOENT_PTR|5.008000||Viu USE_PWENT_BUFFER|5.008000||Viu USE_PWENT_FPTR|5.008000||Viu USE_PWENT_PTR|5.008000||Viu USE_REENTRANT_API|5.007003||Viu USER_PROP_MUTEX_INIT|5.029008||Viu USER_PROP_MUTEX_LOCK|5.029008||Viu USER_PROP_MUTEX_TERM|5.029008||Viu USER_PROP_MUTEX_UNLOCK|5.029008||Viu USE_SEMCTL_SEMID_DS|5.004005|5.004005|Vn USE_SEMCTL_SEMUN|5.004005|5.004005|Vn USE_SERVENT_BUFFER|5.008000||Viu USE_SERVENT_PTR|5.008000||Viu USE_SPENT_BUFFER|5.031011||Viu USE_SPENT_PTR|5.008000||Viu USE_STAT_BLOCKS|5.005003|5.005003|Vn USE_STAT_RDEV|5.003007||Viu USE_STDIO|5.003007||Viu USE_STDIO_BASE|5.006000|5.006000|Vn USE_STDIO_PTR|5.006000|5.006000|Vn USE_SYSTEM_GMTIME|5.011000||Viu USE_SYSTEM_LOCALTIME|5.011000||Viu USE_THREADS|5.006000|5.006000|Vn USE_THREAD_SAFE_LOCALE|5.025004||Viu USE_TM64|5.011000||Viu USE_UTF8_IN_NAMES|5.007003||Viu utf16_textfilter|5.011001||Viu utf16_to_utf8|5.035004||cViu utf16_to_utf8_base|5.035004||cViu utf16_to_utf8_reversed|5.035004||cViu UTF8_ACCUMULATE|5.007001||Viu UTF8_ALLOW_ANY|5.007001||Viu UTF8_ALLOW_ANYUV|5.007001||Viu UTF8_ALLOW_CONTINUATION|5.007001||Viu UTF8_ALLOW_DEFAULT|5.009004||Viu UTF8_ALLOW_EMPTY|5.007001||Viu UTF8_ALLOW_FE_FF|5.027009||Viu UTF8_ALLOW_FFFF|5.007001||Viu UTF8_ALLOW_LONG|5.007001||Viu UTF8_ALLOW_LONG_AND_ITS_VALUE|5.025009||Viu UTF8_ALLOW_NON_CONTINUATION|5.007001||Viu UTF8_ALLOW_OVERFLOW|5.025009||Viu UTF8_ALLOW_SHORT|5.007001||Viu UTF8_ALLOW_SURROGATE|5.007001||Viu UTF8_CHECK_ONLY|5.007001|5.007001| UTF8_CHK_SKIP|5.031006|5.006000|p UTF8_DISALLOW_ABOVE_31_BIT|5.023006||Viu UTF8_DISALLOW_FE_FF|5.013009||Viu UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE|5.025005|5.025005| UTF8_DISALLOW_ILLEGAL_INTERCHANGE|5.013009|5.013009| UTF8_DISALLOW_NONCHAR|5.013009|5.013009| UTF8_DISALLOW_PERL_EXTENDED|5.027002|5.027002| UTF8_DISALLOW_SUPER|5.013009|5.013009| UTF8_DISALLOW_SURROGATE|5.013009|5.013009| utf8_distance|5.006000|5.006000| UTF8_EIGHT_BIT_HI|5.007001||Viu UTF8_EIGHT_BIT_LO|5.007001||Viu UTF8f|5.019001|5.003007|p UTF8fARG|5.019002|5.003007|p UTF8_GOT_ABOVE_31_BIT|5.025006||Viu UTF8_GOT_CONTINUATION|5.025006|5.025006| UTF8_GOT_EMPTY|5.025006|5.025006| UTF8_GOT_LONG|5.025006|5.025006| UTF8_GOT_NONCHAR|5.025006|5.025006| UTF8_GOT_NON_CONTINUATION|5.025006|5.025006| UTF8_GOT_OVERFLOW|5.025006|5.025006| UTF8_GOT_PERL_EXTENDED|5.027002|5.027002| UTF8_GOT_SHORT|5.025006|5.025006| UTF8_GOT_SUPER|5.025006|5.025006| UTF8_GOT_SURROGATE|5.025006|5.025006| utf8_hop|5.006000|5.006000|n utf8_hop_back|5.025007|5.025007|n utf8_hop_forward|5.025007|5.025007|n utf8_hop_safe|5.025007|5.025007|n UTF8_IS_ABOVE_LATIN1|5.017004||Viu UTF8_IS_ABOVE_LATIN1_START|5.023003||Viu UTF8_IS_CONTINUATION|5.007001||Viu UTF8_IS_CONTINUED|5.007001||Viu UTF8_IS_DOWNGRADEABLE_START|5.007001||Viu UTF8_IS_INVARIANT|5.007001|5.003007|p UTF8_IS_NEXT_CHAR_DOWNGRADEABLE|5.017006||Viu UTF8_IS_NONCHAR|5.023002|5.023002| UTF8_IS_NONCHAR_GIVEN_THAT_NON_SUPER_AND_GE_PROBLEMATIC|5.013009||Viu UTF8_IS_PERL_EXTENDED|5.035004||Viu UTF8_IS_REPLACEMENT||| UTF8_IS_START|5.007001||Viu UTF8_IS_START_base|5.031007||Viu UTF8_IS_SUPER|5.023002|5.023002| UTF8_IS_SURROGATE|5.023002|5.023002| utf8_length|5.007001|5.007001| UTF8_MAXBYTES|5.009002|5.006000|p UTF8_MAXBYTES_CASE|5.009002|5.003007|p UTF8_MAX_FOLD_CHAR_EXPAND|5.013009||Viu UTF8_MAXLEN|5.006000||Viu utf8_mg_len_cache_update|5.013003||Viu utf8_mg_pos_cache_update|5.009004||Viu utf8n_to_uvchr|5.007001|5.007001|n utf8n_to_uvchr_error|5.025006|5.025006|n utf8n_to_uvchr_msgs|5.027009|5.027009|n _utf8n_to_uvchr_msgs_helper|5.029001||cVnu utf8n_to_uvuni|5.007001||dcV UTF8_SAFE_SKIP|5.029009|5.006000|p UTF8SKIP|5.006000|5.006000| UTF8_SKIP|5.023002|5.006000|p utf8_to_bytes|5.006001|5.006001|x utf8_to_utf16|5.035004||Viu utf8_to_utf16_base|5.035004||xcViu utf8_to_utf16_reversed|5.035004||Viu utf8_to_uvchr|5.007001|5.006001|pd utf8_to_uvchr_buf|5.015009|5.006001|p utf8_to_uvchr_buf_helper|5.031004||cVu utf8_to_uvuni|5.007001||dcV utf8_to_uvuni_buf|5.015009||dcV UTF8_TWO_BYTE_HI|5.011002||Viu UTF8_TWO_BYTE_HI_nocast|5.011002||Viu UTF8_TWO_BYTE_LO|5.011002||Viu UTF8_TWO_BYTE_LO_nocast|5.011002||Viu UTF8_WARN_ABOVE_31_BIT|5.023006||Viu UTF8_WARN_FE_FF|5.013009||Viu UTF8_WARN_ILLEGAL_C9_INTERCHANGE|5.025005|5.025005| UTF8_WARN_ILLEGAL_INTERCHANGE|5.013009|5.013009| UTF8_WARN_NONCHAR|5.013009|5.013009| UTF8_WARN_PERL_EXTENDED|5.027002|5.027002| UTF8_WARN_SUPER|5.013009|5.013009| UTF8_WARN_SURROGATE|5.013009|5.013009| UTF_ACCUMULATION_SHIFT|5.007001||Viu UTF_CONTINUATION_BYTE_INFO_BITS|5.035004||Viu UTF_CONTINUATION_MARK|5.007001||Viu UTF_CONTINUATION_MASK|5.007001||Viu UTF_EBCDIC_CONTINUATION_BYTE_INFO_BITS|5.035004||Viu UTF_FIRST_CONT_BYTE_110000|5.035004||Viu UTF_FIRST_CONT_BYTE|5.035004||Viu UTF_IS_CONTINUATION_MASK|5.023006||Viu UTF_MIN_ABOVE_LATIN1_BYTE|5.031006||Viu UTF_MIN_CONTINUATION_BYTE|5.035004||Viu UTF_MIN_START_BYTE|5.031006||Viu UTF_START_BYTE_110000|5.035004||Viu UTF_START_BYTE|5.035004||Viu UTF_START_MARK|5.007001||Viu UTF_START_MASK|5.007001||Viu UTF_TO_NATIVE|5.007001||Viu utilize|5.003007||Viu utime|5.005000||Viu U_V|5.006000|5.003007| UVCHR_IS_INVARIANT|5.019004|5.003007|p UVCHR_SKIP|5.022000|5.003007|p uvchr_to_utf8|5.007001|5.007001| uvchr_to_utf8_flags|5.007003|5.007003| uvchr_to_utf8_flags_msgs|5.027009|5.027009| UV_DIG|5.006000||Viu UVf|5.010000|5.010000|d UV_IS_QUAD|5.006000||Viu UV_MAX|5.003007|5.003007| UV_MAX_P1|5.007002||Viu UV_MAX_P1_HALF|5.007002||Viu UV_MIN|5.003007|5.003007| UVof|5.006000|5.003007|poVn uvoffuni_to_utf8_flags|5.027009||cV uvoffuni_to_utf8_flags_msgs|5.027009||cVu UVSIZE|5.006000|5.003007|poVn UVTYPE|5.006000|5.003007|poVn UVuf|5.006000|5.003007|poVn uvuni_to_utf8|5.019004||cVu uvuni_to_utf8_flags|5.007003||dcV UVxf|5.006000|5.003007|poVn UVXf|5.007001|5.007001|poVn VAL_EAGAIN|5.003007|5.003007|Vn validate_proto|5.019002||xcVi validate_suid|||iu valid_utf8_to_uvchr|5.015009||cVn valid_utf8_to_uvuni|5.015009||dcVu VAL_O_NONBLOCK|5.003007|5.003007|Vn variant_byte_number|5.031004||cVnu variant_under_utf8_count|5.027007||Vni varname|5.009003||Viu vcmp|5.009000|5.009000| VCMP|5.019008||Viu vcroak|5.006000|5.006000| vdeb|5.007003|5.007003|u VERB|5.009005||Viu VERB_t8|5.035004||Viu VERB_t8_p8|5.033003||Viu VERB_t8_pb|5.033003||Viu VERB_tb|5.035004||Viu VERB_tb_p8|5.033003||Viu VERB_tb_pb|5.033003||Viu vform|5.006000|5.006000| vfprintf|5.003007||Viu visit|5.005000||Viu vivify_defelem|5.004000||cViu vivify_ref|5.004000||Viu vload_module|5.006000|5.003007|p vmess|5.006000|5.004000|p vnewSVpvf|5.006000|5.004000|p vnormal|5.009002|5.009002| VNORMAL|5.019008||Viu vnumify|5.009000|5.009000| VNUMIFY|5.019008||Viu voidnonfinal|5.035002||Viu VOL|5.003007||Viu vstringify|5.009000|5.009000| VSTRINGIFY|5.019008||Viu VTBL_amagic|5.005003||Viu VTBL_amagicelem|5.005003||Viu VTBL_arylen|5.005003||Viu VTBL_bm|5.005003||Viu VTBL_collxfrm|5.005003||Viu VTBL_dbline|5.005003||Viu VTBL_defelem|5.005003||Viu VTBL_env|5.005003||Viu VTBL_envelem|5.005003||Viu VTBL_fm|5.005003||Viu VTBL_glob|5.005003||Viu VTBL_isa|5.005003||Viu VTBL_isaelem|5.005003||Viu VTBL_mglob|5.005003||Viu VTBL_nkeys|5.005003||Viu VTBL_pack|5.005003||Viu VTBL_packelem|5.005003||Viu VTBL_pos|5.005003||Viu VTBL_regdata|5.006000||Viu VTBL_regdatum|5.006000||Viu VTBL_regexp|5.005003||Viu VTBL_sigelem|5.005003||Viu VTBL_substr|5.005003||Viu VTBL_sv|5.005003||Viu VTBL_taint|5.005003||Viu VTBL_uvar|5.005003||Viu VTBL_vec|5.005003||Viu vTHX|5.006000||Viu VT_NATIVE|5.021004||Viu vtohl|5.003007||Viu vtohs|5.003007||Viu VUTIL_REPLACE_CORE|5.019008||Viu vverify|5.009003|5.009003| VVERIFY|5.019008||Viu vwarn|5.006000|5.003007| vwarner|5.006000|5.004000|p wait4pid|5.003007||Viu wait|5.005000||Viu want_vtbl_bm|5.015000||Viu want_vtbl_fm|5.015000||Viu warn|5.003007||vV WARN_ALL|5.006000|5.003007|p WARN_ALLstring|5.006000||Viu WARN_AMBIGUOUS|5.006000|5.003007|p WARN_ASSERTIONS||5.003007|ponu WARN_BAREWORD|5.006000|5.003007|p WARN_CLOSED|5.006000|5.003007|p WARN_CLOSURE|5.006000|5.003007|p WARN_DEBUGGING|5.006000|5.003007|p WARN_DEPRECATED|5.006000|5.003007|p WARN_DIGIT|5.006000|5.003007|p warner|5.006000||pvV warner_nocontext|5.006000||vVn WARN_EXEC|5.006000|5.003007|p WARN_EXITING|5.006000|5.003007|p WARN_EXPERIMENTAL|5.017004|5.017004| WARN_EXPERIMENTAL__ALPHA_ASSERTIONS|5.027009|5.027009| WARN_EXPERIMENTAL__ARGS_ARRAY_WITH_SIGNATURES|5.035009|5.035009| WARN_EXPERIMENTAL__BITWISE|5.021009|5.021009| WARN_EXPERIMENTAL__BUILTIN|5.035009|5.035009| WARN_EXPERIMENTAL__CONST_ATTR|5.021008|5.021008| WARN_EXPERIMENTAL__DECLARED_REFS|5.025003|5.025003| WARN_EXPERIMENTAL__DEFER|5.035004|5.035004| WARN_EXPERIMENTAL__FOR_LIST|5.035005|5.035005| WARN_EXPERIMENTAL__ISA|5.031007|5.031007| WARN_EXPERIMENTAL__LEXICAL_SUBS|5.017005|5.017005| WARN_EXPERIMENTAL__POSTDEREF|5.019005|5.019005| WARN_EXPERIMENTAL__PRIVATE_USE|5.029009|5.029009| WARN_EXPERIMENTAL__REFALIASING|5.021005|5.021005| WARN_EXPERIMENTAL__REGEX_SETS|5.017008|5.017008| WARN_EXPERIMENTAL__RE_STRICT|5.021008|5.021008| WARN_EXPERIMENTAL__SCRIPT_RUN|5.027008|5.027008| WARN_EXPERIMENTAL__SIGNATURES|5.019009|5.019009| WARN_EXPERIMENTAL__SMARTMATCH|5.017011|5.017011| WARN_EXPERIMENTAL__TRY|5.033007|5.033007| WARN_EXPERIMENTAL__UNIPROP_WILDCARDS|5.029009|5.029009| WARN_EXPERIMENTAL__VLB|5.029009|5.029009| WARN_GLOB|5.006000|5.003007|p WARN_ILLEGALPROTO|5.011004|5.011004| WARN_IMPRECISION|5.011000|5.011000| WARN_INPLACE|5.006000|5.003007|p WARN_INTERNAL|5.006000|5.003007|p WARN_IO|5.006000|5.003007|p WARN_LAYER|5.008000|5.003007|p WARN_LOCALE|5.021006|5.021006| WARN_MALLOC|5.006000|5.003007|p WARN_MISC|5.006000|5.003007|p WARN_MISSING|5.021002|5.021002| WARN_NEWLINE|5.006000|5.003007|p warn_nocontext|5.006000||pvVn WARN_NONCHAR|5.013010|5.013010| WARN_NONEstring|5.006000||Viu WARN_NON_UNICODE|5.013010|5.013010| WARN_NUMERIC|5.006000|5.003007|p WARN_ONCE|5.006000|5.003007|p warn_on_first_deprecated_use|5.025009||Viu WARN_OVERFLOW|5.006000|5.003007|p WARN_PACK|5.006000|5.003007|p WARN_PARENTHESIS|5.006000|5.003007|p WARN_PIPE|5.006000|5.003007|p WARN_PORTABLE|5.006000|5.003007|p WARN_PRECEDENCE|5.006000|5.003007|p WARN_PRINTF|5.006000|5.003007|p _warn_problematic_locale|5.021008||cVniu WARN_PROTOTYPE|5.006000|5.003007|p WARN_QW|5.006000|5.003007|p WARN_RECURSION|5.006000|5.003007|p WARN_REDEFINE|5.006000|5.003007|p WARN_REDUNDANT|5.021002|5.021002| WARN_REGEXP|5.006000|5.003007|p WARN_RESERVED|5.006000|5.003007|p WARN_SEMICOLON|5.006000|5.003007|p WARN_SEVERE|5.006000|5.003007|p WARN_SHADOW|5.027007|5.027007| WARNshift|5.011001||Viu WARN_SIGNAL|5.006000|5.003007|p WARNsize|5.006000||Viu WARN_SUBSTR|5.006000|5.003007|p WARN_SURROGATE|5.013010|5.013010| warn_sv|5.013001|5.003007|p WARN_SYNTAX|5.006000|5.003007|p WARN_SYSCALLS|5.019004|5.019004| WARN_TAINT|5.006000|5.003007|p WARN_THREADS|5.008000|5.003007|p WARN_UNINITIALIZED|5.006000|5.003007|p WARN_UNOPENED|5.006000|5.003007|p WARN_UNPACK|5.006000|5.003007|p WARN_UNTIE|5.006000|5.003007|p WARN_UTF8|5.006000|5.003007|p WARN_VOID|5.006000|5.003007|p was_lvalue_sub|||ciu watch|5.003007||Viu WB_BREAKABLE|5.023008||Viu WB_DQ_then_HL|5.023008||Viu WB_Ex_or_FO_or_ZWJ_then_foo|5.025003||Viu WB_HL_then_DQ|5.023008||Viu WB_hs_then_hs|5.023008||Viu WB_LE_or_HL_then_MB_or_ML_or_SQ|5.023008||Viu WB_MB_or_ML_or_SQ_then_LE_or_HL|5.023008||Viu WB_MB_or_MN_or_SQ_then_NU|5.023008||Viu WB_NOBREAK|5.023008||Viu WB_NU_then_MB_or_MN_or_SQ|5.023008||Viu WB_RI_then_RI|5.025003||Viu WCTOMB_LOCK|5.033005||Viu WCTOMB_UNLOCK|5.033005||Viu what_MULTI_CHAR_FOLD_latin1_safe|5.033005||Viu what_MULTI_CHAR_FOLD_utf8_safe|5.033005||Viu what_MULTI_CHAR_FOLD_utf8_safe_part0|5.033005||Viu what_MULTI_CHAR_FOLD_utf8_safe_part1|5.033005||Viu what_MULTI_CHAR_FOLD_utf8_safe_part2|5.033005||Viu what_MULTI_CHAR_FOLD_utf8_safe_part3|5.033005||Viu what_MULTI_CHAR_FOLD_utf8_safe_part4|5.033005||Viu what_MULTI_CHAR_FOLD_utf8_safe_part5|5.033005||Viu what_MULTI_CHAR_FOLD_utf8_safe_part6|5.033005||Viu what_MULTI_CHAR_FOLD_utf8_safe_part7|5.033005||Viu whichsig|5.003007|5.003007| whichsig_pv|5.015004|5.015004| whichsig_pvn|5.015004|5.015004| whichsig_sv|5.015004|5.015004| WHILEM|5.003007||Viu WHILEM_A_max|5.009005||Viu WHILEM_A_max_fail|5.009005||Viu WHILEM_A_max_fail_t8|5.035004||Viu WHILEM_A_max_fail_t8_p8|5.033003||Viu WHILEM_A_max_fail_t8_pb|5.033003||Viu WHILEM_A_max_fail_tb|5.035004||Viu WHILEM_A_max_fail_tb_p8|5.033003||Viu WHILEM_A_max_fail_tb_pb|5.033003||Viu WHILEM_A_max_t8|5.035004||Viu WHILEM_A_max_t8_p8|5.033003||Viu WHILEM_A_max_t8_pb|5.033003||Viu WHILEM_A_max_tb|5.035004||Viu WHILEM_A_max_tb_p8|5.033003||Viu WHILEM_A_max_tb_pb|5.033003||Viu WHILEM_A_min|5.009005||Viu WHILEM_A_min_fail|5.009005||Viu WHILEM_A_min_fail_t8|5.035004||Viu WHILEM_A_min_fail_t8_p8|5.033003||Viu WHILEM_A_min_fail_t8_pb|5.033003||Viu WHILEM_A_min_fail_tb|5.035004||Viu WHILEM_A_min_fail_tb_p8|5.033003||Viu WHILEM_A_min_fail_tb_pb|5.033003||Viu WHILEM_A_min_t8|5.035004||Viu WHILEM_A_min_t8_p8|5.033003||Viu WHILEM_A_min_t8_pb|5.033003||Viu WHILEM_A_min_tb|5.035004||Viu WHILEM_A_min_tb_p8|5.033003||Viu WHILEM_A_min_tb_pb|5.033003||Viu WHILEM_A_pre|5.009005||Viu WHILEM_A_pre_fail|5.009005||Viu WHILEM_A_pre_fail_t8|5.035004||Viu WHILEM_A_pre_fail_t8_p8|5.033003||Viu WHILEM_A_pre_fail_t8_pb|5.033003||Viu WHILEM_A_pre_fail_tb|5.035004||Viu WHILEM_A_pre_fail_tb_p8|5.033003||Viu WHILEM_A_pre_fail_tb_pb|5.033003||Viu WHILEM_A_pre_t8|5.035004||Viu WHILEM_A_pre_t8_p8|5.033003||Viu WHILEM_A_pre_t8_pb|5.033003||Viu WHILEM_A_pre_tb|5.035004||Viu WHILEM_A_pre_tb_p8|5.033003||Viu WHILEM_A_pre_tb_pb|5.033003||Viu WHILEM_B_max|5.009005||Viu WHILEM_B_max_fail|5.009005||Viu WHILEM_B_max_fail_t8|5.035004||Viu WHILEM_B_max_fail_t8_p8|5.033003||Viu WHILEM_B_max_fail_t8_pb|5.033003||Viu WHILEM_B_max_fail_tb|5.035004||Viu WHILEM_B_max_fail_tb_p8|5.033003||Viu WHILEM_B_max_fail_tb_pb|5.033003||Viu WHILEM_B_max_t8|5.035004||Viu WHILEM_B_max_t8_p8|5.033003||Viu WHILEM_B_max_t8_pb|5.033003||Viu WHILEM_B_max_tb|5.035004||Viu WHILEM_B_max_tb_p8|5.033003||Viu WHILEM_B_max_tb_pb|5.033003||Viu WHILEM_B_min|5.009005||Viu WHILEM_B_min_fail|5.009005||Viu WHILEM_B_min_fail_t8|5.035004||Viu WHILEM_B_min_fail_t8_p8|5.033003||Viu WHILEM_B_min_fail_t8_pb|5.033003||Viu WHILEM_B_min_fail_tb|5.035004||Viu WHILEM_B_min_fail_tb_p8|5.033003||Viu WHILEM_B_min_fail_tb_pb|5.033003||Viu WHILEM_B_min_t8|5.035004||Viu WHILEM_B_min_t8_p8|5.033003||Viu WHILEM_B_min_t8_pb|5.033003||Viu WHILEM_B_min_tb|5.035004||Viu WHILEM_B_min_tb_p8|5.033003||Viu WHILEM_B_min_tb_pb|5.033003||Viu WHILEM_t8|5.035004||Viu WHILEM_t8_p8|5.033003||Viu WHILEM_t8_pb|5.033003||Viu WHILEM_tb|5.035004||Viu WHILEM_tb_p8|5.033003||Viu WHILEM_tb_pb|5.033003||Viu WIDEST_UTYPE|5.015004|5.003007|poVnu win32_croak_not_implemented|5.017006||Vniu WIN32SCK_IS_STDSCK|5.007001||Viu win32_setlocale|5.027006||Viu withinCOUNT|5.031004||Viu withinCOUNT_KNOWN_VALID|5.033005||Viu WITH_LC_NUMERIC_SET_TO_NEEDED|5.031003|5.031003| WITH_LC_NUMERIC_SET_TO_NEEDED_IN|5.031003|5.031003| with_queued_errors|5.013001||Viu with_tp_UTF8ness|5.033003||Viu with_t_UTF8ness|5.035004||Viu wrap_keyword_plugin|5.027006|5.027006|x wrap_op_checker|5.015008|5.015008| write|5.005000||Viu write_to_stderr|5.008001||Viu XCPT_CATCH|5.009002|5.003007|p XCPT_RETHROW|5.009002|5.003007|p XCPT_TRY_END|5.009002|5.003007|p XCPT_TRY_START|5.009002|5.003007|p XDIGIT_VALUE|5.019008||Viu xio_any|5.006001||Viu xio_dirp|5.006001||Viu xiv_iv|5.009003||Viu xlv_targoff|5.019004||Viu XopDISABLE|5.013007|5.013007|V XOPd_xop_class|5.013007||Viu XOPd_xop_desc|5.013007||Viu XOPd_xop_name|5.013007||Viu XOPd_xop_peep|5.013007||Viu XopENABLE|5.013007|5.013007|V XopENTRY|5.013007|5.013007|V XopENTRYCUSTOM|5.019006|5.013007|V XopENTRY_set|5.013007|5.013007|V XopFLAGS|5.013007|5.013007| XOPf_xop_class|5.013007||Viu XOPf_xop_desc|5.013007||Viu XOPf_xop_name|5.013007||Viu XOPf_xop_peep|5.013007||Viu XORSHIFT128_set|5.027001||Viu XORSHIFT96_set|5.027001||Viu XPUSHi|5.003007|5.003007| XPUSHmortal|5.009002|5.003007|p XPUSHn|5.006000|5.003007| XPUSHp|5.003007|5.003007| XPUSHs|5.003007|5.003007| XPUSHTARG|5.003007||Viu XPUSHu|5.004000|5.003007|p XPUSHundef|5.006000||Viu xpv_len|5.017006||Viu XS|5.003007|5.003007|Vu XSANY|5.003007||Viu XS_APIVERSION_BOOTCHECK|5.013004|5.013004| XS_APIVERSION_POPMARK_BOOTCHECK|5.021006||Viu XS_APIVERSION_SETXSUBFN_POPMARK_BOOTCHECK|5.021006||Viu xs_boot_epilog|5.021006||cViu XS_BOTHVERSION_BOOTCHECK|5.021006||Viu XS_BOTHVERSION_POPMARK_BOOTCHECK|5.021006||Viu XS_BOTHVERSION_SETXSUBFN_POPMARK_BOOTCHECK|5.021006||Viu XS_DYNAMIC_FILENAME|5.009004||Viu XS_EXTERNAL|5.015002|5.015002|Vu xs_handshake|||vcniu XSINTERFACE_CVT|5.005000||Viu XSINTERFACE_CVT_ANON|5.010000||Viu XSINTERFACE_FUNC|5.005000||Viu XSINTERFACE_FUNC_SET|5.005000||Viu XS_INTERNAL|5.015002|5.015002|Vu XSprePUSH|5.006000|5.003007|poVnu XSPROTO|5.010000|5.003007|pVu XSRETURN|5.003007|5.003007|p XSRETURN_EMPTY|5.003007|5.003007| XSRETURN_IV|5.003007|5.003007| XSRETURN_NO|5.003007|5.003007| XSRETURN_NV|5.006000|5.003007| XSRETURN_PV|5.003007|5.003007| XSRETURN_PVN|5.006000||Viu XSRETURN_UNDEF|5.003007|5.003007| XSRETURN_UV|5.008001|5.003007|p XSRETURN_YES|5.003007|5.003007| XS_SETXSUBFN_POPMARK|5.021006||Viu XST_mIV|5.003007|5.003007| XST_mNO|5.003007|5.003007| XST_mNV|5.006000|5.003007| XST_mPV|5.003007|5.003007| XST_mPVN|5.006000||Viu XST_mUNDEF|5.003007|5.003007| XST_mUV|5.008001|5.003007|p XST_mYES|5.003007|5.003007| XS_VERSION|5.003007|5.003007| XS_VERSION_BOOTCHECK|5.003007|5.003007| xs_version_bootcheck|||iu XTENDED_PAT_MOD|5.009005||Viu xuv_uv|5.009003||Viu YESEXPR|5.027010||Viu YESSTR|5.027010||Viu YIELD|5.005000||Viu YYDEBUG|5.025006||Viu YYEMPTY|5.009005||Viu yyerror|5.003007||Viu yyerror_pv|5.016000||Viu yyerror_pvn|5.016000||Viu yylex|5.003007||cViu yyparse|5.003007||Viu yyquit|5.025010||Viu YYSTYPE_IS_DECLARED|5.009001||Viu YYSTYPE_IS_TRIVIAL|5.009001||Viu YYTOKENTYPE|5.009001||Viu yyunlex|5.013005||Viu yywarn|5.003007||Viu ZAPHOD32_FINALIZE|5.027001||Viu ZAPHOD32_MIX|5.027001||Viu ZAPHOD32_SCRAMBLE32|5.027001||Viu ZAPHOD32_STATIC_INLINE|5.027001||Viu ZAPHOD32_WARN2|5.027001||Viu ZAPHOD32_WARN3|5.027001||Viu ZAPHOD32_WARN4|5.027001||Viu ZAPHOD32_WARN5|5.027001||Viu ZAPHOD32_WARN6|5.027001||Viu Zero|5.003007|5.003007| ZeroD|5.009002|5.003007|p ); if (exists $opt{'list-unsupported'}) { my $f; for $f (sort dictionary_order keys %API) { next if $API{$f}{core_only}; next if $API{$f}{beyond_depr}; next if $API{$f}{inaccessible}; next if $API{$f}{experimental}; next unless $API{$f}{todo}; next if int_parse_version($API{$f}{todo}) <= $int_min_perl; my $repeat = 40 - length($f); $repeat = 0 if $repeat < 0; print "$f ", '.'x $repeat, " ", format_version($API{$f}{todo}), "\n"; } exit 0; } # Scan for hints, possible replacement candidates, etc. my(%replace, %need, %hints, %warnings, %depends); my $replace = 0; my($hint, $define, $function); sub find_api { BEGIN { 'warnings'->unimport('uninitialized') if "$]" > '5.006' } my $code = shift; $code =~ s{ / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*) | "[^"\\]*(?:\\.[^"\\]*)*" | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx; grep { exists $API{$_} } $code =~ /(\w+)/mg; } while () { if ($hint) { # Here, we are in the middle of accumulating a hint or warning. my $end_of_hint = 0; # A line containing a comment end marker closes the hint. Remove that # marker for processing below. if (s/\s*$rcce(.*?)\s*$//) { die "Nothing can follow the end of comment in '$_'\n" if length $1 > 0; $end_of_hint = 1; } # Set $h to the hash of which type. my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings; # Ignore any leading and trailing white space, and an optional star comment # continuation marker, then place the meat of the line into $1 m/^\s*(?:\*\s*)?(.*?)\s*$/; # Add the meat of this line to the hash value of each API element it # applies to for (@{$hint->[1]}) { $h->{$_} ||= ''; # avoid the warning older perls generate $h->{$_} .= "$1\n"; } # If the line had a comment close, we are through with this hint undef $hint if $end_of_hint; next; } # Set up $hint if this is the beginning of a Hint: or Warning: # These are from a multi-line C comment in the file, with the first line # looking like (a space has been inserted because this file can't have C # comment markers in it): # / * Warning: PL_expect, PL_copline, PL_rsfp # # $hint becomes # [ # 'Warning', # [ # 'PL_expect', # 'PL_copline', # 'PL_rsfp', # ], # ] if (m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$}) { $hint = [$1, [split /,?\s+/, $2]]; next; } if ($define) { # If in the middle of a definition... # append a continuation line ending with backslash. if ($define->[1] =~ /\\$/) { $define->[1] .= $_; } else { # Otherwise this line ends the definition, make foo depend on bar # (and what bar depends on) if its not one of ppp's own constructs if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) { my @n = find_api($define->[1]); push @{$depends{$define->[0]}}, @n if @n } undef $define; } } # For '#define foo bar' or '#define foo(a,b,c) bar', $define becomes a # reference to [ foo, bar ] $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+)\)}; # Set $replace to the number given for lines that look like # / * Replace: \d+ * / # Thus setting it to 1 starts a region where replacements are automatically # done, and setting it to 0 ends that region. $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$}; # Add bar => foo to %replace for lines like '#define foo bar in a region # where $replace is non-zero $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)}; # Add bar => foo to %replace for lines like '#define foo bar / * Replace * / $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce}; # Add foo => bar to %replace for lines like / * Replace foo with bar * / $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+.*?)\s+$rcce\s*$}; # For lines like / * foo, bar depends on baz, bat * / # create a list of the elements on the rhs, and make that list apply to each # element in the lhs, which becomes a key in \%depends. 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 %seen; $_ = [sort dictionary_order grep !$seen{$_}++, @$_]; } if (exists $opt{'api-info'}) { my $f; my $count = 0; my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$"; # Sort the names, and split into two classes; one for things that are part of # the API; a second for things that aren't. my @ok_to_use; my @shouldnt_use; for $f (sort dictionary_order keys %API) { next unless $f =~ /$match/; my $base = int_parse_version($API{$f}{base}) if $API{$f}{base}; if ($base && ! $API{$f}{inaccessible} && ! $API{$f}{core_only}) { push @ok_to_use, $f; } else { push @shouldnt_use, $f; } } # We normally suppress non-API items. But if the search matched no API # items, output the non-ones. This allows someone to get the info for an # item if they ask for it specifically enough, but doesn't normally clutter # the output with irrelevant results. @ok_to_use = @shouldnt_use unless @ok_to_use; for $f (@ok_to_use) { print "\n=== $f ===\n"; my $info = 0; my $base; $base = int_parse_version($API{$f}{base}) if $API{$f}{base}; my $todo; $todo = int_parse_version($API{$f}{todo}) if $API{$f}{todo}; # Output information if ($base) { my $with_or= ""; if ( $base <= $int_min_perl || ( (! $API{$f}{provided} && ! $todo) || ($todo && $todo >= $base))) { $with_or= " with or"; } my $Supported = ($API{$f}{undocumented}) ? 'Available' : 'Supported'; print "\n$Supported at least since perl-", format_version($base), ",$with_or without $ppport."; if ($API{$f}{unverified}) { print "\nThis information is based on inspection of the source code", " and has not been\n", "verified by successful compilation."; } print "\n"; $info++; } if ($API{$f}{provided} || $todo) { print "\nThis is only supported by $ppport, and NOT by perl versions going forward.\n" unless $base; if ($todo) { if (! $base || $todo < $base) { my $additionally = ""; $additionally .= " additionally" if $base; print "$ppport$additionally provides support at least back to perl-", format_version($todo), ".\n"; } } elsif (! $base || $base > $int_min_perl) { if (exists $depends{$f}) { my $max = 0; for (@{$depends{$f}}) { $max = int_parse_version($API{$_}{todo}) if $API{$_}{todo} && $API{$_}{todo} > $max; # XXX What to assume unspecified values are? This effectively makes them MIN_PERL } $todo = $max if $max; } print "\n$ppport provides support for this, but ironically, does not", " currently know,\n", "for this report, the minimum version it supports for this"; if ($API{$f}{undocumented}) { print " and many things\n", "it provides that are implemented as macros and aren't", " documented. You can\n", "help by submitting a documentation patch"; } print ".\n"; if ($todo) { if ($todo <= $int_min_perl) { print "It may very well be supported all the way back to ", format_version(5.003_07), ".\n"; } else { print "But given the things $f depends on, it's a good", " guess that it isn't\n", "supported prior to ", format_version($todo), ".\n"; } } } } if ($API{$f}{provided}) { print "Support needs to be explicitly requested by #define NEED_$f\n", "(or #define NEED_${f}_GLOBAL).\n" if exists $need{$f}; $info++; } if ($base || ! $API{$f}{ppport_fnc}) { my $email = "Send email to perl5-porters\@perl.org if you need to have this functionality.\n"; if ($API{$f}{inaccessible}) { print "\nThis is not part of the public API, and may not even be accessible to XS code.\n"; $info++; } elsif ($API{$f}{core_only}) { print "\nThis is not part of the public API, and should not be used by XS code.\n"; $info++; } elsif ($API{$f}{deprecated}) { print "\nThis is deprecated and should not be used. Convert existing uses.\n"; $info++; } elsif ($API{$f}{experimental}) { print "\nThe API for this is unstable and should not be used by XS code.\n", $email; $info++; } elsif ($API{$f}{undocumented}) { print "\nSince this is undocumented, the API should be considered unstable.\n"; if ($API{$f}{provided}) { print "Consider bringing this up on the list: perl5-porters\@perl.org.\n"; } else { print "It may be that this is not intended for XS use, or it may just be\n", "that no one has gotten around to documenting it.\n", $email; } $info++; } unless ($info) { print "No portability information available. Check your spelling; or", " this could be\na bug in Devel::PPPort. To report an issue:\n", "https://github.com/Dual-Life/Devel-PPPort/issues/new\n"; } } print "\nDepends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f}; if (exists $hints{$f} || exists $warnings{$f}) { print "\n$hints{$f}" if exists $hints{$f}; print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f}; $info++; } $count++; } $count or print "\nFound no API matching '$opt{'api-info'}'."; print "\n"; exit 0; } if (exists $opt{'list-provided'}) { my $f; for $f (sort dictionary_order 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} || int_parse_version($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} && int_parse_version($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 dictionary_order 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 dictionary_order keys %{$file{uses_replace}}) { warning("Uses $func instead of $replace{$func}"); $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); } for $func (sort dictionary_order 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) || 0); } unless ($opt{quiet}) { for $func (sort dictionary_order keys %{$file{uses_todo}}) { next if int_parse_version($API{$func}{todo}) <= $int_min_perl; print "*** WARNING: Uses $func, which may not be portable below perl ", format_version($API{$func}{todo}), ", even with '$ppport'\n"; $warnings++; } } for $func (sort dictionary_order 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 dictionary_order 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 dictionary_order 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 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 || 0; } 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) #define D_PPP_RELEASE_DATE 1693785600 /* 2023-09-04 */ #if ! defined(PERL_REVISION) && ! defined(PERL_VERSION_MAJOR) # if ! defined(__PATCHLEVEL_H_INCLUDED__) \ && ! ( defined(PATCHLEVEL) && defined(SUBVERSION)) # define PERL_PATCHLEVEL_H_IMPLICIT # include # endif # if ! defined(PERL_VERSION) \ && ! defined(PERL_VERSION_MAJOR) \ && ( ! defined(SUBVERSION) || ! defined(PATCHLEVEL) ) # include # endif #endif #ifdef PERL_VERSION_MAJOR # define D_PPP_MAJOR PERL_VERSION_MAJOR #elif defined(PERL_REVISION) # define D_PPP_MAJOR PERL_REVISION #else # define D_PPP_MAJOR 5 #endif #ifdef PERL_VERSION_MINOR # define D_PPP_MINOR PERL_VERSION_MINOR #elif defined(PERL_VERSION) # define D_PPP_MINOR PERL_VERSION #elif defined(PATCHLEVEL) # define D_PPP_MINOR PATCHLEVEL # define PERL_VERSION PATCHLEVEL /* back-compat */ #else # error Could not find a source for PERL_VERSION_MINOR #endif #ifdef PERL_VERSION_PATCH # define D_PPP_PATCH PERL_VERSION_PATCH #elif defined(PERL_SUBVERSION) # define D_PPP_PATCH PERL_SUBVERSION #elif defined(SUBVERSION) # define D_PPP_PATCH SUBVERSION # define PERL_SUBVERSION SUBVERSION /* back-compat */ #else # error Could not find a source for PERL_VERSION_PATCH #endif #if D_PPP_MAJOR < 5 || D_PPP_MAJOR == 6 # error Devel::PPPort works only on Perl 5, Perl 7, ... #elif D_PPP_MAJOR != 5 /* Perl 7 and above: the old forms are deprecated, set up so that they * assume Perl 5, and will make this look like 5.201.201. * * 201 is used so will be well above anything that would come from a 5 * series if we unexpectedly have to continue it, but still gives plenty of * room, up to 255, of numbers that will fit into a byte in case there is * something else unforeseen */ # undef PERL_REVISION # undef PERL_VERSION # undef PERL_SUBVERSION # define D_PPP_REVISION 5 # define D_PPP_VERSION 201 # define D_PPP_SUBVERSION 201 # if (defined(__clang__) /* _Pragma here doesn't work with gcc */ \ && ( (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) \ || defined(_STDC_C99) \ || defined(__c99))) # define D_PPP_STRINGIFY(x) #x # define D_PPP_deprecate(xyz) _Pragma(D_PPP_STRINGIFY(GCC warning(D_PPP_STRINGIFY(xyz) " is deprecated"))) # define PERL_REVISION (D_PPP_REVISION D_PPP_deprecate(PERL_REVISION)) # define PERL_VERSION (D_PPP_REVISION D_PPP_deprecate(PERL_VERSION)) # define PERL_SUBVERSION (D_PPP_SUBVERSION D_PPP_deprecate(PERL_SUBVERSION)) # else # define PERL_REVISION D_PPP_REVISION # define PERL_VERSION D_PPP_REVISION # define PERL_SUBVERSION D_PPP_SUBVERSION # endif #endif /* Warning: PERL_PATCHLEVEL PATCHLEVEL SUBVERSION PERL_REVISION PERL_VERSION * PERL_SUBVERSION PERL_BCDVERSION * * You should be using PERL_VERSION_xy(maj,min,ptch) instead of this, where xy * is one of EQ, NE, LE, GT, LT, GE */ /* Replace PERL_PATCHLEVEL with PERL_VERSION_xy(5,a,b) (where xy is EQ,LT,GT...) */ /* Replace PATCHLEVEL with PERL_VERSION_xy(5,a,b) (where xy is EQ,LT,GT...) */ /* Replace SUBVERSION with PERL_VERSION_xy(5,a,b) (where xy is EQ,LT,GT...) */ /* Replace PERL_REVISION with PERL_VERSION_xy(a,b,c) (where xy is EQ,LT,GT...) */ /* Replace PERL_VERSION with PERL_VERSION_xy(5,a,b) (where xy is EQ,LT,GT...) */ /* Replace PERL_SUBVERSION with PERL_VERSION_xy(5,a,b) (where xy is EQ,LT,GT...) */ /* Replace PERL_BCDVERSION with PERL_VERSION_xy(5,a,b) (where xy is EQ,LT,GT...) */ #define D_PPP_DEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10)) #define D_PPP_JNP_TO_BCD(j,n,p) ((D_PPP_DEC2BCD(j)<<24)|(D_PPP_DEC2BCD(n)<<12)|D_PPP_DEC2BCD(p)) #define PERL_BCDVERSION D_PPP_JNP_TO_BCD(D_PPP_MAJOR, \ D_PPP_MINOR, \ D_PPP_PATCH) /* These differ from the versions outside D:P in using PERL_BCDVERSION instead * of PERL_DECIMAL_VERSION. The formats printing in this module assume BCD, so * always use it */ #undef PERL_VERSION_EQ #undef PERL_VERSION_NE #undef PERL_VERSION_LT #undef PERL_VERSION_GE #undef PERL_VERSION_LE #undef PERL_VERSION_GT /* N.B. These don't work if the patch number is 42 or 92, as those are what '*' * is in ASCII and EBCDIC respectively */ #ifndef PERL_VERSION_EQ # define PERL_VERSION_EQ(j,n,p) \ (((p) == '*') ? ( (j) == D_PPP_MAJOR \ && (n) == D_PPP_MINOR) \ : (PERL_BCDVERSION == D_PPP_JNP_TO_BCD(j,n,p))) #endif #ifndef PERL_VERSION_NE # define PERL_VERSION_NE(j,n,p) (! PERL_VERSION_EQ(j,n,p)) #endif #ifndef PERL_VERSION_LT # define PERL_VERSION_LT(j,n,p) /* p=='*' means _LT(j,n,0) */ \ (PERL_BCDVERSION < D_PPP_JNP_TO_BCD( (j), \ (n), \ (((p) == '*') ? 0 : (p)))) #endif #ifndef PERL_VERSION_GE # define PERL_VERSION_GE(j,n,p) (! PERL_VERSION_LT(j,n,p)) #endif #ifndef PERL_VERSION_LE # define PERL_VERSION_LE(j,n,p) /* p=='*' means _LE(j,n,999) */ \ (PERL_BCDVERSION <= D_PPP_JNP_TO_BCD( (j), \ (n), \ (((p) == '*') ? 999 : (p)))) #endif #ifndef PERL_VERSION_GT # define PERL_VERSION_GT(j,n,p) (! PERL_VERSION_LE(j,n,p)) #endif #ifndef dTHR # define dTHR dNOOP #endif #ifndef dTHX # define dTHX dNOOP #endif /* Hint: dTHX For pre-5.6.0 thread compatibility, instead use dTHXR, available only through ppport.h */ #ifndef dTHXa # define dTHXa(x) dNOOP #endif #ifndef pTHX # define pTHX void #endif #ifndef pTHX_ # define pTHX_ #endif #ifndef aTHX # define aTHX #endif /* Hint: aTHX For pre-5.6.0 thread compatibility, instead use aTHXR, available only through ppport.h */ #ifndef aTHX_ # define aTHX_ #endif /* Hint: aTHX_ For pre-5.6.0 thread compatibility, instead use aTHXR_, available only through ppport.h */ #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 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_Xpv Xpv # 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 # define PL_mess_sv mess_sv /* 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 it, 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 #if (PERL_BCDVERSION <= 0x5003022) # undef start_subparse # if (PERL_BCDVERSION < 0x5003022) #ifndef start_subparse # define start_subparse(a, b) Perl_start_subparse() #endif # else #ifndef start_subparse # define start_subparse(a, b) Perl_start_subparse(b) #endif # endif #if (PERL_BCDVERSION < 0x5003007) foo #endif #endif /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005) /* And before that, we need to make sure this gets compiled for the functions * that rely on it */ #define NEED_newCONSTSUB #if defined(NEED_newCONSTSUB) static CV * DPPP_(my_newCONSTSUB)(HV * stash, const char * name, SV * sv); static #else extern CV * 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 CV * DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv) { CV *cv; 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; cv = newSUB( start_subparse(FALSE, 0), 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; return cv; } #endif #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 #if defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L #ifndef PERL_STATIC_INLINE # define PERL_STATIC_INLINE static inline #endif #else #ifndef PERL_STATIC_INLINE # define PERL_STATIC_INLINE static #endif #endif /* work around a stack alignment bug in 32-bit GCC on Windows */ #if defined(WIN32) && !defined(WIN64) && defined(__GNUC__) #ifndef PERL_STACK_REALIGN # define PERL_STACK_REALIGN __attribute__((force_align_arg_pointer)) #endif #else #ifndef PERL_STACK_REALIGN # define PERL_STACK_REALIGN #endif #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 #if defined(DEBUGGING) && !defined(__COVERITY__) #ifndef __ASSERT_ # define __ASSERT_(statement) assert(statement), #endif #else #ifndef __ASSERT_ # define __ASSERT_(statement) #endif #endif #ifndef __has_builtin # define __has_builtin(x) 0 #endif #if __has_builtin(__builtin_unreachable) # define D_PPP_HAS_BUILTIN_UNREACHABLE #elif (defined(__GNUC__) && ( __GNUC__ > 4 \ || __GNUC__ == 4 && __GNUC_MINOR__ >= 5)) # define D_PPP_HAS_BUILTIN_UNREACHABLE #endif #ifndef ASSUME # ifdef DEBUGGING # define ASSUME(x) assert(x) # elif defined(_MSC_VER) # define ASSUME(x) __assume(x) # elif defined(__ARMCC_VERSION) # define ASSUME(x) __promise(x) # elif defined(D_PPP_HAS_BUILTIN_UNREACHABLE) # define ASSUME(x) ((x) ? (void) 0 : __builtin_unreachable()) # else # define ASSUME(x) assert(x) # endif #endif #ifndef NOT_REACHED # ifdef D_PPP_HAS_BUILTIN_UNREACHABLE # define NOT_REACHED \ STMT_START { \ ASSUME(!"UNREACHABLE"); __builtin_unreachable(); \ } STMT_END # elif ! defined(__GNUC__) && (defined(__sun) || defined(__hpux)) # define NOT_REACHED # else # define NOT_REACHED ASSUME(!"UNREACHABLE") # endif #endif #ifndef WIDEST_UTYPE # ifdef QUADKIND # ifdef U64TYPE # define WIDEST_UTYPE U64TYPE # else # define WIDEST_UTYPE unsigned Quad_t # endif # else # define WIDEST_UTYPE U32 # endif #endif /* These could become provided if/when they become part of the public API */ #ifndef withinCOUNT # define withinCOUNT(c, l, n) \ (((WIDEST_UTYPE) (((c)) - ((l) | 0))) <= (((WIDEST_UTYPE) ((n) | 0)))) #endif #ifndef inRANGE # define inRANGE(c, l, u) \ ( (sizeof(c) == sizeof(U8)) ? withinCOUNT(((U8) (c)), (l), ((u) - (l))) \ : (sizeof(c) == sizeof(U32)) ? withinCOUNT(((U32) (c)), (l), ((u) - (l))) \ : (withinCOUNT(((WIDEST_UTYPE) (c)), (l), ((u) - (l))))) #endif /* The '| 0' part ensures a compiler error if c is not integer (like e.g., a * pointer) */ #undef FITS_IN_8_BITS /* handy.h version uses a core-only constant */ #ifndef FITS_IN_8_BITS # define FITS_IN_8_BITS(c) ( (sizeof(c) == 1) \ || !(((WIDEST_UTYPE)((c) | 0)) & ~0xFF)) #endif /* Create the macro for "is'macro'_utf8_safe(s, e)". For code points below * 256, it calls the equivalent _L1 macro by converting the UTF-8 to code * point. That is so that it can automatically get the bug fixes done in this * file. */ #define D_PPP_IS_GENERIC_UTF8_SAFE(s, e, macro) \ (((e) - (s)) <= 0 \ ? 0 \ : UTF8_IS_INVARIANT((s)[0]) \ ? is ## macro ## _L1((s)[0]) \ : (((e) - (s)) < UTF8SKIP(s)) \ ? 0 \ : UTF8_IS_DOWNGRADEABLE_START((s)[0]) \ /* The cast in the line below is only to silence warnings */ \ ? is ## macro ## _L1((WIDEST_UTYPE) LATIN1_TO_NATIVE( \ UTF8_ACCUMULATE(NATIVE_UTF8_TO_I8((s)[0]) \ & UTF_START_MASK(2), \ (s)[1]))) \ : is ## macro ## _utf8(s)) /* Create the macro for "is'macro'_LC_utf8_safe(s, e)". For code points below * 256, it calls the equivalent _L1 macro by converting the UTF-8 to code * point. That is so that it can automatically get the bug fixes done in this * file. */ #define D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, macro) \ (((e) - (s)) <= 0 \ ? 0 \ : UTF8_IS_INVARIANT((s)[0]) \ ? is ## macro ## _LC((s)[0]) \ : (((e) - (s)) < UTF8SKIP(s)) \ ? 0 \ : UTF8_IS_DOWNGRADEABLE_START((s)[0]) \ /* The cast in the line below is only to silence warnings */ \ ? is ## macro ## _LC((WIDEST_UTYPE) LATIN1_TO_NATIVE( \ UTF8_ACCUMULATE(NATIVE_UTF8_TO_I8((s)[0]) \ & UTF_START_MASK(2), \ (s)[1]))) \ : is ## macro ## _utf8(s)) /* A few of the early functions are broken. For these and the non-LC case, * machine generated code is substituted. But that code doesn't work for * locales. This is just like the above macro, but at the end, we call the * macro we've generated for the above 255 case, which is correct since locale * isn't involved. This will generate extra code to handle the 0-255 inputs, * but hopefully it will be optimized out by the C compiler. But just in case * it isn't, this macro is only used on the few versions that are broken */ #define D_PPP_IS_GENERIC_LC_UTF8_SAFE_BROKEN(s, e, macro) \ (((e) - (s)) <= 0 \ ? 0 \ : UTF8_IS_INVARIANT((s)[0]) \ ? is ## macro ## _LC((s)[0]) \ : (((e) - (s)) < UTF8SKIP(s)) \ ? 0 \ : UTF8_IS_DOWNGRADEABLE_START((s)[0]) \ /* The cast in the line below is only to silence warnings */ \ ? is ## macro ## _LC((WIDEST_UTYPE) LATIN1_TO_NATIVE( \ UTF8_ACCUMULATE(NATIVE_UTF8_TO_I8((s)[0]) \ & UTF_START_MASK(2), \ (s)[1]))) \ : is ## macro ## _utf8_safe(s, e)) #ifndef SvRX # define SvRX(rv) (SvROK((rv)) ? (SvMAGICAL(SvRV((rv))) ? (mg_find(SvRV((rv)), PERL_MAGIC_qr) ? mg_find(SvRV((rv)), PERL_MAGIC_qr)->mg_obj : NULL) : NULL) : NULL) #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 #if (PERL_BCDVERSION < 0x5006001) && (PERL_BCDVERSION < 0x5027007) #undef dNOOP #ifndef dNOOP # define dNOOP struct Perl___notused_struct #endif #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 PERL_STACK_OFFSET_DEFINED typedef I32 Stack_off_t; # define Stack_off_t_MAX I32_MAX # define PERL_STACK_OFFSET_DEFINED #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 #ifdef __cplusplus #undef START_EXTERN_C #ifndef START_EXTERN_C # define START_EXTERN_C extern "C" { #endif #undef END_EXTERN_C #ifndef END_EXTERN_C # define END_EXTERN_C } #endif #undef EXTERN_C #ifndef EXTERN_C # define EXTERN_C extern "C" #endif #else #undef START_EXTERN_C #ifndef START_EXTERN_C # define START_EXTERN_C #endif #undef END_EXTERN_C #ifndef END_EXTERN_C # define END_EXTERN_C #endif #undef EXTERN_C #ifndef EXTERN_C # define EXTERN_C extern #endif #endif #if (PERL_BCDVERSION < 0x5004000) || defined(PERL_GCC_PEDANTIC) # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN #ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN # define PERL_GCC_BRACE_GROUPS_FORBIDDEN #endif # endif #endif #if ! defined(__GNUC__) || defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) || defined(__cplusplus) # undef PERL_USE_GCC_BRACE_GROUPS #else # ifndef PERL_USE_GCC_BRACE_GROUPS # define PERL_USE_GCC_BRACE_GROUPS # endif #endif #if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) #undef STMT_START #ifndef STMT_START # define STMT_START if (1) #endif #undef STMT_END #ifndef STMT_END # define STMT_END else (void)0 #endif #else #undef STMT_START #ifndef STMT_START # define STMT_START do #endif #undef STMT_END #ifndef STMT_END # 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 av_tindex # define av_tindex AvFILL #endif #ifndef av_top_index # define av_top_index AvFILL #endif #ifndef av_count # define av_count(av) (AvFILL(av)+1) #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; \ 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 #ifndef XSRETURN # define XSRETURN(off) \ STMT_START { \ PL_stack_sp = PL_stack_base + ax + ((off) - 1); \ return; \ } STMT_END #endif #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 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 /* On versions without NATIVE_TO_ASCII, only ASCII is supported */ #if defined(EBCDIC) && defined(NATIVE_TO_ASCI) #ifndef NATIVE_TO_LATIN1 # define NATIVE_TO_LATIN1(c) NATIVE_TO_ASCII(c) #endif #ifndef LATIN1_TO_NATIVE # define LATIN1_TO_NATIVE(c) ASCII_TO_NATIVE(c) #endif #ifndef NATIVE_TO_UNI # define NATIVE_TO_UNI(c) ((c) > 255 ? (c) : NATIVE_TO_LATIN1(c)) #endif #ifndef UNI_TO_NATIVE # define UNI_TO_NATIVE(c) ((c) > 255 ? (c) : LATIN1_TO_NATIVE(c)) #endif #else #ifndef NATIVE_TO_LATIN1 # define NATIVE_TO_LATIN1(c) (c) #endif #ifndef LATIN1_TO_NATIVE # define LATIN1_TO_NATIVE(c) (c) #endif #ifndef NATIVE_TO_UNI # define NATIVE_TO_UNI(c) (c) #endif #ifndef UNI_TO_NATIVE # define UNI_TO_NATIVE(c) (c) #endif #endif /* Warning: LATIN1_TO_NATIVE, NATIVE_TO_LATIN1 NATIVE_TO_UNI UNI_TO_NATIVE EBCDIC is not supported on versions earlier than 5.7.1 */ /* The meaning of this changed; use the modern version */ #undef isPSXSPC #undef isPSXSPC_A #undef isPSXSPC_L1 /* Hint: isPSXSPC, isPSXSPC_A, isPSXSPC_L1, isPSXSPC_utf8_safe This is equivalent to the corresponding isSPACE-type macro. On perls before 5.18, this matched a vertical tab and SPACE didn't. But the ppport.h SPACE version does match VT in all perl releases. Since VT's are extremely rarely found in real-life files, this difference effectively doesn't matter */ /* Hint: isSPACE, isSPACE_A, isSPACE_L1, isSPACE_utf8_safe Until Perl 5.18, this did not match the vertical tab (VT). The ppport.h version does match it in all perl releases. Since VT's are extremely rarely found in real-life files, this difference effectively doesn't matter */ #ifdef EBCDIC /* This is the first version where these macros are fully correct on EBCDIC * platforms. Relying on the C library functions, as earlier releases did, * causes problems with locales */ # if (PERL_BCDVERSION < 0x5022000) # undef isALNUM # undef isALNUM_A # undef isALNUM_L1 # undef isALNUMC # undef isALNUMC_A # undef isALNUMC_L1 # undef isALPHA # undef isALPHA_A # undef isALPHA_L1 # undef isALPHANUMERIC # undef isALPHANUMERIC_A # undef isALPHANUMERIC_L1 # undef isASCII # undef isASCII_A # undef isASCII_L1 # undef isBLANK # undef isBLANK_A # undef isBLANK_L1 # undef isCNTRL # undef isCNTRL_A # undef isCNTRL_L1 # undef isDIGIT # undef isDIGIT_A # undef isDIGIT_L1 # undef isGRAPH # undef isGRAPH_A # undef isGRAPH_L1 # undef isIDCONT # undef isIDCONT_A # undef isIDCONT_L1 # undef isIDFIRST # undef isIDFIRST_A # undef isIDFIRST_L1 # undef isLOWER # undef isLOWER_A # undef isLOWER_L1 # undef isOCTAL # undef isOCTAL_A # undef isOCTAL_L1 # undef isPRINT # undef isPRINT_A # undef isPRINT_L1 # undef isPUNCT # undef isPUNCT_A # undef isPUNCT_L1 # undef isSPACE # undef isSPACE_A # undef isSPACE_L1 # undef isUPPER # undef isUPPER_A # undef isUPPER_L1 # undef isWORDCHAR # undef isWORDCHAR_A # undef isWORDCHAR_L1 # undef isXDIGIT # undef isXDIGIT_A # undef isXDIGIT_L1 # endif #ifndef isASCII # define isASCII(c) (isCNTRL(c) || isPRINT(c)) #endif /* The below is accurate for all EBCDIC code pages supported by * all the versions of Perl overridden by this */ #ifndef isCNTRL # define isCNTRL(c) ( (c) == '\0' || (c) == '\a' || (c) == '\b' \ || (c) == '\f' || (c) == '\n' || (c) == '\r' \ || (c) == '\t' || (c) == '\v' \ || ((c) <= 3 && (c) >= 1) /* SOH, STX, ETX */ \ || (c) == 7 /* U+7F DEL */ \ || ((c) <= 0x13 && (c) >= 0x0E) /* SO, SI */ \ /* DLE, DC[1-3] */ \ || (c) == 0x18 /* U+18 CAN */ \ || (c) == 0x19 /* U+19 EOM */ \ || ((c) <= 0x1F && (c) >= 0x1C) /* [FGRU]S */ \ || (c) == 0x26 /* U+17 ETB */ \ || (c) == 0x27 /* U+1B ESC */ \ || (c) == 0x2D /* U+05 ENQ */ \ || (c) == 0x2E /* U+06 ACK */ \ || (c) == 0x32 /* U+16 SYN */ \ || (c) == 0x37 /* U+04 EOT */ \ || (c) == 0x3C /* U+14 DC4 */ \ || (c) == 0x3D /* U+15 NAK */ \ || (c) == 0x3F /* U+1A SUB */ \ ) #endif #if '^' == 106 /* EBCDIC POSIX-BC */ # define D_PPP_OUTLIER_CONTROL 0x5F #else /* EBCDIC 1047 037 */ # define D_PPP_OUTLIER_CONTROL 0xFF #endif /* The controls are everything below blank, plus one outlier */ #ifndef isCNTRL_L1 # define isCNTRL_L1(c) ((WIDEST_UTYPE) (c) < ' ' \ || (WIDEST_UTYPE) (c) == D_PPP_OUTLIER_CONTROL) #endif /* The ordering of the tests in this and isUPPER are to exclude most characters * early */ #ifndef isLOWER # define isLOWER(c) ( (c) >= 'a' && (c) <= 'z' \ && ( (c) <= 'i' \ || ((c) >= 'j' && (c) <= 'r') \ || (c) >= 's')) #endif #ifndef isUPPER # define isUPPER(c) ( (c) >= 'A' && (c) <= 'Z' \ && ( (c) <= 'I' \ || ((c) >= 'J' && (c) <= 'R') \ || (c) >= 'S')) #endif #else /* Above is EBCDIC; below is ASCII */ # if (PERL_BCDVERSION < 0x5004000) /* The implementation of these in older perl versions can give wrong results if * the C program locale is set to other than the C locale */ # undef isALNUM # undef isALNUM_A # undef isALPHA # undef isALPHA_A # undef isDIGIT # undef isDIGIT_A # undef isIDFIRST # undef isIDFIRST_A # undef isLOWER # undef isLOWER_A # undef isUPPER # undef isUPPER_A # endif # if (PERL_BCDVERSION == 0x5007000) /* this perl made space GRAPH */ # undef isGRAPH # endif # if (PERL_BCDVERSION < 0x5008000) /* earlier perls omitted DEL */ # undef isCNTRL # endif # if (PERL_BCDVERSION < 0x5010000) /* earlier perls included all of the isSPACE() characters, which is wrong. The * version provided by Devel::PPPort always overrides an existing buggy * version. */ # undef isPRINT # undef isPRINT_A # endif # if (PERL_BCDVERSION < 0x5014000) /* earlier perls always returned true if the parameter was a signed char */ # undef isASCII # undef isASCII_A # endif # if (PERL_BCDVERSION < 0x5017008) /* earlier perls didn't include PILCROW, SECTION SIGN */ # undef isPUNCT_L1 # endif # if (PERL_BCDVERSION < 0x5013007) /* khw didn't investigate why this failed */ # undef isALNUMC_L1 #endif # if (PERL_BCDVERSION < 0x5020000) /* earlier perls didn't include \v */ # undef isSPACE # undef isSPACE_A # undef isSPACE_L1 # endif #ifndef isASCII # define isASCII(c) ((WIDEST_UTYPE) (c) <= 127) #endif #ifndef isCNTRL # define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127) #endif #ifndef isCNTRL_L1 # define isCNTRL_L1(c) ( (WIDEST_UTYPE) (c) < ' ' \ || inRANGE((c), 0x7F, 0x9F)) #endif #ifndef isLOWER # define isLOWER(c) inRANGE((c), 'a', 'z') #endif #ifndef isUPPER # define isUPPER(c) inRANGE((c), 'A', 'Z') #endif #endif /* Below are definitions common to EBCDIC and ASCII */ #ifndef isASCII_L1 # define isASCII_L1(c) isASCII(c) #endif #ifndef isASCII_LC # define isASCII_LC(c) isASCII(c) #endif #ifndef isALNUM # define isALNUM(c) isWORDCHAR(c) #endif #ifndef isALNUMC # define isALNUMC(c) isALPHANUMERIC(c) #endif #ifndef isALNUMC_L1 # define isALNUMC_L1(c) isALPHANUMERIC_L1(c) #endif #ifndef isALPHA # define isALPHA(c) (isUPPER(c) || isLOWER(c)) #endif #ifndef isALPHA_L1 # define isALPHA_L1(c) (isUPPER_L1(c) || isLOWER_L1(c)) #endif #ifndef isALPHANUMERIC # define isALPHANUMERIC(c) (isALPHA(c) || isDIGIT(c)) #endif #ifndef isALPHANUMERIC_L1 # define isALPHANUMERIC_L1(c) (isALPHA_L1(c) || isDIGIT(c)) #endif #ifndef isALPHANUMERIC_LC # define isALPHANUMERIC_LC(c) (isALPHA_LC(c) || isDIGIT_LC(c)) #endif #ifndef isBLANK # define isBLANK(c) ((c) == ' ' || (c) == '\t') #endif #ifndef isBLANK_L1 # define isBLANK_L1(c) ( isBLANK(c) \ || ( FITS_IN_8_BITS(c) \ && NATIVE_TO_LATIN1((U8) c) == 0xA0)) #endif #ifndef isBLANK_LC # define isBLANK_LC(c) isBLANK(c) #endif #ifndef isDIGIT # define isDIGIT(c) inRANGE(c, '0', '9') #endif #ifndef isDIGIT_L1 # define isDIGIT_L1(c) isDIGIT(c) #endif #ifndef isGRAPH # define isGRAPH(c) (isWORDCHAR(c) || isPUNCT(c)) #endif #ifndef isGRAPH_L1 # define isGRAPH_L1(c) ( isPRINT_L1(c) \ && (c) != ' ' \ && NATIVE_TO_LATIN1((U8) c) != 0xA0) #endif #ifndef isIDCONT # define isIDCONT(c) isWORDCHAR(c) #endif #ifndef isIDCONT_L1 # define isIDCONT_L1(c) isWORDCHAR_L1(c) #endif #ifndef isIDCONT_LC # define isIDCONT_LC(c) isWORDCHAR_LC(c) #endif #ifndef isIDFIRST # define isIDFIRST(c) (isALPHA(c) || (c) == '_') #endif #ifndef isIDFIRST_L1 # define isIDFIRST_L1(c) (isALPHA_L1(c) || (U8) (c) == '_') #endif #ifndef isIDFIRST_LC # define isIDFIRST_LC(c) (isALPHA_LC(c) || (U8) (c) == '_') #endif #ifndef isLOWER_L1 # define isLOWER_L1(c) ( isLOWER(c) \ || ( FITS_IN_8_BITS(c) \ && ( ( NATIVE_TO_LATIN1((U8) c) >= 0xDF \ && NATIVE_TO_LATIN1((U8) c) != 0xF7) \ || NATIVE_TO_LATIN1((U8) c) == 0xAA \ || NATIVE_TO_LATIN1((U8) c) == 0xBA \ || NATIVE_TO_LATIN1((U8) c) == 0xB5))) #endif #ifndef isOCTAL # define isOCTAL(c) (((WIDEST_UTYPE)((c)) & ~7) == '0') #endif #ifndef isOCTAL_L1 # define isOCTAL_L1(c) isOCTAL(c) #endif #ifndef isPRINT # define isPRINT(c) (isGRAPH(c) || (c) == ' ') #endif #ifndef isPRINT_L1 # define isPRINT_L1(c) (FITS_IN_8_BITS(c) && ! isCNTRL_L1(c)) #endif #ifndef isPSXSPC # define isPSXSPC(c) isSPACE(c) #endif #ifndef isPSXSPC_L1 # define isPSXSPC_L1(c) isSPACE_L1(c) #endif #ifndef isPUNCT # define isPUNCT(c) ( (c) == '-' || (c) == '!' || (c) == '"' \ || (c) == '#' || (c) == '$' || (c) == '%' \ || (c) == '&' || (c) == '\'' || (c) == '(' \ || (c) == ')' || (c) == '*' || (c) == '+' \ || (c) == ',' || (c) == '.' || (c) == '/' \ || (c) == ':' || (c) == ';' || (c) == '<' \ || (c) == '=' || (c) == '>' || (c) == '?' \ || (c) == '@' || (c) == '[' || (c) == '\\' \ || (c) == ']' || (c) == '^' || (c) == '_' \ || (c) == '`' || (c) == '{' || (c) == '|' \ || (c) == '}' || (c) == '~') #endif #ifndef isPUNCT_L1 # define isPUNCT_L1(c) ( isPUNCT(c) \ || ( FITS_IN_8_BITS(c) \ && ( NATIVE_TO_LATIN1((U8) c) == 0xA1 \ || NATIVE_TO_LATIN1((U8) c) == 0xA7 \ || NATIVE_TO_LATIN1((U8) c) == 0xAB \ || NATIVE_TO_LATIN1((U8) c) == 0xB6 \ || NATIVE_TO_LATIN1((U8) c) == 0xB7 \ || NATIVE_TO_LATIN1((U8) c) == 0xBB \ || NATIVE_TO_LATIN1((U8) c) == 0xBF))) #endif #ifndef isSPACE # define isSPACE(c) ( isBLANK(c) || (c) == '\n' || (c) == '\r' \ || (c) == '\v' || (c) == '\f') #endif #ifndef isSPACE_L1 # define isSPACE_L1(c) ( isSPACE(c) \ || (FITS_IN_8_BITS(c) \ && ( NATIVE_TO_LATIN1((U8) c) == 0x85 \ || NATIVE_TO_LATIN1((U8) c) == 0xA0))) #endif #ifndef isUPPER_L1 # define isUPPER_L1(c) ( isUPPER(c) \ || (FITS_IN_8_BITS(c) \ && ( NATIVE_TO_LATIN1((U8) c) >= 0xC0 \ && NATIVE_TO_LATIN1((U8) c) <= 0xDE \ && NATIVE_TO_LATIN1((U8) c) != 0xD7))) #endif #ifndef isWORDCHAR # define isWORDCHAR(c) (isALPHANUMERIC(c) || (c) == '_') #endif #ifndef isWORDCHAR_L1 # define isWORDCHAR_L1(c) (isIDFIRST_L1(c) || isDIGIT(c)) #endif #ifndef isWORDCHAR_LC # define isWORDCHAR_LC(c) (isIDFIRST_LC(c) || isDIGIT_LC(c)) #endif #ifndef isXDIGIT # define isXDIGIT(c) ( isDIGIT(c) \ || inRANGE((c), 'a', 'f') \ || inRANGE((c), 'A', 'F')) #endif #ifndef isXDIGIT_L1 # define isXDIGIT_L1(c) isXDIGIT(c) #endif #ifndef isXDIGIT_LC # define isXDIGIT_LC(c) isxdigit(c) #endif #ifndef isALNUM_A # define isALNUM_A(c) isALNUM(c) #endif #ifndef isALNUMC_A # define isALNUMC_A(c) isALNUMC(c) #endif #ifndef isALPHA_A # define isALPHA_A(c) isALPHA(c) #endif #ifndef isALPHANUMERIC_A # define isALPHANUMERIC_A(c) isALPHANUMERIC(c) #endif #ifndef isASCII_A # define isASCII_A(c) isASCII(c) #endif #ifndef isBLANK_A # define isBLANK_A(c) isBLANK(c) #endif #ifndef isCNTRL_A # define isCNTRL_A(c) isCNTRL(c) #endif #ifndef isDIGIT_A # define isDIGIT_A(c) isDIGIT(c) #endif #ifndef isGRAPH_A # define isGRAPH_A(c) isGRAPH(c) #endif #ifndef isIDCONT_A # define isIDCONT_A(c) isIDCONT(c) #endif #ifndef isIDFIRST_A # define isIDFIRST_A(c) isIDFIRST(c) #endif #ifndef isLOWER_A # define isLOWER_A(c) isLOWER(c) #endif #ifndef isOCTAL_A # define isOCTAL_A(c) isOCTAL(c) #endif #ifndef isPRINT_A # define isPRINT_A(c) isPRINT(c) #endif #ifndef isPSXSPC_A # define isPSXSPC_A(c) isPSXSPC(c) #endif #ifndef isPUNCT_A # define isPUNCT_A(c) isPUNCT(c) #endif #ifndef isSPACE_A # define isSPACE_A(c) isSPACE(c) #endif #ifndef isUPPER_A # define isUPPER_A(c) isUPPER(c) #endif #ifndef isWORDCHAR_A # define isWORDCHAR_A(c) isWORDCHAR(c) #endif #ifndef isXDIGIT_A # define isXDIGIT_A(c) isXDIGIT(c) #endif #ifndef isASCII_utf8_safe # define isASCII_utf8_safe(s,e) (((e) - (s)) <= 0 ? 0 : isASCII(*(s))) #endif #ifndef isASCII_uvchr # define isASCII_uvchr(c) (FITS_IN_8_BITS(c) ? isASCII_L1(c) : 0) #endif #if (PERL_BCDVERSION >= 0x5006000) # ifdef isALPHA_uni /* If one defined, all are; this is just an exemplar */ # define D_PPP_is_ctype(upper, lower, c) \ (FITS_IN_8_BITS(c) \ ? is ## upper ## _L1(c) \ : is ## upper ## _uni((UV) (c))) /* _uni is old synonym */ # else # define D_PPP_is_ctype(upper, lower, c) \ (FITS_IN_8_BITS(c) \ ? is ## upper ## _L1(c) \ : is_uni_ ## lower((UV) (c))) /* is_uni_ is even older */ # endif #ifndef isALPHA_uvchr # define isALPHA_uvchr(c) D_PPP_is_ctype(ALPHA, alpha, c) #endif #ifndef isALPHANUMERIC_uvchr # define isALPHANUMERIC_uvchr(c) (isALPHA_uvchr(c) || isDIGIT_uvchr(c)) #endif # ifdef is_uni_blank #ifndef isBLANK_uvchr # define isBLANK_uvchr(c) D_PPP_is_ctype(BLANK, blank, c) #endif # else #ifndef isBLANK_uvchr # define isBLANK_uvchr(c) (FITS_IN_8_BITS(c) \ ? isBLANK_L1(c) \ : ( (UV) (c) == 0x1680 /* Unicode 3.0 */ \ || inRANGE((UV) (c), 0x2000, 0x200A) \ || (UV) (c) == 0x202F /* Unicode 3.0 */\ || (UV) (c) == 0x205F /* Unicode 3.2 */\ || (UV) (c) == 0x3000)) #endif # endif #ifndef isCNTRL_uvchr # define isCNTRL_uvchr(c) D_PPP_is_ctype(CNTRL, cntrl, c) #endif #ifndef isDIGIT_uvchr # define isDIGIT_uvchr(c) D_PPP_is_ctype(DIGIT, digit, c) #endif #ifndef isGRAPH_uvchr # define isGRAPH_uvchr(c) D_PPP_is_ctype(GRAPH, graph, c) #endif #ifndef isIDCONT_uvchr # define isIDCONT_uvchr(c) isWORDCHAR_uvchr(c) #endif #ifndef isIDFIRST_uvchr # define isIDFIRST_uvchr(c) D_PPP_is_ctype(IDFIRST, idfirst, c) #endif #ifndef isLOWER_uvchr # define isLOWER_uvchr(c) D_PPP_is_ctype(LOWER, lower, c) #endif #ifndef isPRINT_uvchr # define isPRINT_uvchr(c) D_PPP_is_ctype(PRINT, print, c) #endif #ifndef isPSXSPC_uvchr # define isPSXSPC_uvchr(c) isSPACE_uvchr(c) #endif #ifndef isPUNCT_uvchr # define isPUNCT_uvchr(c) D_PPP_is_ctype(PUNCT, punct, c) #endif #ifndef isSPACE_uvchr # define isSPACE_uvchr(c) D_PPP_is_ctype(SPACE, space, c) #endif #ifndef isUPPER_uvchr # define isUPPER_uvchr(c) D_PPP_is_ctype(UPPER, upper, c) #endif #ifndef isXDIGIT_uvchr # define isXDIGIT_uvchr(c) D_PPP_is_ctype(XDIGIT, xdigit, c) #endif #ifndef isWORDCHAR_uvchr # define isWORDCHAR_uvchr(c) (FITS_IN_8_BITS(c) \ ? isWORDCHAR_L1(c) : isALPHANUMERIC_uvchr(c)) #endif #ifndef isALPHA_utf8_safe # define isALPHA_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, ALPHA) #endif # ifdef isALPHANUMERIC_utf8 #ifndef isALPHANUMERIC_utf8_safe # define isALPHANUMERIC_utf8_safe(s,e) \ D_PPP_IS_GENERIC_UTF8_SAFE(s, e, ALPHANUMERIC) #endif # else #ifndef isALPHANUMERIC_utf8_safe # define isALPHANUMERIC_utf8_safe(s,e) \ (isALPHA_utf8_safe(s,e) || isDIGIT_utf8_safe(s,e)) #endif # endif /* This was broken before 5.18, and just use this instead of worrying about * which releases the official works on */ # if 'A' == 65 #ifndef isBLANK_utf8_safe # define isBLANK_utf8_safe(s,e) \ ( ( LIKELY((e) > (s)) ) ? /* Machine generated */ \ ( ( 0x09 == ((const U8*)s)[0] || 0x20 == ((const U8*)s)[0] ) ? 1 \ : ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ? \ ( ( 0xC2 == ((const U8*)s)[0] ) ? \ ( ( 0xA0 == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0xE1 == ((const U8*)s)[0] ) ? \ ( ( ( 0x9A == ((const U8*)s)[1] ) && ( 0x80 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xE2 == ((const U8*)s)[0] ) ? \ ( ( 0x80 == ((const U8*)s)[1] ) ? \ ( ( inRANGE(((const U8*)s)[2], 0x80, 0x8A ) || 0xAF == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( ( 0x81 == ((const U8*)s)[1] ) && ( 0x9F == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ( 0xE3 == ((const U8*)s)[0] ) && ( 0x80 == ((const U8*)s)[1] ) ) && ( 0x80 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : 0 ) \ : 0 ) #endif # elif 'A' == 193 && '^' == 95 /* EBCDIC 1047 */ #ifndef isBLANK_utf8_safe # define isBLANK_utf8_safe(s,e) \ ( ( LIKELY((e) > (s)) ) ? \ ( ( 0x05 == ((const U8*)s)[0] || 0x40 == ((const U8*)s)[0] ) ? 1 \ : ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ? \ ( ( 0x80 == ((const U8*)s)[0] ) ? \ ( ( 0x41 == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0xBC == ((const U8*)s)[0] ) ? \ ( ( ( 0x63 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xCA == ((const U8*)s)[0] ) ? \ ( ( 0x41 == ((const U8*)s)[1] ) ? \ ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A ) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( 0x42 == ((const U8*)s)[1] ) ? \ ( ( 0x56 == ((const U8*)s)[2] ) ? 3 : 0 ) \ : ( ( 0x43 == ((const U8*)s)[1] ) && ( 0x73 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ( 0xCE == ((const U8*)s)[0] ) && ( 0x41 == ((const U8*)s)[1] ) ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : 0 ) \ : 0 ) #endif # elif 'A' == 193 && '^' == 176 /* EBCDIC 037 */ #ifndef isBLANK_utf8_safe # define isBLANK_utf8_safe(s,e) \ ( ( LIKELY((e) > (s)) ) ? \ ( ( 0x05 == ((const U8*)s)[0] || 0x40 == ((const U8*)s)[0] ) ? 1 \ : ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ? \ ( ( 0x78 == ((const U8*)s)[0] ) ? \ ( ( 0x41 == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0xBD == ((const U8*)s)[0] ) ? \ ( ( ( 0x62 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xCA == ((const U8*)s)[0] ) ? \ ( ( 0x41 == ((const U8*)s)[1] ) ? \ ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A ) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( 0x42 == ((const U8*)s)[1] ) ? \ ( ( 0x56 == ((const U8*)s)[2] ) ? 3 : 0 ) \ : ( ( 0x43 == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ( 0xCE == ((const U8*)s)[0] ) && ( 0x41 == ((const U8*)s)[1] ) ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : 0 ) \ : 0 ) #endif # else # error Unknown character set # endif #ifndef isCNTRL_utf8_safe # define isCNTRL_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, CNTRL) #endif #ifndef isDIGIT_utf8_safe # define isDIGIT_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, DIGIT) #endif #ifndef isGRAPH_utf8_safe # define isGRAPH_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, GRAPH) #endif # ifdef isIDCONT_utf8 #ifndef isIDCONT_utf8_safe # define isIDCONT_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, IDCONT) #endif # else #ifndef isIDCONT_utf8_safe # define isIDCONT_utf8_safe(s,e) isWORDCHAR_utf8_safe(s,e) #endif # endif #ifndef isIDFIRST_utf8_safe # define isIDFIRST_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, IDFIRST) #endif #ifndef isLOWER_utf8_safe # define isLOWER_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, LOWER) #endif #ifndef isPRINT_utf8_safe # define isPRINT_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, PRINT) #endif /* Use the modern definition */ #undef isPSXSPC_utf8_safe #ifndef isPSXSPC_utf8_safe # define isPSXSPC_utf8_safe(s,e) isSPACE_utf8_safe(s,e) #endif #ifndef isPUNCT_utf8_safe # define isPUNCT_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, PUNCT) #endif #ifndef isSPACE_utf8_safe # define isSPACE_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, SPACE) #endif #ifndef isUPPER_utf8_safe # define isUPPER_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, UPPER) #endif # ifdef isWORDCHAR_utf8 #ifndef isWORDCHAR_utf8_safe # define isWORDCHAR_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, WORDCHAR) #endif # else #ifndef isWORDCHAR_utf8_safe # define isWORDCHAR_utf8_safe(s,e) \ (isALPHANUMERIC_utf8_safe(s,e) || (*(s)) == '_') #endif # endif /* This was broken before 5.12, and just use this instead of worrying about * which releases the official works on */ # if 'A' == 65 #ifndef isXDIGIT_utf8_safe # define isXDIGIT_utf8_safe(s,e) \ ( ( LIKELY((e) > (s)) ) ? \ ( ( inRANGE(((const U8*)s)[0], 0x30, 0x39 ) || inRANGE(((const U8*)s)[0], 0x41, 0x46 ) || inRANGE(((const U8*)s)[0], 0x61, 0x66 ) ) ? 1\ : ( ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xEF == ((const U8*)s)[0] ) ) ? ( ( 0xBC == ((const U8*)s)[1] ) ?\ ( ( inRANGE(((const U8*)s)[2], 0x90, 0x99 ) || inRANGE(((const U8*)s)[2], 0xA1, 0xA6 ) ) ? 3 : 0 )\ : ( ( 0xBD == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x81, 0x86 ) ) ) ? 3 : 0 ) : 0 )\ : 0 ) #endif # elif 'A' == 193 && '^' == 95 /* EBCDIC 1047 */ #ifndef isXDIGIT_utf8_safe # define isXDIGIT_utf8_safe(s,e) \ ( ( LIKELY((e) > (s)) ) ? \ ( ( inRANGE(((const U8*)s)[0], 0x81, 0x86 ) || inRANGE(((const U8*)s)[0], 0xC1, 0xC6 ) || inRANGE(((const U8*)s)[0], 0xF0, 0xF9 ) ) ? 1\ : ( ( ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xDD == ((const U8*)s)[0] ) ) && ( 0x73 == ((const U8*)s)[1] ) ) ? ( ( 0x67 == ((const U8*)s)[2] ) ?\ ( ( inRANGE(((const U8*)s)[3], 0x57, 0x59 ) || inRANGE(((const U8*)s)[3], 0x62, 0x68 ) ) ? 4 : 0 )\ : ( ( inRANGE(((const U8*)s)[2], 0x68, 0x69 ) ) && ( inRANGE(((const U8*)s)[3], 0x42, 0x47 ) ) ) ? 4 : 0 ) : 0 )\ : 0 ) #endif # elif 'A' == 193 && '^' == 176 /* EBCDIC 037 */ #ifndef isXDIGIT_utf8_safe # define isXDIGIT_utf8_safe(s,e) \ ( ( LIKELY((e) > (s)) ) ? \ ( ( inRANGE(((const U8*)s)[0], 0x81, 0x86 ) || inRANGE(((const U8*)s)[0], 0xC1, 0xC6 ) || inRANGE(((const U8*)s)[0], 0xF0, 0xF9 ) ) ? 1\ : ( ( ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xDD == ((const U8*)s)[0] ) ) && ( 0x72 == ((const U8*)s)[1] ) ) ? ( ( 0x66 == ((const U8*)s)[2] ) ?\ ( ( inRANGE(((const U8*)s)[3], 0x57, 0x59 ) || 0x5F == ((const U8*)s)[3] || inRANGE(((const U8*)s)[3], 0x62, 0x67 ) ) ? 4 : 0 )\ : ( ( inRANGE(((const U8*)s)[2], 0x67, 0x68 ) ) && ( inRANGE(((const U8*)s)[3], 0x42, 0x47 ) ) ) ? 4 : 0 ) : 0 )\ : 0 ) #endif # else # error Unknown character set # endif #ifndef isALPHA_LC_utf8_safe # define isALPHA_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, ALPHA) #endif # ifdef isALPHANUMERIC_utf8 #ifndef isALPHANUMERIC_LC_utf8_safe # define isALPHANUMERIC_LC_utf8_safe(s,e) \ D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, ALPHANUMERIC) #endif # else #ifndef isALPHANUMERIC_LC_utf8_safe # define isALPHANUMERIC_LC_utf8_safe(s,e) \ (isALPHA_LC_utf8_safe(s,e) || isDIGIT_LC_utf8_safe(s,e)) #endif # endif #ifndef isBLANK_LC_utf8_safe # define isBLANK_LC_utf8_safe(s,e) \ D_PPP_IS_GENERIC_LC_UTF8_SAFE_BROKEN(s, e, BLANK) #endif #ifndef isCNTRL_LC_utf8_safe # define isCNTRL_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, CNTRL) #endif #ifndef isDIGIT_LC_utf8_safe # define isDIGIT_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, DIGIT) #endif #ifndef isGRAPH_LC_utf8_safe # define isGRAPH_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, GRAPH) #endif # ifdef isIDCONT_utf8 #ifndef isIDCONT_LC_utf8_safe # define isIDCONT_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, IDCONT) #endif # else #ifndef isIDCONT_LC_utf8_safe # define isIDCONT_LC_utf8_safe(s,e) isWORDCHAR_LC_utf8_safe(s,e) #endif # endif #ifndef isIDFIRST_LC_utf8_safe # define isIDFIRST_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, IDFIRST) #endif #ifndef isLOWER_LC_utf8_safe # define isLOWER_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, LOWER) #endif #ifndef isPRINT_LC_utf8_safe # define isPRINT_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, PRINT) #endif /* Use the modern definition */ #undef isPSXSPC_LC_utf8_safe #ifndef isPSXSPC_LC_utf8_safe # define isPSXSPC_LC_utf8_safe(s,e) isSPACE_LC_utf8_safe(s,e) #endif #ifndef isPUNCT_LC_utf8_safe # define isPUNCT_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, PUNCT) #endif #ifndef isSPACE_LC_utf8_safe # define isSPACE_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, SPACE) #endif #ifndef isUPPER_LC_utf8_safe # define isUPPER_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, UPPER) #endif # ifdef isWORDCHAR_utf8 #ifndef isWORDCHAR_LC_utf8_safe # define isWORDCHAR_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, WORDCHAR) #endif # else #ifndef isWORDCHAR_LC_utf8_safe # define isWORDCHAR_LC_utf8_safe(s,e) \ (isALPHANUMERIC_LC_utf8_safe(s,e) || (*(s)) == '_') #endif # endif #ifndef isXDIGIT_LC_utf8_safe # define isXDIGIT_LC_utf8_safe(s,e) \ D_PPP_IS_GENERIC_LC_UTF8_SAFE_BROKEN(s, e, XDIGIT) #endif /* Warning: isALPHANUMERIC_utf8_safe, isALPHA_utf8_safe, isASCII_utf8_safe, * isBLANK_utf8_safe, isCNTRL_utf8_safe, isDIGIT_utf8_safe, isGRAPH_utf8_safe, * isIDCONT_utf8_safe, isIDFIRST_utf8_safe, isLOWER_utf8_safe, * isPRINT_utf8_safe, isPSXSPC_utf8_safe, isPUNCT_utf8_safe, isSPACE_utf8_safe, * isUPPER_utf8_safe, isWORDCHAR_utf8_safe, isWORDCHAR_utf8_safe, * isXDIGIT_utf8_safe, * isALPHANUMERIC_LC_utf8_safe, isALPHA_LC_utf8_safe, isASCII_LC_utf8_safe, * isBLANK_LC_utf8_safe, isCNTRL_LC_utf8_safe, isDIGIT_LC_utf8_safe, * isGRAPH_LC_utf8_safe, isIDCONT_LC_utf8_safe, isIDFIRST_LC_utf8_safe, * isLOWER_LC_utf8_safe, isPRINT_LC_utf8_safe, isPSXSPC_LC_utf8_safe, * isPUNCT_LC_utf8_safe, isSPACE_LC_utf8_safe, isUPPER_LC_utf8_safe, * isWORDCHAR_LC_utf8_safe, isWORDCHAR_LC_utf8_safe, isXDIGIT_LC_utf8_safe, * isALPHANUMERIC_uvchr, isALPHA_uvchr, isASCII_uvchr, isBLANK_uvchr, * isCNTRL_uvchr, isDIGIT_uvchr, isGRAPH_uvchr, isIDCONT_uvchr, * isIDFIRST_uvchr, isLOWER_uvchr, isPRINT_uvchr, isPSXSPC_uvchr, * isPUNCT_uvchr, isSPACE_uvchr, isUPPER_uvchr, isWORDCHAR_uvchr, * isWORDCHAR_uvchr, isXDIGIT_uvchr * * The UTF-8 handling is buggy in early Perls, and this can give inaccurate * results for code points above 0xFF, until the implementation started * settling down in 5.12 and 5.14 */ #endif #define D_PPP_TOO_SHORT_MSG "Malformed UTF-8 character starting with:" \ " \\x%02x (too short; %d bytes available, need" \ " %d)\n" /* Perls starting here had a new API which handled multi-character results */ #if (PERL_BCDVERSION >= 0x5007003) #ifndef toLOWER_uvchr # define toLOWER_uvchr(c, s, l) UNI_TO_NATIVE(to_uni_lower(NATIVE_TO_UNI(c), s, l)) #endif #ifndef toUPPER_uvchr # define toUPPER_uvchr(c, s, l) UNI_TO_NATIVE(to_uni_upper(NATIVE_TO_UNI(c), s, l)) #endif #ifndef toTITLE_uvchr # define toTITLE_uvchr(c, s, l) UNI_TO_NATIVE(to_uni_title(NATIVE_TO_UNI(c), s, l)) #endif #ifndef toFOLD_uvchr # define toFOLD_uvchr(c, s, l) UNI_TO_NATIVE(to_uni_fold( NATIVE_TO_UNI(c), s, l)) #endif # if (PERL_BCDVERSION != 0x5015006) /* Just this version is broken */ /* Prefer the macro to the function */ # if defined toLOWER_utf8 # define D_PPP_TO_LOWER_CALLEE(s,r,l) toLOWER_utf8(s,r,l) # else # define D_PPP_TO_LOWER_CALLEE(s,r,l) to_utf8_lower(s,r,l) # endif # if defined toTITLE_utf8 # define D_PPP_TO_TITLE_CALLEE(s,r,l) toTITLE_utf8(s,r,l) # else # define D_PPP_TO_TITLE_CALLEE(s,r,l) to_utf8_title(s,r,l) # endif # if defined toUPPER_utf8 # define D_PPP_TO_UPPER_CALLEE(s,r,l) toUPPER_utf8(s,r,l) # else # define D_PPP_TO_UPPER_CALLEE(s,r,l) to_utf8_upper(s,r,l) # endif # if defined toFOLD_utf8 # define D_PPP_TO_FOLD_CALLEE(s,r,l) toFOLD_utf8(s,r,l) # else # define D_PPP_TO_FOLD_CALLEE(s,r,l) to_utf8_fold(s,r,l) # endif # else /* Below is 5.15.6, which failed to make the macros available # outside of core, so we have to use the 'Perl_' form. khw # decided it was easier to just handle this case than have to # document the exception, and make an exception in the tests below # */ # define D_PPP_TO_LOWER_CALLEE(s,r,l) \ Perl__to_utf8_lower_flags(aTHX_ s, r, l, 0, NULL) # define D_PPP_TO_TITLE_CALLEE(s,r,l) \ Perl__to_utf8_title_flags(aTHX_ s, r, l, 0, NULL) # define D_PPP_TO_UPPER_CALLEE(s,r,l) \ Perl__to_utf8_upper_flags(aTHX_ s, r, l, 0, NULL) # define D_PPP_TO_FOLD_CALLEE(s,r,l) \ Perl__to_utf8_fold_flags(aTHX_ s, r, l, FOLD_FLAGS_FULL, NULL) # endif /* The actual implementation of the backported macros. If too short, croak, * otherwise call the original that doesn't have an upper limit parameter */ # define D_PPP_GENERIC_MULTI_ARG_TO(name, s, e,r,l) \ (((((e) - (s)) <= 0) \ /* We could just do nothing, but modern perls croak */ \ ? (croak("Attempting case change on zero length string"), \ 0) /* So looks like it returns something, and will compile */ \ : ((e) - (s)) < UTF8SKIP(s)) \ ? (croak(D_PPP_TOO_SHORT_MSG, \ s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \ 0) \ : D_PPP_TO_ ## name ## _CALLEE(s,r,l)) #ifndef toUPPER_utf8_safe # define toUPPER_utf8_safe(s,e,r,l) \ D_PPP_GENERIC_MULTI_ARG_TO(UPPER,s,e,r,l) #endif #ifndef toLOWER_utf8_safe # define toLOWER_utf8_safe(s,e,r,l) \ D_PPP_GENERIC_MULTI_ARG_TO(LOWER,s,e,r,l) #endif #ifndef toTITLE_utf8_safe # define toTITLE_utf8_safe(s,e,r,l) \ D_PPP_GENERIC_MULTI_ARG_TO(TITLE,s,e,r,l) #endif #ifndef toFOLD_utf8_safe # define toFOLD_utf8_safe(s,e,r,l) \ D_PPP_GENERIC_MULTI_ARG_TO(FOLD,s,e,r,l) #endif #elif (PERL_BCDVERSION >= 0x5006000) /* Here we have UTF-8 support, but using the original API where the case * changing functions merely returned the changed code point; hence they * couldn't handle multi-character results. */ # ifdef uvchr_to_utf8 # define D_PPP_UV_TO_UTF8 uvchr_to_utf8 # else # define D_PPP_UV_TO_UTF8 uv_to_utf8 # endif /* Get the utf8 of the case changed value, and store its length; then have * to re-calculate the changed case value in order to return it */ # define D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(name, c, s, l) \ (*(l) = (D_PPP_UV_TO_UTF8(s, \ UNI_TO_NATIVE(to_uni_ ## name(NATIVE_TO_UNI(c)))) - (s)), \ UNI_TO_NATIVE(to_uni_ ## name(NATIVE_TO_UNI(c)))) #ifndef toLOWER_uvchr # define toLOWER_uvchr(c, s, l) \ D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(lower, c, s, l) #endif #ifndef toUPPER_uvchr # define toUPPER_uvchr(c, s, l) \ D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(upper, c, s, l) #endif #ifndef toTITLE_uvchr # define toTITLE_uvchr(c, s, l) \ D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(title, c, s, l) #endif #ifndef toFOLD_uvchr # define toFOLD_uvchr(c, s, l) toLOWER_uvchr(c, s, l) #endif # define D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(name, s, e, r, l) \ (((((e) - (s)) <= 0) \ ? (croak("Attempting case change on zero length string"), \ 0) /* So looks like it returns something, and will compile */ \ : ((e) - (s)) < UTF8SKIP(s)) \ ? (croak(D_PPP_TOO_SHORT_MSG, \ s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \ 0) \ /* Get the changed code point and store its UTF-8 */ \ : D_PPP_UV_TO_UTF8(r, to_utf8_ ## name(s)), \ /* Then store its length, and re-get code point for return */ \ *(l) = UTF8SKIP(r), to_utf8_ ## name(r)) /* Warning: toUPPER_utf8_safe, toLOWER_utf8_safe, toTITLE_utf8_safe, * toUPPER_uvchr, toLOWER_uvchr, toTITLE_uvchr The UTF-8 case changing operations had bugs before around 5.12 or 5.14; this backport does not correct them. In perls before 7.3, multi-character case changing is not implemented; this backport uses the simple case changes available in those perls. */ #ifndef toUPPER_utf8_safe # define toUPPER_utf8_safe(s,e,r,l) \ D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(upper, s, e, r, l) #endif #ifndef toLOWER_utf8_safe # define toLOWER_utf8_safe(s,e,r,l) \ D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(lower, s, e, r, l) #endif #ifndef toTITLE_utf8_safe # define toTITLE_utf8_safe(s,e,r,l) \ D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(title, s, e, r, l) #endif /* Warning: toFOLD_utf8_safe, toFOLD_uvchr The UTF-8 case changing operations had bugs before around 5.12 or 5.14; this backport does not correct them. In perls before 7.3, case folding is not implemented; instead, this backport substitutes simple (not multi-character, which isn't available) lowercasing. This gives the correct result in most, but not all, instances */ #ifndef toFOLD_utf8_safe # define toFOLD_utf8_safe(s,e,r,l) toLOWER_utf8_safe(s,e,r,l) #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 LIKELY # define LIKELY(x) (x) #endif #ifndef UNLIKELY # define UNLIKELY(x) (x) #endif #ifndef MUTABLE_PTR #if defined(PERL_USE_GCC_BRACE_GROUPS) # define MUTABLE_PTR(p) ({ void *_p = (p); _p; }) #else # define MUTABLE_PTR(p) ((void *) (p)) #endif #endif #ifndef MUTABLE_AV # define MUTABLE_AV(p) ((AV *)MUTABLE_PTR(p)) #endif #ifndef MUTABLE_CV # define MUTABLE_CV(p) ((CV *)MUTABLE_PTR(p)) #endif #ifndef MUTABLE_GV # define MUTABLE_GV(p) ((GV *)MUTABLE_PTR(p)) #endif #ifndef MUTABLE_HV # define MUTABLE_HV(p) ((HV *)MUTABLE_PTR(p)) #endif #ifndef MUTABLE_IO # define MUTABLE_IO(p) ((IO *)MUTABLE_PTR(p)) #endif #ifndef MUTABLE_SV # define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p)) #endif #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf) #if defined(PERL_USE_GCC_BRACE_GROUPS) # define vnewSVpvf(pat, args) ({ SV *_sv = newSV(0); sv_vsetpvfn(_sv, (pat), strlen((pat)), (args), Null(SV**), 0, Null(bool*)); _sv; }) #else # define vnewSVpvf(pat, args) ((PL_Sv = newSV(0)), sv_vsetpvfn(PL_Sv, (pat), strlen((pat)), (args), Null(SV**), 0, Null(bool*)), PL_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 * const sv, const char * const pat, ...); static #else extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * const sv, const char * const 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 * const sv, const char * const 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 * const sv, const char * const pat, ...); static #else extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * const sv, const char * const 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 * const sv, const char * const 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 * const sv, const char * const pat, ...); static #else extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * const sv, const char * const 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 * const sv, const char * const 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 * const sv, const char * const pat, ...); static #else extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * const sv, const char * const 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 * const sv, const char * const 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: 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) #ifndef sv_2pvbyte # define sv_2pvbyte(sv, lp) (sv_utf8_downgrade((sv), 0), SvPV((sv), *(lp))) #endif /* Hint: sv_2pvbyte * Use the SvPVbyte() macro instead of sv_2pvbyte(). */ /* Replace sv_2pvbyte with SvPVbyte */ #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(). */ /* Replace sv_pvn with SvPV */ /* Hint: sv_pvn_force * Always use the SvPV_force() macro instead of sv_pvn_force(). */ /* Replace sv_pvn_force with SvPV_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_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) # /* Fix sv_2pv for Perl < 5.7.2 - view https://github.com/Dual-Life/Devel-PPPort/issues/231 */ # ifdef sv_2pv # undef sv_2pv # endif # if defined(PERL_USE_GCC_BRACE_GROUPS) #ifndef sv_2pv # define sv_2pv(sv, lp) ({ SV *_sv_2pv = (sv); STRLEN sv_2pv_dummy_; STRLEN *_lp_2pv = (lp); _lp_2pv = _lp_2pv ? : &sv_2pv_dummy_; SvPOKp(_sv_2pv) ? ((*(_lp_2pv) = SvCUR(_sv_2pv)), SvPVX(_sv_2pv)) : Perl_sv_2pv(aTHX_ _sv_2pv, (_lp_2pv)); }) #endif # else #ifndef sv_2pv # define sv_2pv(sv, lp) (SvPOKp(sv) ? ((*((lp) ? (lp) : &PL_na) = SvCUR(sv)), SvPVX(sv)) : Perl_sv_2pv(aTHX_ (sv), (lp))) #endif # endif #endif #if (PERL_BCDVERSION < 0x5007002) /* Define sv_2pv_flags for Perl < 5.7.2 which does not have it at all */ #if defined(PERL_USE_GCC_BRACE_GROUPS) #ifndef sv_2pv_flags # define sv_2pv_flags(sv, lp, flags) ({ SV *_sv = (sv); STRLEN sv_2pv_dummy_; const I32 _flags = (flags); STRLEN *_lp = lp; _lp = _lp ? : &sv_2pv_dummy_; (!(_flags & SV_GMAGIC) && SvGMAGICAL(_sv)) ? ({ char *_pv; SvGMAGICAL_off(_sv); _pv = sv_2pv(_sv, _lp); SvGMAGICAL_on(_sv); _pv; }) : sv_2pv(_sv, _lp); }) #endif #ifndef sv_pvn_force_flags # define sv_pvn_force_flags(sv, lp, flags) ({ SV *_sv = (sv); STRLEN sv_2pv_dummy_; const I32 _flags = (flags); STRLEN *_lp = lp; _lp = _lp ? : &sv_2pv_dummy_; (!(_flags & SV_GMAGIC) && SvGMAGICAL(_sv)) ? ({ char *_pv; SvGMAGICAL_off(_sv); _pv = sv_pvn_force(_sv, _lp); SvGMAGICAL_on(_sv); _pv; }) : sv_pvn_force(_sv, _lp); }) #endif #else #ifndef sv_2pv_flags # define sv_2pv_flags(sv, lp, flags) ((PL_Sv = (sv)), (!((flags) & SV_GMAGIC) && SvGMAGICAL(PL_Sv)) ? (SvGMAGICAL_off(PL_Sv), (PL_Xpv = (XPV *)sv_2pv(PL_Sv, (lp) ? (lp) : &PL_na)), SvGMAGICAL_on(PL_Sv), (char *)PL_Xpv) : sv_2pv(PL_Sv, (lp) ? (lp) : &PL_na)) #endif #ifndef sv_pvn_force_flags # define sv_pvn_force_flags(sv, lp, flags) ((PL_Sv = (sv)), (!((flags) & SV_GMAGIC) && SvGMAGICAL(PL_Sv)) ? (SvGMAGICAL_off(PL_Sv), (PL_Xpv = (XPV *)sv_pvn_force(PL_Sv, (lp) ? (lp) : &PL_na)), SvGMAGICAL_on(PL_Sv), (char *)PL_Xpv) : sv_pvn_force(PL_Sv, (lp) ? (lp) : &PL_na)) #endif #endif #elif (PERL_BCDVERSION < 0x5017002) /* Fix sv_2pv_flags for Perl < 5.17.2 */ # ifdef sv_2pv_flags # undef sv_2pv_flags # endif # if defined(PERL_USE_GCC_BRACE_GROUPS) #ifndef sv_2pv_flags # define sv_2pv_flags(sv, lp, flags) ({ SV *_sv_2pv = (sv); STRLEN sv_2pv_dummy_; const I32 _flags_2pv = (flags); STRLEN *_lp_2pv = (lp); _lp_2pv = _lp_2pv ? : &sv_2pv_dummy_; ((!(_flags_2pv & SV_GMAGIC) || !SvGMAGICAL(_sv_2pv)) && SvPOKp(_sv_2pv)) ? ((*(_lp_2pv) = SvCUR(_sv_2pv)), SvPVX(_sv_2pv)) : Perl_sv_2pv_flags(aTHX_ _sv_2pv, (_lp_2pv), (_flags_2pv)); }) #endif # else #ifndef sv_2pv_flags # define sv_2pv_flags(sv, lp, flags) (((!((flags) & SV_GMAGIC) || !SvGMAGICAL(sv)) && SvPOKp(sv)) ? ((*((lp) ? (lp) : &PL_na) = SvCUR(sv)), SvPVX(sv)) : Perl_sv_2pv_flags(aTHX_ (sv), (lp), (flags))) #endif # 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 # if defined(PERL_USE_GCC_BRACE_GROUPS) #ifndef SvPVx_nolen_const # define SvPVx_nolen_const(sv) ({SV *sV_ = (sv); SvPV_nolen_const(sV_); }) #endif # else #ifndef SvPVx_nolen_const # define SvPVx_nolen_const(sv) (PL_Sv = sv, SvPV_nolen_const(PL_Sv)) #endif # 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 SvPVCLEAR # define SvPVCLEAR(sv) sv_setpvs((sv), "") #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 packWARN2 # define packWARN2(a,b) (packWARN(a) << 8 | (b)) #endif #ifndef packWARN3 # define packWARN3(a,b,c) (packWARN2(a,b) << 8 | (c)) #endif #ifndef packWARN4 # define packWARN4(a,b,c,d) (packWARN3(a,b,c) << 8 | (d)) #endif #ifndef ckWARN # ifdef G_WARN_ON # define ckWARN(a) (PL_dowarn & G_WARN_ON) # else # define ckWARN(a) PL_dowarn # endif #endif #ifndef ckWARN2 # define ckWARN2(a,b) (ckWARN(a) || ckWARN(b)) #endif #ifndef ckWARN3 # define ckWARN3(a,b,c) (ckWARN(c) || ckWARN2(a,b)) #endif #ifndef ckWARN4 # define ckWARN4(a,b,c,d) (ckWARN(d) || ckWARN3(a,b,c)) #endif #ifndef ckWARN_d # ifdef isLEXWARN_off # define ckWARN_d(a) (isLEXWARN_off || ckWARN(a)) # else # define ckWARN_d(a) 1 # endif #endif #ifndef ckWARN2_d # define ckWARN2_d(a,b) (ckWARN_d(a) || ckWARN_d(b)) #endif #ifndef ckWARN3_d # define ckWARN3_d(a,b,c) (ckWARN_d(c) || ckWARN2_d(a,b)) #endif #ifndef ckWARN4_d # define ckWARN4_d(a,b,c,d) (ckWARN_d(d) || ckWARN3_d(a,b,c)) #endif #ifndef vwarner # define vwarner(err, pat, argsp) \ STMT_START { SV *sv; \ PERL_UNUSED_ARG(err); \ sv = vnewSVpvf(pat, argsp); \ sv_2mortal(sv); \ warn("%s", SvPV_nolen(sv)); \ } STMT_END #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, ...) { va_list args; va_start(args, pat); vwarner(err, pat, &args); va_end(args); } # define warner Perl_warner # define Perl_warner_nocontext Perl_warner # endif #endif #if (PERL_BCDVERSION >= 0x5004000) && !defined(ck_warner) # if defined(NEED_ck_warner) static void DPPP_(my_ck_warner)(pTHX_ U32 err, const char * pat, ...); static #else extern void DPPP_(my_ck_warner)(pTHX_ U32 err, const char * pat, ...); #endif #if defined(NEED_ck_warner) || defined(NEED_ck_warner_GLOBAL) #define Perl_ck_warner DPPP_(my_ck_warner) void DPPP_(my_ck_warner)(pTHX_ U32 err, const char *pat, ...) { va_list args; if ( ! ckWARN((err ) & 0xFF) && ! ckWARN((err >> 8) & 0xFF) && ! ckWARN((err >> 16) & 0xFF) && ! ckWARN((err >> 24) & 0xFF)) { return; } va_start(args, pat); vwarner(err, pat, &args); va_end(args); } # define ck_warner Perl_ck_warner # endif #endif #if (PERL_BCDVERSION >= 0x5004000) && !defined(ck_warner_d) # if defined(NEED_ck_warner_d) static void DPPP_(my_ck_warner_d)(pTHX_ U32 err, const char * pat, ...); static #else extern void DPPP_(my_ck_warner_d)(pTHX_ U32 err, const char * pat, ...); #endif #if defined(NEED_ck_warner_d) || defined(NEED_ck_warner_d_GLOBAL) #define Perl_ck_warner_d DPPP_(my_ck_warner_d) void DPPP_(my_ck_warner_d)(pTHX_ U32 err, const char *pat, ...) { va_list args; if ( ! ckWARN_d((err ) & 0xFF) && ! ckWARN_d((err >> 8) & 0xFF) && ! ckWARN_d((err >> 16) & 0xFF) && ! ckWARN_d((err >> 24) & 0xFF)) { return; } va_start(args, pat); vwarner(err, pat, &args); va_end(args); } # define ck_warner_d Perl_ck_warner_d # 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 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 #if defined(PERL_USE_GCC_BRACE_GROUPS) #ifndef sv_2uv # define sv_2uv(sv) ({ SV *_sv = (sv); (UV) (SvNOK(_sv) ? SvNV(_sv) : sv_2nv(_sv)); }) #endif #else #ifndef sv_2uv # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv))) #endif #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 #if defined(PERL_USE_GCC_BRACE_GROUPS) #ifndef SvUVx # define SvUVx(sv) ({ SV *_sv = (sv)); SvUV(_sv); }) #endif #else #ifndef SvUVx # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) #endif #endif /* Hint: sv_uv * Always use the SvUVx() macro instead of sv_uv(). */ /* Replace sv_uv with SvUVx */ #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 #if !defined(my_strnlen) #if defined(NEED_my_strnlen) static Size_t DPPP_(my_my_strnlen)(const char * str, Size_t maxlen); static #else extern Size_t DPPP_(my_my_strnlen)(const char * str, Size_t maxlen); #endif #if defined(NEED_my_strnlen) || defined(NEED_my_strnlen_GLOBAL) #define my_strnlen DPPP_(my_my_strnlen) #define Perl_my_strnlen DPPP_(my_my_strnlen) Size_t DPPP_(my_my_strnlen)(const char *str, Size_t maxlen) { const char *p = str; while(maxlen-- && *p) p++; return p - str; } #endif #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 memCHRs # define memCHRs(s, c) ((const char *) memchr("" s "" , c, sizeof(s)-1)) #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 #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_FOR_SV(sv) \ STMT_START { \ SV *_errsv = ERRSV; \ SvFLAGS(_errsv) = (SvFLAGS(_errsv) & ~SVf_UTF8) | \ (SvFLAGS(sv) & SVf_UTF8); \ } STMT_END # else # define D_PPP_FIX_UTF8_ERRSV_FOR_SV(sv) STMT_START {} STMT_END # endif PERL_STATIC_INLINE void D_PPP_croak_sv(SV *sv) { dTHX; SV *_sv = (sv); if (SvROK(_sv)) { sv_setsv(ERRSV, _sv); croak(NULL); } else { D_PPP_FIX_UTF8_ERRSV_FOR_SV(_sv); croak("%" SVf, SVfARG(_sv)); } } # define croak_sv(sv) D_PPP_croak_sv(sv) #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 * baseex); static #else extern OP * DPPP_(my_die_sv)(pTHX_ SV * baseex); #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 *baseex) { croak_sv(baseex); 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 #if ! defined vmess && (PERL_BCDVERSION >= 0x5004000) # 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) && (PERL_BCDVERSION >= 0x5004000) #undef mess #endif #if !defined(mess_nocontext) && !defined(Perl_mess_nocontext) && (PERL_BCDVERSION >= 0x5004000) #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 #if ! defined mess_sv && (PERL_BCDVERSION >= 0x5004000) #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) 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 #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 #if (PERL_BCDVERSION >= 0x5003098) && (PERL_BCDVERSION < 0x5006000) #ifndef eval_pv # define eval_pv perl_eval_pv #endif #endif /* Replace: 0 */ #if (PERL_BCDVERSION < 0x5006000) #ifndef Perl_eval_sv # define Perl_eval_sv perl_eval_sv #endif #if (PERL_BCDVERSION >= 0x5003098) #ifndef Perl_eval_pv # define Perl_eval_pv perl_eval_pv #endif #endif #endif #ifndef G_LIST # define G_LIST G_ARRAY /* Replace */ #endif #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 #if defined(PERL_USE_GCC_BRACE_GROUPS) # define D_PPP_CROAK_IF_ERROR(cond) ({ \ SV *_errsv; \ ( (cond) \ && (_errsv = ERRSV) \ && (SvROK(_errsv) || SvTRUE(_errsv)) \ && (croak_sv(_errsv), 1)); \ }) #else PERL_STATIC_INLINE void D_PPP_CROAK_IF_ERROR(int cond) { dTHX; SV *errsv; if (!cond) return; errsv = ERRSV; if (SvROK(errsv) || SvTRUE(errsv)) croak_sv(errsv); } # define D_PPP_CROAK_IF_ERROR(cond) D_PPP_CROAK_IF_ERROR(cond) #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 #ifndef G_RETHROW # define G_RETHROW 8192 # ifdef eval_sv # undef eval_sv # endif # if defined(PERL_USE_GCC_BRACE_GROUPS) # define eval_sv(sv, flags) ({ I32 _flags = (flags); I32 _ret = Perl_eval_sv(aTHX_ sv, (_flags & ~G_RETHROW)); D_PPP_CROAK_IF_ERROR(_flags & G_RETHROW); _ret; }) # else # define eval_sv(sv, flags) ((PL_na = Perl_eval_sv(aTHX_ sv, ((flags) & ~G_RETHROW))), D_PPP_CROAK_IF_ERROR((flags) & G_RETHROW), (I32)PL_na) # endif #endif /* Older Perl versions have broken croak_on_error=1 */ #if (PERL_BCDVERSION < 0x5031002) # ifdef eval_pv # undef eval_pv # if defined(PERL_USE_GCC_BRACE_GROUPS) # define eval_pv(p, croak_on_error) ({ SV *_sv = Perl_eval_pv(aTHX_ p, 0); D_PPP_CROAK_IF_ERROR(croak_on_error); _sv; }) # else # define eval_pv(p, croak_on_error) ((PL_Sv = Perl_eval_pv(aTHX_ p, 0)), D_PPP_CROAK_IF_ERROR(croak_on_error), PL_Sv) # endif # endif #endif /* This is backport for Perl 5.3.97d and older which do not provide perl_eval_pv */ #ifndef eval_pv #if defined(NEED_eval_pv) static SV * DPPP_(my_eval_pv)(const char * p, I32 croak_on_error); static #else extern SV * DPPP_(my_eval_pv)(const 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)(const 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; D_PPP_CROAK_IF_ERROR(croak_on_error); return sv; } #endif #endif #if ! defined(vload_module) && defined(start_subparse) #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_compiling 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_compiling */ 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; utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0), #if (PERL_BCDVERSION > 0x5003000) veop, #endif modname, imop); 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(PERL_USE_GCC_BRACE_GROUPS) # define newRV_noinc(sv) ({ SV *_sv = (SV *)newRV((sv)); SvREFCNT_dec((sv)); _sv; }) #else # define newRV_noinc(sv) ((PL_Sv = (SV *)newRV((sv))), SvREFCNT_dec((sv)), PL_Sv) #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 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 /* not as efficient as the real thing, but it works */ #ifndef SvREFCNT_dec_NN # define SvREFCNT_dec_NN(sv) SvREFCNT_dec(sv) #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(PERL_USE_GCC_BRACE_GROUPS) # define newSV_type(t) ({ SV *_sv = newSV(0); sv_upgrade(_sv, (t)); _sv; }) #else # define newSV_type(t) ((PL_Sv = newSV(0)), sv_upgrade(PL_Sv, (t)), PL_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(PERL_USE_GCC_BRACE_GROUPS) # define newSVpvn_flags(s, len, flags) \ ({ \ SV * sv = newSVpvn(D_PPP_CONSTPV_ARG(s), (len)); \ SvFLAGS(sv) |= ((flags) & SVf_UTF8); \ if ((flags) & SVs_TEMP) sv = sv_2mortal(sv); \ sv; \ }) # else PERL_STATIC_INLINE SV* D_PPP_newSVpvn_flags(const char *const s, const STRLEN len, const U32 flags) { dTHX; SV * sv = newSVpvn(s, len); SvFLAGS(sv) |= (flags & SVf_UTF8); if (flags & SVs_TEMP) return sv_2mortal(sv); return sv; } # define newSVpvn_flags(s, len, flags) D_PPP_newSVpvn_flags((s), (len), (flags)) # endif #endif #ifndef SV_NOSTEAL # define SV_NOSTEAL 16 #endif #if ( (PERL_BCDVERSION >= 0x5007003) && (PERL_BCDVERSION < 0x5008007) ) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009002) ) #undef sv_setsv_flags #if defined(PERL_USE_GCC_BRACE_GROUPS) #define sv_setsv_flags(dstr, sstr, flags) \ STMT_START { \ if (((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) { \ SvTEMP_off((SV *)(sstr)); \ Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL); \ SvTEMP_on((SV *)(sstr)); \ } else { \ Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL); \ } \ } STMT_END #else #define sv_setsv_flags(dstr, sstr, flags) \ ( \ (((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) ? ( \ SvTEMP_off((SV *)(sstr)), \ Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL), \ SvTEMP_on((SV *)(sstr)), \ 1 \ ) : ( \ Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL), \ 1 \ ) \ ) #endif #endif #if defined(PERL_USE_GCC_BRACE_GROUPS) #ifndef sv_setsv_flags # define sv_setsv_flags(dstr, sstr, flags) \ STMT_START { \ if (((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) { \ SvTEMP_off((SV *)(sstr)); \ if (!((flags) & SV_GMAGIC) && (sstr) && SvGMAGICAL((SV *)(sstr))) { \ SvGMAGICAL_off((SV *)(sstr)); \ sv_setsv((dstr), (sstr)); \ SvGMAGICAL_on((SV *)(sstr)); \ } else { \ sv_setsv((dstr), (sstr)); \ } \ SvTEMP_on((SV *)(sstr)); \ } else { \ if (!((flags) & SV_GMAGIC) && (sstr) && SvGMAGICAL((SV *)(sstr))) { \ SvGMAGICAL_off((SV *)(sstr)); \ sv_setsv((dstr), (sstr)); \ SvGMAGICAL_on((SV *)(sstr)); \ } else { \ sv_setsv((dstr), (sstr)); \ } \ } \ } STMT_END #endif #else #ifndef sv_setsv_flags # define sv_setsv_flags(dstr, sstr, flags) \ ( \ (((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) ? ( \ SvTEMP_off((SV *)(sstr)), \ (!((flags) & SV_GMAGIC) && (sstr) && SvGMAGICAL((SV *)(sstr))) ? ( \ SvGMAGICAL_off((SV *)(sstr)), \ sv_setsv((dstr), (sstr)), \ SvGMAGICAL_on((SV *)(sstr)), \ 1 \ ) : ( \ sv_setsv((dstr), (sstr)), \ 1 \ ), \ SvTEMP_on((SV *)(sstr)), \ 1 \ ) : ( \ (!((flags) & SV_GMAGIC) && (sstr) && SvGMAGICAL((SV *)(sstr))) ? ( \ SvGMAGICAL_off((SV *)(sstr)), \ sv_setsv((dstr), (sstr)), \ SvGMAGICAL_on((SV *)(sstr)), \ 1 \ ) : ( \ sv_setsv((dstr), (sstr)), \ 1 \ ) \ ) \ ) #endif #endif #ifndef newSVsv_flags # if defined(PERL_USE_GCC_BRACE_GROUPS) # define newSVsv_flags(sv, flags) \ ({ \ SV *n= newSV(0); \ sv_setsv_flags(n, (sv), (flags)); \ n; \ }) # else PERL_STATIC_INLINE SV* D_PPP_newSVsv_flags(SV *const old, I32 flags) { dTHX; SV *n= newSV(0); sv_setsv_flags(n, old, flags); return n; } # define newSVsv_flags(sv, flags) D_PPP_newSVsv_flags(sv, flags) # endif #endif #ifndef newSVsv_nomg # define newSVsv_nomg(sv) newSVsv_flags((sv), SV_NOSTEAL) #endif #if (PERL_BCDVERSION >= 0x5017005) #ifndef sv_mortalcopy_flags # define sv_mortalcopy_flags(sv, flags) Perl_sv_mortalcopy_flags(aTHX_ (sv), (flags)) #endif #else #ifndef sv_mortalcopy_flags # define sv_mortalcopy_flags(sv, flags) sv_2mortal(newSVsv_flags((sv), (flags))) #endif #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 /* 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 * s, I32 len, U32 hash); static #else extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char * s, 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 *s, I32 len, U32 hash) { SV *sv; if (len < 0) len = -len; if (!hash) PERL_HASH(hash, (char*) s, len); sv = newSVpvn((char *) s, 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 #if (PERL_BCDVERSION >= 0x5009002) && (PERL_BCDVERSION <= 0x5009003) /* 5.9.2 and 5.9.3 ignore the length param */ #undef gv_fetchpvn_flags #endif #ifdef GV_NOADD_MASK # define D_PPP_GV_NOADD_MASK GV_NOADD_MASK #else # define D_PPP_GV_NOADD_MASK 0xE0 #endif #ifndef gv_fetchpvn_flags # define gv_fetchpvn_flags(name, len, flags, sv_type) gv_fetchpv(SvPVX(sv_2mortal(newSVpvn((name), (len)))), ((flags) & D_PPP_GV_NOADD_MASK) ? FALSE : TRUE, (I32)(sv_type)) #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 /* 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 #undef SvGETMAGIC #ifndef SvGETMAGIC # define SvGETMAGIC(x) ((void)(UNLIKELY(SvGMAGICAL(x)) && mg_get(x))) #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 #ifdef SVf_IVisUV #if defined(PERL_USE_GCC_BRACE_GROUPS) #ifndef SvIV_nomg # define SvIV_nomg(sv) (!SvGMAGICAL((sv)) ? SvIV((sv)) : ({ SV *_sviv = sv_mortalcopy_flags((sv), SV_NOSTEAL); IV _iv = SvIV(_sviv); SvFLAGS((sv)) = (SvFLAGS((sv)) & ~SVf_IVisUV) | (SvFLAGS(_sviv) & SVf_IVisUV); _iv; })) #endif #ifndef SvUV_nomg # define SvUV_nomg(sv) (!SvGMAGICAL((sv)) ? SvUV((sv)) : ({ SV *_svuv = sv_mortalcopy_flags((sv), SV_NOSTEAL); UV _uv = SvUV(_svuv); SvFLAGS((sv)) = (SvFLAGS((sv)) & ~SVf_IVisUV) | (SvFLAGS(_svuv) & SVf_IVisUV); _uv; })) #endif #else #ifndef SvIV_nomg # define SvIV_nomg(sv) (!SvGMAGICAL((sv)) ? SvIV((sv)) : ((PL_Sv = sv_mortalcopy_flags((sv), SV_NOSTEAL)), sv_upgrade(PL_Sv, SVt_PVIV), (SvIVX(PL_Sv) = SvIV(PL_Sv)), (SvFLAGS((sv)) = (SvFLAGS((sv)) & ~SVf_IVisUV) | (SvFLAGS(PL_Sv) & SVf_IVisUV)), SvIVX(PL_Sv))) #endif #ifndef SvUV_nomg # define SvUV_nomg(sv) (!SvGMAGICAL((sv)) ? SvIV((sv)) : ((PL_Sv = sv_mortalcopy_flags((sv), SV_NOSTEAL)), sv_upgrade(PL_Sv, SVt_PVIV), (SvUVX(PL_Sv) = SvUV(PL_Sv)), (SvFLAGS((sv)) = (SvFLAGS((sv)) & ~SVf_IVisUV) | (SvFLAGS(PL_Sv) & SVf_IVisUV)), SvUVX(PL_Sv))) #endif #endif #else #ifndef SvIV_nomg # define SvIV_nomg(sv) (!SvGMAGICAL((sv)) ? SvIV((sv)) : SvIVx(sv_mortalcopy_flags((sv), SV_NOSTEAL))) #endif #ifndef SvUV_nomg # define SvUV_nomg(sv) (!SvGMAGICAL((sv)) ? SvUV((sv)) : SvUVx(sv_mortalcopy_flags((sv), SV_NOSTEAL))) #endif #endif #ifndef SvNV_nomg # define SvNV_nomg(sv) (!SvGMAGICAL((sv)) ? SvNV((sv)) : SvNVx(sv_mortalcopy_flags((sv), SV_NOSTEAL))) #endif #ifndef SvTRUE_nomg # define SvTRUE_nomg(sv) (!SvGMAGICAL((sv)) ? SvTRUE((sv)) : SvTRUEx(sv_mortalcopy_flags((sv), SV_NOSTEAL))) #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)(const SV * sv, int type, const MGVTBL * vtbl); static #else extern MAGIC * DPPP_(my_mg_findext)(const 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)(const 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, const MGVTBL * vtbl); static #else extern int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, const 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, const 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 #ifndef SvVSTRING # define SvVSTRING(sv, len) (sv_vstring_get(sv, &(len))) #endif #ifndef SvVOK # define SvVOK(sv) (FALSE) #endif #if !defined(sv_vstring_get) #if defined(NEED_sv_vstring_get) static const char * DPPP_(my_sv_vstring_get)(pTHX_ SV * sv, STRLEN * lenp); static #else extern const char * DPPP_(my_sv_vstring_get)(pTHX_ SV * sv, STRLEN * lenp); #endif #if defined(NEED_sv_vstring_get) || defined(NEED_sv_vstring_get_GLOBAL) #ifdef sv_vstring_get # undef sv_vstring_get #endif #define sv_vstring_get(a,b) DPPP_(my_sv_vstring_get)(aTHX_ a,b) #define Perl_sv_vstring_get DPPP_(my_sv_vstring_get) const char * DPPP_(my_sv_vstring_get)(pTHX_ SV *sv, STRLEN *lenp) { #ifdef SvVSTRING_mg MAGIC *mg = SvVSTRING_mg(sv); if (!mg) return NULL; if (lenp) *lenp = mg->mg_len; return mg->mg_ptr; #else return NULL; #endif } #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--) { 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 level, const PERL_CONTEXT * * dbcxp); static #else extern const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 level, 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 level, const PERL_CONTEXT **dbcxp) { I32 cxix = DPPP_dopoptosub_at(cxstack, cxstack_ix); const PERL_CONTEXT *cx; 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)) level++; if (!level--) 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) /* Warning: my_sprintf It's safer to use my_snprintf instead */ /* Replace my_sprintf with my_snprintf */ 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 #ifdef SVf_UTF8 #ifndef SvUTF8 # define SvUTF8(sv) (SvFLAGS(sv) & SVf_UTF8) #endif #endif #if (PERL_BCDVERSION == 0x5019001) /* 5.19.1 does not have UTF8fARG, only broken UTF8f */ #undef UTF8f #endif #ifdef SVf_UTF8 #ifndef UTF8f # define UTF8f SVf #endif #ifndef UTF8fARG # define UTF8fARG(u,l,p) newSVpvn_flags((p), (l), ((u) ? SVf_UTF8 : 0) | SVs_TEMP) #endif #endif #define D_PPP_MIN(a,b) (((a) <= (b)) ? (a) : (b)) #ifndef UNICODE_REPLACEMENT # define UNICODE_REPLACEMENT 0xFFFD #endif #ifdef UTF8_MAXLEN #ifndef UTF8_MAXBYTES # define UTF8_MAXBYTES UTF8_MAXLEN #endif #endif #ifndef UTF_START_MARK # define UTF_START_MARK(len) \ (((len) > 7) ? 0xFF : (0xFF & (0xFE << (7-(len))))) #endif /* On non-EBCDIC was valid for some releases earlier than this, but easier to * just do one check */ #if (PERL_BCDVERSION < 0x5018000) # undef UTF8_MAXBYTES_CASE #endif #if 'A' == 65 # define D_PPP_BYTE_INFO_BITS 6 /* 6 bits meaningful in continuation bytes */ #ifndef UTF8_MAXBYTES_CASE # define UTF8_MAXBYTES_CASE 13 #endif #else # define D_PPP_BYTE_INFO_BITS 5 /* 5 bits meaningful in continuation bytes */ #ifndef UTF8_MAXBYTES_CASE # define UTF8_MAXBYTES_CASE 15 #endif #endif #ifndef UTF_ACCUMULATION_SHIFT # define UTF_ACCUMULATION_SHIFT D_PPP_BYTE_INFO_BITS #endif #ifdef NATIVE_TO_UTF #ifndef NATIVE_UTF8_TO_I8 # define NATIVE_UTF8_TO_I8(c) NATIVE_TO_UTF(c) #endif #else /* System doesn't support EBCDIC */ #ifndef NATIVE_UTF8_TO_I8 # define NATIVE_UTF8_TO_I8(c) (c) #endif #endif #ifdef UTF_TO_NATIVE #ifndef I8_TO_NATIVE_UTF8 # define I8_TO_NATIVE_UTF8(c) UTF_TO_NATIVE(c) #endif #else /* System doesn't support EBCDIC */ #ifndef I8_TO_NATIVE_UTF8 # define I8_TO_NATIVE_UTF8(c) (c) #endif #endif #ifndef UTF_START_MASK # define UTF_START_MASK(len) \ (((len) >= 7) ? 0x00 : (0x1F >> ((len)-2))) #endif #ifndef UTF_IS_CONTINUATION_MASK # define UTF_IS_CONTINUATION_MASK \ ((U8) (0xFF << UTF_ACCUMULATION_SHIFT)) #endif #ifndef UTF_CONTINUATION_MARK # define UTF_CONTINUATION_MARK \ (UTF_IS_CONTINUATION_MASK & 0xB0) #endif #ifndef UTF_MIN_START_BYTE # define UTF_MIN_START_BYTE \ ((UTF_CONTINUATION_MARK >> UTF_ACCUMULATION_SHIFT) | UTF_START_MARK(2)) #endif #ifndef UTF_MIN_ABOVE_LATIN1_BYTE # define UTF_MIN_ABOVE_LATIN1_BYTE \ ((0x100 >> UTF_ACCUMULATION_SHIFT) | UTF_START_MARK(2)) #endif #if (PERL_BCDVERSION < 0x5007000) /* Was the complement of what should have been */ # undef UTF8_IS_DOWNGRADEABLE_START #endif #ifndef UTF8_IS_DOWNGRADEABLE_START # define UTF8_IS_DOWNGRADEABLE_START(c) \ inRANGE(NATIVE_UTF8_TO_I8(c), \ UTF_MIN_START_BYTE, UTF_MIN_ABOVE_LATIN1_BYTE - 1) #endif #ifndef UTF_CONTINUATION_MASK # define UTF_CONTINUATION_MASK \ ((U8) ((1U << UTF_ACCUMULATION_SHIFT) - 1)) #endif #ifndef UTF8_ACCUMULATE # define UTF8_ACCUMULATE(base, added) \ (((base) << UTF_ACCUMULATION_SHIFT) \ | ((NATIVE_UTF8_TO_I8(added)) \ & UTF_CONTINUATION_MASK)) #endif #ifndef UTF8_ALLOW_ANYUV # define UTF8_ALLOW_ANYUV 0 #endif #ifndef UTF8_ALLOW_EMPTY # define UTF8_ALLOW_EMPTY 0x0001 #endif #ifndef UTF8_ALLOW_CONTINUATION # define UTF8_ALLOW_CONTINUATION 0x0002 #endif #ifndef UTF8_ALLOW_NON_CONTINUATION # define UTF8_ALLOW_NON_CONTINUATION 0x0004 #endif #ifndef UTF8_ALLOW_SHORT # define UTF8_ALLOW_SHORT 0x0008 #endif #ifndef UTF8_ALLOW_LONG # define UTF8_ALLOW_LONG 0x0010 #endif #ifndef UTF8_ALLOW_OVERFLOW # define UTF8_ALLOW_OVERFLOW 0x0080 #endif #ifndef UTF8_ALLOW_ANY # define UTF8_ALLOW_ANY ( UTF8_ALLOW_CONTINUATION \ |UTF8_ALLOW_NON_CONTINUATION \ |UTF8_ALLOW_SHORT \ |UTF8_ALLOW_LONG \ |UTF8_ALLOW_OVERFLOW) #endif #if defined UTF8SKIP /* Don't use official versions because they use MIN, which may not be available */ #undef UTF8_SAFE_SKIP #undef UTF8_CHK_SKIP #ifndef UTF8_SAFE_SKIP # define UTF8_SAFE_SKIP(s, e) ( \ ((((e) - (s)) <= 0) \ ? 0 \ : D_PPP_MIN(((e) - (s)), UTF8SKIP(s)))) #endif #ifndef UTF8_CHK_SKIP # define UTF8_CHK_SKIP(s) \ (s[0] == '\0' ? 1 : ((U8) D_PPP_MIN(my_strnlen((char *) (s), UTF8SKIP(s)), \ UTF8SKIP(s)))) #endif /* UTF8_CHK_SKIP depends on my_strnlen */ #ifndef UTF8_SKIP # define UTF8_SKIP(s) UTF8SKIP(s) #endif #endif #if 'A' == 65 #ifndef UTF8_IS_INVARIANT # define UTF8_IS_INVARIANT(c) isASCII(c) #endif #else #ifndef UTF8_IS_INVARIANT # define UTF8_IS_INVARIANT(c) (isASCII(c) || isCNTRL_L1(c)) #endif #endif #ifndef UVCHR_IS_INVARIANT # define UVCHR_IS_INVARIANT(c) UTF8_IS_INVARIANT(c) #endif #ifdef UVCHR_IS_INVARIANT # if 'A' != 65 || UVSIZE < 8 /* 32 bit platform, which includes UTF-EBCDIC on the releases this is * backported to */ # define D_PPP_UVCHR_SKIP_UPPER(c) 7 # else # define D_PPP_UVCHR_SKIP_UPPER(c) \ (((WIDEST_UTYPE) (c)) < \ (((WIDEST_UTYPE) 1) << (6 * D_PPP_BYTE_INFO_BITS)) ? 7 : 13) # endif #ifndef UVCHR_SKIP # define UVCHR_SKIP(c) \ UVCHR_IS_INVARIANT(c) ? 1 : \ (WIDEST_UTYPE) (c) < (32 * (1U << ( D_PPP_BYTE_INFO_BITS))) ? 2 : \ (WIDEST_UTYPE) (c) < (16 * (1U << (2 * D_PPP_BYTE_INFO_BITS))) ? 3 : \ (WIDEST_UTYPE) (c) < ( 8 * (1U << (3 * D_PPP_BYTE_INFO_BITS))) ? 4 : \ (WIDEST_UTYPE) (c) < ( 4 * (1U << (4 * D_PPP_BYTE_INFO_BITS))) ? 5 : \ (WIDEST_UTYPE) (c) < ( 2 * (1U << (5 * D_PPP_BYTE_INFO_BITS))) ? 6 : \ D_PPP_UVCHR_SKIP_UPPER(c) #endif #endif #ifdef is_ascii_string #ifndef is_invariant_string # define is_invariant_string(s,l) is_ascii_string(s,l) #endif #ifndef is_utf8_invariant_string # define is_utf8_invariant_string(s,l) is_ascii_string(s,l) #endif /* Hint: is_ascii_string, is_invariant_string is_utf8_invariant_string() does the same thing and is preferred because its name is more accurate as to what it does */ #endif #ifdef ibcmp_utf8 #ifndef foldEQ_utf8 # define foldEQ_utf8(s1,pe1,l1,u1,s2,pe2,l2,u2) \ cBOOL(! ibcmp_utf8(s1,pe1,l1,u1,s2,pe2,l2,u2)) #endif #endif #if defined(is_utf8_string) && defined(UTF8SKIP) #ifndef isUTF8_CHAR # define isUTF8_CHAR(s, e) ( \ (e) <= (s) || ! is_utf8_string(s, UTF8_SAFE_SKIP(s, e)) \ ? 0 \ : UTF8SKIP(s)) #endif #endif #if 'A' == 65 #ifndef BOM_UTF8 # define BOM_UTF8 "\xEF\xBB\xBF" #endif #ifndef REPLACEMENT_CHARACTER_UTF8 # define REPLACEMENT_CHARACTER_UTF8 "\xEF\xBF\xBD" #endif #elif '^' == 95 #ifndef BOM_UTF8 # define BOM_UTF8 "\xDD\x73\x66\x73" #endif #ifndef REPLACEMENT_CHARACTER_UTF8 # define REPLACEMENT_CHARACTER_UTF8 "\xDD\x73\x73\x71" #endif #elif '^' == 176 #ifndef BOM_UTF8 # define BOM_UTF8 "\xDD\x72\x65\x72" #endif #ifndef REPLACEMENT_CHARACTER_UTF8 # define REPLACEMENT_CHARACTER_UTF8 "\xDD\x72\x72\x70" #endif #else # error Unknown character set #endif #if (PERL_BCDVERSION < 0x5035010) /* Versions prior to 5.31.4 accepted things that are now considered * malformations, and didn't return -1 on error with warnings enabled. * Versions before 5.35.10 dereferenced empty input without checking */ # undef utf8_to_uvchr_buf #endif /* This implementation brings modern, generally more restricted standards to * utf8_to_uvchr_buf. Some of these are security related, and clearly must * be done. But its arguable that the others need not, and hence should not. * The reason they're here is that a module that intends to play with the * latest perls should be able to work the same in all releases. An example is * that perl no longer accepts any UV for a code point, but limits them to * IV_MAX or below. This is for future internal use of the larger code points. * If it turns out that some of these changes are breaking code that isn't * intended to work with modern perls, the tighter restrictions could be * relaxed. khw thinks this is unlikely, but has been wrong in the past. */ /* 5.6.0 is the first release with UTF-8, and we don't implement this function * there due to its likely lack of still being in use, and the underlying * implementation is very different from later ones, without the later * safeguards, so would require extra work to deal with */ #if (PERL_BCDVERSION >= 0x5006001) && ! defined(utf8_to_uvchr_buf) /* Choose which underlying implementation to use. At least one must be * present or the perl is too early to handle this function */ # if defined(utf8n_to_uvchr) || defined(utf8_to_uvchr) || defined(utf8_to_uv) # if defined(utf8n_to_uvchr) /* This is the preferred implementation */ # define D_PPP_utf8_to_uvchr_buf_callee utf8n_to_uvchr # elif /* Must be at least 5.6.1 from #if above; \ If have both regular and _simple, regular has all args */ \ defined(utf8_to_uv) && defined(utf8_to_uv_simple) # define D_PPP_utf8_to_uvchr_buf_callee utf8_to_uv # elif defined(utf8_to_uvchr) /* The below won't work well on error input */ # define D_PPP_utf8_to_uvchr_buf_callee(s, curlen, retlen, flags) \ utf8_to_uvchr((U8 *)(s), (retlen)) # else # define D_PPP_utf8_to_uvchr_buf_callee(s, curlen, retlen, flags) \ utf8_to_uv((U8 *)(s), (retlen)) # endif # endif # if defined(NEED_utf8_to_uvchr_buf) static UV DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 * s, const U8 * send, STRLEN * retlen); static #else extern UV DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 * s, const U8 * send, STRLEN * retlen); #endif #if defined(NEED_utf8_to_uvchr_buf) || defined(NEED_utf8_to_uvchr_buf_GLOBAL) #ifdef utf8_to_uvchr_buf # undef utf8_to_uvchr_buf #endif #define utf8_to_uvchr_buf(a,b,c) DPPP_(my_utf8_to_uvchr_buf)(aTHX_ a,b,c) #define Perl_utf8_to_uvchr_buf DPPP_(my_utf8_to_uvchr_buf) UV DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen) { # if (PERL_BCDVERSION >= 0x5031004) /* But from above, must be < 5.35.10 */ # if (PERL_BCDVERSION != 0x5035009) /* Versions less than 5.35.9 could dereference s on zero length, so * pass it something where no harm comes from that. */ if (send <= s) s = send = (U8 *) "?"; return Perl_utf8_to_uvchr_buf_helper(aTHX_ s, send, retlen); # else /* Below is 5.35.9, which also works on non-empty input, but for empty input, can wrongly dereference, and additionally is also just plain broken */ if (send > s) return Perl_utf8_to_uvchr_buf_helper(aTHX_ s, send, retlen); if (! ckWARN_d(WARN_UTF8)) { if (retlen) *retlen = 0; return UNICODE_REPLACEMENT; } else { s = send = (U8 *) "?"; /* Call just for its warning */ (void) Perl__utf8n_to_uvchr_msgs_helper(s, 0, NULL, 0, NULL, NULL); if (retlen) *retlen = (STRLEN) -1; return 0; } # endif # else UV ret; STRLEN curlen; bool overflows = 0; const U8 *cur_s = s; const bool do_warnings = ckWARN_d(WARN_UTF8); # if (PERL_BCDVERSION < 0x5026000) && ! defined(EBCDIC) STRLEN overflow_length = 0; # endif if (send > s) { curlen = send - s; } else { assert(0); /* Modern perls die under this circumstance */ curlen = 0; if (! do_warnings) { /* Handle empty here if no warnings needed */ if (retlen) *retlen = 0; return UNICODE_REPLACEMENT; } } # if (PERL_BCDVERSION < 0x5026000) && ! defined(EBCDIC) /* Perl did not properly detect overflow for much of its history on * non-EBCDIC platforms, often returning an overlong value which may or may * not have been tolerated in the call. Also, earlier versions, when they * did detect overflow, may have disallowed it completely. Modern ones can * replace it with the REPLACEMENT CHARACTER, depending on calling * parameters. Therefore detect it ourselves in releases it was * problematic in. */ if (curlen > 0 && UNLIKELY(*s >= 0xFE)) { /* First, on a 32-bit machine the first byte being at least \xFE * automatically is overflow, as it indicates something requiring more * than 31 bits */ if (sizeof(ret) < 8) { overflows = 1; overflow_length = (*s == 0xFE) ? 7 : 13; } else { const U8 highest[] = /* 2*63-1 */ "\xFF\x80\x87\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF"; const U8 *cur_h = highest; for (cur_s = s; cur_s < send; cur_s++, cur_h++) { if (UNLIKELY(*cur_s == *cur_h)) { continue; } /* If this byte is larger than the corresponding highest UTF-8 * byte, the sequence overflows; otherwise the byte is less * than (as we handled the equality case above), and so the * sequence doesn't overflow */ overflows = *cur_s > *cur_h; break; } /* Here, either we set the bool and broke out of the loop, or got * to the end and all bytes are the same which indicates it doesn't * overflow. If it did overflow, it would be this number of bytes * */ overflow_length = 13; } } if (UNLIKELY(overflows)) { ret = 0; if (! do_warnings && retlen) { *retlen = overflow_length; } } else # endif /* < 5.26 */ /* Here, we are either in a release that properly detects overflow, or * we have checked for overflow and the next statement is executing as * part of the above conditional where we know we don't have overflow. * * The modern versions allow anything that evaluates to a legal UV, but * not overlongs nor an empty input */ ret = D_PPP_utf8_to_uvchr_buf_callee( (U8 *) /* Early perls: no const */ s, curlen, retlen, (UTF8_ALLOW_ANYUV & ~(UTF8_ALLOW_LONG|UTF8_ALLOW_EMPTY))); # if (PERL_BCDVERSION >= 0x5026000) && (PERL_BCDVERSION < 0x5028000) /* But actually, more modern versions restrict the UV to being no more than * what an IV can hold, so it could still have gotten it wrong about * overflowing. */ if (UNLIKELY(ret > IV_MAX)) { overflows = 1; } # endif if (UNLIKELY(overflows)) { if (! do_warnings) { if (retlen) { *retlen = D_PPP_MIN(*retlen, UTF8SKIP(s)); *retlen = D_PPP_MIN(*retlen, curlen); } return UNICODE_REPLACEMENT; } else { /* We use the error message in use from 5.8-5.26 */ Perl_warner(aTHX_ packWARN(WARN_UTF8), "Malformed UTF-8 character (overflow at 0x%" UVxf ", byte 0x%02x, after start byte 0x%02x)", ret, *cur_s, *s); if (retlen) { *retlen = (STRLEN) -1; } return 0; } } /* Here, did not overflow, but if it failed for some other reason, and * warnings are off, to emulate the behavior of the real utf8_to_uvchr(), * try again, allowing anything. (Note a return of 0 is ok if the input * was '\0') */ if (UNLIKELY(ret == 0 && (curlen == 0 || *s != '\0'))) { /* If curlen is 0, we already handled the case where warnings are * disabled, so this 'if' will be true, and so later on, we know that * 's' is dereferencible */ if (do_warnings) { if (retlen) { *retlen = (STRLEN) -1; } } else { ret = D_PPP_utf8_to_uvchr_buf_callee( (U8 *) /* Early perls: no const */ s, curlen, retlen, UTF8_ALLOW_ANY); /* Override with the REPLACEMENT character, as that is what the * modern version of this function returns */ ret = UNICODE_REPLACEMENT; # if (PERL_BCDVERSION < 0x5016000) /* Versions earlier than this don't necessarily return the proper * length. It should not extend past the end of string, nor past * what the first byte indicates the length is, nor past the * continuation characters */ if (retlen && (IV) *retlen >= 0) { unsigned int i = 1; *retlen = D_PPP_MIN(*retlen, curlen); *retlen = D_PPP_MIN(*retlen, UTF8SKIP(s)); do { # ifdef UTF8_IS_CONTINUATION if (! UTF8_IS_CONTINUATION(s[i])) # else /* Versions without the above don't support EBCDIC anyway */ if (s[i] < 0x80 || s[i] > 0xBF) # endif { *retlen = i; break; } } while (++i < *retlen); } # endif /* end of < 5.16.0 */ } } return ret; # endif /* end of < 5.31.4 */ } # endif #endif #if defined(UTF8SKIP) && defined(utf8_to_uvchr_buf) #undef utf8_to_uvchr /* Always redefine this unsafe function so that it refuses to read past a NUL, making it much less likely to read off the end of the buffer. A NUL indicates the start of the next character anyway. If the input isn't NUL-terminated, the function remains unsafe, as it always has been. */ #ifndef utf8_to_uvchr # define utf8_to_uvchr(s, lp) \ ((*(s) == '\0') \ ? utf8_to_uvchr_buf(s,((s)+1), lp) /* Handle single NUL specially */ \ : utf8_to_uvchr_buf(s, (s) + UTF8_CHK_SKIP(s), (lp))) #endif #endif /* Hint: utf8_to_uvchr Use utf8_to_uvchr_buf() instead. But ONLY if you KNOW the upper bound of the input string (not resorting to using UTF8SKIP, etc., to infer it). The backported utf8_to_uvchr() will do a better job to prevent most cases of trying to read beyond the end of the buffer */ /* Replace utf8_to_uvchr with utf8_to_uvchr_buf */ #ifdef sv_len_utf8 # if (PERL_BCDVERSION >= 0x5017005) # ifndef sv_len_utf8_nomg # if defined(PERL_USE_GCC_BRACE_GROUPS) # define sv_len_utf8_nomg(sv) \ ({ \ SV *sv_ = (sv); \ sv_len_utf8(!SvGMAGICAL(sv_) \ ? sv_ \ : sv_mortalcopy_flags(sv_, SV_NOSTEAL)); \ }) # else PERL_STATIC_INLINE STRLEN D_PPP_sv_len_utf8_nomg(SV * sv) { dTHX; if (SvGMAGICAL(sv)) return sv_len_utf8(sv_mortalcopy_flags(sv, SV_NOSTEAL)); else return sv_len_utf8(sv); } # define sv_len_utf8_nomg(sv) D_PPP_sv_len_utf8_nomg(sv) # endif # endif # else /* < 5.17.5 */ /* Older Perl versions have broken sv_len_utf8() when passed sv does not * have SVf_UTF8 flag set */ /* Also note that SvGETMAGIC() may change presence of SVf_UTF8 flag */ # undef sv_len_utf8 # if defined(PERL_USE_GCC_BRACE_GROUPS) # define sv_len_utf8_nomg(sv) \ ({ \ SV *sv2 = (sv); \ STRLEN len; \ if (SvUTF8(sv2)) { \ if (SvGMAGICAL(sv2)) \ len = Perl_sv_len_utf8(aTHX_ \ sv_mortalcopy_flags(sv2, \ SV_NOSTEAL));\ else \ len = Perl_sv_len_utf8(aTHX_ sv2); \ } \ else SvPV_nomg(sv2, len); \ len; \ }) # define sv_len_utf8(sv) ({ SV *_sv1 = (sv); \ SvGETMAGIC(_sv1); \ sv_len_utf8_nomg(_sv1); \ }) # else /* Below is no brace groups */ PERL_STATIC_INLINE STRLEN D_PPP_sv_len_utf8_nomg(SV * sv) { dTHX; STRLEN len; if (SvUTF8(sv)) { if (SvGMAGICAL(sv)) len = Perl_sv_len_utf8(aTHX_ sv_mortalcopy_flags(sv, SV_NOSTEAL)); else len = Perl_sv_len_utf8(aTHX_ sv); } else SvPV_nomg(sv, len); return len; } # define sv_len_utf8_nomg(sv) D_PPP_sv_len_utf8_nomg(sv) PERL_STATIC_INLINE STRLEN D_PPP_sv_len_utf8(SV * sv) { dTHX; SvGETMAGIC(sv); return sv_len_utf8_nomg(sv); } # define sv_len_utf8(sv) D_PPP_sv_len_utf8(sv) # endif # endif /* End of < 5.17.5 */ #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_buf) 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_buf) 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_buf) isuni ? utf8_to_uvchr_buf((U8*)pv, end, &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 #if PERL_VERSION_LT(5,27,9) #ifndef LC_NUMERIC_LOCK # define LC_NUMERIC_LOCK #endif #ifndef LC_NUMERIC_UNLOCK # define LC_NUMERIC_UNLOCK #endif # if PERL_VERSION_LT(5,19,0) # undef STORE_LC_NUMERIC_SET_STANDARD # undef RESTORE_LC_NUMERIC # undef DECLARATION_FOR_LC_NUMERIC_MANIPULATION # ifdef USE_LOCALE #ifndef DECLARATION_FOR_LC_NUMERIC_MANIPULATION # define DECLARATION_FOR_LC_NUMERIC_MANIPULATION char *LoC_ #endif #ifndef STORE_NUMERIC_SET_STANDARD # define STORE_NUMERIC_SET_STANDARD() \ LoC_ = savepv(setlocale(LC_NUMERIC, NULL)); \ SAVEFREEPV(LoC_); \ setlocale(LC_NUMERIC, "C"); #endif #ifndef RESTORE_LC_NUMERIC # define RESTORE_LC_NUMERIC() \ setlocale(LC_NUMERIC, LoC_); #endif # else #ifndef DECLARATION_FOR_LC_NUMERIC_MANIPULATION # define DECLARATION_FOR_LC_NUMERIC_MANIPULATION #endif #ifndef STORE_LC_NUMERIC_SET_STANDARD # define STORE_LC_NUMERIC_SET_STANDARD() #endif #ifndef RESTORE_LC_NUMERIC # define RESTORE_LC_NUMERIC() #endif # endif # endif #endif #ifndef LOCK_NUMERIC_STANDARD # define LOCK_NUMERIC_STANDARD() #endif #ifndef UNLOCK_NUMERIC_STANDARD # define UNLOCK_NUMERIC_STANDARD() #endif /* The names of these changed in 5.28 */ #ifndef LOCK_LC_NUMERIC_STANDARD # define LOCK_LC_NUMERIC_STANDARD LOCK_NUMERIC_STANDARD #endif #ifndef UNLOCK_LC_NUMERIC_STANDARD # define UNLOCK_LC_NUMERIC_STANDARD UNLOCK_NUMERIC_STANDARD #endif /* If this doesn't exist, it's not needed, so is void noop */ #ifndef switch_to_global_locale # define switch_to_global_locale() #endif /* Originally, this didn't return a value, but in perls like that, the value * should always be TRUE. Add a return to Perl_sync_locale() when it's * available. And actually do a sync when its not, if locales are available on * this system. */ #ifdef sync_locale # if (PERL_BCDVERSION < 0x5027009) # if (PERL_BCDVERSION >= 0x5021003) # undef sync_locale # define sync_locale() (Perl_sync_locale(aTHX), 1) # elif defined(sync_locale) /* These should only be the 5.20 maints*/ # undef sync_locale /* Just copy their defn and return 1 */ # define sync_locale() (new_ctype(setlocale(LC_CTYPE, NULL)), \ new_collate(setlocale(LC_COLLATE, NULL)), \ set_numeric_local(), \ new_numeric(setlocale(LC_NUMERIC, NULL)), \ 1) # elif defined(new_ctype) && defined(LC_CTYPE) # define sync_locale() (new_ctype(setlocale(LC_CTYPE, NULL)), 1) # endif # endif #endif #ifndef sync_locale # define sync_locale() 1 #endif #endif /* _P_P_PORTABILITY_H_ */ /* End of File ppport.h */ Math-Prime-Util-0.74/powerfree.h000644 000765 000024 00000000555 15145577415 016562 0ustar00danastaff000000 000000 #ifndef MPU_POWERFREE_H #define MPU_POWERFREE_H extern bool is_powerfree(UV n, uint32_t k); extern UV powerfree_count(UV n, uint32_t k); extern UV powerfree_sum(UV n, uint32_t k); extern UV powerfree_part(UV n, uint32_t k); extern UV powerfree_part_sum(UV n, uint32_t k); extern UV nth_powerfree(UV n, uint32_t k); extern UV squarefree_kernel(UV n); #endif Math-Prime-Util-0.74/perfect_powers.h000644 000765 000024 00000001466 15145577415 017615 0ustar00danastaff000000 000000 #ifndef MPU_PERFECT_POWERS_H #define MPU_PERFECT_POWERS_H #include "ptypes.h" extern bool is_perfect_power(UV n); extern bool is_perfect_power_neg(UV n); /* answer for -n */ extern bool is_perfect_power_iv(IV n); extern UV next_perfect_power(UV n); extern UV prev_perfect_power(UV n); extern UV next_perfect_power_neg(UV n); /* return -next for -n */ extern UV prev_perfect_power_neg(UV n); /* return -prev for -n */ extern UV perfect_power_count_range(UV lo, UV hi); extern UV perfect_power_count(UV n); extern UV perfect_power_count_lower(UV n); extern UV perfect_power_count_upper(UV n); extern UV perfect_power_count_approx(UV n); extern UV nth_perfect_power(UV n); extern UV nth_perfect_power_lower(UV n); extern UV nth_perfect_power_upper(UV n); extern UV nth_perfect_power_approx(UV n); #endif Math-Prime-Util-0.74/t/000755 000765 000024 00000000000 15154713771 014646 5ustar00danastaff000000 000000 Math-Prime-Util-0.74/entropy.h000644 000765 000024 00000000205 15145577415 016254 0ustar00danastaff000000 000000 #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.74/xt/000755 000765 000024 00000000000 15154713771 015036 5ustar00danastaff000000 000000 Math-Prime-Util-0.74/README000644 000765 000024 00000006754 15153174005 015265 0ustar00danastaff000000 000000 Math::Prime::Util version 0.74 A comprehensive number theory module for Perl, also available as "ntheory". It provides over 370 functions covering: - Prime sieving, generation, and iteration - Primality testing (BPSW, Miller-Rabin, Lucas, Frobenius, AKS) and proving - Integer factoring (trial, Pollard rho, p-1, p+1, SQUFOF, ECM) - Prime counting: exact (Lehmer/LMO), bounds, and approximations - Nth prime, twin primes, almost primes, semiprimes - Random prime generation (cryptographic CSPRNG) - Combinatorics: binomial, factorial, Stirling, partitions, permutations - Multiplicative functions: euler_phi, moebius, divisor_sum, liouville, etc. - Modular arithmetic: powmod, sqrtmod, chinese (CRT), znorder, znlog - Integer arithmetic: addint, mulint, divint, powint, etc. (arbitrary size) - Special functions: Riemann zeta, R, Li, Lambert W, Chebyshev theta/psi - Iterators: forprimes, forcomposites, fordivisors, forcomb, forpart, etc. - Integer set operations: union, intersection, minus, delta, sumset, etc. Performance-critical code is written in C (XS). A pure Perl backend is included for portability. For bignum inputs, installing the optional Math::Prime::Util::GMP module gives a large additional speedup. The default sieving and factoring are intended to be the fastest on CPAN, and are faster than Math::Prime::XS, Math::Prime::FastSieve, Math::Factor::XS, Math::Big, Math::Factoring, Math::Primality, and Crypt::Primes. For native-size integers it is typically faster than Math::Pari. With Math::Prime::Util::GMP installed it is usually faster than Math::Pari for bigints as well. SYNOPSIS use Math::Prime::Util qw/:all/; # or: use ntheory qw/:all/; # Sieving and iteration my $aref = primes(100_000_000); # array ref of primes my @twins = @{ twin_primes(1000, 2000) }; # twin primes in range forprimes { say } 1e6, 1e6+1000; # iterate over primes # Primality say is_prime(1000000007) ? "prime" : "composite"; say is_provable_prime($n) ? "proven prime" : "not prime"; # Factoring my @factors = factor(1234567890); my @fexp = factor_exp("290375823984720394875209384750932"); # Prime counting say prime_count(1e11); # exact: 4118054813 say prime_count_approx(int(1e18)); # fast approximation # Number-theoretic functions say euler_phi(240); # 64 say moebius(30); # -1 say carmichael_lambda(1002); # 166 # Modular arithmetic say powmod(2, 1000, 1009); # 2^1000 mod 1009 say chinese([14,643], [254,419]); # CRT say znorder(2, 1009); # multiplicative order See the POD documentation for full details on all functions: perldoc Math::Prime::Util INSTALLATION To install this module: 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). C89 compiler, 32-bit or 64-bit. Optional: Math::Prime::Util::GMP for faster bignum operations. COPYRIGHT AND LICENCE Copyright (C) 2011-2026 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.74/lucky_numbers.c000644 000765 000024 00000053612 15151725161 017431 0ustar00danastaff000000 000000 #include #include #include #include "ptypes.h" #include "constants.h" #include "lucky_numbers.h" #include "inverse_interpolate.h" #include "ds_bitmask126.h" static const int _verbose = 0; /******************************************************************************/ /* LUCKY NUMBERS */ /******************************************************************************/ static const unsigned char _small_lucky[48] = {1,3,7,9,13,15,21,25,31,33,37,43,49,51,63,67,69,73,75,79,87,93,99,105,111,115,127,129,133,135,141,151,159,163,169,171,189,193,195,201,205,211,219,223,231,235,237,241}; static const unsigned char _small_lucky_count[48] = {0,1,1,2,2,2,2,3,3,4,4,4,4,5,5,6,6,6,6,6,6,7,7,7,7,8,8,8,8,8,8,9,9,10,10,10,10,11,11,11,11,11,11,12,12,12,12,12}; /* True for any position where (n % 7*9) could be a lucky number */ static const char _lmask63[63+2] = {1,1,0,1,1,0,1,1,0,1,1,0,1,1,0,1,1,0,0,0,0,1,1,0,1,1,0,0,0,0,1,1,0,1,1,0,1,1,0,0,0,0,1,1,0,1,1,0,1,1,0,1,1,0,1,1,0,0,0,0,0,0,0,1,1}; /* mpufile '$n++; chomp; $v=$_; next unless $v > 10000; $m[ ($v>>1) % 4095 ]++; END { for (0..4094) { next unless $m[$_]; $b[$_ >> 5] |= (1 << ($_%32)); } say join ",",@b; }' ~/misc/ntheory/lucky_1e8.txt */ /* A large bitmask for ((n>>1) % 3*7*3*13) (819). Covers 2,3,7,9,13. */ static const uint32_t _lmask5[26] = {2334495963U,2261929142U,1169344621,2204739155U,2727961910U,1639207725,3513561243U,2430232978U,1754683725,3630970059U,3025873062U,1278646881,3658323539U,3055177010U,1830209833,3406669457U,3054200212U,1837519692,1531293898,650340770,757258597,2606838995U,2530306226U,1169218145,3408442969U,11572}; /* Lucky Number sieves. * * Mask presieving for the first 5 levels, followed by pre-sieving with a small * number of initial values. * * For fairly small sieves, less than 250k or so, we use a simplied pagelist. * Unlike the full pagelist method, this does not use an index tree. * * For sieving of non-small sizes, a bitmask (32 bits per 126 integers) is * used, with an index tree allowing log(n) time index lookups. This is much * faster and uses substantially less memory than the other methods. Memory * use grows linearly with the sieve size n. * * Generate first 10M lucky numbers (from 1 to 196502733) on 2020 M1 Mac: * 1.8s bitmask126 memory: n/25 ( 8MB) * 3.1s pagelist_sieve32 memory: 4 * count * ~2.5 (100MB) * 4.2s pagelist_sieve64 memory: 8 * count * ~2.3 (190MB) * 1356s lucky_cgen memory: 8 * count * 2 (160MB) * 8950s Wilson memory: 8 * count * 1 ( 80MB) * * pagelist: * nth_lucky(1<<31): 55291335127 47 sec using lucky_sieve32 930MB * nth_lucky(1<<32): 113924214621 140 sec using lucky_sieve64 3.2GB * nth_lucky(1<<33): 234516370291 312 sec using lucky_sieve64 6.3GB * nth_lucky(1<<34): 482339741617 733 sec using lucky_sieve64 12.1GB * * bitmask: * nth_lucky(1<<31): 55291335127 23 sec using lucky_sieve32 89MB * nth_lucky(1<<32): 113924214621 50 sec using lucky_sieve64 173MB * nth_lucky(1<<33): 234516370291 107 sec using lucky_sieve64 341MB * nth_lucky(1<<34): 482339741617 224 sec using lucky_sieve64 675MB * nth_lucky(1<<35): 991238156013 469 sec using lucky_sieve64 1.3GB * nth_lucky(1<<36): 2035487409679 987 sec using lucky_sieve64 2.6GB * nth_lucky(1<<37): 4176793875529 2063 sec using lucky_sieve64 5.3GB * * A Graviton3 r7g takes about 1.6x more CPU time. * nth_lucky(1<<39) 17551419620869 in 258min on Graviton3 r7g, 21GB. * nth_lucky(1<<40) 35944896074391 in 523min on Graviton3 r7g, 42GB. * nth_lucky(1<<41) 73571139180453 in 1112min on Graviton3 r7g, 84GB. * nth_lucky(1<<42) 150499648533909 in 2303min on Graviton3 r7g, 168GB. * nth_lucky(1<<43) 307703784778627 in 3691min on Graviton3 r7g, 334GB. */ /* Simple 32-bit pagelist: fast for small (less than 10M or so) inputs. * Simple filtering, then sieve a big block using memmove. * This is memory intensive and has poor performance with large n. */ static uint32_t* _small_lucky_sieve32(UV *size, uint32_t n) { uint32_t i, m, c13, level, init_level, fsize, lsize, *lucky; if (n < 259) { if (n == 0) { *size = 0; return 0; } New(0, lucky, 5+n/5, uint32_t); for (lsize = 0; lsize < 48 && _small_lucky[lsize] <= n; lsize++) lucky[lsize] = _small_lucky[lsize]; *size = lsize; return lucky; } /* @l=(2,3,7,9,13); $n=vecprod(@l); $n -= divint($n,$_) for @l; say $n */ fsize = 1152*(n+4913)/4914; New(0, lucky, 1 + fsize, uint32_t); lsize = c13 = 0; /* Create initial list, filtering out 3,7,9,13 */ for (i = 1, m = 1; i <= n; i += 6) { if (_lmask63[m ]) { if (++c13 == 13) c13 = 0; else lucky[lsize++] = i; } if (_lmask63[m+2] && (i+2) <= n) { if (++c13 == 13) c13 = 0; else lucky[lsize++] = i+2; } if ((m += 6) >= 63) m -= 63; } init_level = 5; /* After the fill-in, we'll start deleting at 15 */ for (level = init_level; level < lsize && lucky[level]-1 < lsize; level++) { uint32_t skip = lucky[level]-1, nlsize = skip; if (2*(skip+1) > lsize) break; /* Only single skips left */ for (i = skip+1; i < lsize; i += skip+1) { uint32_t ncopy = (skip <= (lsize-i)) ? skip : (lsize-i); memmove( lucky + nlsize, lucky + i, ncopy * sizeof(uint32_t) ); nlsize += ncopy; } lsize = nlsize; } /* Now we just have single skips. Process them all in one pass. */ if (level < lsize && lucky[level]-1 < lsize) { uint32_t skip = lucky[level], nlsize = skip-1; while (skip < lsize) { uint32_t ncopy = lucky[level+1] - lucky[level]; if (ncopy > lsize-skip) ncopy = lsize - skip; memmove(lucky + nlsize, lucky + skip, ncopy * sizeof(uint32_t)); nlsize += ncopy; skip += ncopy + 1; level++; } lsize = nlsize; } *size = lsize; return lucky; } #if 0 /* No longer used */ #include "ds_pagelist32.h" uint32_t* _pagelist_lucky_sieve32(UV *size, uint32_t n) { uint32_t i, m, lsize, level, init_level, *lucky; pagelist32_t *pl; if (n > 4294967275U) n = 4294967275U; /* Max 32-bit lucky number */ if (n <= 280000) return _small_lucky_sieve32(size, n); pl = pagelist32_create(n); /* make initial list using filters for small lucky numbers. */ { UV slsize; uint32_t sln, ln, lbeg, lend, *count, *slucky; /* Decide how much additional filtering we'll do. */ sln = (n <= 1000000U) ? 133 : (n <= 100000000) ? 241 : 925; slucky = _small_lucky_sieve32(&slsize, sln); Newz(0, count, slsize, uint32_t); lbeg = 5; lend = slsize-1; if (1) { uint32_t ntarget = (2.4 * (double)n/log(n)); uint32_t ninit = n/2; for (i = 1; i < slsize && ninit > ntarget; i++) ninit -= ninit/slucky[i]; if (i < slsize) lend = i; if (lend < lbeg) lend = lbeg; } if (_verbose) printf("lucky_sieve32 pre-sieve using %u lucky numbers up to %u\n", lend, slucky[lend]); /* Construct the initial list */ for (i = 1, m = 0; i <= n; i += 2, m += 1) { if (m >= 819) m -= 819; /* m = (i>>1) % 819 */ if (_lmask5[m >> 5] & (1U << (m & 0x1F))) { for (ln = lbeg; ln <= lend; ln++) { if (++count[ln] == slucky[ln]) { count[ln] = 0; break; } } if (ln > lend) pagelist32_append(pl,i); } } init_level = lend+1; Safefree(slucky); Safefree(count); } lsize = pl->nelems; if (_verbose) printf("lucky_sieve32 done inserting. values: %u pages: %u\n", lsize, pl->npages[0]); if (init_level < lsize) { /* Use an iterator rather than calling pagelist32_val(pl,level) */ pagelist32_iter_t iter = pagelist32_iterator_create(pl, init_level); for (level = init_level; level < lsize; level++) { uint32_t skip = pagelist32_iterator_next(&iter) - 1; if (skip >= lsize) break; for (i = skip; i < lsize; i += skip) { pagelist32_delete(pl, i); lsize--; } } if (_verbose) printf("lucky_sieve32 done sieving. values: %u pages: %u\n", lsize, pl->npages[0]); } lucky = pagelist32_to_array(size, pl); if (*size != lsize) croak("bad sizes in lucky sieve 32"); if (_verbose) printf("lucky_sieve32 done copying.\n"); pagelist32_destroy(pl); return lucky; } #endif static bitmask126_t* _bitmask126_sieve(UV* size, UV n) { UV i, lsize, level, init_level; bitmask126_t *pl; pl = bitmask126_create(n); { uint8_t count[48] = {0}; uint32_t m, sln, ln, lbeg, lend; /* Decide how much additional filtering we'll do. */ sln = (n <= 200000000) ? 21 : (n <= 0xFFFFFFFF) ? 25 : 87; for (lbeg = lend = 5; lend < 48; lend++) if (_small_lucky[lend] >= sln) break; if (_verbose) printf("bitmask lucky pre-sieve using %u lucky numbers up to %u\n", lend, _small_lucky[lend]); /* Construct the initial list */ for (i = 1, m = 0; i <= n; i += 2, m += 1) { if (m >= 819) m -= 819; /* m = (i>>1) % 819 */ if (_lmask5[m >> 5] & (1U << (m & 0x1F))) { for (ln = lbeg; ln <= lend; ln++) { if (++count[ln] == _small_lucky[ln]) { count[ln] = 0; break; } } if (ln > lend) bitmask126_append(pl,i); } } init_level = lend+1; } lsize = pl->nelems; if (_verbose) printf("bitmask lucky done inserting. values: %lu\n",lsize); if (init_level < lsize) { bitmask126_iter_t iter = bitmask126_iterator_create(pl, init_level); for (level = init_level; level < lsize; level++) { UV skip = bitmask126_iterator_next(&iter) - 1; if (skip >= lsize) break; for (i = skip; i < lsize; i += skip) { bitmask126_delete(pl, i); lsize--; } } if (_verbose) printf("bitmask lucky done sieving. values: %lu\n",lsize); } *size = lsize; return pl; } uint32_t* lucky_sieve32(UV *size, uint32_t n) { uint32_t *lucky; bitmask126_t *pl; if (n == 0) { *size = 0; return 0; } if (n > 4294967275U) n = 4294967275U; /* Max 32-bit lucky number */ if (n <= 240000U) return _small_lucky_sieve32(size, n); pl = _bitmask126_sieve(size, n); lucky = bitmask126_to_array32(size, pl); if (_verbose) printf("lucky_sieve32 done copying.\n"); bitmask126_destroy(pl); return lucky; } UV* lucky_sieve64(UV *size, UV n) { UV *lucky; bitmask126_t *pl; if (n == 0) { *size = 0; return 0; } pl = _bitmask126_sieve(size, n); lucky = bitmask126_to_array(size, pl); if (_verbose) printf("lucky_sieve64 done copying.\n"); bitmask126_destroy(pl); return lucky; } UV* lucky_sieve_range(UV *size, UV beg, UV end) { UV i, nlucky, startcount, *lucky; bitmask126_t *pl; bitmask126_iter_t iter; if (end == 0 || beg > end) { *size = 0; return 0; } if (beg <= 1) return lucky_sieve64(size, end); startcount = lucky_count_lower(beg) - 1; pl = _bitmask126_sieve(size, end); New(0, lucky, *size - startcount, UV); iter = bitmask126_iterator_create(pl, startcount); for (i = startcount, nlucky = 0; i < *size; i++) { UV l = bitmask126_iterator_next(&iter); if (l >= beg) lucky[nlucky++] = l; } bitmask126_destroy(pl); *size = nlucky; return lucky; } /* Lucky Number sieve for 64-bit inputs. * Uses running counters to skip entries while we add them. * Based substantially on Hugo van der Sanden's cgen_lucky.c. */ UV* lucky_sieve_cgen(UV *size, UV n) { UV i, j, c3, lsize, lmax, lindex, *lucky, *count; if (n == 0) { *size = 0; return 0; } /* Init */ lmax = (n < 1000) ? 153 : 100 + n/log(n); New(0, lucky, lmax, UV); New(0, count, lmax, UV); lucky[0] = 1; lucky[1] = 3; lucky[2] = 7; lindex = 2; lsize = 1; c3 = 2; for (i = 3; i <= n; i += 2) { if (!--c3) { c3 = 3; continue; } /* Shortcut count[1] */ for (j = 2; j < lindex; j++) { if (--count[j] == 0) { count[j] = lucky[j]; break; } } if (j < lindex) continue; if (lsize >= lmax) { /* Given the estimate, we probably never do this. */ lmax = 1 + lsize * 1.2; Renew(lucky, lmax, UV); Renew(count, lmax, UV); } lucky[lsize] = count[lsize] = i; lsize++; if (lucky[lindex] == lsize) { lindex++; lsize--; /* Discard immediately */ } } Safefree(count); *size = lsize; return lucky; } /******************************************************************************/ /* static UV lucky_count_approx(UV n) { return 0.5 + 0.970 * n / log(n); } */ /* static UV lucky_count_upper(UV n) { return 200 + lucky_count_approx(n) * 1.025; } */ static UV _simple_lucky_count_approx(UV n) { double logn = log(n); return (n < 7) ? (n > 0) + (n > 2) : (n <= 10000) ? 1.03591 * n/logn : (n <= 1000000) ? 0.99575 * n/logn : (n <= 10000000) ? (1.03523 - logn/305) * n/logn : (n <= 100000000) ? (1.03432 - logn/304) * n/logn : (n <= 4000000000U) ? (1.03613 - logn/(100*log(logn))) * n/logn /* fit 1e9 to 1e10 */ : (1.03654 - logn/(100*log(logn))) * n/logn; } static UV _simple_lucky_count_upper(UV n) { double a, logn = log(n); if (n <= 6) return (n > 0) + (n > 2); if (n <= 7000) return 5 + 1.039 * n/logn; /* Don't make discontinities */ a = (n < 10017000) ? 0.58003 - 3.00e-9 * (n-7000) : 0.55; return n/(1.065*logn - a - 3.1/logn - 2.85/(logn*logn)); } static UV _simple_lucky_count_lower(UV n) { if (n <= 6) return (n > 0) + (n > 2); if (n <= 9000) return 1.028 * n/log(n) - 1; return 0.99 * _simple_lucky_count_approx(n); } UV lucky_count_approx(UV n) { UV lo, hi; if (n < 48) return _small_lucky_count[n]; /* return _simple_lucky_count_approx(n); */ lo = _simple_lucky_count_lower(n); hi = _simple_lucky_count_upper(n); return inverse_interpolate(lo, hi, n, &nth_lucky_approx, 0); } UV lucky_count_upper(UV n) { /* Holds under 1e9 */ UV lo, hi; if (n < 48) return _small_lucky_count[n]; /* The count estimator is better than nth lucky estimator for small values */ if (n < 40000000) return _simple_lucky_count_upper(n); #if 1 && BITS_PER_WORD == 64 if (n > UVCONST(18428297000000000000)) return _simple_lucky_count_upper(n); #endif lo = _simple_lucky_count_lower(n); hi = 1 + (_simple_lucky_count_upper(n) * 1.001); return inverse_interpolate(lo, hi, n, &nth_lucky_lower, 0); } UV lucky_count_lower(UV n) { /* Holds under 1e9 */ UV lo, hi; if (n < 48) return _small_lucky_count[n]; if (n < 9000) return _simple_lucky_count_lower(n); lo = _simple_lucky_count_lower(n); hi = _simple_lucky_count_upper(n); return inverse_interpolate(lo, hi, n, &nth_lucky_upper, 0); } UV lucky_count_range(UV lo, UV hi) { UV nlucky, lsize; if (hi < lo) return 0; if (hi < 48) return _small_lucky_count[hi] - (lo == 0 ? 0 : _small_lucky_count[lo-1]); /* * Analogous to how nth_lucky works, we sieve enough lucky numbers to * ensure we cover everything up to 'hi'. We can then get an exact * count by determining exactly how many values will be removed. */ if ((lo & 1)) lo--; /* Both lo and hi will be even */ if ((hi & 1)) hi++; lsize = 1+lucky_count_upper(hi); if (hi <= UVCONST(2000000000)) { uint32_t i, hicount = hi/2, locount = lo/2; uint32_t *lucky32 = lucky_sieve32(&nlucky, lsize); for (i = 1; i < nlucky && lucky32[i] <= lo; i++) { locount -= locount/lucky32[i]; hicount -= hicount/lucky32[i]; } for ( ; i < nlucky && lucky32[i] <= hicount; i++) hicount -= hicount/lucky32[i]; Safefree(lucky32); return hicount - locount; } else { /* We use the iterator here to cut down on memory use. */ UV i, hicount = hi/2, locount = lo/2; bitmask126_t* pl = _bitmask126_sieve(&nlucky, lsize); bitmask126_iter_t iter = bitmask126_iterator_create(pl, 1); for (i = 1; i < nlucky; i++) { UV l = bitmask126_iterator_next(&iter); if (l <= lo) locount -= locount/l; if (l > hicount) break; hicount -= hicount/l; } bitmask126_destroy(pl); return hicount - locount; } } UV lucky_count(UV n) { return lucky_count_range(0,n); } UV nth_lucky_approx(UV n) { double est, corr, fn, logn, loglogn, loglogn2; if (n <= 48) return (n == 0) ? 0 : _small_lucky[n-1]; fn = n; logn = log(fn); loglogn = log(logn); loglogn2 = loglogn * loglogn; /* Use interpolation so we have monotonic growth, as well as good results. * We use one formula for small values, and another for larger. */ /* p1=1<<14; e1=199123; p2=1<<16; e2=904225; * x1=log(log(p1))^2; x2=log(log(p2))^2; y1=(e1/p1-log(p1)-0.5*log(log(p1)))/x1; y2=(e2/p2-log(p2)-0.5*log(log(p2)))/x2; m=(y2-y1)/(x2-x1); printf(" corr = %13.11f + %.11f * (loglogn2 - %.11f);\n", y1, m, x1); */ if (n <= 65536) { if (n >= 16384) /* 16384 -- 65536 */ corr = 0.25427076035 + 0.00883698771 * (loglogn2 - 5.16445809103); else if (n >= 2048) /* 2048 -- 16384 */ corr = 0.24513311782 + 0.00880360023 * (loglogn2 - 4.12651426090); else if (n >= 256) /* 256 -- 2048 */ corr = 0.25585213066 - 0.00898952075 * (loglogn2 - 2.93412446098); else /* 49 -- 256 */ corr = 0.38691439589 - 0.12050840608 * (loglogn2 - 1.84654667704); est = fn * (logn + 0.5*loglogn + corr*loglogn2) + 0.5; } else { /* p1=1<<32; e1=113924214621; p2=1<<37; e2=4176793875529; * x1=log(log(p1))^2; x2=log(log(p2))^2; y1=(e1/p1-log(p1)-0.5*x1)/x1; y2=(e2/p2-log(p2)-0.5*x2)/x2; m=(y2-y1)/(x2-x1); printf(" corr = %13.11f + %.11f * (loglogn2 - %.11f);\n", y1, m, x1); */ if (fn >= 1099511627776.0) /* 2^40 -- 2^43 */ corr = -0.05012215934 - 0.00139445216 * (loglogn2 - 11.03811938314); else if (fn >= 68719476736.0) /* 2^36 -- 2^40 */ corr = -0.04904974983 - 0.00155649126 * (loglogn2 - 10.34912771904); else if (fn >= 4294967296.0) /* 2^32 -- 2^36 */ corr = -0.04770894029 - 0.00180229750 * (loglogn2 - 9.60518309351); else if (fn >= 67108864) /* 2^26 -- 2^32 */ corr = -0.04484819198 - 0.00229977135 * (loglogn2 - 8.36125581665); else if (fn >= 1048576) /* 2^20 -- 2^26 */ corr = -0.03971615189 - 0.00354309756 * (loglogn2 - 6.91279440604); else if (n >= 65536) /* 2^16 -- 2^20 */ corr = -0.03240114452 - 0.00651036735 * (loglogn2 - 5.78920076332); else if (n >= 512) /* 2^9 -- 2^16 */ corr = 0.00990254026 - 0.01735396532 * (loglogn2 - 3.35150517018); else /* 2^6 -- 2^9 */ corr = 0.13714087150 - 0.09637971899 * (loglogn2 - 2.03132772443); /* Hawkins and Briggs (1958), attributed to S. Chowla. */ est = fn * (logn + (0.5+corr)*loglogn2) + 0.5; } if (est >= MPU_MAX_LUCKY) return MPU_MAX_LUCKY; return (UV)est; } UV nth_lucky_upper(UV n) { double est, corr; if (n <= 48) return (n == 0) ? 0 : _small_lucky[n-1]; corr = (n <= 1000) ? 1.01 : (n <= 8200) ? 1.005 : 1.001; /* verified to n=3e9 / v=1e11 */ est = corr * nth_lucky_approx(n) + 0.5; if (est >= MPU_MAX_LUCKY) return MPU_MAX_LUCKY; return (UV)est; } UV nth_lucky_lower(UV n) { double est, corr; if (n <= 48) return (n == 0) ? 0 : _small_lucky[n-1]; est = nth_lucky_approx(n); corr = (n <= 122) ? 0.95 : (n <= 4096) ? 0.97 : (n <= 115000) ? 0.998 : 0.999 ; /* verified to n=3e9 / v=1e11 */ est = corr * nth_lucky_approx(n); return (UV)est; } UV nth_lucky(UV n) { UV i, k, nlucky; if (n <= 48) return (n == 0) ? 0 : _small_lucky[n-1]; /* Apply the backward sieve, ala Wilson, for entry n */ if (n <= UVCONST(100000000)) { uint32_t *lucky32 = lucky_sieve32(&nlucky, n); for (i = nlucky-1, k = n-1; i >= 1; i--) k += k/(lucky32[i]-1); Safefree(lucky32); } else { /* Iterate backwards through the sieve directly to save memory. */ bitmask126_t* pl = _bitmask126_sieve(&nlucky, n); bitmask126_iter_t iter = bitmask126_iterator_create(pl, nlucky-1); for (i = nlucky-1, k = n-1; i >= 1; i--) k += k / (bitmask126_iterator_prev(&iter) - 1); bitmask126_destroy(pl); } return (2 * k + 1); } static int _test_lucky_to(UV lsize, UV *beg, UV *end) { UV i = *beg, pos = *end, l, quo, nlucky; int ret = -1; if (lsize <= 700000000U) { uint32_t *lucky32 = lucky_sieve32(&nlucky, lsize); while (i < nlucky) { l = lucky32[i++]; if (pos < l) { ret = 1; break; } quo = pos / l; if (pos == quo*l) { ret = 0; break; } pos -= quo; } Safefree(lucky32); } else { /* For 64-bit, iterate directly through the bit-mask to save memory. */ bitmask126_t* pl = _bitmask126_sieve(&nlucky, lsize); if (i < nlucky) { bitmask126_iter_t iter = bitmask126_iterator_create(pl, i); while (i < nlucky) { l = bitmask126_iterator_next(&iter); i++; if (pos < l) { ret = 1; break; } quo = pos / l; if (pos == quo*l) { ret = 0; break; } pos -= quo; } } bitmask126_destroy(pl); } /* printf("tested lsize = %lu from %lu to %lu\n", lsize, *beg, i-1); */ *beg = i; *end = pos; return ret; } bool is_lucky(UV n) { UV i, l, quo, pos, lsize; int res; /* Simple pre-tests */ if ( !(n & 1) || (n%6) == 5 || !_lmask63[n % 63]) return 0; if (n < 45) return 1; if (n > MPU_MAX_LUCKY) return 0; /* Check valid position using the static list */ pos = (n+1) >> 1; /* Initial position in odds */ for (i = 1; i < 48; i++) { l = _small_lucky[i]; if (pos < l) return 1; quo = pos / l; if (pos == quo*l) return 0; pos -= quo; } lsize = 1+lucky_count_upper(n); { /* Check more small values */ UV psize = 600, gfac = 6; while (psize < lsize/3) { res = _test_lucky_to(psize, &i, &pos); if (res != -1) return res; psize *= gfac; gfac += 1; } } res = _test_lucky_to(lsize, &i, &pos); return (res == 0) ? 0 : 1; } Math-Prime-Util-0.74/factor.h000644 000765 000024 00000006566 15154713505 016042 0ustar00danastaff000000 000000 #ifndef MPU_FACTOR_H #define MPU_FACTOR_H #include "ptypes.h" #if BITS_PER_WORD == 64 #define MPU_MAX_FACTORS 64 #define MPU_MAX_DFACTORS 15 #else #define MPU_MAX_FACTORS 32 #define MPU_MAX_DFACTORS 9 #endif /* These all return the number of factors set in factors[]. * Nothing found: returns 1 and factors[0] = n * One factor found: returns 2 and factors[0] = f, factors[1] = n/f * ... */ extern int factor(UV n, UV *factors); extern int factor_one(UV n, UV *factors, bool primality, bool trial); typedef struct { UV n; UV f[MPU_MAX_DFACTORS]; uint8_t e[MPU_MAX_DFACTORS]; uint16_t nfactors; } factored_t; extern void factorintp(factored_t *nf, UV n); extern void factoredp_validate(const factored_t *nf); extern uint32_t factoredp_total_factors(const factored_t *nf); extern bool factoredp_is_square_free(const factored_t *nf); extern signed char factoredp_moebius(const factored_t *nf); extern uint32_t factoredp_linear_factors(UV fac[], const factored_t *nf); static INLINE factored_t factorint(UV n) { factored_t nf; factorintp(&nf, n); return nf; } static INLINE void factored_validate(const factored_t nf) { factoredp_validate(&nf); } static INLINE uint32_t factored_total_factors(const factored_t nf) { return factoredp_total_factors(&nf); } static INLINE bool factored_is_square_free(const factored_t nf) { return factoredp_is_square_free(&nf); } static INLINE signed char factored_moebius(const factored_t nf) { return factoredp_moebius(&nf); } static INLINE uint32_t factored_linear_factors(UV fac[], const factored_t nf) { return factoredp_linear_factors(fac, &nf); } extern int trial_factor(UV n, UV *factors, UV first, UV last); extern int fermat_factor(UV n, UV *factors, UV rounds); extern int holf_factor(UV n, UV *factors, UV rounds); extern int pbrent_factor(UV n, UV *factors, UV maxrounds, UV a); extern int prho_factor(UV n, UV *factors, UV maxrounds); extern int pminus1_factor(UV n, UV *factors, UV B1, UV B2); extern int pplus1_factor(UV n, UV *factors, UV B); extern int squfof_factor(UV n, UV *factors, UV rounds); extern int lehman_factor(UV n, UV *factors, bool dotrial); extern int cheb_factor(UV n, UV *factors, UV B, UV initx); extern UV* divisor_list(UV n, UV *num_divisors, UV maxd); extern UV divisor_sum(UV n, UV k); extern int prime_omega(UV n); /* number of distinct prime factors */ extern int prime_bigomega(UV n); /* number of prime factors w/ multiplicity */ /* bigomega => with_multiplicity=1 omega => with_multiplicity=0 */ extern unsigned char* range_nfactor_sieve(UV lo, UV hi, bool with_multiplicity); /* Factoring all numbers in a range. */ typedef struct { UV lo; UV hi; UV n; bool is_square_free; UV *factors; UV _coffset; UV _noffset; UV *_farray; UV *_nfactors; } factor_range_context_t; extern factor_range_context_t factor_range_init(UV lo, UV hi, bool square_free); extern int factor_range_next(factor_range_context_t *ctx); extern void factor_range_destroy(factor_range_context_t *ctx); /* extern UV dlp_trial(UV a, UV g, UV p, UV maxrounds); extern UV dlp_prho(UV a, UV g, UV p, UV n, UV maxrounds); extern UV dlp_bsgs(UV a, UV g, UV p, UV n, UV maxent); */ /* Generic znlog returns k that solves a = g^k mod p */ extern UV znlog(UV a, UV g, UV p); /* znlog given prime gorder = znorder(g,p) */ extern UV znlog_solve(UV a, UV g, UV p, UV gorder); #endif Math-Prime-Util-0.74/twin_primes.c000644 000765 000024 00000026376 15145577415 017130 0ustar00danastaff000000 000000 #include #include #include #include "ptypes.h" #include "constants.h" #include "cache.h" #include "sieve.h" #include "twin_primes.h" #include "prime_counts.h" #include "inverse_interpolate.h" #include "real.h" #include "mathl.h" #include "util.h" /******************************************************************************/ /* TWIN PRIMES */ /******************************************************************************/ /* Twin prime counts (X * 10^Y to (X+1) * 10^Y). */ #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, /* pi2(1e10,2e10) = 24096420; pi2(2e10,3e10) = 23046519; ... */ 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; /* 4e18 */ #endif UV twin_prime_count(UV n) { return (n < 3) ? 0 : twin_prime_count_range(0,n); } UV twin_prime_count_range(UV beg, UV end) { unsigned char* segment; UV sum = 0; /* First use the tables of #e# from 1e7 to 4e18. */ 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, x; const unsigned char* sp = segment; const unsigned char* const spend = segment + bytes - 1; for (s = x = *sp; sp++ < spend; s = x) { x = *sp; if (!(s & 0x0C)) sum++; if (!(s & 0x30)) sum++; if (!(s & 0x80) && !(x & 0x01)) sum++; } x = is_prime(seg_high+2) ? 0x00 : 0xFF; if (!(s & 0x0C)) sum++; if (!(s & 0x30)) sum++; if (!(s & 0x80) && !(x & 0x01)) sum++; } end_segment_primes(ctx); } return sum; } /* 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) */ /* Lichtman (2021) improved the limit: https://arxiv.org/pdf/2109.02851.pdf */ UV twin_prime_count_approx(UV n) { /* Best would be another estimate for n < ~ 5000 */ if (n < 2000) return twin_prime_count(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. */ /* We compromise to prevent discontinuities. */ if (n < 32000000) { long double fm; if (n < 4000) fm = 0.2952; else if (n < 8000) fm = 0.3102; else if (n < 16000) fm = 0.3090; else if (n < 32000) fm = 0.3096; else if (n < 64000) fm = 0.3097; else if (n < 128000) fm = 0.3094; else if (n < 256000) fm = 0.3099; else if (n < 600000) fm = .3098 + (n-256000) * (.3056-.3098) / (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 = .3041 + (n-4000000) * (.2983-.3041) / (16000000-4000000); else fm = .2983 + (n-16000000) * (.2961-.2983) / (32000000-16000000); li2 *= fm * logl(12+logn); } return (UV) (two_C2 * li2 + 0.5L); } } 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; return inverse_interpolate(lo, hi, n, &twin_prime_count_approx, 0); } #if 0 /* Generic cluster sieve. Works but not as fast as we'd like. */ #include "sieve_cluster.h" UV range_twin_prime_sieve(UV** list, UV beg, UV end) { const uint32_t cl[2] = {0,2}; UV ntwin; *list = sieve_cluster(beg, end, 2, cl, &ntwin); return ntwin; } #endif #if 0 /* Prime sieve and look for twins */ UV range_twin_prime_sieve(UV** list, UV beg, UV end) { UV nalloc, *L, ntwin; if (end > MPU_MAX_TWIN_PRIME) end = MPU_MAX_TWIN_PRIME; /* overshoot bounds, could also compare to 3*((end+29)/30 - beg/30) */ nalloc = prime_count_upper(end) - prime_count_lower(beg); New(0, L, nalloc + 1 + 3, UV); ntwin = 0; if (beg <= 3 && end >= 3) L[ntwin++] = 3; if (beg <= 5 && end >= 5) L[ntwin++] = 5; if (beg < 11) beg = 7; if (beg <= end) { unsigned char* segment; UV seg_base, seg_low, seg_high, lastp = 0; void* ctx = start_segment_primes(beg, end+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 ) if (lastp+2 == p) L[ntwin++] = lastp; lastp = p; END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } *list = L; return ntwin; } #endif #if 1 /* Also just using the prime sieve and pulling out twins. */ UV range_twin_prime_sieve(UV** list, UV beg, UV end) { UV nalloc, *L, ntwin; if (end > MPU_MAX_TWIN_PRIME) end = MPU_MAX_TWIN_PRIME; /* overshoot bounds, could also compare to 3*((end+29)/30 - beg/30) */ nalloc = prime_count_upper(end) - prime_count_lower(beg); New(0, L, nalloc + 1 + 3, UV); ntwin = 0; if (beg <= 3 && end >= 3) L[ntwin++] = 3; if (beg <= 5 && end >= 5) L[ntwin++] = 5; if (beg < 11) beg = 7; if (beg <= end) { /* Make end points odd */ beg |= 1; end = (end-1) | 1; while (1) { /* Get us to the start of a sieve byte. */ uint32_t beg30 = beg % 30; if (beg30 == 1) break; else if (beg30 <= 11) beg = beg-beg30+11; else if (beg30 <= 17) beg = beg-beg30+17; else if (beg30 <= 29) beg = beg-beg30+29; if (beg <= end && is_prime(beg) && is_prime(beg+2)) L[ntwin++] = beg; beg = (beg30 <= 11) ? beg+6 : (beg30 <= 17) ? beg+12 : beg+2; } } if (beg <= end) { 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)) { UV bytes = seg_high/30 - seg_low/30 + 1; UV pos = seg_base; unsigned char s, x; const unsigned char* sp = segment; const unsigned char* const spend = segment + bytes - 1; for (s = x = *sp; sp++ < spend; s = x) { x = *sp; if (!(s & 0x0C)) L[ntwin++] = pos+11; if (!(s & 0x30)) L[ntwin++] = pos+17; if (!(s & 0x80) && !(x & 0x01)) L[ntwin++] = pos+29; pos += 30; } x = is_prime(seg_high+2) ? 0x00 : 0xFF; if (!(s & 0x0C)) L[ntwin++] = pos+11; if (!(s & 0x30)) L[ntwin++] = pos+17; if (!(s & 0x80) && !(x & 0x01)) L[ntwin++] = pos+29; } end_segment_primes(ctx); /* Remove anything from the end because we did full bytes. */ while (ntwin > 0 && L[ntwin-1] > end) ntwin--; } *list = L; return ntwin; } #endif Math-Prime-Util-0.74/prime_count_cache.h000644 000765 000024 00000001346 15145577415 020232 0ustar00danastaff000000 000000 #ifndef MPU_PRIME_COUNT_CACHE_H #define MPU_PRIME_COUNT_CACHE_H #include "ptypes.h" /* * Create will attempt to cache up to n, but possibly less. * * Destroy is necessary to call to free the memory. * * Lookup will return prime_count(n) (it looks in cache first, then calls LMO). */ extern void* prime_count_cache_create(UV n); extern void prime_count_cache_destroy(void* cache); extern UV prime_count_cache_lookup(void* cache, UV n); /* Alternate creation method using an array of primes: * P[0]=0, P[1]=2, P[2]=3, P[3]=5, ..., P[lastidx] = * If the caller already has this, this can be faster. */ extern void* prime_count_cache_create_with_primes(const uint32_t *primes, uint32_t lastidx); #endif Math-Prime-Util-0.74/TODO000644 000765 000024 00000055402 15154713505 015074 0ustar00danastaff000000 000000 - 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 -Werror=vla -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 02+92, lib/ntheory.pm, Changes, doc, test(2) - 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. - 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. - 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 chinese2, 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 - Support FH for print_primes. PerlIO_write is giving me fits. - Test for print_primes. Not as easy with filenos. - 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. 2024 May on Macbook. Some improvements to validation. 3.4s my $f=factorial(144); urandomm($f) for 1..5e5; 7.6s my $f=factorial(144); urandomm("$f") for 1..5e5; 6.8s my $f="".factorial(144); urandomm($f) for 1..5e5; 2.2s use Math::GMP qw/:constant/; my $f=factorial(144); urandomm($f) for 1..5e5; 0.7s my $f=Math::Prime::Util::GMP::factorial(144); Math::Prime::Util::GMP::urandomm($f) for 1..5e5; 2026 we're slow again, 8.2s for the first. triage this. - 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. also see: https://github.com/int128-libraries/curtint128/blob/master/include/cuda_uint128.h - 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. - update prime count lower/upper from https://arxiv.org/pdf/1703.08032.pdf also from Dusart (2018). https://piyanit.nl/wp-content/uploads/2020/10/art_10.1007_s11139-016-9839-4.pdf - update prime counts from Axler 2022: https://arxiv.org/pdf/2203.05917.pdf This not only improves the 2014 results, but has promising looking results at all sizes. - nth_prime and bounds, updates from Dusart (2018) and Axler (2022) - 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 - Things from Pari/GP 2.12 beta: - rewritten (much faster) Bernoulli. - factorial - divisors? - DLP/PH - semiprime_count PP just walk if small range. - add b125527.txt to oeis 125527. (semiprime counts 2^n) - improve 64-bit limit estimates for twin prime and ramanujan prime. - add to A033843 (twin prime count < 2^n). Oliviera e Silva has good data. - consider adding multifactorial. See MPU::GMP. - multicall in forpart/forcomp. - check memory use for non-multicall. We need enter/leave which were removed. - Add aliquot sum - testing: lehman_factor, print_primes, aks - new function: toint or asint or intify. Takes generic input, returns integer - similar, but how to decide on floor, ceil, trunc? name floorint is weird Math::GMP calls it intify. - factor, factor_exp should accept negative inputs - NEGMAXINT testing in PP. - NEGMAXINT input in XS. - In theory IFLAG_ABS in _validate_and_set should allow up to neg(~0). Looks a bit messy but possible. - euler_phi should do XS -> GMP directly. Maybe make totient in PP for uniform name. - Make prime_omega, prime_bigomega, and liouville take a range like moebius. - think about making an iterator for range omega/bigomega. We can precalc the primes and offsets, which should enable fast sieving of small windows. - dickman_rho, debruijn_psi See: https://arxiv.org/pdf/1301.5293.pdf https://www.ams.org/journals/mcom/1969-23-106/S0025-5718-1969-0247789-3/S0025-5718-1969-0247789-3.pdf Hunter/Sorenson(1997) https://cosec.bit.uni-bonn.de/fileadmin/user_upload/teaching/08us/08us-cryptabit/AnatInt_Crypto-sld.pdf - consider random_smooth_integer, random_rough_integer. nbit or range or mod? See: https://cr.yp.to/papers/epsi.pdf https://arxiv.org/pdf/2006.07445.pdf - ipowsafe could have the limits using hard-coded sqrt and cbrt to avoid div. - almost primes check and enter new for 3 http://oeis.org/A109251 4 http://oeis.org/A114106 5 http://oeis.org/A114453 6 http://oeis.org/A120047 7 http://oeis.org/A120048 8 http://oeis.org/A120049 9 http://oeis.org/A120050 10 http://oeis.org/A120051 11 http://oeis.org/A120052 12 http://oeis.org/A120053 4^n https://oeis.org/A116426 mpu 'for (0..60) { say "$_ ",almost_prime_count($_,powint(4,$_)); }' 6^n https://oeis.org/A116427 8^n https://oeis.org/A116428 9^n https://oeis.org/A116429 nth https://oeis.org/A101695 Try sequence A052130. a(n) = {my m = ceil(n*log(3)/log(1.5)); return apc(1< 3 - optimize PP nth_almost_prime and bounds (this is super slow) - Consider getting rid of the unused construction code. - almost_prime_count(k,beg,end) - almost_prime_count_approx revisit weighting. - almost_prime_count lower/upper mmpu '$n=subint(powint(2,64),1); ($k,$c)=(26,3323560145881); for (0..100000000) { $c-- if is_almost_prime($k,$n); $n--; die "$n $c" if almost_prime_count_lower($k,$n) > $c; }' - optimize nth_powerful, both in C and PP. - Add OEIS sequence, a(n) = the k-th k-powerful number mpu 'for my $k (1..40) { say "$k ",nth_powerful($k,$k); }' - Better inverse interpolation in PP. - For almost primes in PP, maybe use Lagrange estimator to start, given that we have no bounds. - omega primes, work on figuring out formula for omega_prime_count better construction and counting OEIS sequence for omega k=3 counts for 10^i look into the code for omega prime count k=2, especially overflow pr[] - There might be a better method for _sqrtmod_prime_power. - extend qnr with optional root argument, cubic non-residue, etc. - practical numbers: make OEIS sequence with count <= 10^n. mpu '$s=1; for my $e (1..9) { $s += is_practical($_) for 10**($e-1)+1..10**$e; say "10^$e $s"; }' mpu 'for my $e (1..9) { $s=0; $s += is_practical($_) for 1..10**$e; say "10^$e $s"; }' 5, 30, 198, 1456, 11751, 97385, 829157, 7266286, 64782731, 582798892, 5283879886 - consider forprimepowers { ... } beg,end - sum_prime_powers(start,end) or prime_power_sum(start, end) Look at sum_primes and do similar 128-bit See Sidef for implementation - test coverage for PP. - Revisit AKS in PP. Essentially all the time is spent in two lines of poly_mod_mul. (2) try using bigint multiply (Kronecker) like we do in GMP. - any way to make non-GMP random_strong_prime faster - Speed up XS RiemannR with quadmath. - binomialmod: - PP implementation for primes, squarefree, and general composites. - better factorialmod_without_p. E.g. binomialmod(powint(10,18),5*powint(10,17),powint(2,60))' binomialmod(1234567890123456789,123456789012345678,powint(999979,3) - Possible new: - checksums? Rather than print | md5sum. adler32, sha1/2/3, blake2 (b2sum) - inverse sigma. Better, determine how to generalize this somehow. - consider negative k in sigma: https://github.com/trizen/sidef/commit/00f083f4645b810292f9fbf4020e762279fdb4d4 - stronger BPSW test: https://arxiv.org/abs/2006.14425 - faster prime gaps: https://arxiv.org/abs/2012.03771 https://github.com/sethtroisi/prime-gap - Pari 2.13 has faster exp, Catalan, log2, gamma, factorial, lngamma. Completely new Bernoulli and bernvec. eulerreal, eulervec, ramanujantau MPQS Take a look. - Pari 2.13 added an optional third argument to sqrtint, just like rootint. Not high priority since we can just call rootint with k=2. - Faster Mertens. Helfgott/Thompson 2020. https://arxiv.org/pdf/2101.08773.pdf - gcdext, see Sorenson, Jabelean, and kernel/none/gcdll.c. - OEIS A186995 mmpu 'for $b (2..29) { forprimes { if (is_delicate_prime($_,$b)) { say "$b $_"; lastfor(); } } 1e13; }' - refactor lucas code. split out all the different codes, benchmark them all. - Complete reviewing docs for positive vs. non-negative, and comparing to XS.xs. Everything after modular functions was not reviewed. - PP needs a revamp of the bigint->int downgrade. Using the babs(BMAX) is wrong. We can use max/min. Better come up with something more consistent. Possibly XS, or try "$x=$n->numify; return ($x eq $n) ? $x : $n;" - GMP - rootmod, binomialmod - almost primes - omega primes - powerful numbers, counts - prime_power_count - smooth_count - rough_count - fdivrem, lucasuv, lucasumod, lucasvmod, lucasuvmod - prime_bigomega - prime_omega - qnr - fdivrem - consider (in GMP 0.53): - setbit, clrbit, combit, tstbit - bitand, bitor, bitxor, bitcom - other *int functions? See overload and GMP for possible things we want. remove_factors, clzint, ctzint (scan0,scan1) - an overload option or module, to call our *int functions. have: add, sub, mul, pow, div, rem, neg, ++, --, <<, >>, <=> need: not, bnot, and, or, xor, gt, lt, geq, leq, eq, neq, as_bool, as_string, as_num, clone - 32-bit testing - Lots of older PP code, especially factoring, is built on a bigint vs PP idea. It might be useful to write normally using Mpowmod etc. and benchmark various inputs. - incremental factoring. Maybe a stateful iterator? - consider forfactors { } n. Iterate through factors using iterator. Allows convenient early exit. - new semiprime approximations should be used in PP. - semiprime bounds (for count or nth, inverse for the other) - twin prime bounds (for count or nth, inverse for the other) - omega prime bounds (for count or nth, inverse for the other) - omega prime approx (for count or nth, inverse for the other) - faster squarefree count in PP. - faster squarefree sieving. https://arxiv.org/pdf/2411.01964 - PP lucky number functions should be improved. - 64-bit max lucky index should be improved if possible OEIS lucky numbers: - add program - add link to file - OEIS https://oeis.org/A161170 We can use approx and limits to create a small window containing the crossover. Then use forfactored to find the exact point, or binary search. mmpu '$n = 1e10; while (1) { $c=prime_count_approx($n); $C=almost_prime_count_approx(8,$n); if ($c < $C) { die "$n $c $C\n"; } $n = int($n * 1.001); }' - make GMPFE.pm. No validation, just call GMP and objectify. Use _gmpcall consistently to prevent auto-vivify XS should call it if possible. Maybe gmpobj? PPFE should direct to it after validation. PP.pm should remove the first-thing GMP checks included by PPFE and in the XS call. Not by default. See about moving more GMP related things to that file. If/when the GMP backend finally does objects, remove it all. - faster next_prime_power / prev_prime_power? - PP next_prime_power, prev_prime_power: skip evens. - prime sum bounds and approx https://arxiv.org/pdf/2309.16007.pdf - prime_count_cache.c: - direct cache should not skip 0,1. Removes a test - try cache with wheel30 instead of odds. 240/128 fewer entries. - test Brent and/or Chandrupatla with inverse interp https://www.embeddedrelated.com/showarticle/855.php also see May 2025 email about this - is_congruent_number A006991 tmmpu 'forsquarefreeint { say if ($_%8) < 4 && is_congruent_number($_) } 1e7;' >/tmp/prim-cn.txt A274264: tmmpu 'forsquarefreeint { $n++ if ($_%8)>4; } 1e7; say $n;' A274403: 3039648+213318 or: mpu 'forsquarefreeint { $n++ if is_congruent_number($_) } 1e7; say $n;' A290449: mpu 'sub a { vecfirst { is_congruent_number($_*$_[0]) } (1,2,3,5); } say "$_ ",a($_) for 1..100000' - R\'edei symbol, Borromean primes https://arxiv.org/pdf/2403.17957.pdf http://www.rnta.eu/4MSRNTA/PROC4MSRNTA.pdf https://arxiv.org/pdf/1806.06250.pdf https://www.researchgate.net/publication/367529395_Primes_knots_and_periodic_orbits (p,q,r), each 1 mod 4, (p|q)=(p|r)=(q|r)=1, [p,q,r]=-1 Really not clear how we would do this. - cornacchia negative d? - nonpowerfree: is_npf, mpf_count, npf_sum, nth_npf - pf_numbers(lo,hi,k), npf_numbers(lo,hi,k) - mertens(lo,hi) = mertens(hi) - mertens(lo-1) - consider moving leaf PP functions to new file, so PP loads faster - find a proper BigInt workaroud for binomial with bigint n. bnok powersum uses binomial stirling uses binomial falling_factorial and rising_factorial uses binomial for m >= 250 subfactorial uses binomial can use falling_factorial and factorial - factor_range. Get rid of N[i]. Always complete sieve. Get the last factor when we return the value in next (n-vecprod(factors). - rewrite parts of RandomPrimes using our math - remove Math::BigInt assumptions - rewrite _random_prime using our math functions - is there any desire for perfect power count on negative ranges? - Look at things that loop over floor(n/i). https://math.stackexchange.com/a/1740370/117584 - toint == almost_prime_count bounds verify DONE 2^20 - 2^32 complete DONE 2^32 - 2^37 complete 2.5+5+11+23+46 hours 2^37 - 2^38 k=2-63 (est 4 days) 2^38 - 2^39 k=2-63 (est 8 days) 2^39 - 2^40 k=2-63 (est 16 days) == almost_prime_count_approx revisit weighting (e.g. 6,1<<56) Perhaps use one or two linear interpolations for weight. Different behavior for high k - omega primes, work on figuring out formula for omega_prime_count = omega primes construction, single call routine and construct primes tmmpu 'omega_primes(8,powint(10,14), powint(10,14) + 1e6)' - A253595, should clean this code: mmpu '@cyc = grep { is_cyclic($_) } 0..10000; for $i (3..100) { $n = $cyc[$i-1]; for $t (1..1e10) { next unless is_carmichael($n*$t); say "$i $n ",$n*$t; last; } }' - we should have an extra debug mode for asserts. - contfrac with negative inputs in XS - cfrac_add, cfrac_sub, cfrac_mul, cfrac_div - C99 designated initializers - consider inversions, see 22 Apr 2025 email - we could split reading arrays into signed and unsigned parts, possibly putting them into the same array front/back. - trizen sigma_sum, pillai_sum, etc. - more efficient kth_farey in PP = OEIS sequence for omega k=3 counts for 10^i = cheb_factor in GMP = taupower = rtau = chacha update to rfc8439 - more tests - compare with https://github.com/DavyLandman/portable8439 https://github.com/smuellerDD/chacha20_drng - chacha - init_context - neon+sse - refill return have - refill not zero key from buf - congruent_numbers - permuted factors = lobby email - almost_prime_count ranged = gmp cmpint - totient sum, look at paper from Sukhoy and Stoytchev (s41598-021-99545-w.pdf) Better: https://arxiv.org/pdf/2506.07386 = tot sum 0.049 1e10 8.8x 0.155 1e11 9.3x 0.636 1e12 8.9x 3.140 1e13 7.5x 21.084 1e14 5.0x 201.467 1e15 2.4x 2061.928 1e16 1.1x https://github.com/lucasaugustus/mertens https://github.com/lucasaugustus/labmath3/ https://github.com/lucasaugustus/oeis/ A064018 0.433 1e10 1.448 1e11 5.645 1e12 23.472 1e13 105.522 1e14 483.986 1e15 2293.631 1e16 pypy3.10 src/lucasa-oeis/A064018.py - moebius_iterator generate a batch, dole it out, make the next, etc. primes to sqrt(n) Also test it using a sliding window so we generate monolithic see how that performs vs. range_moebius or windowed range_moebius - objectify based on gmp_info - array of bigints: - sieve_range - sieve_cluster - factor - special - factorial - merge vcallsubn into dispatch_external - find_gmp_info replace linear scan with hash? - use amagic_call for simple addint etc. See List::Util::XS save/XS.xs-amagic1 - consider my_svuv redefined, like in validate_int. Call sv_2uv if needed. See https://github.com/Perl/perl5/issues/22653 We avoid this most of the time already. - harmfrac for negative n https://mathworld.wolfram.com/HarmonicNumber.html - default bigint to better package - revisit PP factorial - t/81-bignum should try different bigint classes - ecm - waring_goldbach(n,k,t) {p1}^k + {p2}^k + ... + {pt}^k - add pillai composite sequence to OEIS mpu 'forcomposites { say ++$n," $_" if is_pillai($_) } 100000;' - rosettacode Calin-Wilf needs this line: splice @f, 0, 1, 1, $f[0]-1 if $#f & 1; - nth_ramanujan_lower, should be redone like upper. - calculate primecount 24^14 and use it in t/81-bignum.t. - vecwindow incr,len {... @_ ...} @list This is slideatatime incr==len is natatime - vecpairwise {... $a,$b ...} \@A,\@B List::MoreUtils::pairwise - primality https://arxiv.org/pdf/2411.01638 (Pell Cubic) https://eprint.iacr.org/2025/2083.pdf (BFW extension to BPSW, SuperBFW) https://arxiv.org/pdf/1908.06964 (Phatak, similar to Khashin) 1. Different QNR selection (faster?) 2. Adds Euler test 3. Khashin: (1+q)^n = 1-q or (2+q)^n = 2-q Phatak: (1+q)^n - 1 - q^n = 0 => (1+q)^n = 1 + q^n https://arxiv.org/pdf/2505.02167 - sqrtmod_prime https://eprint.iacr.org/2025/2083.pdf - move to 5.10.1 minimum - we're flakey about return types with different bigint type powmod returns typeof($n), but invmod returns $_BIGINT. Usually. - API change to use tobigint / maybetobigint instead of reftyped. They can set the class now, so no need to keep trying to mix classes. So we will expect to return $BIGINT class, not the input class. - should vecsort have a code block option? usort does not. Time to add list reverse is negligible. - second parameter for Real functions, and/or default precision. Get rid of looking at input accuracy. - put all real funcs in separate Real.pm file. ei ExponentialIntegral li LogarithmicIntegral lambertw LambertW riemannr RiemannR zeta RiemannZeta plus Pi(n) and Schoenfeld distance - what should irand64() do on a 32-bit Perl? = PP is_prime7 deterministic MR. Test crossover again and remove dead code. Math-Prime-Util-0.74/constants.h000644 000765 000024 00000004066 15145577415 016601 0ustar00danastaff000000 000000 #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) #define MPU_MAX_POW3 20 #define MPU_MAX_PERFECT_POW UVCONST(4294836225) #define MPU_MAX_PERFECT_POW_IDX UVCONST(67226) #define MPU_MAX_LUCKY UVCONST(4294967275) #define MPU_MAX_LUCKY_IDX UVCONST(186812128) #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(1701748900850019777) #define MPU_MAX_POW3 40 #define MPU_MAX_PERFECT_POW UVCONST(18446744065119617025) #define MPU_MAX_PERFECT_POW_IDX UVCONST(4297615581) /* Max Lucky Tested through 200000000000, but need to 394961521040845441. */ #define MPU_MAX_LUCKY UVCONST(18446744073709551517) /* Maybe */ #define MPU_MAX_LUCKY_IDX UVCONST(395236168661920929) /* Not correct */ #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.74/almost_primes.c000644 000765 000024 00000107314 15151340011 017407 0ustar00danastaff000000 000000 /******************************************************************************/ /* ALMOST PRIMES */ /******************************************************************************/ #include #include #include #include #include "ptypes.h" #include "constants.h" #define FUNC_isqrt 1 #define FUNC_ctz 1 #include "sort.h" #include "cache.h" #include "sieve.h" #include "util.h" #include "prime_counts.h" #include "prime_count_cache.h" #include "semi_primes.h" #include "inverse_interpolate.h" #include "almost_primes.h" /******************************************************************************/ /* KAP UTILITY */ /******************************************************************************/ #if BITS_PER_WORD == 32 static uint32_t const _pow3[21] = {1,3,9,27,81,243,729,2187,6561,19683,59049,177147,531441,1594323,4782969,14348907,43046721,129140163,387420489,1162261467,3486784401U}; #else static UV const _pow3[41] = {1,3,9,27,81,243,729,2187,6561,19683,59049,177147,531441,1594323,4782969,14348907,43046721,129140163,387420489,1162261467,3486784401U,UVCONST(10460353203),UVCONST(31381059609),UVCONST(94143178827),UVCONST(282429536481),UVCONST(847288609443),UVCONST(2541865828329),UVCONST(7625597484987),UVCONST(22876792454961),UVCONST(68630377364883),UVCONST(205891132094649),UVCONST(617673396283947),UVCONST(1853020188851841),UVCONST(5559060566555523),UVCONST(16677181699666569),UVCONST(50031545098999707),UVCONST(150094635296999121),UVCONST(450283905890997363),UVCONST(1350851717672992089),UVCONST(4052555153018976267),UVCONST(12157665459056928801)}; #endif #define A078843_MAX_K 49 static const uint32_t _first_3[A078843_MAX_K+1] = {1, 2, 3, 5, 8, 14, 23, 39, 64, 103, 169, 269, 427, 676, 1065, 1669, 2628, 4104, 6414, 10023, 15608, 24281, 37733, 58503, 90616, 140187, 216625, 334527, 516126, 795632, 1225641, 1886570, 2901796, 4460359, 6851532, 10518476, 16138642, 24748319, 37932129, 58110457, 88981343, 136192537, 208364721, 318653143, 487128905, 744398307, 1137129971, 1736461477, 2650785552U, 4045250962U}; /* For all n <= hi, we can get the same results using 2*result with lower k */ static uint32_t reduce_k_for_n(uint32_t k, UV n) { uint32_t r = 0; if (k <= 1 || k >= BITS_PER_WORD) return 0; if (k > MPU_MAX_POW3) /* Larger n would not fit in a UV type */ r = k-MPU_MAX_POW3; while ((k-r) > 1 && (n>>r) < _pow3[k-r]) r++; return r; } /* Least r s.t. almost_prime_count(k, n) = almost_prime_count(k-r, n >> r) */ static void reduce_prime_count_factor(uint32_t *pk, UV *n) { uint32_t k = *pk, r = 0; if (k > MPU_MAX_POW3) /* Larger n would not fit in a UV type */ r = k-MPU_MAX_POW3; while (k >= r && ((*n)>>r) < _pow3[k-r]) r++; /* Reduce */ if (r > 0) { *pk -= r; *n >>= r; } } /* Least r s.t. nth_almost_prime(k,n) = nth_almost_prime(k-r,n) << r */ static uint32_t reduce_nth_factor(uint32_t k, UV n) { uint32_t r = 0; if (k <= 1 || k >= BITS_PER_WORD) return 0; if (k > A078843_MAX_K) { if (n >= _first_3[A078843_MAX_K]) return 0; r = k-A078843_MAX_K+1; } while (n < _first_3[k-r]) r++; return r; } /* This could be easily extended to 16 or 32 */ static UV _fast_small_nth_almost_prime(uint32_t k, UV n) { static const uint8_t semi[8] = {0, 4, 6, 9, 10, 14, 15, 21}; static const uint8_t mult[8] = {0, 8, 12, 18, 20, 27, 28, 30}; MPUassert(n < 8 && k >= 2, "Fast small nth almost prime out of range"); if (k == 2) return semi[n]; return mult[n] * (UVCONST(1) << (k-3)); } static void _almost_prime_count_bounds(UV *lower, UV *upper, uint32_t k, UV n); #if 0 /* Not currently used */ /* Somewhere around k=20 it is faster to do: * return nth_almost_prime(h, 1+almost_prime_count(k,n)); */ static UV _next_almost_prime(uint32_t k, UV n) { while (!is_almost_prime(k, ++n)) ; return n; } static UV _prev_almost_semiprime(uint32_t k, UV n) { while (!is_almost_prime(k, --n)) ; return n; } #endif /******************************************************************************/ /* KAP COUNT */ /******************************************************************************/ #define CACHED_PC(cache,n) prime_count_cache_lookup(cache,n) /* Debatably useful. Slightly faster for small n, the same for larger. */ static UV almost3prime_count(UV n) { UV sum = 0, cbrtn = prev_prime(rootint(n,3)+1); void *cache = prime_count_cache_create( (UV)pow(n,0.72) ); SIMPLE_FOR_EACH_PRIME(2, cbrtn) { UV pdiv = p, lo = p, hi = isqrt(n/pdiv); UV j = CACHED_PC(cache, lo) - 1; /* IDX(Pi) */ if ((lo <= 2) && (hi >= 2)) sum += CACHED_PC(cache,n/(pdiv*2)) - j++; if ((lo <= 3) && (hi >= 3)) sum += CACHED_PC(cache,n/(pdiv*3)) - j++; if ((lo <= 5) && (hi >= 5)) sum += CACHED_PC(cache,n/(pdiv*5)) - j++; if (lo < 7) lo = 7; if (lo <= hi) { unsigned char* segment; UV seg_base, seg_low, seg_high; void* ctx = start_segment_primes(lo, hi, &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 ) sum += CACHED_PC(cache,n/(pdiv*p)) - j++; END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } } END_SIMPLE_FOR_EACH_PRIME prime_count_cache_destroy(cache); return sum; } /* almost_prime_count(k,n) is the main interface, it will call the recursive * function _cs(), with the terminal function _final_sum(). */ /* for Pi from Pi to isqrt(N/Pi) [pc[n/Pi]-idx(Pi)+1] */ /* semiprime count = _final_sum(n, 1, 2, cache); */ /* 3-almost prime count = sum(Pj < icbrt(n) of _final_sum(n, Pj, Pj, cache); */ static UV _final_sum(UV n, UV pdiv, UV lo, void *cache) { UV s = 0, hi = isqrt(n/pdiv); UV j = CACHED_PC(cache, lo) - 1; /* IDX(Pi) */ if (hi-lo < 500) { SIMPLE_FOR_EACH_PRIME(lo, hi) { s += CACHED_PC(cache,n/(pdiv*p)) - j++; } END_SIMPLE_FOR_EACH_PRIME return s; } if ((lo <= 2) && (hi >= 2)) s += CACHED_PC(cache,n/(pdiv*2)) - j++; if ((lo <= 3) && (hi >= 3)) s += CACHED_PC(cache,n/(pdiv*3)) - j++; if ((lo <= 5) && (hi >= 5)) s += CACHED_PC(cache,n/(pdiv*5)) - j++; if (lo < 7) lo = 7; if (lo <= hi) { unsigned char* segment; UV seg_base, seg_low, seg_high; void* ctx = start_segment_primes(lo, hi, &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 ) s += CACHED_PC(cache,n/(pdiv*p)) - j++; END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); } return s; } static UV _cs(UV n, UV pdiv, UV lo, uint32_t k, void *cache) { UV count = 0; if (k == 2) return _final_sum(n, pdiv, lo, cache); SIMPLE_FOR_EACH_PRIME(lo, rootint(n/pdiv,k)) { if (k == 3) count += _final_sum(n, pdiv*p, p, cache); else count += _cs(n, pdiv*p, p, k-1, cache); } END_SIMPLE_FOR_EACH_PRIME return count; } UV almost_prime_count(uint32_t k, UV n) { void* cache; UV count, csize; if (k == 0) return (n >= 1); if (k >= BITS_PER_WORD || (n >> k) == 0) return 0; reduce_prime_count_factor(&k, &n); /* Reduce to lower k,n if possible */ if (n >= max_nth_almost_prime(k)) return max_almost_prime_count(k); if (k == 0) return n; if (k == 1) return prime_count(n); if (k == 2) return semiprime_count(n); if (k == 3) return almost3prime_count(n); if (n < 3*(UVCONST(1) << (k-1))) return 1; if (n < 9*(UVCONST(1) << (k-2))) return 2; if (n < 10*(UVCONST(1) << (k-2))) return 3; /* Decide how much we will cache prime counts. * * n/(1UL << (k+M)) has 0,1,2,7,15,37,84,187,... lookups for M=-2,-1,0,... * The number of non-cached counts performed follows OEIS A052130. */ csize = n / (1UL << (k-2)); if (csize < 32) csize = 32; if (csize > 16UL*1024) csize = n / (1UL << (k+2)); /* 15 */ if (csize > 128UL*1024) csize = n / (1UL << (k+4)); /* 84 */ if (csize > 1UL*1024*1024) csize = n / (1UL << (k+6)); /* 421 */ if (((csize >> 16) >> 16) >= 3) csize >>= 1; cache = prime_count_cache_create( csize ); count = _cs(n, 1, 2, k, cache); prime_count_cache_destroy(cache); return count; } UV almost_prime_count_range(uint32_t k, UV lo, UV hi) { if (k == 0) return (lo <= 1 && hi >= 1); if (k == 1) return prime_count_range(lo, hi); if (k == 2) return semiprime_count_range(lo, hi); /* See semiprime_count. Possibly clever solutions for small ranges. */ if (k >= BITS_PER_WORD || (hi >> k) == 0 || hi < lo) return 0; return almost_prime_count(k, hi) - (((lo >> k) == 0) ? 0 : almost_prime_count(k,lo-1)); } UV almost_prime_count_approx(uint32_t k, UV n) { UV lo, hi; if (k == 0) return (n >= 1); if (k >= BITS_PER_WORD || (n >> k) == 0) return 0; reduce_prime_count_factor(&k, &n); /* Reduce to lower k,n if possible */ if (k == 1) return prime_count_approx(n); if (k == 2) return semiprime_count_approx(n); if (n < 3*(UVCONST(1) << (k-1))) return 1; if (n < 9*(UVCONST(1) << (k-2))) return 2; if (n < 10*(UVCONST(1) << (k-2))) return 3; if (k == 3 && n < 102) { unsigned char const sm3[19] = {27,28,30,42,44,45,50,52,63,66,68,70,75,76,78,92,98,99}; for (lo=0; lo < 19; lo++) if (n < sm3[lo]) break; return 4+lo; } _almost_prime_count_bounds(&lo, &hi, k, n); if (k == 3) { /* Much better fit for k=3. */ double x = n, logx = log(x), loglogx = log(logx); double a = 1.0, s = 2.0; UV est; if (x <= 638) { s = 1.554688; a = 0.865814; } else if (x <= 1544) { s = 1.050000; a = 0.822256; } else if (x <= 1927) { s = 0.625000; a = 0.791747; } else if (x <= 486586) { s = 2.865611; a = 1.004090; } else if (x <= 1913680) { s = 2.790963; a = 0.999618; } else if (x <= 22347532) { s = 2.719238; a = 0.995635; } else if (x <= 2.95e8) { s = 2.584473; a = 0.988802; } else if (x <= 4.20e9) { s = 2.457108; a = 0.983098; } else if (x <= 7.07e10) { s = 2.352818; a = 0.978931; } else if (x <= 1.36e12) { s = 2.269745; a = 0.975953; } else if (x <= 4.1e13) { s = 2.203002; a = 0.973796; } else if (x <= 9.2e14) { s = 2.148463; a = 0.972213; } else { s = 2.119279; a = 0.971438; } est = 0.5 * a * x * ((loglogx+0.26153)*(loglogx+0.26153)) / (logx+s)+0.5; if (est < lo) est = lo; else if (est > hi) est = hi; return est; } #if 0 /* Equation 6 from https://arxiv.org/pdf/2103.09866v3.pdf */ { const double nu[21] = { 1.0, 2.61497e-1, -5.62153e-1, 3.05978e-1, 2.62973e-2, -6.44501e-2, 3.64064e-2, -4.70865e-3, -4.33984e-4, 1.50850e-3, -1.83548e-4, 1.49365e-4, 4.99174e-5, 1.82657e-5, 1.30241e-5, 5.52779e-6, 2.90194e-6, 1.45075e-6, 7.19861e-7, 3.61606e-7, 1.80517e-7 }; double sum = 0, x = n, logx = log(x), loglogx = log(logx); uint32_t i, j; for (j = 0; j < k; j++) { uint32_t idx = k-1-j; double v = (idx <= 20) ? nu[idx] : 0.1893475 * powl(2.0, -(double)k); for (i = 1; i <= j; i++) v = v * loglogx / i; sum += v; } sum = (x / logx) * sum; return (UV) (sum+0.5); } #endif /* We should look at (1) better bounds, (2) better weighting here */ /* return lo + (hi-lo)/2; */ /* Consider two variables to control our weight: k and n */ if (k > 11) return lo + (hi-lo) * 0.20; return lo + (hi-lo) * 0.76; } /******************************************************************************/ /* NTH KAP */ /******************************************************************************/ #if 0 /* Asymptotic estimate for the nth k-almost prime */ static double _asymptotic_nth(uint32_t k, UV n) { uint32_t i; double x, logn, loglogn; if (k == 0 || n == 0) return 0; if (n == 1) return UVCONST(1) << k; logn = log(n); loglogn = log(logn); x = n * logn; for (i = 1; i < k; i++) x *= (double)i / loglogn; return x; } #endif static UV apcu(UV mid, UV k) { return almost_prime_count_upper(k, mid); } static UV apcl(UV mid, UV k) { return almost_prime_count_lower(k, mid); } static UV apca(UV mid, UV k) { return almost_prime_count_approx(k, mid); } static UV apce(UV mid, UV k) { return almost_prime_count(k, mid); } UV nth_almost_prime_upper(uint32_t k, UV n) { UV r, maxc, maxn, lo, up; if (n == 0) return 0; if (k == 0) return (n == 1) ? 1 : 0; if (k == 1) return nth_prime_upper(n); if (n < 8) return _fast_small_nth_almost_prime(k, n); maxn = max_nth_almost_prime(k); maxc = max_almost_prime_count(k); if (n >= maxc) return n == maxc ? maxn : 0; r = reduce_nth_factor(k,n); if (r > 0) { UV redup = nth_almost_prime_upper(k-r, n); if (redup > maxn || ((redup<>r) != redup) return maxn; return redup << r; } /* We start out with the literal min and max because we have NO idea. */ lo = UVCONST(5) << k; /* For k >= 1 and n >= 8 */ up = inverse_interpolate_k(lo, 0, n, k, &apcl, 0); return up > maxn ? maxn : up; } UV nth_almost_prime_lower(uint32_t k, UV n) { UV r, maxc, lo; if (n == 0) return 0; if (k == 0) return (n == 1) ? 1 : 0; if (k == 1) return nth_prime_lower(n); if (n < 8) return _fast_small_nth_almost_prime(k, n); maxc = max_almost_prime_count(k); if (n >= maxc) return n == maxc ? max_nth_almost_prime(k) : 0; r = reduce_nth_factor(k,n); if (r > 0) return nth_almost_prime_lower(k-r, n) << r; /* We start out with the literal min and max because we have NO idea. */ /* \_/ note 3 instead of 5! TODO: apcu is not tight enough, so reduce */ lo = UVCONST(3) << k; /* For k >= 1 and n >= 8 */ return inverse_interpolate_k(lo, 0, n, k, &apcu, 0); } UV nth_almost_prime_approx(uint32_t k, UV n) { UV maxc, lo; if (n == 0) return 0; if (k == 0) return (n == 1) ? 1 : 0; if (k == 1) return nth_prime_approx(n); if (k == 2) return nth_semiprime_approx(n); maxc = max_almost_prime_count(k); if (n >= maxc) return n == maxc ? max_nth_almost_prime(k) : 0; /* We could reduce but really no reason to do it */ if (n < 8) return _fast_small_nth_almost_prime(k,n); lo = nth_almost_prime_lower(k,n); return inverse_interpolate_k(lo, 0, n, k, &apca, 0); } static UV _cb_nth3(UV n) { return nth_almost_prime_approx(3,n); } static UV _cb_cnt3(UV n) { return almost_prime_count(3,n); } static bool _cb_is3(UV n) { return is_almost_prime(3,n); } static UV _cb_nth4(UV n) { return nth_almost_prime_approx(4,n); } static UV _cb_cnt4(UV n) { return almost_prime_count(4,n); } static bool _cb_is4(UV n) { return is_almost_prime(4,n); } UV nth_almost_prime(uint32_t k, UV n) { UV r, lo, hi, maxc; if (n == 0) return 0; if (k == 0) return (n == 1) ? 1 : 0; if (k == 1) return nth_prime(n); if (k == 2) return nth_semiprime(n); maxc = max_almost_prime_count(k); if (n >= maxc) return n == maxc ? max_nth_almost_prime(k) : 0; /* For k >= 3 and small n we can answer this quickly. */ if (n < 8) return _fast_small_nth_almost_prime(k,n); r = reduce_nth_factor(k,n); if (r > 0) return nth_almost_prime(k-r,n) << r; /* NOTE: given n a 64-bit integer, k always <= 40 after reduction */ /* Using the approximation to narrow in is *much* more efficient. But * there is no good way to make it generic without closures (GCC extension) * or statics (not thread-safe). */ if (k == 3) return interpolate_with_approx(n, 0, 20000, &_cb_nth3, &_cb_cnt3, &_cb_is3); if (k == 4) return interpolate_with_approx(n, 0, 20000, &_cb_nth4, &_cb_cnt4, &_cb_is4); lo = nth_almost_prime_lower(k,n); hi = nth_almost_prime_upper(k,n); hi = inverse_interpolate_k(lo, hi, n, k, &apce, 60000); while (!is_almost_prime(k,hi)) hi--; return hi; } /******************************************************************************/ /* Bounds */ /******************************************************************************/ /* Bayless et al. (2018) and Kinlaw (2019) are main references. * * https://www.researchgate.net/publication/329788487_Sums_over_primitive_sets_with_a_fixed_number_of_prime_factors * http://math.colgate.edu/~integers/t22/t22.pdf * https://arxiv.org/pdf/2103.09866v3.pdf * * Note that they use Pi_k(x) to mean square-free numbers, and * Tau_k(x) to mean the general count like we use. * They also have results for k = 2,3,4 only. * Also see https://archimede.mat.ulaval.ca/MAINE-QUEBEC/19/Kinlaw19.pdf. * * We split into three ranges: * 1 - 2^20 complete computations * 2^20 - 2^32 complete computations * 2^32 - 2^64 correct upper for k=2,3,4. correct lower for k=2. * empirical for other k. * */ static const double _upper_20[13] = {0,0, 1.006,0.7385,0.6830,0.5940,0.3596,0.2227,0.1439, 0.09785,0.07016,0.05303,0.04202}; static const double _upper_32[21] = {0,0, 1.013,0.8094,0.7485, /* 5-12 */ 0.6467,0.3984,0.2464,0.1572,0.1049,0.07364,0.05452,0.04266, /* 13-20 */ 0.03542,0.03082,0.02798,0.02642,0.02585,0.02615,0.02808,0.03054}; static const double _upper_64[41] = {0,0, 1.028, 1.028, 1.3043,/* <--corrrect */ /* 5-12 */ 0.72208, 0.46609, 0.29340,0.18571,0.12063,0.0815,0.0575,0.0427, /* 13-20 */ 0.03490, 0.03007, 0.02710, 0.02554, 0.02504, 0.02554, 0.02699, 0.02954, /* 21-28 */ 0.03294, 0.03779, 0.04453, 0.05393, 0.06703, 0.08543, 0.1117, 0.1494, /* 29-31 */ 0.205,0.287,0.410, /* 32-40 */ 0.60,0.90,1.36,2.12,3.35,5.38,8.83,14.75,25.07, }; static const double _lower_20[13] = {0,0, 0.8197, 0.8418, 0.5242, /* 5-12 */ 0.5154,0.3053,0.1901,0.1253,0.0892,0.06551,0.05082,0.04101}; static const double _lower_32[21] = {0,0, 1.004, 0.7383, 0.6828, /* 5-12 */ 0.5939,0.3594,0.2222,0.1438,0.09754,0.06981,0.05245,0.04151, /* 13-20 */ 0.03461,0.03006,0.02709,0.02553,0.02502,0.02552,0.02697,0.02945 }; static const double _lower_64[41] = {0,0, 1.011, 0.8093, 0.7484, /* 5-12 */ 0.6465,0.3982,0.2463,0.1571,0.1048,0.07363,0.0545,0.0422, /* 13-20 */ 0.0331,0.0270,0.0232,0.0208,0.0194,0.0190,0.0193,0.0203, /* 21-28 */ 0.0222,0.0252,0.0295,0.0356,0.0444,0.0570,0.0753,0.102, /* 29-31 */ 0.14,0.20,0.297, /* 32-40 */ 0.44,0.68,1.07,1.71,2.8,4.7,8.0,13.89,23.98, }; /* k,count n <= 2^64-1 1,425656284035217743 2,1701748900850019777 10 hours 3,3167597434038354478 320 hours 4,3787884015050788482 322 hours 5,3378907169603895030 294 hours 6,2466706950238087748 209 hours 7,1571012171387856192 123 hours 8,913164427599983727 82 hours 9,499840874923678341 42 hours 10,263157990621533964 20 hours 11,135128109904869290 12 hours 12,68283616225825256 7 hours 13,34151861008771016 4 hours 14,16967424859951587 2 hours 15,8393048221327186 16,4139595949113890 17,2037655246635364 18,1001591348315641 19,491808604962296 20,241293656953012 21,118304122014405 22,57968649799947 23,28388662714236 24,13895161400556 25,6797526392535 26,3323560145881 27,1624109166018 28,793189260998 29,387148515886 30,188844769357 31,92054377509 32,44841620426 33,21827124353 34,10616326552 35,5159281045 36,2505087309 37,1215204383 38,588891145 39,285076316 40,137840686 */ static void _almost_prime_count_bounds(UV *lower, UV *upper, uint32_t k, UV n) { double x, logx, loglogx, logplus, multl, multu, boundl, boundu; UV max; uint32_t i; if (k >= BITS_PER_WORD || (n >> k) == 0) { *lower = *upper = 0; return; } reduce_prime_count_factor(&k, &n); /* Reduce to lower k,n if possible */ if (k == 0) { *lower = *upper = (n >= 1); return; } if (k == 1) { *lower = prime_count_lower(n); *upper = prime_count_upper(n); return; } if (n < 3*(UVCONST(1) << (k-1))) { *lower = *upper = 1; return; } if (n < 9*(UVCONST(1) << (k-2))) { *lower = *upper = 2; return; } if (n < 10*(UVCONST(1) << (k-2))) { *lower = *upper = 3; return; } max = max_almost_prime_count(k); if (n >= max_nth_almost_prime(k)) { *lower = *upper = max; return; } x = (double) n; logx = log(x); loglogx = log(logx); logplus = loglogx + 0.26153; /* Select the appropriate table for n's range. * 20/32/64-bit n will always reduce k to these limits. */ if (n <= 1048575U) { MPUassert(k <= 12, "almost prime count: 20-bit n doesn't exceed k 12"); multu = _upper_20[k]; multl = _lower_20[k]; } else if (n <= 4294967295U) { MPUassert(k <= 20, "almost prime count: 32-bit n doesn't exceed k 20"); multu = _upper_32[k]; multl = _lower_32[k]; } else { MPUassert(k <= 40, "almost prime count: after reduction, k <= 40"); multu = _upper_64[k]; multl = _lower_64[k]; } if (k == 2) { boundl = boundu = x * (loglogx + 0.261536) / logx; if (x >= 1e12) { boundl = x*(loglogx+0.1769)/logx * (1+0.4232/logx); multl = 1; } } else if (k == 3) { boundu = x * (logplus*logplus + 1.055852) / (2*logx); /* Kinlaw (2019) Theorem 1 (with 1.000) */ boundl = x * loglogx * loglogx / (2*logx); if (n < 638) { multl = 0.8418; } else if (n <= 1926) { double weight = (x - 638L) / (double)(1926 - 638); multl = (1L-weight) * 0.8939 + weight * 0.9233; } else if (n <= 500194) { double weight = (x - 1927L) / (double)(500194 - 1927); multl = (1L-weight) * 0.9233 + weight * 1.000; } else if (n <= 3184393786U) { double weight = (x - 500194L) / (double)(3184393786U - 500194U); multl = (1L-weight) * 1.0000 + weight * 1.039; } else { /* TODO blend down to this */ multl = 1.0004; } /* Bayless (2018) Theorem 5.3 proves that multu=1.028 is a correct bound * for all x >= 10^12. However it is not a tight bound for the range * 2^32 to 2^64. We tighten it a lot for the reduced range. */ if (n > 4294967295U) multu = 0.8711; } else if (k == 4) { /* Bayless doesn't discuss a lower bound for k=4. */ /* Bayless Theorem 5.4 part 1 (with multu = 1.3043) */ boundl = boundu = x * logplus*logplus*logplus / (6*logx); /* Bayless Theorem 5.4 part 2 */ if (x > 1e12) { boundu += 0.511977 * x * (log(log(x/4)) + 0.261536) / logx; multu = 1.028; } /* As with k=3, adjust to tighten in the finite range. */ if (n > 4294967295U) multu = 0.780; if (x > 1e12) multu = 0.6921; } else { /* Completely empirical and by no means optimal. * It is easy and seems fairly reasonable through k=20 or so. * * For high k, this follows the lower bound well but upper grows too fast. */ boundl = x / logx; logplus = loglogx + (log(k)*log(log(k))-0.504377); /* k=5 => 0.26153 */ for (i = 1; i < k; i++) boundl *= logplus / (double)i; boundu = boundl; } #if 0 printf(" lower: %lf * %lf = %lf\n", boundl, multl, boundl*multl); printf(" upper: %lf * %lf = %lf\n", boundu, multu, boundu*multu); printf(" max: %lu\n", max); #endif boundl *= multl; boundu *= multu; *lower = (boundl >= UV_MAX || (max > 0 && boundl > max)) ? max : (UV)boundl; *upper = (boundu >= UV_MAX || (max > 0 && boundu > max)) ? max : (UV)(boundu+1.0); } UV almost_prime_count_upper(uint32_t k, UV n) { UV l, u; if (k == 2 && n < 256) return semiprime_count(n); _almost_prime_count_bounds(&l, &u, k, n); return u; } UV almost_prime_count_lower(uint32_t k, UV n) { UV l, u; if (k == 2 && n < 256) return semiprime_count(n); _almost_prime_count_bounds(&l, &u, k, n); return l; } UV max_nth_almost_prime(uint32_t k) { #if BITS_PER_WORD == 32 static const UV offset[32] = {UV_MAX-1,4,1,9,5,0,7,47,31,3,15,511,1263,5119,1023,255,23295,2559,4095,126975,16383,262143,2359295,2097151,5767167,1048575,33554431,16777215,100663295,67108863,268435455,1073741823}; #else static const UV offset[64] = {UV_MAX-1,58,14,2,4, /* 5-12 */ 3,17,0,1,195,51,127,63, /* 13-22 */ 767,1535,511,255,15,8191,1023,83967,16383,111615, /* 23-32 */ 557055,2097151,524287,65535,1048575,6553599,33554431,4194303,671088639,16777215, /* 33-63 */ UVCONST(536870911),UVCONST(2684354559),UVCONST(2147483647), UVCONST(25769803775),UVCONST(4294967295),UVCONST(268435455), UVCONST(206158430207),UVCONST(137438953471),UVCONST(17179869183), UVCONST(68719476735),UVCONST(2199023255551),UVCONST(5428838662143), UVCONST(21990232555519),UVCONST(4398046511103),UVCONST(1099511627775), UVCONST(100055558127615),UVCONST(10995116277759),UVCONST(17592186044415), UVCONST(545357767376895),UVCONST(70368744177663),UVCONST(1125899906842623), UVCONST(10133099161583615),UVCONST(9007199254740991), UVCONST(24769797950537727),UVCONST(4503599627370495), UVCONST(144115188075855871),UVCONST(72057594037927935), UVCONST(432345564227567615),UVCONST(288230376151711743), UVCONST(1152921504606846975),UVCONST(4611686018427387903) }; #endif if (k >= BITS_PER_WORD) return 0; return UV_MAX - offset[k]; } UV max_almost_prime_count(uint32_t k) { #if BITS_PER_WORD == 32 static const UV max[32] = {1,203280221,658662065,967785236,916899721,665533848,410630859,229679168,121092503,61600699,30653019,15043269,7315315,3535071,1700690,814699,389357,185245,87964,41599,19611,9184,4283,2001,914,421,187,84,37,15,7,2}; #else static const UV max[64] = {1, UVCONST( 425656284035217743), /* max prime count */ UVCONST(1701748900850019777), /* max semiprime count */ UVCONST(3167597434038354478), /* max 3-almost-prime count */ UVCONST(3787884015050788482), /* max 4-almost-prime count */ /* 5-12 */ UVCONST(3378907169603895030),UVCONST(2466706950238087748),UVCONST(1571012171387856192),UVCONST(913164427599983727),UVCONST(499840874923678341),UVCONST(263157990621533964),UVCONST(135128109904869290),UVCONST(68283616225825256), /* 13-22 */ UVCONST(34151861008771016),UVCONST(16967424859951587),UVCONST(8393048221327186),UVCONST(4139595949113890),UVCONST(2037655246635364),UVCONST(1001591348315641),UVCONST(491808604962296),UVCONST(241293656953012),UVCONST(118304122014405),UVCONST(57968649799947), /* 23-32 */ UVCONST(28388662714236),UVCONST(13895161400556),UVCONST(6797526392535),UVCONST(3323560145881),UVCONST(1624109166018),UVCONST(793189260998),UVCONST(387148515886),UVCONST(188844769357),UVCONST(92054377509),UVCONST(44841620426), /* 33-63 */ UVCONST(21827124353),UVCONST(10616326552),UVCONST(5159281045),UVCONST(2505087309),1215204383,588891145,285076316,137840686,66567488,32103728,15460810,7433670,3567978,1709640,817053,389954,185387,87993,41604,19611,9184,4283,2001,914,421,187,84,37,15,7,2 }; #endif if (k >= BITS_PER_WORD) return 0; /* if (max[k] == 0) return UV_MAX; All filled in so no need */ return max[k]; } /******************************************************************************/ /* Construction */ /******************************************************************************/ /* There are a few options for constructing KAPs without sieving/factoring. * * 1) we can make an iterator that recursively constructs them using * a prime list and a k-1 iterator. This is a generalization of * Dijkstra's Hamming number algorithm. * * 2) Given a range [lo,hi], We can ask for all k-1 kaps less than hi/2, * then multiply through by primes to see which fall in our range. * * Each of these (and sieving) is limited in some ways. For example, #1 * can output 500-almost-primes quite rapidly which some other methods have * trouble with, even with all the calculation in Perl. But it rapidly * slows down with increasing n. * * I suspect there are far more efficient methods. */ static void _tidy_list(UV **list, UV *Lsize, UV *count, bool minimal) { UV *L = *list; if (*count > 1) { UV i, j; sort_uv_array(L, *count); for (j = 0, i = 1; i < *count; i++) { if (L[i] != L[j]) L[++j] = L[i]; } *count = j+1; } if (minimal) { *Lsize = *count; Renew(*list, *Lsize, UV); } else if (*count * 1.5 > *Lsize) { *Lsize = *count * 2 + 100; Renew(*list, *Lsize, UV); } } UV range_construct_almost_prime(UV** list, uint32_t k, UV lo, UV hi) { UV *L, minkap1, lastprime, count = 0; if (k == 0 || k >= BITS_PER_WORD) { *list = 0; return 0; } if ((lo >> k) == 0) lo = UVCONST(1) << k; if (hi > max_nth_almost_prime(k)) hi = max_nth_almost_prime(k); if (lo > hi) { *list = 0; return 0; } if (k == 1) return range_prime_sieve(list, lo, hi); if (k == 2) return range_semiprime_sieve(list, lo, hi); /* if (k <= 5) return range_almost_prime_sieve(list, k, lo, hi); */ minkap1 = 1 << (k-1); lastprime = hi / minkap1; /* lastprime = prev_prime(lastprime+1); */ { UV i, Lsize; UV *lkap1, nkap1=range_construct_almost_prime(&lkap1, k-1, minkap1, hi>>1); /* Now multiply through exhaustively. */ Lsize = nkap1*4 + 100; New(0, L, Lsize, UV); START_DO_FOR_EACH_PRIME(2, lastprime) { for (i = 0; i < nkap1; i++) { UV prod = p * lkap1[i]; if (prod < lo) continue; if (prod > hi) break; if (count >= Lsize) _tidy_list(&L, &Lsize, &count, 0); L[count++] = prod; } } END_DO_FOR_EACH_PRIME _tidy_list(&L, &Lsize, &count, 1); Safefree(lkap1); } *list = L; return count; } UV range_almost_prime_sieve(UV** list, uint32_t k, UV slo, UV shi) { UV *S, Ssize, i, j, count; const UV thresh_pred = 40; if (k == 0 || k >= BITS_PER_WORD) { *list = 0; return 0; } if ((slo >> k) == 0) slo = UVCONST(1) << k; if (shi > max_nth_almost_prime(k)) shi = max_nth_almost_prime(k); if (slo > shi) { *list = 0; return 0; } #if 1 if (shi-slo+1 < thresh_pred) { Ssize = 3 + (thresh_pred >> 1); New(0, S, Ssize, UV); for (i = 0, j = 0; i < shi-slo+1; i++) if (is_almost_prime(k, slo+i)) S[j++] = slo+i; *list = S; return j; } #endif if (k == 1) return range_prime_sieve(list, slo, shi); if (k == 2) return range_semiprime_sieve(list, slo, shi); /* See if we can reduce k. * If for all possible kap from 1 to shi, ap(k,n) = 2*ap(k-1,n), then * sieve for k-1 from lo/2 to hi/2+1. * For large k this can continue even further so we might reduce a lot. */ { uint32_t r = reduce_k_for_n(k, shi); if (r > 0) { UV lo = (slo >> r) + (((slo >> r) << r) < slo); UV hi = shi >> r; count = range_almost_prime_sieve(&S, k-r, lo, hi); for (i = 0; i < count; i++) S[i] <<= r; *list = S; return count; } } Ssize = (almost_prime_count_approx(k,shi) - almost_prime_count_approx(k,slo) + 1) * 1.2 + 100; if (Ssize > 10000000UL) Ssize = 10000000UL; New(0, S, Ssize, UV); /* Do a range nfactor sieve in small windows, with one optimization. * * We know that we are looking for numbers with k factors, hence after * looking for small factors we could get a remainder R as large as: * 2 x 2 x ... x R where R could be prime or semiprime. Hence we can * reduce the sieve limit somewhat. Effectively we are sieving to the * maximum possible *second largest* factor for a k-almost-prime, * allowing us to correctly decide whether R is prime or semiprime * (if it has >= k factors). * * This isn't a big deal for small k, but it's a big impact for high k. * * I still think there should be a better way to do this for high k. * Is there any way to do this just sieving to rootint(hi,k+1)? * Given hi=10^6: * k=3 => 97^3, 2x701^2, 2x2x249989 * k=4 => 31^4, 2x79^3, 2x2x499^2, 2x2x2x724991 */ { unsigned char* nf; UV const segsize = 65536*4; UV *N, lo, hi, range; UV kdiv = (k < 3) ? UVCONST(1) : (UVCONST(1) << (k-2)); New(0, nf, segsize+1, unsigned char); New(0, N, segsize+1, UV); prime_precalc(isqrt(shi/kdiv)); count = 0; for (lo = slo; lo <= shi && lo >= slo; lo = hi+1) { hi = lo+segsize-1; if (hi > shi || hi < lo) hi = shi; range = hi - lo + 1; memset(nf, 0, range); for (i = lo; i <= hi; i++) { if (!(i&1) && i >= 2) { const unsigned char nz = (unsigned char)ctz(i); nf[i-lo] = nz; N[i-lo] = UVCONST(1) << nz; } else N[i-lo] = 1; } START_DO_FOR_EACH_PRIME(3, isqrt(hi/kdiv)) { UV pk, maxpk = UV_MAX/p; \ for (i = P_GT_LO_0(p,p,lo); i < range; i += p) { N[i] *= p; nf[i]++; } for (pk = p*p; pk <= hi; pk *= p) { for (i = P_GT_LO_0(pk,pk,lo); i < range; i += pk) { N[i] *= p; nf[i]++; } if (pk >= maxpk) break; /* Overflow protection */ } } END_DO_FOR_EACH_PRIME for (i = 0; i < range; i++) { if (N[i] < (lo+i)) nf[i]++; if (nf[i] == k) { if (count >= Ssize) Renew(S, Ssize += 10000, UV); S[count++] = i+lo; } } } Safefree(N); Safefree(nf); } *list = S; return count; } /* Algorithm from Trizen, May 2022 */ static void _genkap(UV lo, UV hi, uint32_t k, UV m, UV begp, UV **List, UV *Lpos, UV *Lsize) { if (k == 1) { UV pos = *Lpos, size = *Lsize, *L = *List; UV start = lo/m + (lo % m != 0), endp = hi/m; if (start > begp) begp = start; if (endp < 10000000U) { START_DO_FOR_EACH_PRIME(begp, endp) { if (L != 0) { if (pos >= size) Renew(L, size += 100000, UV); L[pos] = m*p; } pos++; } END_DO_FOR_EACH_PRIME } else { UV i, count, *list; count = range_prime_sieve(&list, begp, endp); if (L == 0) { pos += count; } else { if ((pos + count - 1) >= size) Renew(L, size += (count + 100000), UV); for (i = 0; i < count; i++) L[pos++] = m * list[i]; } Safefree(list); } *Lpos = pos; *Lsize = size; *List = L; } else { UV p, s; for (s = rootint(hi/m, k), p = begp; p <= s; p = next_prime(p)) { UV t = m * p; if ((lo/t + (lo % t != 0)) <= (hi/t)) _genkap(lo, hi, k-1, t, p, List, Lpos, Lsize); } } } UV generate_almost_primes(UV** list, uint32_t k, UV lo, UV hi) { UV *L, Lpos = 0, Lsize, countest; if (k >= BITS_PER_WORD) { *list = 0; return 0; } if ((lo >> k) == 0) lo = UVCONST(1) << k; if (hi > max_nth_almost_prime(k)) hi = max_nth_almost_prime(k); if (lo > hi) { *list = 0; return 0; } /* For these small k values, these are typically faster */ if (k == 0) { New(0,L,1,UV); L[0]=1; *list=L; return 1; } if (k == 1) return range_prime_sieve(list, lo, hi); if (k == 2) return range_semiprime_sieve(list, lo, hi); /* Large base with small range: better to sieve */ if ( (k >= 3 && hi >= 1e12 && (hi-lo) <= 5e6) || (k >= 3 && hi >= 1e13 && (hi-lo) <= 2e8) || (k >= 3 && hi >= 1e14 && (hi-lo) <= 4e8) ) return range_almost_prime_sieve(list, k, lo, hi); /* Optional: we could try reduce_k_for_n() here. */ prime_precalc(10000000U); countest = almost_prime_count_approx(k,hi) - almost_prime_count_approx(k,lo-1); Lsize = (countest > 10000000U) ? 10000000U : countest+1000; New(0, L, Lsize, UV); _genkap(lo, hi, k, 1, 2, &L, &Lpos, &Lsize); sort_uv_array(L, Lpos); *list = L; return Lpos; } /******************************************************************************/ /* CHEN PRIMES */ /******************************************************************************/ /* consider Chen(h,k) where p prime and bigomega(p+h) <= k */ #if BITS_PER_WORD == 64 #define MAX_CHEN_PRIME UVCONST(18446744073709551437) #else #define MAX_CHEN_PRIME UVCONST(4294967291) #endif bool is_chen_prime(UV n) { if (n < 2 || n > MAX_CHEN_PRIME) return 0; return (is_prime(n) && (is_prime(n+2) || is_semiprime(n+2))); } UV next_chen_prime(UV n) { for ( n = next_prime(n); n != 0 && n < MAX_CHEN_PRIME; n = next_prime(n+2) ) if (is_prime(n+2) || is_semiprime(n+2)) return n; return 0; } Math-Prime-Util-0.74/semi_primes.h000644 000765 000024 00000000523 15145577415 017073 0ustar00danastaff000000 000000 #ifndef MPU_SEMI_PRIMES_H #define MPU_SEMI_PRIMES_H #include "ptypes.h" extern UV range_semiprime_sieve(UV** semis, UV lo, UV hi); extern UV semiprime_count_range(UV lo, UV hi); extern UV semiprime_count(UV n); extern UV semiprime_count_approx(UV n); extern UV nth_semiprime(UV n); extern UV nth_semiprime_approx(UV n); #endif Math-Prime-Util-0.74/primality.c000644 000765 000024 00000105250 15154713505 016557 0ustar00danastaff000000 000000 #include #include #include #include /* Primality related functions */ #include "ptypes.h" #include "primality.h" #include "lucas_seq.h" #include "mulmod.h" #define FUNC_gcd_ui 1 #define FUNC_is_perfect_square #include "util.h" #include "montmath.h" /* Fast Montgomery math */ /******************************************************************************/ 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) { UV g = gcd_ui(D,n); if (g != 1 && g != n) 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 */ bool is_pseudoprime(UV const n, UV a) { if (n < 3) return (n == 2); 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 */ bool is_euler_pseudoprime(UV const n, UV a) { if (n < 3) return (n == 2); 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. */ bool 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; } bool is_strong_pseudoprime(UV const n, UV a) { UV d = n-1; int r, s = 0; if (n < 3) return (n == 2); if (!(n&1)) return 0; if (a < 2) croak("Base %"UVuf" is invalid", a); if (a >= n) a %= n; if (a <= 1 || a == n-1) return 1; while (!(d&1)) { s++; d >>= 1; } /* 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 */ { #if USE_MONTMATH const uint64_t npi = mont_inverse(n), mont1 = mont_get1(n); const uint64_t ma = mont_geta(a,n); uint64_t mx; if (!ma) return 1; mx = mont_powmod(ma, d, n); if (mx != mont1 && mx != n-mont1) { for (r = 1; r < s; r++) { mx = mont_sqrmod(mx, n); if (mx == n-mont1) break; if (mx == mont1 ) return 0; } if (r >= s) return 0; } #else UV x = powmod(a, d, n); if (x != 1 && x != n-1) { 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; } /* Miller-Rabin probabilistic primality test for multiple bases at a time. * Returns 1 if probably prime relative to the bases, 0 if composite. * Bases must be between 2 and n-2 */ bool miller_rabin(UV const n, const UV *bases, int nbases) { int i; /* For best performance, especially with montmath, we would do as much * as possible up front, then do the per-base loop. This code used to * do that, but we never actually used it with more than one base. */ for (i = 0; i < nbases; i++) if (!is_strong_pseudoprime(n, bases[i])) break; return i >= nbases; } bool 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 } /******************************************************************************/ /******************************************************************************/ /* 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. */ bool is_lucas_pseudoprime(UV n, int strength) { IV P, Q, D; UV U, V, Pu, Qu, 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; lucasuvmod(&us, &vs, P, Q, n+1, n); 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 Pu = ivmod(P,n); Qu = ivmod(Q,n); lucasuvmod(&U, &V, Pu, Qu, d, n); 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 */ Qk = powmod(Qu, d, n); 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; int qjacobi, is_slpsp = 0; if (U == 0) is_slpsp = 1; Qk = powmod(Qu, d, n); 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 || Qu == 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. */ bool 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 const _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 } bool is_perrin_pseudoprime(UV n, uint32_t 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; } bool is_frobenius_pseudoprime(UV n, IV P, IV Q) { UV U, V, t, 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 = ivmod(P,n); Qu = ivmod(Q,n); t = gcd_ui(n, Pu*Qu*Du); if (t != 1) { if (t == n) return is_prob_prime(n); return 0; } if (k == 0) { k = kronecker_su(D, n); if (k == 0) return 0; Vcomp = (k == 1) ? 2 : addmod(Qu,Qu,n); } lucasuvmod(&U, &V, Pu, Qu, n-k, n); /* 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. */ bool 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. */ bool 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 52 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,82589933,136279841}; #define LAST_CHECKED_MERSENNE 79711549 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; } bool 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); } /******************************************************************************/ static const uint16_t mr_bases_hash32[256] = { /* requires div 2,3,5 */ 4816, 6332, 958, 6124, 1001, 1431, 9644, 3700, 9251,20069, 7085, 2484, 3255, 218, 4660, 732, 1863, 3716, 2480, 2120, 2464,38264, 3070, 2621, 1592,17862,15223, 2926, 9119, 2181,24932, 4407,10915,13832, 1965, 3646, 2470, 62, 8548, 449, 4440, 7656, 1065,10100, 6497, 1868,33282, 4277, 805, 636,11536, 34, 2065, 406, 6435, 1043,27985, 7134, 1357, 3056, 6077, 4704, 6174, 865,15190,14419, 38, 6161,18774, 3990, 976, 1267, 3251, 233, 7387, 241, 3871, 4331, 8780, 2233,30331, 1656, 462, 5585, 194,10300, 1072, 1197, 1573, 1144, 1273,19439, 696, 1477,15858, 2684, 6022, 80, 9726, 6731, 1132, 774, 2202, 3668,19479,10837, 183, 71, 403, 5245, 1995, 2019, 5209, 174, 503,13830,21013, 3284, 7164, 2607, 10769, 473, 119, 8227, 1216, 3550, 1450, 1399,45822, 609, 721, 47, 9665, 4242, 767, 4880,16037, 844, 333, 8560, 1907, 2532,13468, 302, 2589, 5546,14312, 1548,18013, 8452,12427, 4431,10248, 4022, 5545, 1399, 41507, 1160, 1865, 219, 1254, 3330,13627, 1070, 3304, 5537, 6085,26999, 10279, 5369, 4992,38919, 2191, 1663,46961, 6570,11876,21689, 2804, 1202, 5764, 275, 2862, 2139, 7799, 4646, 1696, 4964,19016,12891, 4282, 4741, 7274, 174, 541,26596, 7524, 2777, 1819, 339, 1399, 2636, 668, 291, 559, 4992, 520, 7874, 2544, 4618, 4122, 1128, 326, 275,13080, 156, 236, 7015, 6349,11673, 2632, 475, 4560, 1543, 78, 3611, 34, 3811, 137, 737,31269, 2522,13354, 2033, 8577, 3597, 9269, 3815, 2511, 8088, 903, 109,12454, 1985, 8065,17637, 1645, 1404, 6106, 3661, 328, 6160, 1602, 6601, 1491, 8657 }; /* Correct for any 32-bit input. */ bool MR32(uint32_t n) { if (n < 11) return 0xAC >> n & 1; /* equal to 2, 3, 5 or 7 */ if (is_divis_2_3_5(n)) return 0; /* divis by 2, 3, or 5 */ return is_strong_pseudoprime(n, mr_bases_hash32[n >> 8 & 255]); } /******************************************************************************/ /********** PRIMALITY TEST **********/ /******************************************************************************/ /* * For numbers under 3481 (59^2) everything handled by trial division. * * For numbers under 500k when we don't have fast ASM Montgomery math, * do it with trial division. * * If input is 32-bit, use a hashed single base Miller-Rabin test. * * Otherwise (input is bigger than 32-bit), do trial division to 89, then * call BPSW. This is typically about 25% slower than a big (300k+) hash * table to allow two Miller-Rabin tests, and 20% faster than a reasonable * size table allowing three M-R tests. * * See: * - https://github.com/flintlib/flint/pull/2487 * - https://github.com/JASory/machine-prime * for examples of using the big table. */ bool is_prob_prime(UV n) { #if BITS_PER_WORD == 64 if (n > UVCONST(4294967295)) { /* input is >= 2^32, UV is 64-bit*/ if (is_divis_2_3_5_7(n)) 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 BPSW(n); } #endif { uint32_t x = n; if (x < 11) return 0xAC >> x & 1; /* Bits 2, 3, 5 and 7 */ if (is_divis_2_3_5_7(x)) return 0; if (x < 121) /* 11*11 */ return 1; 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 1; /* For tiny inputs, continue trial division. */ if (!USE_MONTMATH && n < 500000) { 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 1; } return is_strong_pseudoprime(x, mr_bases_hash32[x >> 8 & 255]); } } Math-Prime-Util-0.74/powerful.h000644 000765 000024 00000000450 15145577415 016421 0ustar00danastaff000000 000000 #ifndef MPU_POWERFUL_H #define MPU_POWERFUL_H #include "ptypes.h" extern bool is_powerful(UV n, UV k); extern UV powerful_count(UV n, UV k); extern UV nth_powerful(UV n, UV k); extern UV sumpowerful(UV n, UV k); extern UV* powerful_numbers_range(UV* npowerful, UV lo, UV hi, UV k); #endif Math-Prime-Util-0.74/ds_pagelist64.h000644 000765 000024 00000017252 15145577415 017236 0ustar00danastaff000000 000000 #ifndef MPU_DS_PAGELIST64_H #define MPU_DS_PAGELIST64_H #include "ptypes.h" /******************************************************************************/ /* PAGELIST DATA STRUCTURE */ /******************************************************************************/ /* * This is a form of unrolled skip list. However, for the sake of vastly * improved cache hits to find the right page, we use two arrays rather * than a linked list. */ #ifndef PLTYPE #define PLTYPE UV #endif #define PLDEBUG 0 #define PAGESIZE 256 #define ELEV 7 #define ESHIFT 4 #define DELFACTOR 0.66 /* 1.0 means always merge */ #define NEPG(n,i) (((n) + (1UL<<((i)*ESHIFT)) - 1) >> ((i)*ESHIFT)) #define ADDSIZE(pl, p, n) \ { int _i; \ for (_i = 0; _i < ELEV; _i++) \ { pl->pgsize[_i][(p) >> (_i*ESHIFT)] += n; } } typedef struct pagelist64_t { uint32_t pagesize; PLTYPE nelems; PLTYPE npages_allocated[ELEV]; PLTYPE npages[ELEV]; PLTYPE *pgsize[ELEV]; PLTYPE **pgdata; } pagelist64_t; static pagelist64_t* pagelist64_create(UV n) { pagelist64_t *pl; int i; New(0, pl, 1, pagelist64_t); pl->pagesize = PAGESIZE; pl->nelems = 0; for (i = 0; i < ELEV; i++) { pl->npages[i] = 1; pl->npages_allocated[i] = (i == 0) ? (1UL << ESHIFT) : 1; Newz(0, pl->pgsize[i], pl->npages_allocated[i], PLTYPE); } New(0, pl->pgdata, pl->npages_allocated[0], PLTYPE *); New(0, pl->pgdata[0], pl->pagesize, PLTYPE); return pl; } static void pagelist64_destroy(pagelist64_t *pl) { PLTYPE p; int i; for (p = 0; p < pl->npages[0]; p++) Safefree(pl->pgdata[p]); Safefree(pl->pgdata); for (i = 0; i < ELEV; i++) { Safefree(pl->pgsize[i]); pl->npages[i] = pl->npages_allocated[i] = 0; } pl->nelems = 0; } #if PLDEBUG #define CHECKPL(pl, msg) _pagelist64_check_epg(pl, msg) static void _pagelist64_check_epg(pagelist64_t *pl, const char* msg) { PLTYPE p, npages0 = pl->npages[0], *pgsz0 = pl->pgsize[0], sum[ELEV] = {0}; int i; for (i = 0; i < ELEV; i++) if (pl->npages[i] > pl->npages_allocated[i]) croak("level %u more pages in use than allocated\n", i); for (i = 1; i < ELEV; i++) if ( NEPG(npages0,i) > pl->npages[i] ) croak("%s: level %u not enough pages nepg\n",msg,i); for (i = 1; i < ELEV; i++) if ( ((npages0-1) >> (i*ESHIFT)) >= pl->npages[i] ) croak("%s: level %u not enough pages\n",msg,i); for (p = 0; p < npages0; p++) { for (i = 1; i < ELEV; i++) { PLTYPE pagesper = 1UL << (i*ESHIFT); sum[i] += pgsz0[p]; if (p == npages0-1 || (p % pagesper) == (pagesper-1)) { PLTYPE ep = p >> (i*ESHIFT); if (sum[i] != pl->pgsize[i][ep]) croak("%s: bad epg: sum %u pgsize[%u][%u] %u\n", msg, sum[i], i, ep, pl->pgsize[i][ep]); sum[i] = 0; } } } } #else #define CHECKPL(pl, msg) #endif #if 0 static void _pagelist64_remake_epg(pagelist64_t *pl) { PLTYPE i, p, npages0 = pl->npages[0], *pgsz0 = pl->pgsize[0]; for (i = 1; i < ELEV; i++) { PLTYPE* pgszi = pl->pgsize[i]; memset( pgszi, 0, pl->npages[i] * sizeof(PLTYPE) ); for (p = 0; p < npages0; p++) pgszi[ p >> (i*ESHIFT) ] += pgsz0[p]; } CHECKPL(pl, "remake"); } #endif static PLTYPE _pagelist64_find_page(pagelist64_t *pl, PLTYPE *n) { PLTYPE p; int i; if (*n >= pl->nelems) croak("pagelist64 index out of range"); CHECKPL(pl, "find page"); for (i = ELEV-1, p = 0; i >= 0; i--) { PLTYPE npagesi = pl->npages[i], *pgszi = pl->pgsize[i]; for (p = p << ESHIFT; p < npagesi && *n >= pgszi[p]; p++) *n -= pgszi[p]; } return p; } static void _pagelist64_add_page(pagelist64_t *pl) { PLTYPE npages0; int i; if (pl->npages[0] == pl->npages_allocated[0]) { pl->npages_allocated[0] += (1UL << ESHIFT); Renew(pl->pgsize[0], pl->npages_allocated[0], PLTYPE); Renew(pl->pgdata, pl->npages_allocated[0], PLTYPE*); } /* Mark one more page in use */ npages0 = pl->npages[0]; pl->pgsize[0][npages0] = 0; New(0, pl->pgdata[npages0], pl->pagesize, PLTYPE); pl->npages[0]++; /* Enlarge the higher levels if needed */ for (i = 1; i < ELEV; i++) { if (NEPG(pl->npages_allocated[0], i) > pl->npages_allocated[i]) { pl->npages_allocated[i] += 4 + NEPG(pl->npages_allocated[0], i); Renew(pl->pgsize[i], pl->npages_allocated[i], PLTYPE); } if (NEPG(pl->npages[0], i) > pl->npages[i]) { pl->pgsize[i][pl->npages[i]] = 0; pl->npages[i]++; } } CHECKPL(pl, "add page"); } static void pagelist64_append(pagelist64_t *pl, PLTYPE v) { PLTYPE *pgsz0 = pl->pgsize[0], ptail = pl->npages[0] - 1; if (pgsz0[ptail] >= pl->pagesize) { _pagelist64_add_page(pl); pgsz0 = pl->pgsize[0]; ptail = pl->npages[0] - 1; } pl->pgdata[ptail][pgsz0[ptail]] = v; ADDSIZE(pl, ptail, 1); pl->nelems++; CHECKPL(pl, "append"); } static PLTYPE pagelist64_val(pagelist64_t *pl, PLTYPE idx) { PLTYPE p = _pagelist64_find_page(pl, &idx); #if PLDEBUG if (p >= pl->npages[0]) croak("pagelist64: bad page in val"); if (idx >= pl->pgsize[0][p]) croak("pagelist64: bad index in val"); #endif return pl->pgdata[p][idx]; } static PLTYPE* pagelist64_to_array(UV *size, pagelist64_t *pl) { PLTYPE *pgsz0 = pl->pgsize[0]; PLTYPE d, p, *arr; New(0, arr, pl->nelems, PLTYPE); for (d = 0, p = 0; p < pl->npages[0]; p++) { memcpy(arr + d, pl->pgdata[p], pgsz0[p] * sizeof(PLTYPE)); d += pgsz0[p]; } if (d != pl->nelems) croak("pagelist64: bad number of elements in list"); *size = d; return arr; } static void pagelist64_delete(pagelist64_t *pl, PLTYPE idx) { /* idx 0,1,... */ PLTYPE npages0 = pl->npages[0], *pgsz0 = pl->pgsize[0]; PLTYPE p = _pagelist64_find_page(pl, &idx); if (p >= npages0) croak("pagelist64: bad page in delete"); if (idx < pgsz0[p]-1) memmove(pl->pgdata[p]+idx, pl->pgdata[p]+idx+1, (pgsz0[p]-1-idx) * sizeof(PLTYPE)); ADDSIZE(pl, p, -1); pl->nelems--; #if 1 /* Merge with leveled add/subtract. */ if ((p+1) < npages0 && (pgsz0[p] + pgsz0[p+1] <= DELFACTOR * pl->pagesize)) { int i; /* 1 copy data to end of this page, and remove next page data */ memcpy(pl->pgdata[p] + pgsz0[p], pl->pgdata[p+1], pgsz0[p+1] * sizeof(PLTYPE)); Safefree(pl->pgdata[p+1]); if ( (p+1) < (npages0-1) ) memmove(pl->pgdata + p + 1, pl->pgdata + p + 2, (npages0-1-p) * sizeof(PLTYPE*)); /* 2 adjust upper levels, moving sizes on boundaries */ for (i = 1; i < ELEV; i++) { PLTYPE ep, npagesi = pl->npages[i], *pgszi = pl->pgsize[i]; for (ep = 1 + ((p+0) >> (i*ESHIFT)); ep < npagesi; ep++) { PLTYPE amt = pgsz0[ep << (i*ESHIFT)]; pgszi[ep] -= amt; pgszi[ep-1] += amt; } pl->npages[i] = NEPG(npages0-1, i); /* Possibly lower now */ } /* 3 Move sizes at base level over efficiently */ pgsz0[p] += pgsz0[p+1]; if ( (p+1) < (npages0-1) ) memmove(pgsz0 + p + 1, pgsz0 + p + 2, (npages0-1-p) * sizeof(PLTYPE)); pl->npages[0]--; } #endif CHECKPL(pl, "delete"); } typedef struct pagelist64_iter_t { pagelist64_t *pl; PLTYPE p; PLTYPE idx; } pagelist64_iter_t; static pagelist64_iter_t pagelist64_iterator_create(pagelist64_t *pl, PLTYPE idx) { pagelist64_iter_t iter; iter.pl = pl; iter.p = _pagelist64_find_page(pl, &idx); iter.idx = idx; return iter; } static PLTYPE pagelist64_iterator_next(pagelist64_iter_t *iter) { PLTYPE v, p = iter->p; if (p >= iter->pl->npages[0]) return 0; v = iter->pl->pgdata[p][iter->idx]; if (++iter->idx >= iter->pl->pgsize[0][p]) { iter->p++; iter->idx = 0; } return v; } #undef PLTYPE #undef PLDEBUG #undef PAGESIZE #undef ELEV #undef ESHIFT #undef DELFACTOR #undef NEPG #undef ADDSIZE #undef CHECKPL #endif Math-Prime-Util-0.74/examples/000755 000765 000024 00000000000 15154713771 016221 5ustar00danastaff000000 000000 Math-Prime-Util-0.74/lehmer.c000644 000765 000024 00000021775 15145577415 016042 0ustar00danastaff000000 000000 #include #include #include #include #define USE_PHI_CACHE 1 #define FUNC_isqrt 1 #include "lehmer.h" #include "util.h" #include "cache.h" #include "sieve.h" #include "prime_counts.h" #include "prime_count_cache.h" #include "legendre_phi.h" /***************************************************************************** * * Counting primes with Legendre, Meissel, and Lehmer methods. * * Since we have a reasonable extended LMO, this is just for demonstration. * * The first versions of this were in 2012 and 2013, and included a novel * phi calculation using iterative list merging, which greatly sped up * the calculations compared to recursive phi calculations, even when caching * was added. * * Kim Walisch started his primecount project in mid-2013, which quickly * surpassed this in speed. Currently (2021) his project is substantially * faster, as well as having support for the Deleglise-Rivat and * Gourdon algorithms, efficient parallelization, and big number support. * * Reference: Hans Riesel, "Prime Numbers and Computer Methods for * Factorization", 2nd edition, 1994. */ /* Below this size, just get primecount using standard methods */ #define SIEVE_LIMIT 60000000 /* Bigger prime count cache in Lehmer loop */ #define SIEVE_MULT 1 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 static UV P2_with_primes(UV n, UV a, UV b, const uint32_t *primes, uint32_t lastidx) { UV P2, lastw, lastwpc, i; UV lastpc = 6 * primes[lastidx]; void* pcache = prime_count_cache_create(lastpc); /* 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) ? prime_count_cache_lookup(pcache, w) : lastwpc + segment_prime_count(lastw+1, w); lastw = w; P2 += lastwpc; } P2 -= ((b+a-2) * (b-a+1) / 2) - a + 1; prime_count_cache_destroy(pcache); return P2; } /* b = prime_count(isqrt(n)) */ static UV P2(UV n, UV a, UV b) { uint32_t lastidx, *primes; UV maxn, P2; maxn = nth_prime_upper( b ); if (maxn > 4294967291U) maxn = 4294967291U; lastidx = range_prime_sieve_32(&primes, maxn, 1); MPUassert(lastidx >= b, "failed to generate enough primes\n"); P2 = P2_with_primes(n, a, b, primes, lastidx); 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 = legendre_phi(n, a); 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 = legendre_phi(n, a) + a - 1 - P2(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, lastidx, lastpc, lastw, lastwpc; uint32_t* primes = 0; /* small prime cache, first b=pi(z)=pi(sqrt(n)) */ void* pcache; /* Prime count cache */ 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 = legendre_phi(n, a) + ((b+a-2) * (b-a+1) / 2); TIMING_END_PRINT("phi(x,a)") /* The first b primes are used in stage 4. Hence, primes to isqrt(n). */ TIMING_START; lastidx = range_prime_sieve_32(&primes, isqrt(n), 1); MPUassert(lastidx >= b, "failed to generate enough primes\n"); TIMING_END_PRINT("small primes") if (verbose > 0) printf("lehmer %lu stage 3: %lu small primes\n", n, lastidx); TIMING_START; lastpc = SIEVE_MULT * primes[lastidx]; if (SIEVE_MULT == 1) pcache = prime_count_cache_create_with_primes(primes, lastidx); else pcache = prime_count_cache_create(lastpc); TIMING_END_PRINT("prime count cache") 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) ? prime_count_cache_lookup(pcache, w) : lastwpc + segment_prime_count(lastw+1, w); lastw = w; sum = sum - lastwpc; if (i <= c) { UV bi = prime_count_cache_lookup(pcache, isqrt(w)); for (j = i; j <= bi; j++) { sum = sum - prime_count_cache_lookup(pcache, w / primes[j]) + j - 1; } /* We could wrap the +j-1 in: sum += ((bi+1-i)*(bi+i))/2 - (bi-i+1); */ } } TIMING_END_PRINT("stage 4") prime_count_cache_destroy(pcache); 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, c, lastidx, P2, S1, S2; uint32_t primec; 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 */ void *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] */ TIMING_START; lastidx = range_prime_sieve_32(&primes, isqrt(n), 1); MPUassert(lastidx >= b, "failed to generate enough primes\n"); TIMING_END_PRINT("small primes") TIMING_START; 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; TIMING_END_PRINT("mu and lpf") /* Thanks to Kim Walisch for help with the S1+S2 calculations. */ c = (a < tiny_phi_max_a()) ? a : tiny_phi_max_a(); primec = primes[c]; S1 = 0; S2 = 0; pcache = prepare_cached_legendre_phi(n, a); TIMING_START; for (i = 1; i <= n13; i++) if (lpf[i] > primec) S1 += mu[i] * tiny_phi(n/i, c); TIMING_END_PRINT("S1") /* TODO: This is about 1.5x slower than the old way. Fix. */ TIMING_START; for (i = c; i+1 < a; i++) { uint32_t p = primes[i+1]; for (j = (n13/p)+1; j <= n13; j++) if (lpf[j] > p) S2 += -mu[j] * cached_legendre_phi(pcache, n / (j*p), i); } TIMING_END_PRINT("S2") destroy_cached_legendre_phi(pcache); Safefree(lpf); Safefree(mu); TIMING_START; prime_precalc( (UV) pow(n, 2.9/5.0) ); P2 = P2_with_primes(n, a, b, primes, lastidx); 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; } Math-Prime-Util-0.74/META.yml000644 000765 000024 00000003407 15154713772 015661 0ustar00danastaff000000 000000 --- abstract: 'Utilities related to prime numbers, including fast sieves and factoring' author: - 'Dana A Jacobsen ' build_requires: ExtUtils::MakeMaker: '0' Test::More: '0.96' bignum: '0.65' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.76, CPAN::Meta::Converter version 2.150012' 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.74' Math::Prime::Util::ChaCha: file: lib/Math/Prime/Util/ChaCha.pm version: '0.74' Math::Prime::Util::Entropy: file: lib/Math/Prime/Util/Entropy.pm version: '0.74' Math::Prime::Util::MemFree: file: lib/Math/Prime/Util/MemFree.pm version: '0.74' Math::Prime::Util::PP: file: lib/Math/Prime/Util/PP.pm version: '0.74' Math::Prime::Util::PrimeArray: file: lib/Math/Prime/Util/PrimeArray.pm version: '0.74' Math::Prime::Util::PrimeIterator: file: lib/Math/Prime/Util/PrimeIterator.pm version: '0.74' ntheory: file: lib/ntheory.pm version: '0.74' recommends: Digest::SHA: '5.87' Math::BigInt::GMP: '0' Math::GMPz: '0.68' Math::Prime::Util::GMP: '0.53' requires: Carp: '0' Config: '0' Exporter: '5.57' Math::BigFloat: '1.59' Math::BigInt: '1.999814' 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.74' x_serialization_backend: 'CPAN::Meta::YAML version 0.020' Math-Prime-Util-0.74/rational.c000644 000765 000024 00000021156 15145577415 016370 0ustar00danastaff000000 000000 #include #include "ptypes.h" #include "rational.h" #define FUNC_gcd_ui 1 #include "util.h" #include "totients.h" int contfrac(UV** cfrac, UV *rem, UV num, UV den) { UV *cf; int steps = 0; New(0, cf, 2 * BITS_PER_WORD, UV); /* Upper limit for gcd steps */ while (den > 0) { UV q = num/den; UV r = num - q*den; num = den; den = r; cf[steps++] = q; } *rem = num; *cfrac = cf; return steps; } bool next_calkin_wilf(UV* num, UV* den) { UV n, d; if (num == 0 || den == 0) return 0; n = *num; d = *den; if (n == 0 || d == 0 || gcd_ui(n,d) != 1) return 0; /* next = d / (n+d-2*(n%d)) = d / (2(n/d)+1)*d-n */ if (n < d) { /* n/d is 0 */ *den = d-n; } else if (d == 1) { if (n == UV_MAX) return 0; *den = n + 1; } else { /* n >= d and d >= 2 */ UV nd = n % d; /* nd is less than d and less than n */ UV nr = n-nd, dr = d-nd; if (nr > UV_MAX-dr) return 0; *den = nr + dr; } *num = d; return 1; } bool next_stern_brocot(UV* num, UV* den) { UV n, d; if (num == 0 || den == 0) return 0; n = *num; d = *den; if (n == 0 || d == 0 || gcd_ui(n,d) != 1) return 0; /* Backhouse and Ferreira show how to do this *if* we had a 2x2 matrix * for the node. We could also exploit that given a/b and the next c/d * bc-ad=3 if they share a parent * but this doesn't give us enough information to solve for both c,d. */ if (*den == 1) { /* At end of the row, go to the start of the next. */ if (*num == UV_MAX) return 0; *den = *num+1; *num = 1; return 1; } /* Given the tree e.g. LLLRRLLRR, we can go up to the nearest ancestor, * then back down. That is, from the right, invert all L/R from the end * to and including the right L. This really isn't a huge savings over * doing the full process. Doing nth(n(F)+1) is clean. */ return nth_stern_brocot(num, den, 1+stern_brocot_n(*num, *den)); } #if 0 /* A recursive version */ UV calkin_wilf_n(UV num, UV den) { if (num == den) { return 1; } else if (num > den) { UV f = calkin_wilf_n(num-den, num); if (f == 0 || f == UV_MAX) return 0; return 1 + f; } else { UV f = calkin_wilf_n(num, den-num); if (f == 0 || f > (UV_MAX/2)) return 0; return 2 * f; } } #endif UV calkin_wilf_n(UV num, UV den) { UV *cf = 0, n = 0, rem; uint32_t bit, d = 1, shift = 0; int i, steps = contfrac(&cf, &rem, num, den); if (rem != 1) croak("Rational must be reduced"); if (steps == 0) return 0; cf[steps-1]--; for (i = 0; i < steps; i++) { if ((shift+cf[i]) >= BITS_PER_WORD) break; if (d) for (bit = 0; bit < cf[i]; bit++) n |= UVCONST(1) << (shift+bit); shift += cf[i]; d ^= 1; /* d = 1-d; */ } Safefree(cf); if (i < steps) return 0; n |= UVCONST(1) << shift; return n; } UV stern_brocot_n(UV num, UV den) { /* Reverse bits in the Calkin-Wilf n */ UV n, M = calkin_wilf_n(num,den); if (M == 0) return 0; for (n = 1; M > 1; M >>= 1) n = (n << 1) | (M & 1); return n; } bool nth_calkin_wilf(UV* num, UV* den, UV n) { uint32_t b = 1; UV p = 0, q = 1; /* p odd q even */ { UV v = n; while (v >>= 1) b++; } while (b--) { if ((n >> b) & 1) p += q; else q += p; } *num = p; *den = q; return 1; } bool nth_stern_brocot(UV* num, UV* den, UV n) { UV p = 1, q = 1; /* p odd q even */ while (n > 1) { if (n & 1) p += q; else q += p; n >>= 1; } *num = p; *den = q; return 1; } UV nth_stern_diatomic(UV n) { UV p = 0, q = 1; while (n) { if (n & 1) p += q; else q += p; n >>= 1; } return p; } UV farey_length(uint32_t n) { UV t = sumtotient(n); return (t == 0) ? 0 : 1 + sumtotient(n); } bool next_farey(uint32_t n, uint32_t* p, uint32_t* q) { IV ivu, ivg; UV u, uvp, uvq; if (n == 0 || p == 0 || q == 0 || *p >= *q) return 0; ivg = gcdext( (IV)*p, (IV)*q, &ivu, 0, 0, 0); u = ivu; uvp = *p / ivg; uvq = *q / ivg; *q = ((n+u) / uvq) * uvq - u; *p = (*q * uvp + 1) / uvq; return 1; } UV farey_array(uint32_t n, uint32_t **rnum, uint32_t **rden) { uint32_t *num, *den; UV i, j, p0 = 0, q0 = 1, p1 = 1, q1 = n, p2, q2; UV len = farey_length(n); if (n < 1 || len < 2 || len >= UVCONST(4294967295)) return 0; New(0, num, len, uint32_t); New(0, den, len, uint32_t); for (i = 0; i < len; i++) { num[i] = p0; den[i] = q0; /* Haros (1802), gives p/q using two previous terms */ j = (q0 + n) / q1; p2 = j * p1 - p0; q2 = j * q1 - q0; p0 = p1; q0 = q1; p1 = p2; q1 = q2; } *rnum = num; *rden = den; return len; } /* * See: * Pătraşcu and Pătraşcu (ANTS 2004) * https://citeseerx.ist.psu.edu/document?repid=rep1&type=pdf&doi=d8882e782674d5cd312129823287768e123674e1 * * Pawlewicz (2007) * https://www.mimuw.edu.pl/~pan/papers/farey-esa.pdf * * Pawlewicz and Pătraşcu (2008) * https://www.researchgate.net/publication/225715205_Order_Statistics_in_the_Farey_Sequences_in_Sublinear_Time_and_Counting_Primitive_Lattice_Points_in_Polygons * * For the rank, we're using a very simple but fast version. * TODO: Use the method from Pawlewicz 2007 (see page 7). * * For the kth member, binary search on rank. */ UV farey_rank(uint32_t n, uint32_t p, uint32_t q) { uint32_t *count, i, g; UV sum; if (n == 0 || q == 0 || p == 0) return 0; g = gcd_ui(p,q); if (g != 1) { p /= g; q /= g; } New(0, count, n+1, uint32_t); for (i = 2; i <= n; i++) count[i] = ((UV)i * p - 1) / q; sum = 1; for (i = 2; i <= n; i++) { uint32_t j, icount = count[i]; for (j = i; j <= n-i; j += i) count[j+i] -= icount; sum += icount; } Safefree(count); return sum; } #if 0 /* Naive method. */ int kth_farey(uint32_t n, UV k, uint32_t* p, uint32_t* q) { UV i, j, p0 = 0, q0 = 1, p1 = 1, q1 = n, p2, q2; UV len = farey_length(n); if (n > 0 && len < 2) return -1; /* overflow */ if (n == 0 || k >= len) return 0; /* undefined */ if (k > len/2) { /* Exploit symmetry about 1/2, iterate backwards */ p0 = 1; p1 = n-1; k = (len-1)-k; } for (i = 0; i < k; i++) { j = (q0 + n) / q1; p2 = j * p1 - p0; q2 = j * q1 - q0; p0 = p1; q0 = q1; p1 = p2; q1 = q2; } *p = p0; *q = q0; return 1; } #else static bool _walk_to_k(uint32_t a, uint32_t n, uint32_t k, uint32_t* p, uint32_t* q) { uint32_t g, j, p0, q0, p1, q1, p2, q2; g = gcd_ui(a,n); p0 = a/g; q0 = n/g; if (k == 0) { *p = p0; *q = q0; return 1; } /* From the single point, use extgcd to get the exact next fraction */ p1 = p0; q1 = q0; next_farey(n, &p1, &q1); /* Now we have two fractions, so quick step through */ while (--k) { j = (q0 + n) / q1; p2 = j * p1 - p0; q2 = j * q1 - q0; p0 = p1; p1 = p2; q0 = q1; q1 = q2; } *p = p1; *q = q1; return 1; } bool kth_farey(uint32_t n, UV k, uint32_t* p, uint32_t* q) { uint32_t lo = 1, hi = n; UV cnt = 1; if (k < 2) { if (k == 0) { *p = 0; *q = 1; } else { *p = 1; *q = n; } return 1; } if (n < 2) return 0; /* For a substantial performance benefit, we will estimate the position * and get its rank. Then look a small distance in the other direction. * For small n this often completely brackets the value after only one * or two calls. For large n, we can often do 2-5 times fewer calls. * * The downside is this is ugly, but it makes this call 2-4x faster. */ if (n >= 5) { uint32_t const ginc = ((UV)n+8191)>>13; double const dlen = 1 + (0.304*(double)n*n + .29*(double)n + 0.95); uint32_t guess = k * ((double)n/dlen); UV gcnt = 0; if (guess <= lo) guess = lo+1; else if (guess >= hi) guess = hi-1; if (lo < hi) { gcnt = farey_rank(n, guess, n); if (gcnt <= k) { lo = guess; cnt = gcnt; } else { hi = guess-1; } } /* Look a small distance in the other direction. We want it to be * far enough that we bracket the value, but not so far that we make * too many calls getting back. */ if (gcnt <= k) { guess = (hi-ginc < guess) ? hi : guess+ginc; } else { guess = (lo+ginc+1 > guess) ? lo : guess-1-ginc; } if (lo < hi && guess > lo && guess < hi) { gcnt = farey_rank(n,guess,n); if (gcnt <= k) { lo = guess; cnt = gcnt; } else { hi = guess-1; } } } /* Now the binary search. */ while (lo < hi) { uint32_t mid = lo + ((hi-lo+1)>>1); UV midcnt = farey_rank(n, mid, n); if (midcnt <= k) { lo = mid; cnt = midcnt; } else { hi = mid-1; } } if (lo == n) { *p = (cnt == k); *q = 1; return k <= cnt; } return _walk_to_k(lo, n, k-cnt, p, q); } #endif Math-Prime-Util-0.74/goldbach.c000644 000765 000024 00000007215 15146553566 016324 0ustar00danastaff000000 000000 #include #include #include #include "ptypes.h" #include "goldbach.h" #define FUNC_is_prime_in_sieve 1 #include "sieve.h" #include "cache.h" #include "primality.h" #include "util.h" /* TODO: Consider adding Waring-Goldbach(n,k,t) */ UV minimal_goldbach_pair(UV n) { UV p; if (n < 4) return 0; if (n & 1 || n == 4) return (is_prime(n-2)) ? 2 : 0; /* Maybe this could be faster using a sieve. Max p < 4*10^18 is 9781 */ for (p=3; p <= n/2; p = next_prime(p)) if (is_prime(n-p)) return p; return 0; } #if 0 /* Some ways for finding Goldbach pairs */ /* 1. Simple */ START_DO_FOR_EACH_PRIME(3,n/2) { if (is_prob_prime(n-p)) L[s++] = p; } END_DO_FOR_EACH_PRIME Renew(L, s, UV); *size=s; return L; /* 2. Get a full list then walk from the edges. Not bad for small sizes. */ if (n >= 22 && n < 4294967295U) { uint32_t *pr; UV nprimes = range_prime_sieve_32(&pr, n, 0); /* pr[0]=2, pr[1]=3, */ UV i = 4, j = nprimes-1; while (i <= j) { UV sum = pr[i] + pr[j]; if (sum > n) { j--; } else { if (sum == n) L[s++] = pr[i]; i++; } } Safefree(pr); } /* 3. Single sieve */ if (n >= 22) { unsigned char* segment; UV seg_base, seg_low, seg_high; void* ctx = start_segment_primes(n/2, n-11, &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 ) UV q = n-p; if (is_prob_prime(q)) L[s++] = q; END_DO_FOR_EACH_SIEVE_PRIME } end_segment_primes(ctx); sort_uv_array(L, s); } /* The double sieve, low as inner, comes out fastest. */ #endif static UV sieve_pairs(UV* L, UV n) { size_t s = 0; if (n >= 22) { unsigned char* segment; UV seg_base, seg_low, seg_high; void* ctx = start_segment_primes(n/2, n-11, &segment); while (next_segment_primes(ctx, &seg_base, &seg_low, &seg_high)) { size_t qbeg = n-seg_high, qend = n-seg_low; UV qdbeg = qbeg/30, qdend = (qend+29)/30; unsigned char* lowsieve; New(0, lowsieve, qdend-qdbeg+1, unsigned char); sieve_segment(lowsieve, qdbeg, qdend); START_DO_FOR_EACH_SIEVE_PRIME( segment, seg_base, seg_low, seg_high ) UV q = n-p; if (L) { if (is_prime_in_sieve(lowsieve, q-qdbeg*30)) L[s++] = q; } else { if (is_prime_in_sieve(lowsieve, q-qdbeg*30)) s++; } END_DO_FOR_EACH_SIEVE_PRIME Safefree(lowsieve); } end_segment_primes(ctx); if (L && s > 1) { /* Reverse the list */ size_t i = 0, j = s-1; while (i < j) { UV t=L[i]; L[i]=L[j]; L[j]=t; i++; j--; } } } return s; } UV* goldbach_pairs(size_t *size, UV n) { UV *L; size_t s = 0; if (n < 4) return 0; if (n & 1 || n == 4) { if (!is_prime(n-2)) return 0; New(0, L, 1, UV); L[0] = 2; *size = 1; return L; } /* Overestimate */ New(0, L, max_nprimes(n/2) >> (n > 30030 ? 1 : 0), UV); if (n >= 6 && is_prime(n-3)) L[s++] = 3; if (n >= 10 && is_prime(n-5)) L[s++] = 5; if (n >= 14 && is_prime(n-7)) L[s++] = 7; s += sieve_pairs(L+s, n); Renew(L, s, UV); /* Possibly reduce storage */ *size = s; return L; } UV goldbach_pair_count(UV n) { size_t s = 0; if (n < 4) return 0; if (n & 1 || n == 4) return (is_prime(n-2)) ? 1 : 0; if (n >= 6 && is_prime(n-3)) s++; if (n >= 10 && is_prime(n-5)) s++; if (n >= 14 && is_prime(n-7)) s++; s += sieve_pairs(0, n); return s; } /* See https://arxiv.org/pdf/2601.16193 for ideas on upper,lower,approx. */ Math-Prime-Util-0.74/sieve_cluster.h000644 000765 000024 00000000413 15145577415 017431 0ustar00danastaff000000 000000 #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, const uint32_t* cl, UV* numret); extern UV* sieve_cluster(UV beg, UV end, uint32_t nc, const uint32_t* cl, UV* numret); #endif Math-Prime-Util-0.74/chacha.c000644 000765 000024 00000025424 15151316026 015752 0ustar00danastaff000000 000000 /* * The ChaCha(20) CSPRNG interface. * New simple core, 10 Apr 2017, Dana Jacobsen * Follows RFC 7539, including test vectors. * Uses 64-bit counter, 64-bit nonce. * * TODO: update to RFC 8439 (June 2018). */ /* 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 & 0xFF; \ (p)[1] = _v >> 8 & 0xFF; \ (p)[2] = _v >> 16 & 0xFF; \ (p)[3] = _v >> 24 & 0xFF; \ } while (0) #endif static void init_context(chacha_context_t *ctx, const unsigned char *seed, bool init_buffer) { uint32_t *x = ctx->state; x[ 0] = 0x61707865; /* "expa" */ x[ 1] = 0x3320646e; /* "nd 3" */ x[ 2] = 0x79622d32; /* "2-by" */ x[ 3] = 0x6b206574; /* "te k" */ #if __LITTLE_ENDIAN__ || (defined(BYTEORDER) && (BYTEORDER == 0x1234 || BYTEORDER == 0x12345678)) memcpy(x+4, seed, 32); x[12] = 0; x[13] = 0; memcpy(x+14, seed+32, 8); #else 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); #endif 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[64], const uint32_t s[16]) { uint32_t i, x[16]; 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) { /* Use the original 64-bit counter. */ 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->state); increment_chacha_counter(ctx); buf += CORESZ; r -= CORESZ; } if (r > 0) { unsigned char sbuf[CORESZ]; chacha_core(sbuf, ctx->state); 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 = (uint16_t) chacha_keystream(ctx->buf, BUFSZ, ctx); init_context(ctx, ctx->buf, FALSE); memset(ctx->buf, 0, KEYSZ); ctx->have = BUFSZ - KEYSZ; #else ctx->have = (uint16_t) chacha_keystream(ctx->buf, BUFSZ, ctx); #endif return ctx->have; } /*****************************************************************************/ /* Test vectors */ /*****************************************************************************/ #if RUN_INTERNAL_TESTS static bool _test_qr(void) { uint32_t i; uint32_t tv1i[4] = {0x11111111, 0x01020304, 0x9b8d6f43, 0x01234567}; const uint32_t tv1o[4] = {0xea2a92f4, 0xcb1cf8ce, 0x4581472e, 0x5881c4bb}; uint32_t tv2i[4] = {0x516461b1, 0x2a5f714c, 0x53372767, 0x3d631689}; const uint32_t tv2o[4] = {0xbdb886dc, 0xcfacafd2, 0xe46bea80, 0xccc07c79}; 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 TRUE; } /* Test 5 is RFC7539 2.3.2 */ static bool _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 < 40; i++) keys[4][i] = (unsigned char) i % 32; for (i = 0; i < 32; i++) keys[5][i] = (unsigned char) i; keys[5][35] = 0x4a; if (CHACHA_ROUNDS != 20) return FALSE; { /* Ensure the "have" variable is large enough to store a buffer */ chacha_context_t ctx; if (BUFSZ >> (8*sizeof(ctx.have)) != 0) croak("BUFSZ is set too large for context"); } for (test = 0; test < 6; test++) { unsigned char* key = keys[test]; const char* expout = ebuf[test]; char got[129]; chacha_context_t ctx; init_context(&ctx, key, TRUE); if (test == 5) { ctx.state[12]=1; ctx.state[13]=0x09000000; } chacha_core(ctx.buf, ctx.state); if (test == 0) { for (i = 4; 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 TRUE; } static bool _test_keystream(void) { uint32_t test, i; unsigned char keys[2][40] = { {0},{0} }; static const char ebuf[2][1024+1] = { "f798a189f195e66982105ffb640bb7757f579da31602fc93ec01ac56f85ac3c134a4547b733b46413042c9440049176905d3be59ea1c53f15916155c2be8241a38008b9a26bc35941e2444177c8ade6689de95264986d95889fb60e84629c9bd9a5acb1cc118be563eb9b3a4a472f82e09a7e778492b562ef7130e88dfe031c79db9d4f7c7a899151b9a475032b63fc385245fe054e3dd5a97a5f576fe064025d3ce042c566ab2c507b138db853e3d6959660996546cc9c4a6eafdc777c040d70eaf46f76dad3979e5c5360c3317166a1c894c94a371876a94df7628fe4eaaf2ccb27d5aaae0ad7ad0f9d4b6ad3b54098746d4524d38407a6deb3ab78fab78c9", "af051e40bba0354981329a806a140eafd258a22a6dcb4bb9f6569cb3efe2deaf837bd87ca20b5ba12081a306af0eb35c41a239d20dfc74c81771560d9c9c1e4b224f51f3401bd9e12fde276fb8631ded8c131f823d2c06e27e4fcaec9ef3cf788a3b0aa372600a92b57974cded2b9334794cba40c63e34cdea212c4cf07d41b769a6749f3f630f4122cafe28ec4dc47e26d4346d70b98c73f3e9c53ac40c5945398b6eda1a832c89c167eacd901d7e2bf363", }; for (i = 0; i < 40; i++) keys[0][i] = (unsigned char) i % 32; for (i = 0; i < 32; i++) keys[1][i] = (unsigned char) i; keys[1][35] = 0x4a; if (CHACHA_ROUNDS != 20) return FALSE; for (test = 0; test < 2; test++) { unsigned char* key = keys[test]; const 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, TRUE); 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 TRUE; } bool chacha_selftest(void) { return _test_qr() && _test_core() && _test_keystream(); } #else bool chacha_selftest(void) { return TRUE; } #endif /*****************************************************************************/ /* API */ /*****************************************************************************/ void chacha_seed(chacha_context_t *cs, uint32_t bytes, const unsigned char* data, bool good) { if (bytes < 40) croak("Not enough seed bytes given to ChaCha\n"); init_context(cs, data, TRUE); 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.74/util.h000644 000765 000024 00000032452 15146553566 015544 0ustar00danastaff000000 000000 #ifndef MPU_UTIL_H #define MPU_UTIL_H #include "ptypes.h" extern int _XS_get_verbose(void); extern void _XS_set_verbose(int v); extern int _XS_get_callgmp(void); extern void _XS_set_callgmp(int v); /* Disable all manual seeding */ extern bool _XS_get_secure(void); extern void _XS_set_secure(void); extern unsigned long index_in_sorted_uv_array(UV v, UV* L, unsigned long len); extern unsigned long index_in_sorted_iv_array(IV v, IV* L, unsigned long len); #define is_in_sorted_uv_array(v,L,len) (index_in_sorted_uv_array(v,L,len) > 0) #define is_in_sorted_iv_array(v,L,len) (index_in_sorted_iv_array(v,L,len) > 0) extern bool do_arrays_intersect_uv(const UV* A, size_t alen, const UV* B, size_t blen); extern bool do_arrays_intersect_iv(const IV* A, size_t alen, const IV* B, size_t blen); extern bool is_prime(UV x); extern UV next_prime(UV x); extern UV prev_prime(UV x); /* Simple estimate for upper limit: max_nprimes(n) >= prime_count(n) */ extern UV max_nprimes(UV n) ISCONSTFUNC; extern void print_primes(UV low, UV high, int fd); /* Returns maximal k for c^k = n for k > 1, n > 1. 0 otherwise. */ extern uint32_t powerof_ret(UV n, uint32_t *root); #define powerof(n) powerof_ret(n,0) /* Return true if n = r^k for the given k, sets root if given */ extern bool is_power_ret(UV n, uint32_t k, uint32_t *root); #define is_power(n,k) is_power_ret(n,k,0) extern uint32_t icbrt(UV n) ISCONSTFUNC; extern UV rootint(UV n, uint32_t k) ISCONSTFUNC; extern UV ipowsafe(UV n, UV k) ISCONSTFUNC; /* returns UV_MAX if overflows */ extern UV lcmsafe(UV x, UV u) ISCONSTFUNC; /* returns 0 if overflows */ extern UV valuation(UV n, UV k) ISCONSTFUNC; extern UV valuation_remainder(UV n, UV k, UV *r); extern UV logint(UV n, UV b) ISCONSTFUNC; extern UV mpu_popcount_string(const char* ptr, uint32_t len); extern unsigned char* range_issquarefree(UV lo, UV hi); extern UV powersum(UV n, UV k) ISCONSTFUNC; extern signed char* range_moebius(UV low, UV high); extern signed char* range_liouville(UV low, UV high); extern int liouville(UV n); extern IV mertens(UV n); extern IV sumliouville(UV n); extern int kronecker_uu(UV a, UV b) ISCONSTFUNC; extern int kronecker_su(IV a, UV b) ISCONSTFUNC; extern int kronecker_ss(IV a, IV b) ISCONSTFUNC; extern UV pn_primorial(UV n) ISCONSTFUNC; extern UV primorial(UV n) ISCONSTFUNC; extern UV factorial(UV n) ISCONSTFUNC; extern UV subfactorial(UV n) ISCONSTFUNC; extern UV fubini(UV n) ISCONSTFUNC; extern UV binomial(UV n, UV k) ISCONSTFUNC; extern UV falling_factorial(UV n, UV m) ISCONSTFUNC; extern UV rising_factorial(UV n, UV m) ISCONSTFUNC; extern IV falling_factorial_s(IV n, UV m) ISCONSTFUNC; extern IV rising_factorial_s(IV n, UV m) ISCONSTFUNC; extern IV gcdext(IV a, IV b, IV* u, IV* v, IV* s, IV* t); /* Ext Euclidean */ extern UV modinverse(UV a, UV p) ISCONSTFUNC; /* Returns 1/a mod p */ extern UV divmod(UV a, UV b, UV n) ISCONSTFUNC;/* Returns a/b mod n */ extern UV gcddivmod(UV a, UV b, UV n) ISCONSTFUNC; /* divmod(a/gcd,b/gcd,n) */ extern UV pisano_period(UV n); /* 0 overflow, -1 no inverse, 1 ok */ /* The a/n arrays will be sorted by descending n. */ extern int chinese(UV *r, UV *lcm, UV* a, UV* n, UV num);/* Chinese Remainder */ /* Do the inverse for a negative modular power / root. a^-k => (1/a)^k mod n */ extern bool prep_pow_inv(UV *a, UV *k, int kstatus, UV n); /* Signed division and remainder. Returns remainder.*/ extern IV tdivrem(IV *q, IV *r, IV D, IV d); /* divrem trunc */ extern IV fdivrem(IV *q, IV *r, IV D, IV d); /* divrem floor */ extern IV cdivrem(IV *q, IV *r, IV D, IV d); /* divrem ceiling */ extern IV edivrem(IV *q, IV *r, IV D, IV d); /* divrem Euclidian */ extern UV ivmod(IV a, UV n) ISCONSTFUNC; /* Returns a mod n (trunc) */ extern UV carmichael_lambda(UV n); extern int moebius(UV n); extern UV exp_mangoldt(UV n); extern UV znprimroot(UV n); extern UV znorder(UV a, UV n); /* nprime says to assume n = p or n = 2p. Skips power and primality tests. */ extern bool is_primitive_root(UV a, UV n, bool nprime); extern UV factorialmod(UV n, UV m); extern bool binomialmod(UV *res, UV n, UV k, UV m); extern bool is_square_free(UV n); extern bool is_perfect_number(UV n); extern bool is_fundamental(UV n, bool neg); extern bool is_semiprime(UV n); extern bool is_almost_prime(UV k, UV n); extern bool is_cyclic(UV n); extern bool is_carmichael(UV n); extern UV is_quasi_carmichael(UV n); /* Returns number of bases */ extern UV pillai_v(UV n) ISCONSTFUNC; /* v: v! % n == n-1 && n % v != 1 */ extern UV qnr(UV n); extern bool is_qr(UV a, UV n); /* kronecker that works for composites */ extern bool is_practical(UV n); extern int is_delicate_prime(UV n, uint32_t b); extern int happy_height(UV n, uint32_t base, uint32_t exponent) ISCONSTFUNC; extern bool is_smooth(UV n, UV k); extern bool is_rough(UV n, UV k); extern bool is_sum_of_two_squares(UV n); extern bool is_sum_of_three_squares(UV n); extern bool cornacchia(UV *x, UV *y, UV d, UV p); extern UV debruijn_psi(UV x, UV y); extern UV buchstab_phi(UV x, UV y); extern UV stirling3(UV n, UV m) ISCONSTFUNC; extern IV stirling2(UV n, UV m) ISCONSTFUNC; extern IV stirling1(UV n, UV m) ISCONSTFUNC; extern bool bernfrac(IV *num, UV *den, UV n); extern bool harmfrac(UV *num, UV *den, UV n); extern IV hclassno(UV n); extern IV ramanujan_tau(UV n); extern char* pidigits(uint32_t digits); /* min defines if min or max. Return of 0 means select a, 1 means select b. */ extern bool strnum_minmax(bool min, const char* a, STRLEN alen, const char* b, STRLEN blen); extern int strnum_cmp(const char* a, STRLEN alen, const char* b, STRLEN blen); extern bool from_digit_string(UV* n, const char* s, int base); extern bool from_digit_to_UV(UV* rn, const UV* r, int len, int base); extern bool from_digit_to_str(char** rstr, const UV* r, int len, int base); /* These return length */ 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); /* Returns 1 if good, 0 if bad, -1 if non canon, 2 ok but out of range */ extern int validate_zeckendorf(const char* str); extern UV from_zeckendorf(const char* str); extern char* to_zeckendorf(UV n); extern bool is_catalan_pseudoprime(UV n); extern UV polygonal_root(UV n, UV k, bool* overflow); extern UV npartitions(UV n); extern UV consecutive_integer_lcm(UV n); extern UV frobenius_number(UV* A, uint32_t alen); extern bool num_to_perm(UV rank, int n, int *vec); extern bool 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) ISCONSTFUNC; /* Inputs are assumed to be UNSIGNED */ /* These could use a static table if that turned out better */ #define is_divis_2_3(n) ( (n)%2 == 0 || (n) % 3 == 0 ) #if defined(__arm64__) #define is_divis_2_3_5(n) ( (n)%2 == 0 || (0x1669>>((n)%15))&1 ) #else #define is_divis_2_3_5(n) ( (n)%2 == 0 || (n) % 3 == 0 || (n) % 5 == 0 ) #endif /* 2,3,5 could use the single test: (0x1f75d77d >> (n % 30)) & 1 */ #define is_divis_2_3_5_7(n) ( is_divis_2_3_5(n) || (n) % 7 == 0 ) /******************************************************************************/ #if defined(FUNC_is_perfect_square) && !defined(FUNC_isqrt) #define FUNC_isqrt 1 #endif #if defined(FUNC_lcm_ui) && !defined(FUNC_gcd_ui) #define FUNC_gcd_ui 1 #endif /******************************************************************************/ /* I think uint32_t is a better return type, but we follow GCC's prototype. */ #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__) && 100*__GNUC__ + __GNUC_MINOR >= 304 #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 int ctz(UV n) { return n ? _debruijn64[((n & -n)*UVCONST(0x07EDD5E59A4E28C2)) >> 58] : 64; } #endif #if defined(FUNC_clz) || defined(FUNC_log2floor) static 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 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 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__) && 100*__GNUC__ + __GNUC_MINOR >= 402 #define popcnt(b) __builtin_popcountll(b) #else static int 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 int popcnt(UV b) { b -= (b >> 1) & 0x55555555; b = (b & 0x33333333) + ((b >> 2) & 0x33333333); b = (b + (b >> 4)) & 0x0f0f0f0f; return (b * 0x01010101) >> 24; } #endif #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) /* If we have a very fast ctz, then use the fast FLINT version of gcd */ #if defined(__GNUC__) && 100*__GNUC__ + __GNUC_MINOR >= 304 #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 #if defined(FUNC_isqrt) /* Correct for all 64-bit inputs and all FP rounding modes. */ #include static uint32_t isqrt(UV n) { /* The small addition means we only need to check for fixing downwards. */ IV r = sqrt((double)n) + 1e-6f; IV diff = n - (UV)r*r; return r - (diff < 0); } #endif #ifdef FUNC_is_perfect_square static bool is_perfect_square_ret(UV n, uint32_t *root) { uint32_t r; /* Fast filters reject 95.0% of non-squares */ #if BITS_PER_WORD == 64 if ((UVCONST(1) << (n&63)) & UVCONST(0xfdfdfdedfdfcfdec)) return 0; /* if ((UVCONST(1) << (n%45)) & UVCONST(0xfffffeeb7df6f9ec)) return 0; */ #else /* uint32_t m; */ if ((1U << (n&31)) & 0xfdfcfdec) return 0; /* m = n % 105; if ((m*0xd24554cd) & (m*0x0929579a) & 0x38020141) return 0; */ #endif r = isqrt(n); if (root != 0) *root = r; return ((UV)r*r == n); } #define is_perfect_square(n) is_perfect_square_ret(n,0) #endif #endif Math-Prime-Util-0.74/prime_sums.c000644 000765 000024 00000023605 15145577415 016743 0ustar00danastaff000000 000000 #include #include #include #define FUNC_isqrt 1 #include "ptypes.h" #include "constants.h" #include "util.h" #include "cache.h" #include "sieve.h" #include "prime_sums.h" /******************************************************************************/ /* SUMS */ /******************************************************************************/ /* As an aside, good information about bounds and approximations can be * found in Axler (2019) "On the sum of the first n prime numbers" * https://jtnb.centre-mersenne.org/item/10.5802/jtnb.1081.pdf */ 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}; /* The fastest way to compute the sum of primes is using a combinatorial * algorithm such as Deleglise-Rivat or Gourdon. This is what Kim Walisch's * primesum program does. Note that one quickly needs 128-bit or larger * storage, as the sums grow rapidly. * * We are using much simpler methods. Performance at small sizes is also a * consideration. Using tables combined with summing over sieved primes can * work well with small input sizes. */ /* Simplified Legendre method giving pisum(n) for n <= 65535 or 4294967295. */ UV sum_primes64(UV n) { uint32_t *V, j, k, r, r2, p; UV *S, sum; if (n < 2 || (n >> (BITS_PER_WORD/2)) > 0) /* S[] will overflow */ return 0; r = isqrt(n); r2 = r + n/(r+1); New(0, V, r2+1, uint32_t); New(0, S, r2+1, UV); for (k = 1; k <= r2; k++) { UV v = (k <= r) ? k : n/(r2-k+1); V[k] = v; S[k] = ((v*(v-1))>>1) + (v-1); } for (p = 2; p <= r; p++) { if (S[p] > S[p-1]) { /* For each prime p from 2 to r */ UV sp = S[p-1], p2 = p*p; for (j = r2; j > 1 && V[j] >= p2; j--) { uint32_t a = V[j], b = a/p; if (a > r) a = r2 - n/a + 1; if (b > r) b = r2 - n/b + 1; S[a] -= (UV)p * (S[b] - sp); /* sp = sum of primes less than p */ } } } sum = S[r2]; Safefree(V); Safefree(S); return sum; } /* Simplified Legendre method giving pisum(n) for any 64-bit input n, * assuming the uint128_t type is available. The result is returned as * two 64-bit results. */ bool sum_primes128(UV n, UV *hi_sum, UV *lo_sum) { #if HAVE_SUM_PRIMES128 uint128_t *S; UV *V, j, k, r, r2, p; /* pisum(2^64-1) < 2^128-1, so no overflow issues */ r = isqrt(n); r2 = r + n/(r+1); New(0, V, r2+1, UV); New(0, S, r2+1, uint128_t); for (k = 0; k <= r2; k++) { UV v = (k <= r) ? k : n/(r2-k+1); V[k] = v; S[k] = ((uint128_t)v+1)/2 * (v|1) - 1; /* (v*(v+1))/2-1 */ } for (p = 2; p <= r; p++) { if (S[p] > S[p-1]) { /* For each prime p from 2 to r */ uint128_t sp = S[p-1], p2 = ((uint128_t)p) * p; for (j = r2; j > 1 && V[j] >= p2; j--) { UV 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 */ } } } *hi_sum = (S[r2] >> 64) & UV_MAX; *lo_sum = (S[r2] ) & UV_MAX; Safefree(V); Safefree(S); return 1; #else return 0; #endif } /* sum primes in a 64-bit range using a sieving with table acceleration */ 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 bool sum_primes(UV low, UV high, UV *return_sum) { UV sum = 0; bool overflow = 0; if (low <= 2 && high >= 100000) { *return_sum = sum_primes64(high); if (*return_sum != 0) return 1; } /* TODO: performance: more cases where using sum_primes64 is faster. */ 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; } Math-Prime-Util-0.74/sieve.h000644 000765 000024 00000020156 15145577415 015676 0ustar00danastaff000000 000000 #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 bool sieve_segment_partial(unsigned char* mem, UV startd, UV endd, UV depth); extern bool sieve_segment(unsigned char* mem, UV startd, UV endd); extern void* start_segment_primes(UV low, UV high, unsigned char** segmentmem); extern bool next_segment_primes(void* vctx, UV* base, UV* low, UV* high); extern void end_segment_primes(void* vctx); /* Generate primes P[0] = 2, P[1] = 3, P[2] = 5, .... */ extern UV range_prime_sieve(UV** list, UV lo, UV hi); /* Generate 32-bit primes up to n. * The first entries will be zero, followed by 2, 3, 5, 7, 11, ... * Returns the count of primes created, irrespective of the offset. * Hence, the last prime will be in P[offset+count-1]. */ extern uint32_t range_prime_sieve_32(uint32_t** list, uint32_t n, uint32_t offset); static const unsigned char 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 bool 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_; /* last 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 > 1 && p < 7) p--; \ 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_); \ } #define SIMPLE_FOR_EACH_PRIME(a, b) \ { \ UV p_ = a; \ UV l_ = b; \ if (p_ > 0) p_--; \ while (1) { \ UV p = (p_ = next_prime(p_)); \ if (p > l_ || p == 0) break; \ { \ #define END_SIMPLE_FOR_EACH_PRIME \ } \ } \ } /* Mark at , but if that is less than , then use the first multiple * of

at or after lo. * * I.e. the result n is n = p2 + k*p >= lo with the smallest possible k. * TODO: this assumes first is a multiple of p. Fix. */ #define P_GT_LO(first,p,lo) ( ((first)>=(lo)) ? (first) : (lo)+(((p)-((lo)%(p)))%(p)) ) /* As above, but as an offset from lo, so returns 0+ */ #define P_GT_LO_0(first,p,lo) ( ((first)>=(lo)) ? ((first)-(lo)) : (((p)-((lo)%(p)))%(p)) ) #endif Math-Prime-Util-0.74/lib/000755 000765 000024 00000000000 15154713771 015151 5ustar00danastaff000000 000000 Math-Prime-Util-0.74/omega_primes.h000644 000765 000024 00000000706 15145577415 017231 0ustar00danastaff000000 000000 #ifndef MPU_OMEGA_PRIMES_H #define MPU_OMEGA_PRIMES_H #include "ptypes.h" /* Almost primes use prime_bigomega, Omega primes use prime_omega */ extern bool is_omega_prime(uint32_t k, UV n); extern UV max_nth_omega_prime(uint32_t k); extern UV max_omega_prime_count(uint32_t k); extern UV range_omega_prime_sieve(UV** ret, uint32_t k, UV lo, UV hi); extern UV omega_prime_count(uint32_t k, UV n); extern UV nth_omega_prime(uint32_t k, UV n); #endif Math-Prime-Util-0.74/legendre_phi.h000644 000765 000024 00000001133 15145577415 017202 0ustar00danastaff000000 000000 #ifndef MPU_LEGENDRE_PHI_H #define MPU_LEGENDRE_PHI_H #include "ptypes.h" extern UV legendre_phi(UV n, UV a); /* These have almost no overhead, so make good stopping points */ /* Extremely fast, a <= ~6 */ extern uint32_t tiny_phi_max_a(void); extern UV tiny_phi(UV n, uint32_t a); /* Fast, a <= ~15 */ extern uint32_t small_phi_max_a(void); extern UV small_phi(UV n, uint32_t a); /* For doing many calls with small values */ extern void* prepare_cached_legendre_phi(UV n, UV a); extern UV cached_legendre_phi(void* cache, UV n, UV a); extern void destroy_cached_legendre_phi(void* cache); #endif Math-Prime-Util-0.74/Makefile.PL000644 000765 000024 00000016004 15154713505 016351 0ustar00danastaff000000 000000 use 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 ' . 'lucas_seq.o ' . 'aks.o ' . 'legendre_phi.o ' . 'lehmer.o ' . 'lmo.o ' . 'random_prime.o ' . 'sieve.o ' . 'sieve_cluster.o '. 'ramanujan_primes.o ' . 'semi_primes.o ' . 'almost_primes.o '. 'twin_primes.o ' . 'omega_primes.o ' . 'prime_count_cache.o ' . 'prime_counts.o ' . 'prime_sums.o ' . 'prime_powers.o ' . 'lucky_numbers.o '. 'goldbach.o ' . 'perfect_powers.o ' . 'congruent_numbers.o ' . 'powerfree.o ' . 'powerful.o ' . 'rational.o ' . 'real.o ' . 'rootmod.o ' . 'sort.o ' . 'totients.o ' . 'util.o ' . 'inverse_interpolate.o ' . 'entropy.o ' . 'csprng.o ' . 'chacha.o ' . 'ds_iset.o ' . 'XS.o', LIBS => ['-lm'], EXE_FILES => ['bin/primes.pl', 'bin/factor.pl'], TEST_REQUIRES=> { 'Test::More' => '0.96', # See issue #61 for reasons why we want 0.65 vs 0.22. 'bignum' => '0.65', }, PREREQ_PM => { 'Exporter' => '5.57', 'XSLoader' => '0.01', 'Carp' => ($] < 5.008) ? '1.17' : 0, 'Tie::Array' => 0, 'base' => 0, 'constant' => 0, 'Config' => 0, # Has from_base 'Math::BigInt' => '1.999814', '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.74', file => 'lib/ntheory.pm', }, 'Math::Prime::Util' => { version => '0.74', file => 'lib/Math/Prime/Util.pm', }, 'Math::Prime::Util::MemFree' => { version => '0.74', file => 'lib/Math/Prime/Util/MemFree.pm', }, 'Math::Prime::Util::PP' => { version => '0.74', file => 'lib/Math/Prime/Util/PP.pm', }, 'Math::Prime::Util::PrimeArray' => { version => '0.74', file => 'lib/Math/Prime/Util/PrimeArray.pm', }, 'Math::Prime::Util::PrimeIterator' => { version => '0.74', file => 'lib/Math/Prime/Util/PrimeIterator.pm', }, 'Math::Prime::Util::Entropy' => { version => '0.74', file => 'lib/Math/Prime/Util/Entropy.pm', }, 'Math::Prime::Util::ChaCha' => { version => '0.74', file => 'lib/Math/Prime/Util/ChaCha.pm', }, # Skip: PPFE, PrimalityProving, RandomPrimes, ZetaBigFloat, # ECAffinePoint, ECProjectivePoint }, prereqs => { runtime => { recommends => { 'Math::Prime::Util::GMP' => 0.53, 'Math::BigInt::GMP' => 0, 'Math::GMPz' => 0.68, '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.74/totients.c000644 000765 000024 00000034420 15151340153 016406 0ustar00danastaff000000 000000 #include #include #include #define FUNC_isqrt 1 #define FUNC_ipow 1 #include "ptypes.h" #include "sort.h" #include "totients.h" #include "sieve.h" #include "util.h" #include "factor.h" #include "keyval.h" static UV _totient_fac(uint32_t nfacs, UV* facs) { uint32_t i; UV totient = 1, lastf = 0; /* n=0 is factored as (0) so it correctly returns 0. */ for (i = 0; i < nfacs; i++) { UV f = facs[i]; if (f == lastf) { totient *= f; } else { totient *= f-1; lastf = f; } } return totient; } UV totient(UV n) { #if 1 UV factors[MPU_MAX_FACTORS+1]; uint32_t nfactors = factor(n, factors); return _totient_fac(nfactors, factors); #else factored_t nf; UV totient; uint32_t i; if (n <= 0) return n; nf = factorint(n); for (i = 0, totient = 1; i < nf.nfactors; i++) { UV f = nf.f[i]; unsigned e = nf.e[i]; totient *= f-1; while (e-- > 1) totient *= f; } return totient; #endif } UV* range_totient(UV lo, UV hi) { UV i, count = hi-lo+1, *totients; if (hi < lo || count == 0 || count > (Size_t)((SSize_t)-1)) croak("range_totient error hi %"UVuf" < lo %"UVuf"\n", hi, lo); if (hi < 16) { static const uint8_t small_totients[] = {0,1,1,2,2,4,2,6,4,6,4,10,4,12,6,8}; New(0, totients, count, UV); for (i = 0; i < count; i++) totients[i] = small_totients[lo+i]; return totients; } if (lo > 0) { /* With a non-zero start, use our ranged factoring */ factor_range_context_t fctx; fctx = factor_range_init(lo, hi, 0); New(0, totients, count, UV); for (i = 0; i < count; i++) { uint32_t nfactors = factor_range_next(&fctx); totients[i] = _totient_fac(nfactors, fctx.factors); } factor_range_destroy(&fctx); } else { /* start at zero */ uint32_t j, *prime; uint32_t sqrthi = isqrt(hi); uint32_t nprimes = 0; if (hi == UV_MAX) croak("range_totient error hi %"UVuf" < lo %"UVuf"\n", hi, lo); /* prime[] will hold primes from 3 to sqrthi */ New(0, prime, max_nprimes(sqrthi), uint32_t); Newz(0, totients, count, UV); totients[1] = 1; for (i = 1; i <= hi/2; i += 2) { UV toti = totients[i]; if (toti == 0) { totients[i] = toti = i-1; if (i <= sqrthi) prime[nprimes++] = i; } for (j = 0; j < nprimes; j++) { UV index = i*prime[j]; if (index > hi) break; if (i % prime[j] == 0) { totients[index] = toti * prime[j]; break; } totients[index] = toti * (prime[j] - 1); } /* Fill in even values as we go */ totients[i*2] = toti; if (i+1 <= hi/2) totients[2*i+2] = totients[i+1] * 2; } Safefree(prime); /* All totient values have been filled in except the primes. Mark them. */ for (; i <= hi; i += 2) if (totients[i] == 0) totients[i] = i-1; } return totients; } /******************************************************************************/ #define HAVE_SUMTOTIENT_128 (BITS_PER_WORD == 64 && HAVE_UINT128) #if BITS_PER_WORD == 64 # define MAX_TOTSUM UVCONST(7790208950) #else # define MAX_TOTSUM 118868 #endif /* sumtotient(7790208950) = 2^64 - 1664739356 */ /* sumtotient(7790208951) = 2^64 + 2584983748 */ /* Direct method: split the computation into two loops running over sqrtn. * * Page 7 of https://www.mimuw.edu.pl/~pan/papers/farey-esa.pdf * https://math.stackexchange.com/a/1740370/117584 */ static UV _sumtotient_direct(UV n) { UV finalsum, *sumcache2; uint32_t sqrtn, sum, i, j, k, *sumcache1; bool flag; if (n <= 2) return n; if (n > MAX_TOTSUM) return 0; sqrtn = isqrt(n); flag = (n < (UV)sqrtn * ((UV)sqrtn+1)); /* Does n/r == r ? */ sumcache2 = range_totient(0, sqrtn); New(0, sumcache1, sqrtn+1, uint32_t); for (sum = 1, i = 2; i <= sqrtn; i++) { sum += sumcache2[i]; sumcache1[i] = sum; } if (flag) sumcache2[sqrtn] = sumcache1[sqrtn]; for (i = sqrtn - flag; i > 0; i--) { const UV m = n/i; const uint32_t s = isqrt(m); UV sum = (m+1)/2 * (m|1); /* m*(m+1)/2; */ sum -= (m - m/2); /* k=1 */ for (k = 2, j = k*i; j <= sqrtn; k++) { sum -= sumcache2[j]; sum -= (m/k - m/(k+1)) * sumcache1[k]; j += i; } for (; k <= s; k++) { sum -= sumcache1[m/k]; sum -= (m/k - m/(k+1)) * sumcache1[k]; } if (m < (UV)s * ((UV)s+1)) sum += sumcache1[s]; sumcache2[i] = sum; } finalsum = sumcache2[1]; Safefree(sumcache1); Safefree(sumcache2); return finalsum; } /* Recursive method using a cache. */ typedef struct { UV hsize; UV *nhash; /* n value */ UV *shash; /* sum for n */ } sumt_hash_t; #define _CACHED_SUMT(x) \ (((x) lim) sum -= ((n/s) - (n/(s+1))) * _CACHED_SUMT(s); for (; hashk <= probes; hashk++) { if (thash.nhash[hn] == 0) { thash.nhash[hn] = n; thash.shash[hn] = sum; break; } hn = (hn+1 < thash.hsize) ? hn+1 : 0; } return sum; } UV sumtotient(UV n) { UV sum, i, cbrtn, csize, *sumcache; sumt_hash_t thash; if (n <= 2) return n; if (n > MAX_TOTSUM) return 0; if (n < 4000) return _sumtotient_direct(n); cbrtn = icbrt(n); csize = cbrtn * cbrtn; sumcache = range_totient(0, csize-1); for (i = 2; i < csize; i++) sumcache[i] += sumcache[i-1]; thash.hsize = next_prime(10 + 4*cbrtn); Newz(0, thash.nhash, thash.hsize, UV); New( 0, thash.shash, thash.hsize, UV); sum = _sumt(n, sumcache, csize, thash); Safefree(thash.nhash); Safefree(thash.shash); Safefree(sumcache); return sum; } #if HAVE_SUMTOTIENT_128 #define _CACHED_SUMT128(x) \ (((x)> 8) & 15); /* mitigate clustering */ uint32_t hashk; if (n < csize) return cdata[n]; hn = n % thash.hsize; for (hashk = 0; hashk <= probes; hashk++) { if (thash.nhash[hn] == n) return thash.shash[hn]; if (thash.nhash[hn] == 0) break; hn = (hn+hinc < thash.hsize) ? hn+hinc : hn+hinc-thash.hsize; } s = isqrt(n); lim = n/(s+1); sum = ((uint128_t)n+1)/2 * (n|1); /* (n*(n+1))/2 */ sum -= (n - n/2); for (k = 2; k <= lim; k++) { sum -= _CACHED_SUMT128(n/k); sum -= ((n/k) - (n/(k+1))) * _CACHED_SUMT128(k); } if (s > lim) sum -= ((n/s) - (n/(s+1))) * _CACHED_SUMT128(s); for (; hashk <= probes; hashk++) { if (thash.nhash[hn] == 0) { thash.nhash[hn] = n; thash.shash[hn] = sum; break; } hn = (hn+hinc < thash.hsize) ? hn+hinc : hn+hinc-thash.hsize; } return sum; } int sumtotient128(UV n, UV *hi_sum, UV *lo_sum) { UV i, cbrtn, csize, hsize, *sumcache; uint128_t sum; sumt_hash_128_t thash; if (n <= 2) { *hi_sum = 0; *lo_sum = n; return 1; } /* sumtotient(2^64-1) < 2^128, so we can't overflow. */ cbrtn = icbrt(n); csize = 0.6 * cbrtn * cbrtn; hsize = 8 * cbrtn; /* 12.5% filled with csize = 1 * n^(2/3) */ if (csize > 400000000U) { /* Limit to 3GB */ csize = 400000000; hsize = isqrt(n); } sumcache = range_totient(0, csize-1); for (i = 2; i < csize; i++) sumcache[i] += sumcache[i-1]; /* Arguably we should expand the hash as it fills. */ thash.hsize = next_prime( 16 + hsize ); Newz(0, thash.nhash, thash.hsize, UV); New( 0, thash.shash, thash.hsize, uint128_t); sum = _sumt128(n, sumcache, csize, thash); *hi_sum = (sum >> 64) & UV_MAX; *lo_sum = (sum ) & UV_MAX; if (_XS_get_verbose() >= 2) { UV filled = 0; for (i = 0; i < thash.hsize; i++) filled += (thash.nhash[i] != 0); printf(" 128-bit totsum phi %6.1lfMB hash size %6.1lfMB, fill: %6.2lf%%\n", csize*sizeof(UV)/1048576.0, thash.hsize*3*sizeof(UV)/1048576.0, 100.0 * (double)filled / (double)thash.hsize); } Safefree(thash.nhash); Safefree(thash.shash); Safefree(sumcache); return 1; } #else int sumtotient128(UV n, UV *hi_sum, UV *lo_sum) { return 0; } #endif /******************************************************************************/ /******************************************************************************/ 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) { factored_t nf; uint32_t 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< 1) totient *= pk; } return totient; } /******************************************************************************/ static bool _totpred(UV n, UV maxd) { UV i, ndivisors, *divs; bool res; if (n & 1) return 0; if ((n & (n-1)) == 0) return 1; n >>= 1; if (n == 1) return 1; if (n < maxd && is_prime(2*n+1)) return 1; divs = divisor_list(n, &ndivisors, maxd); 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; } bool 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, n); 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; 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; } else if (n >= UV_MAX/2) { /* overflow */ *ntotients = UV_MAX; return totlist; } else if (n >= 10) { New(0, totlist, 2, UV); totlist[0] = n+1; totlist[1] = 2*n+2; *ntotients = 2; return totlist; } } /* Check for possible overflow in the inner loop. * Smallest 32-bit overflow is at 716636160 with 272 divisors. * 1145325184 with <= 16 divisors * 64-bit overflow: 2459565884898017280 < n <= 2772864768682229760. */ if (n >= (BITS_PER_WORD == 64 ? UVCONST(2459565884898017280) : 716636160UL)) { *ntotients = UV_MAX; return totlist; } divs = divisor_list(n, &ndivisors, n); init_setlist(&setlist, 2*ndivisors); setlist_addval(&setlist, 1, 1); /* Add 1 => [1] */ for (i = 0; i < ndivisors; i++) { UV d = divs[ndivisors - i - 1], p = d+1; /* Divisors in reverse order */ 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 */ for (k = 0; k < ndivisors && divs[k] <= ndiv; k++) { UV nvals, *vals, d2 = divs[k]; if ((ndiv % d2) != 0) continue; /* For the last divisor [1], don't add intermediate values */ if (d == 1 && d2*dp != n) 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)); sort_uv_array(totlist, *ntotients); } free_setlist(&setlist); return totlist; } Math-Prime-Util-0.74/ds_iset.h000644 000765 000024 00000004056 15153425600 016201 0ustar00danastaff000000 000000 #ifndef MPU_DS_ISET_H #define MPU_DS_ISET_H #include "ptypes.h" /******************************************************************************/ /* INTEGER SET DATA STRUCTURE */ /******************************************************************************/ #define ISET_TYPE_ANY 0 #define ISET_TYPE_UV 1 #define ISET_TYPE_IV 2 #define ISET_TYPE_INVALID 3 typedef struct { UV *arr; size_t mask; size_t maxsize; size_t size; bool contains_zero; unsigned char type; } iset_t; iset_t iset_create(size_t init_size); void iset_destroy(iset_t *set); iset_t iset_create_from_array(UV* d, size_t dlen, int dsign); /* Returns 1 if unsigned, -1 if signed, 0 if messed up. */ static int iset_sign(const iset_t set) { static const signed char _iset_typeret[4] = {1,1,-1,0}; return _iset_typeret[set.type]; } static int iset_is_invalid(const iset_t set) { return set.type == ISET_TYPE_INVALID; } static size_t iset_size(const iset_t set) { return set.size; } bool iset_contains(const iset_t set, UV val); /* returns 0 or 1 */ /* void iset_minmax(const iset_t set, UV *min, UV *max); */ /* sign indicates: val is a UV (1) or IV (-1) */ bool iset_add(iset_t *set, UV val, int sign); /* Returns 1 if added, 0 if not */ /* This would require non-trivial changes to handle chains */ /* void iset_remove(iset_t *set, UV val); */ /* We could make an iterator */ /* caller supplied array must have room */ void iset_allvals(const iset_t set, UV* array); void iset_union_with(iset_t *set, const iset_t L); void iset_intersect_with(iset_t *set, const iset_t L); void iset_difference_with(iset_t *set, const iset_t L); void iset_symdiff_with(iset_t *set, const iset_t L); iset_t iset_union_of(const iset_t A, const iset_t B); iset_t iset_intersection_of(const iset_t A, const iset_t B); iset_t iset_difference_of(const iset_t A, const iset_t B); iset_t iset_symdiff_of(const iset_t A, const iset_t B); bool iset_is_subset_of(const iset_t A, const iset_t B); /* A subset of B? */ void iset_test(void); #endif Math-Prime-Util-0.74/congruent_numbers.h000644 000765 000024 00000000524 15145577415 020317 0ustar00danastaff000000 000000 #ifndef MPU_CONGRUENT_NUMBERS_H #define MPU_CONGRUENT_NUMBERS_H #include "ptypes.h" extern bool is_congruent_number(UV n); /* We supply two functions to allow testing. */ /* Answers 0: non-congruent, 1: congruent, -1: don't know */ extern int is_congruent_number_filter(UV n); extern bool is_congruent_number_tunnell(UV n); #endif Math-Prime-Util-0.74/cache.c000644 000765 000024 00000014226 15145577415 015622 0ustar00danastaff000000 000000 #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.74/rootmod.h000644 000765 000024 00000000754 15145577415 016250 0ustar00danastaff000000 000000 #ifndef MPU_ROOTMOD_H #define MPU_ROOTMOD_H #include "ptypes.h" extern bool sqrtmodp(UV *r, UV a, UV p); /* sqrt(a) mod p */ extern bool sqrtmod(UV *r, UV a, UV n); /* sqrt(a) mod n */ extern bool rootmodp(UV *r, UV a, UV k, UV p); /* a^(1/k) mod p */ extern bool rootmod(UV *r, UV a, UV k, UV n); /* a^(1/k) mod n */ extern UV* allsqrtmod(UV* nroots, UV a, UV n); /* all results */ extern UV* allrootmod(UV* nroots, UV a, UV k, UV n); /* all results */ #endif Math-Prime-Util-0.74/prime_counts.c000644 000765 000024 00000057004 15147036436 017262 0ustar00danastaff000000 000000 #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_counts.h" #include "util.h" #include "real.h" #include "mathl.h" #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; UV newsize = (UV)isqrt(endp)+1; if (newsize > 2642245) newsize = 2642245; /* Limit to icbrt(2^64) */ release_prime_cache(cache_sieve); segment_size = get_prime_cache( newsize, &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_range(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(UV n) { if (n < 2) return 0; /* We use table acceleration so this is preferable for small inputs */ if (n < _MPU_LMO_CROSSOVER) return segment_prime_count(0, n); return LMO_prime_count(n); } UV prime_count_approx(UV n) { if (n < 3000000) return segment_prime_count(2, n); return (UV) (RiemannR((long double) n, 1e-6) + 0.5); } 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 <= 300070) { /* Quite accurate and avoids calling Li for speed. */ /* Based on Axler 2022, page 9, Corollary 5.1 */ a = (n < 69720) ? 905 : (n < 70120) ? 961 : (n < 88800) ? 918.2 : (n < 176000) ? 887.7 : (n < 299270) ? 839.46 : 846.66; /* Good to 300071 */ lower = fn / (fl1 - 1 - 1/fl1 - 2.975666/fl2 - 13.024334/(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.48f }, { 355991, 2.54f }, { 3550000, 2.51f }, { 3560000, 2.49f }, { 5000000, 2.48f }, { 8000000, 2.47f }, { 13000000, 2.46f }, { 18000000, 2.45f }, { 31000000, 2.44f }, { 41000000, 2.43f }, { 48000000, 2.42f }, { 119000000, 2.41f }, { 182000000, 2.40f }, { 192000000, 2.395f }, { 213000000, 2.390f }, { 271000000, 2.385f }, { 322000000, 2.380f }, { 400000000, 2.375f }, { 510000000, 2.370f }, { 682000000, 2.367f }, { UVCONST(2953652287), 2.362f } }; #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); * * Axler 2022: https://arxiv.org/pdf/2203.05917.pdf (v4 2022) improves this. */ 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, c, d; if (n < NPRIMES_SMALL) return primes_small[n]; if (n >= MPU_MAX_PRIME_IDX) return n == MPU_MAX_PRIME_IDX ? MPU_MAX_PRIME : 0; fn = (long double) n; flogn = logl(n); flog2n = logl(flogn); /* Note distinction between log_2(n) and log^2(n) */ /* Binary search on prime count lower. Good but quite slow. */ if (n < 15360) { 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; } /* See: Axler 2013, Dusart 2010 */ /* Axler 2017: http://arxiv.org/pdf/1706.03651.pdf */ if (n >= 46254381) { c = 2.00; d = 10.667; } /* Axler 2017 Cor 1.2 */ else if (n >= 8009824) { c = 2.00; d = 10.273; } /* Axler 2013 Kor G */ /* This is about 3x better than Dusart (2010) for 688382-8009823: * * else if (n >= 688382) { c = 2.30; d = 0.5730; } * * but we can split the range and get another 2x improvement in MSE. */ else if (n >= 5450000) { c = 2.00; d = 10.1335; } /*5450-8009 */ else if (n >= 3906280) { c = 1.67; d = 20.2675; } /*3906-5450 */ else if (n >= 2110840) { c = 2.51; d = -5.5714; } /*2110-3906 */ else if (n >= 876700) { c = 2.49; d = -4.5129; } /* 877-2110 */ else if (n >= 688382) { c = 3.31; d = -26.3858; } /* 688-877 */ /* Use the Axler framework to get good bounds for smaller inputs. */ else if (n >= 575750) { c =-0.79; d = 83.5215; } /* 580-688 */ else if (n >= 467650) { c = 0.93; d = 37.1597; } /* 467-580 */ else if (n >= 382440) { c = 2.92; d = -15.4768; } /* 382-467 */ else if (n >= 301130) { c = 5.92; d = -91.3415; } /* 301-382 */ else if (n >= 138630) { c = 2.01; d = 7.2842; } /* 138-301 */ else if (n >= 85820) { c = 2.07; d = 5.2103; } /* 86-138 */ else if (n >= 39016) { c = 2.76; d = -11.5918; } /* 39- 86 */ else if (n >= 31490) { c = 1.49; d = 15.1821; } /* 31- 39 */ else if (n >= 25070) { c =11.89; d =-197.8951; } /* 25- 31 */ else if (n >= 15359) { c = 4.80; d = -51.5928; } /* 15- 25 */ else { c = 3.92; d = -33.3994; } /* 0- 15 */ upper = fn * ( flogn + flog2n - 1.0 + ((flog2n-c)/flogn) - (flog2n*flog2n-6*flog2n+d)/(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; UV plower; if (n < NPRIMES_SMALL) return primes_small[n]; if (n >= MPU_MAX_PRIME_IDX) return n == MPU_MAX_PRIME_IDX ? MPU_MAX_PRIME : 0; 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.50800000002; double lower = fn * (flogn + flog2n-1.0 + ((flog2n-2.00)/flogn) - ((flog2n*flog2n-6*flog2n+b1)/(2*flogn*flogn))); plower = (UV) ceill(lower); } return plower < MPU_MAX_PRIME ? plower : MPU_MAX_PRIME; } 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]; if (n >= MPU_MAX_PRIME_IDX) return n == MPU_MAX_PRIME_IDX ? MPU_MAX_PRIME : 0; /* 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(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 ); } /******************************************************************************/ /* MISC */ /******************************************************************************/ double ramanujan_axler(long double n, long double c, long double d) { long double res, U, c1, c2, log2 = logl(2), logn = logl(n), loglogn = logl(logn); c1 = 2*log2*log2 + log2 + c; c2 = log2*log2*log2 + 2*log2*log2 + d; U = (log2 * logn*loglogn*loglogn - c1*logn*loglogn + c2*logn - log2*log2*loglogn + log2*log2*log2 + log2*log2) / (logn*logn*logn*logn + logn*logn*logn*loglogn - logn*logn*logn*log2 - logn*logn*log2); res = 2*n * (1.0L + log2/logn - (log2*loglogn - log2*log2 - log2) / (logn*logn) + U); return res; } Math-Prime-Util-0.74/lmo.h000644 000765 000024 00000000143 15145577415 015344 0ustar00danastaff000000 000000 #ifndef MPU_LMO_H #define MPU_LMO_H #include "ptypes.h" extern UV LMO_prime_count(UV n); #endif Math-Prime-Util-0.74/mulmod.h000644 000765 000024 00000011707 15146553566 016064 0ustar00danastaff000000 000000 #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 /* x86-64 ARM RISC-V * umul 64->128 mul -> rdx:rax umulh/mul mulhu/mulu * smul 64->128 imul -> rdx:rax smulh/mul mulsu/muls * udiv 128->64 div -> q:rax r:rdx divu (RV128I) * sdiv 128->64 idiv -> q:rax r:rdx divs (RV128I) * clmul 64->128 pclmulqdq -> xmm pmull/pmull2 clmul/clmulh * * __int128 (GCC, clang, CUDA 11.5+) * MSVC std::_Unsigned128 in <__msvc_int128.hpp> * C23 _BitInt(128) (clang 14+, gcc 14+) */ #if (BITS_PER_WORD == 32) && HAVE_UINT64 /* 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. * However, the late 2020 Apple M1 Macs use this. */ #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) static INLINE UV negmod(UV a, UV n) { if (a >= n) a %= n; return (a) ? (n-a) : 0; } #endif Math-Prime-Util-0.74/aks.h000644 000765 000024 00000000142 15145577415 015332 0ustar00danastaff000000 000000 #ifndef MPU_AKS_H #define MPU_AKS_H #include "ptypes.h" extern bool is_aks_prime(UV n); #endif Math-Prime-Util-0.74/ramanujan_primes.h000644 000765 000024 00000001371 15145577415 020114 0ustar00danastaff000000 000000 #ifndef MPU_RAMANUJAN_PRIMES_H #define MPU_RAMANUJAN_PRIMES_H #include "ptypes.h" extern bool is_ramanujan_prime(UV n); 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 UV range_ramanujan_prime_sieve(UV** list, UV lo, UV hi); extern UV ramanujan_prime_count_range(UV lo, UV hi); extern UV ramanujan_prime_count(UV n); 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.74/ds_bitmask126.h000644 000765 000024 00000021636 15146553566 017142 0ustar00danastaff000000 000000 #ifndef MPU_DS_BITMASK126_H #define MPU_DS_BITMASK126_H #include "ptypes.h" /******************************************************************************/ /* BITMASK126 DATA STRUCTURE */ /******************************************************************************/ /* * This is a bitmask for lucky numbers, using a 32-bit word for 126 integers. * Crucially, we use a tree of counts so we can skip to a given index in a * reasonable amount of time. * * The amount of memory used is about n/25. This is about 20x smaller than * the 64-bit pagelist or cgen method, and 10x smaller than Wilson's list, * in addition to being orders of magnitude faster than cgen or Wilson. */ #ifndef BMTYPE #define BMTYPE UV #endif #define BMDEBUG 0 /* Not clear if SSHIFT/TSHIFT should be 3/3, 3/4, 4/3, or 4/4 */ #define SSHIFT 4 #define TSHIFT 3 static unsigned char _bm_offset[32] = { 1, 3, 7, 9,13,15,21,25,31,33,37, 43, 45, 49, 51, 55, 63,67,69,73,75,79,85,87,93,97,99,105,109,111,115,117}; static unsigned char _bm_bit[63] = { 0, 1, 1, 2, 3, 3, 4, 5, 5, 5, 6, 6, 7, 7, 7, 8, 9, 9,10,10,10,11,12,12,13,14,14,15,15,15,15,16, 16,17,18,18,19,20,20,21,21,21,22,23,23,23,24,24, 25,26,26,26,27,27,28,29,29,30,31,31,31,31,31 }; #define BM_WORD(n) ((n) / 2 / 63) #define BM_BITN(n) _bm_bit[(n) / 2 % 63] #define BM_BITM(n) (1U << BM_BITN(n)) /* Modified from Stanford Bit Twiddling Hacks, via "Nominal Animal" */ static uint32_t _nth_bit_set(uint32_t n, uint32_t word) { const uint32_t pop2 = word - (word >> 1 & 0x55555555u); const uint32_t pop4 = (pop2 & 0x33333333u) + (pop2 >> 2 & 0x33333333u); const uint32_t pop8 = (pop4 + (pop4 >> 4)) & 0x0f0f0f0fu; const uint32_t pop16 = (pop8 + (pop8 >> 8)) & 0x00ff00ffu; const uint32_t pop32 = (pop16 + (pop16 >> 16)) & 0x000000ffu; uint32_t temp, rank = 0; if (n++ >= pop32) return 32; temp = pop16 & 0xffu; if (n > temp) { n -= temp; rank += 16; } temp = (pop8 >> rank) & 0xffu; if (n > temp) { n -= temp; rank += 8; } temp = (pop4 >> rank) & 0x0fu; if (n > temp) { n -= temp; rank += 4; } temp = (pop2 >> rank) & 0x03u; if (n > temp) { n -= temp; rank += 2; } temp = (word >> rank) & 0x01u; if (n > temp) rank += 1; return rank; } /* We are trying to balance space and performance. */ /* Also note that we do not support a bitmask with 256 consecutive bits set, * as that would overflow bsize. * A "block" could be changed to 16 or 32 words * with a uint16_t bsize. */ typedef struct bitmask126_t { BMTYPE n; /* The upper limit on the sieve */ BMTYPE nelems; /* The total number of bits set */ BMTYPE nwords; /* The number of words in data[] */ int nilevels; /* The number of tbsize[] arrays actually used */ uint32_t* data; /* The bitmap itself */ uint8_t* size; /* The number of bits set in each data[] word */ uint8_t* bsize; /* Sums over 8-word blocks */ uint16_t* sbsize; /* Sums over 1<n = n; bm->nelems = 0; bm->nwords = (n+125)/126; nblocks = (bm->nwords + 7) / 8; Newz(0, bm->data, bm->nwords, uint32_t); Newz(0, bm->size, bm->nwords, uint8_t); Newz(0, bm->bsize, nblocks, uint8_t); nblocks = (nblocks + (1U << SSHIFT) - 1) >> SSHIFT; Newz(0, bm->sbsize, nblocks, uint16_t); for (nlevels=0; nlevels < 12; nlevels++) { nblocks = (nblocks + (1U << TSHIFT) - 1) >> TSHIFT; if (nblocks < 3) break; #if BMDEBUG printf(" level %lu blocks = %lu\n", nlevels, nblocks); #endif Newz(0, bm->tbsize[nlevels], nblocks, BMTYPE); } bm->nilevels = nlevels; return bm; } static void bitmask126_destroy(bitmask126_t *bm) { int i; Safefree(bm->data); Safefree(bm->size); Safefree(bm->bsize); Safefree(bm->sbsize); for (i = 0; i < bm->nilevels; i++) Safefree(bm->tbsize[i]); bm->nelems = 0; bm->n = 0; Safefree(bm); } /* Update all index levels for adding (subtracting) n bits to word wi. */ #define ADDSIZE(bm, wi, n) \ do { int _i; \ BMTYPE _j = wi; \ bm->size[_j] += n; \ bm->bsize[_j >>= 3] += n; \ bm->sbsize[_j >>= SSHIFT] += n; \ for (_i = 0; _i < bm->nilevels; _i++) \ bm->tbsize[_i][_j >>= TSHIFT] += n; \ bm->nelems += n; \ } while (0) static void bitmask126_append(bitmask126_t *bm, BMTYPE n) { BMTYPE w = BM_WORD(n); #if BMDEBUG if (n >= bm->n) croak("bitmask126: bad n in append"); #endif bm->data[w] |= BM_BITM(n); ADDSIZE(bm, w, 1); } static BMTYPE* bitmask126_to_array(UV *size, bitmask126_t *bm) { BMTYPE nelem, wi, nwords, *arr; New(0, arr, bm->nelems, BMTYPE); nwords = bm->nwords; nelem = 0; for (wi = 0; wi < nwords; wi++) { uint32_t bit, w = bm->data[wi]; for (bit = 0; bit < 32; bit++, w >>= 1) if (w & 1) arr[nelem++] = wi*126 + _bm_offset[bit]; } if (nelem != bm->nelems) croak("bitmask126: bad number of elements in array"); *size = nelem; return arr; } static uint32_t* bitmask126_to_array32(UV *size, const bitmask126_t *bm) { uint32_t nelem, wi, nwords, *arr; New(0, arr, bm->nelems, uint32_t); nwords = bm->nwords; nelem = 0; for (wi = 0; wi < nwords; wi++) { uint32_t bit, w = bm->data[wi]; for (bit = 0; bit < 32; bit++, w >>= 1) if (w & 1) arr[nelem++] = wi*126 + _bm_offset[bit]; } if (nelem != bm->nelems) croak("bitmask126: bad number of elements in array"); *size = nelem; return arr; } /* We want to find the e.g. 101'st set value, returns the array word index, * and set *idx to the number of bits to skip within that word. */ static BMTYPE _bitmask126_find_index(const bitmask126_t *bm, BMTYPE *idx) { int lev; BMTYPE i = *idx, j = 0; if (i > bm->nelems) croak("index higher than number of elements"); /* Skip though superblock tree (128,2048,32768,524288,... words) */ for (lev = bm->nilevels-1; lev >= 0; lev--) { const BMTYPE *tbsizei = bm->tbsize[lev]; for (j <<= TSHIFT; i >= tbsizei[j]; j++) i -= tbsizei[j]; } for (j <<= TSHIFT; i >= bm->sbsize[j]; j++) /* Skip superblocks */ i -= bm->sbsize[j]; for (j <<= SSHIFT; i >= bm->bsize[j]; j++) /* Skip 8w blocks */ i -= bm->bsize[j]; for (j <<= 3; i >= bm->size[j]; j++) /* Skip words */ i -= bm->size[j]; *idx = i; return j; } static INLINE BMTYPE bitmask126_val(const bitmask126_t *bm, BMTYPE idx) { BMTYPE wi; uint32_t bit; wi = _bitmask126_find_index(bm, &idx); bit = _nth_bit_set(idx, bm->data[wi]); return wi * 126 + _bm_offset[bit]; } static void bitmask126_delete(bitmask126_t *bm, BMTYPE idx) { /* idx 0,1,... */ BMTYPE wi; #if BMDEBUG if (idx >= bm->nelems) croak("bitmask126: bad index in delete"); #endif wi = _bitmask126_find_index(bm, &idx); if (bm->size[wi] == 1) { /* Only 1 value, zero the word. */ bm->data[wi] = 0; } else { /* Find the index bit and zero it */ uint32_t bit = _nth_bit_set(idx, bm->data[wi]); bm->data[wi] &= ~(1U << bit); } ADDSIZE(bm, wi, -1); } typedef struct bitmask126_iter_t { const bitmask126_t *bm; const uint32_t *data; BMTYPE wi; uint32_t bit; } bitmask126_iter_t; static bitmask126_iter_t bitmask126_iterator_create(const bitmask126_t *bm, BMTYPE idx) { bitmask126_iter_t iter; if (idx >= bm->nelems) croak("bitmask126: invalid iterator initial position\n"); iter.bm = bm; iter.data = bm->data; iter.wi = _bitmask126_find_index(bm, &idx); iter.bit = _nth_bit_set(idx, bm->data[iter.wi]); return iter; } static BMTYPE bitmask126_iterator_next(bitmask126_iter_t *iter) { BMTYPE v, wi = iter->wi; uint32_t bit = iter->bit; uint32_t w = iter->data[wi] >> bit; while (w == 0) { /* skip any empty words */ w = iter->data[++wi]; bit = 0; } #if defined(__GNUC__) && 100*__GNUC__ + __GNUC_MINOR >= 304 bit += __builtin_ctzl(w); #else for ( ; bit < 32; bit++, w >>= 1) /* Find next set bit */ if (w & 1) break; #endif v = wi * 126 + _bm_offset[bit]; iter->bit = ++bit & 31; iter->wi = wi + (bit>>5); return v; } static BMTYPE bitmask126_iterator_prev(bitmask126_iter_t *iter) { BMTYPE v, wi = iter->wi; int bit = iter->bit; uint32_t w = iter->data[wi]; do { if (bit < 0) { if (wi == 0) croak("bitmask126: iterator underflow"); w = iter->data[--wi]; bit = 31; } for ( ; bit >= 0; bit--) { /* Find prev set bit */ if (w & 1U << bit) break; } } while (bit < 0); v = wi * 126 + _bm_offset[bit]; iter->bit = --bit & 31; iter->wi = wi - (bit >> 5 & 1); return v; } #undef BMTYPE #undef BMDEBUG #undef SSHIFT #undef TSHIFT #undef ADDSIZE #undef BM_WORD #undef BM_BITN #undef BM_BITM #endif Math-Prime-Util-0.74/sort.h000644 000765 000024 00000000353 15145577415 015547 0ustar00danastaff000000 000000 #ifndef MPU_SORT_H #define MPU_SORT_H #include "ptypes.h" extern void sort_uv_array(UV* L, size_t len); extern void sort_iv_array(IV* L, size_t len); extern void sort_dedup_uv_array(UV* L, bool data_is_signed, size_t *len); #endif Math-Prime-Util-0.74/csprng.h000644 000765 000024 00000002233 15145577415 016053 0ustar00danastaff000000 000000 #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 bool 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 void* prng_new(uint32_t a, uint32_t b, uint32_t c, uint32_t d); extern uint32_t prng_next(void* rng); #endif Math-Prime-Util-0.74/random_prime.c000644 000765 000024 00000011662 15146553566 017236 0ustar00danastaff000000 000000 #include #include #include "csprng.h" #include "primality.h" #include "util.h" #include "prime_counts.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) return 0; if (d == 1) return nth_prime(1 + urandomm32(ctx,4)); if (d == 2) return nth_prime(5 + urandomm32(ctx,21)); if (d >= (BITS_PER_WORD == 64 ? 20 : 10)) return 0; 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. */ bool 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 (!is_strong_pseudoprime(n, base)) 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; } UV random_safe_prime(void* ctx, UV bits) { static const unsigned char small_safe[] = {5,7,11,23,47,59,83,107}; const uint16_t p15mask = 14079; UV p, q, B; if (bits < 3 || bits > BITS_PER_WORD) return 0; switch (bits) { case 3: return small_safe[ 0 + urandomm32(ctx, 2) ]; case 4: return 11; case 5: return 23; case 6: return small_safe[ 4 + urandomm32(ctx, 2) ]; case 7: return small_safe[ 6 + urandomm32(ctx, 2) ]; default: break; } /* do { q = 2 * random_nbit_prime(ctx, bits-1) + 1; } while (!is_prob_prime(q)); */ /* Alternately we could construct p with last 2 bits set, then q = p >> 1. */ B = (UVCONST(1) << (bits-2)) + 1; do { p = B + (urandomb(ctx, bits-3) << 1); q = 2*p+1; } while ( (p15mask & (1U << (p%15))) || (p%7) == 0 || (p%7) == 3 || !is_prob_prime(p) || !is_prob_prime(q) ); return q; } Math-Prime-Util-0.74/prime_powers.c000644 000765 000024 00000016675 15145577415 017304 0ustar00danastaff000000 000000 #include #include #include #include "ptypes.h" #include "constants.h" #include "prime_powers.h" #define FUNC_ctz 1 #define FUNC_log2floor 1 #define FUNC_ipow 1 #include "util.h" #include "sort.h" #include "cache.h" #include "sieve.h" #include "primality.h" #include "prime_counts.h" #include "inverse_interpolate.h" /******************************************************************************/ /* PRIME POWERS */ /******************************************************************************/ int prime_power(UV n, UV* prime) { int power = 0; uint32_t root; if (n < 2) return 0; /* Check for small divisors */ if (!(n&1)) { if (n & (n-1)) return 0; if (prime) *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; if (prime) *prime = 3; return power; } if ((n%5) == 0) { do { n /= 5; power++; } while (n > 1 && (n%5) == 0); if (n != 1) return 0; if (prime) *prime = 5; return power; } if ((n%7) == 0) { do { n /= 7; power++; } while (n > 1 && (n%7) == 0); if (n != 1) return 0; if (prime) *prime = 7; return power; } if (is_prob_prime(n)) { if (prime) *prime = n; return 1; } /* Composite. Test for perfect power with prime root. */ power = powerof_ret(n, &root); if (power) { if (is_prob_prime(root)) { if (prime) *prime = root; } else power = 0; } return power; } UV next_prime_power(UV n) { UV i, bit; if (n < 2) return 2; if (n >= MPU_MAX_PRIME) return 0; /* Overflow (max power = max prime) */ #if 0 /* Straightforward loop */ for (i = n+1; !is_prime_power(i); i++) ; return i; #else /* Skip evens */ bit = UVCONST(1) << log2floor(n); for (i = n+1+(n&1); i & bit; i += 2) if (is_prime_power(i)) return i; return i-1; /* We went past a power of two */ #endif } UV prev_prime_power(UV n) { UV i, bit; if (n <= 2) return 0; #if 0 for (i = n-1; !is_prime_power(i); i--) ; return i; #else n--; bit = UVCONST(1) << log2floor(n); for (i = n-!(n&1); i & bit; i -= 2) if (is_prime_power(i)) return i; return i+1; /* We went past a power of two */ #endif } /* The prime powers without the primes */ UV prime_power_sieve2(UV** list, UV lo, UV hi) { UV k, log2n, *powers, np = 0, npmax = 0; if (hi < 2 || lo > hi) { *list = 0; return 0; } /* Bound on how many powers we'll have */ log2n = log2floor(hi); for (k = 2; k <= log2n; k++) { npmax += prime_count_upper(rootint(hi,k)); if (lo > 2) npmax -= prime_count_lower(rootint(lo-1,k)); } New(0, powers, npmax, UV); /* Find all powers and add to list */ for (k = 2; k <= log2n; k++) { START_DO_FOR_EACH_PRIME(2, rootint(hi,k)) { UV pk = ipow(p,k); if (pk >= lo) powers[np++] = pk; } END_DO_FOR_EACH_PRIME } /* Sort them and return */ sort_uv_array(powers, np); *list = powers; return np; } /* The prime powers with the primes */ UV prime_power_sieve(UV** list, UV lo, UV hi) { UV npower, nprime, ipower, iprime, ntotal, i, *powers, *primes, *tot; if (hi < 2 || lo > hi) { *list = 0; return 0; } /* For better performance / memory: * 1) realloc primes, use reverse merge to add powers in with one pass * 2) sieve the primes here and merge the powers in. */ npower = prime_power_sieve2(&powers, lo, hi); nprime = range_prime_sieve(&primes, lo, hi); /* The powers get sparse, so this isn't impossible. */ if (npower == 0) { Safefree(powers); *list = primes; return nprime; } ipower = 0; iprime = 0; ntotal = nprime + npower; New(0, tot, ntotal, UV); for (i = 0; i < ntotal; i++) { if (ipower == npower) tot[i] = primes[iprime++]; else if (iprime == nprime) tot[i] = powers[ipower++]; else tot[i] = (primes[iprime] < powers[ipower]) ? primes[iprime++] : powers[ipower++]; } Safefree(powers); Safefree(primes); *list = tot; return ntotal; } UV prime_power_count_range(UV lo, UV hi) { if (hi < 2 || hi < lo) return 0; return prime_power_count(hi) - ((lo <= 2) ? 0 : prime_power_count(lo-1)); } /* n A025528; 10^n A267712 */ UV prime_power_count(UV n) { uint32_t k, log2n; UV sum; if (n <= 5) return (n==0) ? 0 : n-1; sum = prime_count(n); log2n = log2floor(n); for (k = 2; k <= log2n; k++) sum += prime_count(rootint(n,k)); return sum; } UV prime_power_count_lower(UV n) { uint32_t k, log2n; UV sum; if (n <= 5) return (n==0) ? 0 : n-1; sum = prime_count_lower(n); log2n = log2floor(n); for (k = 2; k <= log2n; k++) sum += prime_count_lower(rootint(n,k)); return sum; } UV prime_power_count_upper(UV n) { uint32_t k, log2n; UV sum; if (n <= 5) return (n==0) ? 0 : n-1; sum = prime_count_upper(n); log2n = log2floor(n); for (k = 2; k <= log2n; k++) sum += prime_count_upper(rootint(n,k)); return sum; } UV prime_power_count_approx(UV n) { uint32_t k, log2n; UV sum; if (n <= 5) return (n==0) ? 0 : n-1; sum = prime_count_approx(n); log2n = log2floor(n); for (k = 2; k <= log2n; k++) sum += prime_count_approx(rootint(n,k)); return sum; } static UV _simple_nth_prime_power_lower(UV n) { if (n <= 100) return n+1; return (0.98 * nth_prime_lower(n)) - 400; } static UV _simple_nth_prime_power_upper(UV n) { return nth_prime_upper(n); } UV nth_prime_power_lower(UV n) { UV lo, hi; if (n <= 7) return (n==0) ? 0 : n+1+(n/5); lo = _simple_nth_prime_power_lower(n); hi = _simple_nth_prime_power_upper(n); return inverse_interpolate(lo, hi, n, &prime_power_count_upper, 0); } UV nth_prime_power_upper(UV n) { UV lo, hi; if (n <= 7) return (n==0) ? 0 : n+1+(n/5); lo = _simple_nth_prime_power_lower(n); hi = _simple_nth_prime_power_upper(n); return inverse_interpolate(lo, hi, n, &prime_power_count_lower, 0); } UV nth_prime_power_approx(UV n) { UV lo, hi; if (n <= 7) return (n==0) ? 0 : n+1+(n/5); lo = _simple_nth_prime_power_lower(n); hi = _simple_nth_prime_power_upper(n); return inverse_interpolate(lo, hi, n, &prime_power_count_approx, 0); } UV nth_prime_power(UV n) { if (n <= 7) return (n==0) ? 0 : n+1+(n/5); if (n >= MPU_MAX_PRIME_IDX) return MPU_MAX_PRIME; #if 0 /* Bilinear interpolation. Not bad, but not great. */ UV lo, hi, pp; if (n <= 7) return (n==0) ? 0 : n+1+(n/5); lo = nth_prime_power_lower(n); hi = nth_prime_power_upper(n); pp = inverse_interpolate(lo, hi, n, &prime_power_count, 10000); return prev_prime_power(pp+1); #endif #if 0 /* Approximating interpolation. Very good, but prefer simpler. */ UV g, count; g = interpolate_with_approx(n, &count, 500, &nth_prime_power_approx, &prime_power_count, 0); if (g > MPU_MAX_PRIME) g = MPU_MAX_PRIME; if (count >= n) { for (g = prev_prime_power(g+1); count > n; count--) g = prev_prime_power(g); } else { for (; count < n; count++) g = next_prime_power(g); } return g; #endif /* Interpolation using functions for approximate nth and exact count. * This works quite well, and uses the is_prime_power() function to get * the exact result. Our next/prev functions save negligible time. */ return interpolate_with_approx(n, 0, 800, &nth_prime_power_approx, &prime_power_count, &is_prime_power); } Math-Prime-Util-0.74/Timeline000644 000765 000024 00000041554 15153327136 016100 0ustar00danastaff000000 000000 A timeline of when each function was added. ------------------------------------------------------------------------------- 2026-03-20 v0.74 2026-01-20 vecslide { ... } @list 2026-01-18 vecsingleton(...) 2025-12-20 minimal_goldbach_pair(n) 2025-12-20 goldbach_pairs(n) 2025-12-20 goldbach_pair_count(n) 2025-11-29 from_contfrac(@A) 2025-09-16 vecfreq(...) 2025-06-18 inverse_li_nv(x) 2025-06-17 vecsample(k,@list) 2025-06-14 setcontainsany(\@A,\@B) 2025-04-21 next_farey(n,[p,q]) 2025-04-21 farey_rank(n,[p,q]) 2025-04-18 farey(n) farey(n,k) 2025-04-17 vecsorti(\@L) 2025-04-16 stern_brocot_n(n,d) 2025-04-16 nth_stern_diatomic(n) 2025-04-16 nth_stern_brocot(n) 2025-04-16 nth_calkin_wilf(n) 2025-04-16 next_stern_brocot(n,d) 2025-04-16 next_calkin_wilf(n,d) 2025-04-16 calkin_wilf_n(n,d) 2025-04-16 contfrac(n,d) 2025-04-04 is_happy(n) is_happy(n,base,exponent) 2025-04-02 is_cyclic(n) 2025-03-17 forsquarefreeint {} lo,hi 2025-03-12 setremove(\@A,$v) setremove(\@A,\@B) 2025-03-12 setinvert(\@A,$v) setinvert(\@A,\@B) 2025-02-25 set_is_superset(\@A,\@B) 2025-02-25 set_is_subset(\@A,\@B) 2025-02-25 set_is_proper_superset(\@A,\@B) 2025-02-25 set_is_proper_subset(\@A,\@B) 2025-02-25 set_is_proper_intersection(\@A,\@B) 2025-02-25 set_is_equal(\@A,\@B) 2025-02-25 set_is_disjoint(\@A,\@B) 2025-02-24 setinsert(\@A,$v) setinsert(\@A,\@B) 2025-02-21 setcontains(\@A,$v) setcontains(\@A,\@B) 2025-02-10 vecsort(@L) 2024-11-04 is_sumfree_set(\@L) 2024-11-04 is_sidon_set(\@L) 2024-09-07 toset(\@A) 2024-09-07 setunion(\@A,\@B) 2024-09-07 setminus(\@A,\@B) 2024-09-07 setintersect(\@A,\@B) 2024-09-07 setdelta(\@A,\@B) 2024-08-25 vecuniq(...) 2024-08-25 sumset(\@A[,\@B]) 2024-08-25 setbinop {...} \@A[,\@B] 2024-07-27 rising_factorial(x,n) 2024-07-27 falling_factorial(x,n) 2024-07-20 fubini(n) 2024-07-19 subfactorial(n) 2024-06-18 squarefree_kernel(n) 2024-06-17 frobenius_number(...) 2024-05-30 next_chen_prime(n) 2024-05-30 is_chen_prime(n) 2024-05-20 nth_powerfree(n[,k]) 2024-05-20 is_perfect_number(n) 2024-05-12 pisano_period(n) 2024-04-09 powerful_numbers([lo,]hi[,k]) 2024-04-05 negmod(a, n) 2024-04-03 cornacchia(d,n) 2024-03-31 is_qr(a,n) 2024-03-31 is_congruent_number(n) 2023-05-16 is_divisible(n,d) 2023-05-16 is_congruent(n,c,d) 2023-05-12 mulsubmod(a, b, c, n) 2023-05-12 muladdmod(a, b, c, n) 2023-05-11 is_odd(n) 2023-05-11 is_even(n) 2023-05-06 cheb_factor(n) 2023-05-05 cdivint(a, b) 2023-05-04 cdivrem(a, b) 2023-05-02 sumpowerful(n[,k]) 2023-05-02 powersum(n,k) 2023-03-10 vecpmex(...) 2023-03-10 vecmex(...) 2023-03-10 sumtotient(n) 2021-09-20 prev_perfect_power(n) 2021-09-20 perfect_power_count_upper(n) 2021-09-20 perfect_power_count_lower(n) 2021-09-20 perfect_power_count_approx(n) 2021-09-20 nth_perfect_power_upper(n) 2021-09-20 nth_perfect_power_lower(n) 2021-09-20 nth_perfect_power_approx(n) 2021-09-20 nth_perfect_power(n) 2021-09-20 next_perfect_power(n) 2021-09-20 is_perfect_power(n) 2021-09-05 prime_powers([start,] end) 2021-09-05 prime_power_count_upper(n) 2021-09-05 prime_power_count_lower(n) 2021-09-05 prime_power_count_approx(n) 2021-09-05 prime_power_count([start,] end) 2021-09-05 prev_prime_power(n) 2021-09-05 next_prime_power(n) 2021-09-05 nth_prime_power_upper(n) 2021-09-05 nth_prime_power_lower(n) 2021-09-05 nth_prime_power_approx(n) 2021-09-05 nth_prime_power(n) 2021-09-05 nth_lucky_upper(n) 2021-09-05 nth_lucky_lower(n) 2021-09-05 nth_lucky_approx(n) 2021-09-05 nth_lucky(n) 2021-09-05 lucky_count_upper(n) 2021-09-05 lucky_count_lower(n) 2021-09-05 lucky_count_approx(n) 2021-09-05 lucky_count([start,] end) 2021-09-05 chinese2([a1,m1],[a2,m2],...) 2021-08-28 powerfree_part_sum(n[,k]) 2021-08-27 powerfree_part(n[,k]) 2021-08-26 powerfree_sum(n[,k]) 2021-08-26 powerfree_count(n[,k]) 2021-08-26 is_powerfree(n[,k]) 2021-08-12 is_sum_of_squares(n[,k]) 2021-07-05 allrootmod(a,k,n) 2021-06-28 allsqrtmod(a,n) 2021-06-08 nth_omega_prime(k,n) 2021-03-13 is_omega_prime(k,n) 2021-03-05 omega_primes(k,[start,]end) 2021-03-05 omega_prime_count(k,n) 2021-03-05 almost_primes(k,[start,]end) 2021-03-02 add1int(n) 2021-03-02 sub1int(n) 2021-03-02 signint(a, b) 2021-03-02 cmpint(a, b) 2021-02-11 lucasvmod 2021-02-11 lucasumod 2021-02-11 lucasuvmod 2021-02-11 lucasuv(p,q,k) 2021-02-11 fdivrem(a, b) 2021-01-26 is_delicate_prime(n[,b]) 2021-01-18 rshiftint(n, k) 2021-01-18 rashiftint(n, k) 2021-01-18 lshiftint(n, k) 2021-01-14 tozeckendorf(n) 2021-01-14 fromzeckendorf(str) 2021-01-13 vecequal(\@a, \@b) 2021-01-12 foralmostprimes {} k,a,b 2020-08-08 binomialmod(n,k,m) 2020-07-23 is_practical(n) 2020-07-17 smooth_count(n,k) 2020-07-17 rough_count(n,k) 2020-07-16 perfect_power_count([beg,] end) 2020-07-15 qnr 2020-07-09 powerful_count(n[,k]) 2020-07-09 nth_powerful(n[,k]) 2020-07-07 is_powerful(n[,k]) 2020-07-04 almost_prime_count_lower(k,n) 2020-07-04 almost_prime_count_upper(k,n) 2020-07-04 nth_almost_prime_approx(k,n) 2020-07-04 nth_almost_prime_lower(k,n) 2020-07-04 nth_almost_prime_upper(k,n) 2020-07-04 nth_almost_prime 2020-06-24 almost_prime_count 2020-06-24 almost_prime_count_approx 2020-06-23 is_almost_prime(n,k) 2020-06-23 is_smooth(n,k) 2020-06-23 is_rough(n,k) 2020-06-20 prime_bigomega(n) 2020-06-20 prime_omega(n) 2020-06-18 sumliouville(n) 2020-08-21 rootmod 2020-08-19 submod 2019-06-28 absint 2019-06-28 negint 2019-02-24 random_safe_prime 2019-01-07 powint 2019-01-07 mulint 2019-01-07 addint 2019-01-07 subint 2019-01-07 divint 2019-01-07 modint 2019-01-07 divrem 2019-01-07 tdivrem 2019-01-03 is_gaussian_prime(a,b) 2018-12-14 is_lucky(n) 2018-12-14 nth_lucky(n) 2018-12-12 lucky_numbers([start],] end) ------------------------------------------------------------------------------- 2018-11-15 v0.73 2018-11-13 inverse_totient ------------------------------------------------------------------------------- 2018-11-08 v0.72 2018-10-30 forsetproduct {...} \@a,\@b 2018-10-16 semiprime_count_approx 2018-10-08 semi_primes 2018-10-05 nth_semiprime_approx 2018-09-20 nth_semiprime ------------------------------------------------------------------------------- 2018-08-28 v0.71 2018-08-23 semiprime_count([lo,]hi) 2018-08-16 random_factored_integer(n) 2018-08-16 forsemiprimes {...} a,b 2018-02-11 forsquarefree {...} a,b 2018-02-11 forfactored {...} a,b ------------------------------------------------------------------------------- 2017-12-02 v0.70 ------------------------------------------------------------------------------- 2017-11-08 v0.69 2017-10-20 is_totient(n) ------------------------------------------------------------------------------- 2017-10-19 v0.68 2017-10-16 is_fundamental(d) 2017-09-26 factorialmod(n,m) ------------------------------------------------------------------------------- 2017-09-23 v0.67 2017-09-23 is_polygonal(n,k) 2017-09-22 lastfor 2017-09-18 is_square(n) ------------------------------------------------------------------------------- 2017-09-12 v0.66 2017-09-11 shuffle 2017-09-09 numtoperm 2017-09-09 permtonum 2017-09-09 randperm 2017-09-01 forderange {} ? 2017-05-26 random_semiprime(n) 2017-05-26 random_unrestricted_semiprime(n) ------------------------------------------------------------------------------- 2017-05-03 v0.65 ------------------------------------------------------------------------------- 2017-04-17 v0.64 ------------------------------------------------------------------------------- 2017-04-16 v0.63 ------------------------------------------------------------------------------- 2017-04-16 v0.62 2017-04-14 nth_ramanujan_prime_upper(n) 2017-04-14 nth_ramanujan_prime_lower(n) 2017-04-14 nth_ramanujan_prime_approx(n) 2017-04-14 ramanujan_prime_count_upper(n) 2017-04-14 ramanujan_prime_count_lower(n) 2017-04-14 ramanujan_prime_count_approx(n) 2017-04-14 entropy_bytes(n) 2017-04-10 csrand(str) 2017-04-05 rand(UV) 2017-04-05 urandomm 2017-04-05 urandomb 2017-04-05 srand 2017-04-05 random_bytes 2017-04-05 irand64 2017-04-05 irand 2017-04-05 drand ------------------------------------------------------------------------------- 2017-03-12 v0.61 2017-02-22 is_semiprime(n) 2017-02-21 inverse_li(n) 2017-01-10 is_pillai(n) ------------------------------------------------------------------------------- 2016-10-09 v0.60 2016-08-30 vecfirstidx {...} @n ------------------------------------------------------------------------------- 2016-08-03 v0.59 2016-07-26 rootint(n,k) 2016-07-24 is_euler_plumb_pseudoprime 2016-07-21 logint(n,b) 2016-07-21 ramanujan_sum(k,n) 2016-07-10 is_prime_power(n) ------------------------------------------------------------------------------- 2016-05-21 v0.58 2016-05-18 sieve_range(n, width, depth) 2016-05-03 hclassno 2016-04-29 is_quasi_carmichael 2016-04-22 is_primitive_root 2016-01-14 is_euler_pseudoprime 2016-01-10 sqrtmod 2016-01-05 addmod 2016-01-05 mulmod 2016-01-05 divmod 2016-01-05 powmod ------------------------------------------------------------------------------- 2016-01-03 v0.57 2016-01-01 formultiperm {...} \@n 2015-12-23 vecnone vecall vecany vecnotall vecfirst 2015-12-20 ramanujan_prime_count 2015-12-18 todigits 2015-12-18 todigitstring 2015-12-18 fromdigits ------------------------------------------------------------------------------- 2015-12-13 v0.56 2015-12-11 forcomp { ... } n[,{...}] 2015-11-02 is_carmichael(n) ------------------------------------------------------------------------------- 2015-10-19 v0.55 ------------------------------------------------------------------------------- 2015-10-14 v0.54 2015-10-04 sieve_prime_cluster ------------------------------------------------------------------------------- 2015-09-05 v0.53 2015-09-02 sumdigits(n,base) 2015-08-12 ramanujan_tau(n) ------------------------------------------------------------------------------- 2015-08-09 v0.52 2015-07-23 is_square_free(n) ------------------------------------------------------------------------------- 2015-06-21 v0.51 2015-06-13 is_frobenius_khashin_pseudoprime 2015-06-12 sum_primes 2015-06-12 print_primes 2015-05-23 is_catalan_pseudoprime ------------------------------------------------------------------------------- 2015-05-03 v0.50 2015-04-24 is_ramanujan_prime 2015-04-22 nth_ramanujan_prime 2015-01-28 vecextract 2014-12-29 ramanujan_primes 2014-12-27 sqrtint 2014-12-25 harmfrac 2014-12-25 harmreal ------------------------------------------------------------------------------- 2014-11-30 v0.49 ------------------------------------------------------------------------------- 2014-11-28 v0.48 2014-11-18 lucasu(p,q,k) 2014-11-18 lucasv(p,q,k) ------------------------------------------------------------------------------- 2014-11-18 v0.47 2014-11-06 is_mersenne_prime ------------------------------------------------------------------------------- 2014-10-21 v0.46 2014-10-20 hammingweight 2014-10-20 vecreduce ------------------------------------------------------------------------------- 2014-09-26 v0.45 2014-09-25 stirling 2014-09-22 vecprod 2014-09-21 Pi 2014-09-19 bernfrac 2014-09-19 bernreal 2014-09-18 vecmin 2014-09-18 vecmax 2014-09-16 LambertW 2014-09-16 is_perrin_pseudoprime 2014-09-16 is_frobenius_pseudoprime 2014-09-08 is_bpsw_prime 2014-09-07 factorial 2014-09-05 forperm 2014-09-05 forcomb ------------------------------------------------------------------------------- 2014-08-16 v0.43 2014-08-04 twin_primes 2014-07-30 foroddcomposites ------------------------------------------------------------------------------- 2014-06-18 v0.42 2014-06-02 chinese 2014-06-02 gcdext ------------------------------------------------------------------------------- 2014-05-18 v0.41 2014-05-12 binomial 2014-05-11 vecsum 2014-05-10 forpart 2014-05-05 invmod 2014-04-28 valuation ------------------------------------------------------------------------------- 2014-04-21 v0.40 2014-04-10 nth_twin_prime_approx 2014-03-27 nth_twin_prime 2014-03-20 twin_prime_count_approx 2014-03-20 twin_prime_count 2014-03-06 random_shawe_taylor_prime_with_cert 2014-03-06 random_shawe_taylor_prime ------------------------------------------------------------------------------- 2014-03-01 v0.39 ------------------------------------------------------------------------------- 2014-02-28 v0.38 2014-01-30 is_power ------------------------------------------------------------------------------- 2014-01-13 v0.36 2014-01-07 znlog 2014-01-06 legendre_phi 2014-01-06 lcm 2014-01-03 gcd 2013-12-27 kronecker 2013-12-27 znprimroot 2013-12-18 forcomposites 2013-12-18 fordivisors ------------------------------------------------------------------------------- 2013-12-08 v0.35 ------------------------------------------------------------------------------- 2013-11-19 v0.34 ------------------------------------------------------------------------------- 2013-11-18 v0.33 2013-10-18 partitions(n) 2013-10-18 liouville(n) 2013-10-18 factor_exp(n) ------------------------------------------------------------------------------- 2013-10-13 v0.32 2013-09-27 miller_rabin_random(n,k) 2013-09-19 prime_iterator_object 2013-09-12 znorder(a,n) 2013-08-13 carmichael_lambda(n) ------------------------------------------------------------------------------- 2013-08-07 v0.31 ------------------------------------------------------------------------------- 2013-08-06 v0.30 2013-07-12 pplus1_factor(n) 2013-07-04 is_almost_extra_strong_lucas_pseudoprime(n) 2013-06-24 lucas_sequence(n,P,Q,k) 2013-06-24 is_frobenius_underwood_pseudoprime(n) ------------------------------------------------------------------------------- 2013-05-30 v0.29 2013-05-29 is_extra_strong_lucas_pseudoprime(n) 2013-05-29 is_lucas_pseudoprime(n) 2013-05-29 is_pseudoprime(n,base) ------------------------------------------------------------------------------- 2013-05-23 v0.28 2013-05-21 prime_iterator([start]) 2013-05-20 forprimes {...} [start,]end ------------------------------------------------------------------------------- 2013-05-20 v0.27 ------------------------------------------------------------------------------- 2013-04-21 v0.26 2013-04-12 prime_certificate(n) 2013-04-10 verify_prime(cert) ------------------------------------------------------------------------------- 2013-03-19 v0.25 ------------------------------------------------------------------------------- 2013-03-10 v0.24 ------------------------------------------------------------------------------- 2013-03-05 v0.23 2013-03-01 chebyshev_theta(n) 2013-03-01 chebyshev_psi(n) 2013-02-27 consecutive_integer_lcm(n) ------------------------------------------------------------------------------- 2013-02-26 v0.22 ------------------------------------------------------------------------------- 2013-02-22 v0.21 2013-02-22 exp_mangoldt(n) 2013-02-21 mertens(n) ------------------------------------------------------------------------------- 2013-02-03 v0.20 ------------------------------------------------------------------------------- 2013-02-01 v0.19 ------------------------------------------------------------------------------- 2013-01-14 v0.18 2013-01-14 random_strong_prime(n) ------------------------------------------------------------------------------- 2012-12-20 v0.17 ------------------------------------------------------------------------------- 2012-12-11 v0.16 ------------------------------------------------------------------------------- 2012-12-09 v0.15 ------------------------------------------------------------------------------- 2012-11-29 v0.14 2012-11-22 jordan_totient(n,k) 2012-11-22 divisor_sum(n[,k]) ------------------------------------------------------------------------------- 2012-11-19 v0.13 ------------------------------------------------------------------------------- 2012-11-17 v0.12 2012-11-17 is_aks_prime(n) 2012-11-05 is_provable_prime(n) 2012-08-02 primorial(n) 2012-08-02 pn_primorial(n) 2012-07-23 RiemannZeta(x) ------------------------------------------------------------------------------- 2012-07-23 v0.11 ------------------------------------------------------------------------------- 2012-07-16 v0.10 2012-07-07 random_maurer_prime(bits) 2012-07-03 is_strong_lucas_pseudoprime(n) 2012-06-29 moebius(n) 2012-06-29 euler_phi(n) 2012-06-25 is_strong_pseudoprime(n,base) 2012-06-19 all_factors(n) [renamed to divisors in v0.36] 2012-06-10 ExponentialIntegral(x) 2012-06-10 LogarithmicIntegral(x) 2012-06-10 RiemannR(x) 2012-06-07 random_nbit_prime(bits) 2012-06-07 random_ndigit_prime(digits) 2012-06-07 random_prime([lo,]hi) ------------------------------------------------------------------------------- 2012-06-04 v0.01 Initial release primes([lo,]hi) is_prime(n) is_prob_prime(n) prime_count([lo,]hi) nth_prime(n) next_prime(n) prev_prime(n) factor(n) prime_count_approx(n) prime_count_lower(n) prime_count_upper(n) nth_prime_approx(n) nth_prime_lower(n) nth_prime_upper(n) Math-Prime-Util-0.74/entropy.c000644 000765 000024 00000004203 15145577415 016251 0ustar00danastaff000000 000000 #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.74/.travis.yml000644 000765 000024 00000001523 13667653334 016522 0ustar00danastaff000000 000000 language: "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.74/powerfree.c000644 000765 000024 00000013653 15145577415 016560 0ustar00danastaff000000 000000 #include #include #include #define FUNC_isqrt 1 #define FUNC_ipow 1 #define FUNC_ctz 1 #include "ptypes.h" #include "constants.h" #include "powerfree.h" #include "util.h" #include "factor.h" #include "real.h" static INLINE UV T(UV n) { return (n+1)/2 * (n|1); } static UV fprod(UV n, UV r) { factored_t nf; UV P; uint32_t i; nf = factorint(n); for (P = 1, i = 0; i < nf.nfactors; i++) P *= 1 - ipow(nf.f[i], r); return P; } bool is_powerfree(UV n, uint32_t k) { factored_t nf; uint32_t i; if (k < 2 || n <= 1) return (n==1); if (k >= BITS_PER_WORD) return 1; if (n < (UVCONST(1) << (k-1))) return 1; if (n == ((n >> k) << k)) return 0; if (k == 2) return is_square_free(n); /* Try to quickly find common powers so we don't have to factor */ if (k == 3) { if ( !(n % 27) || !(n % 125) || !(n % 343) || !(n%1331) || !(n%2197) ) return 0; if (n < 4913) return 1; } /* A factor iterator would be good to use here */ nf = factorint(n); for (i = 0; i < nf.nfactors; i++) { if (nf.e[i] >= k) return 0; } return 1; } /* Basic method from https://arxiv.org/pdf/1107.4890.pdf */ static UV squarefree_count(UV n) { signed char* mu; IV *M, *Mx, Mxisum, mert; UV I, D, i, j, S1 = 0, S2 = 0; if (n < 4) return n; I = rootint(n, 5); /* times loglogn ^ (4/5) */ D = isqrt(n / I); mu = range_moebius(0, D); S1 += n; New(0, M, D+1, IV); M[0] = 0; M[1] = 1; mert = 1; for (i = 2; i <= D; i++) { if (mu[i] != 0) { S1 += mu[i] * (n/(i*i)); mert += mu[i]; } M[i] = mert; } Safefree(mu); Newz(0, Mx, I+1, IV); Mxisum = 0; for (i = I-1; i > 0; i--) { IV Mxi = 1; UV xi = isqrt(n/i); UV L = isqrt(xi); for (j = 1; j <= xi/(L+1); j++) Mxi -= M[j] * (xi/j - xi/(j+1)); for (j = 2; j <= L; j++) Mxi -= (xi/j <= D) ? M[xi/j] : Mx[j*j*i]; Mx[i] = Mxi; Mxisum += Mxi; } S2 = Mxisum - (I - 1) * M[D]; Safefree(Mx); Safefree(M); return S1 + S2; } UV powerfree_count(UV n, uint32_t k) { UV i, nk, count; if (k < 2) return (n >= 1); if (n < 4) return n; if (k == 2) return squarefree_count(n); count = n; nk = rootint(n, k); if (nk <= 100) { for (i = 2; i <= nk; i++) { int m = moebius(i); if (m != 0) count += m * (n / ipow(i, k)); } } else { signed char* mu = range_moebius(0, nk); for (i = 2; i <= nk; i++) if (mu[i] != 0) count += mu[i] * (n/ipow(i,k)); Safefree(mu); } return count; } UV powerfree_sum(UV n, uint32_t k) { UV i, nk, sum; if (k < 2) return (n >= 1); if (n >= (UVCONST(1) << (BITS_PER_WORD/2))) return 0; /* Overflow */ sum = T(n); nk = rootint(n, k); for (i = 2; i <= nk; i++) { int m = moebius(i); if (m != 0) { UV ik = (k==2) ? i*i : ipow(i,k); UV nik = n / ik; sum += m * ik * T(nik); } } return sum; } UV powerfree_part(UV n, uint32_t k) { factored_t nf; UV t, P; uint32_t i; if (k < 2 || n <= 1) return (n==1); if (k >= BITS_PER_WORD || n < (UVCONST(1) << (k-1))) return n; /* Pull all powers of two out */ t = ctz(n); P = n >> t; if ((t % k)) P <<= (t % k); nf = factorint(P); for (i = 0; i < nf.nfactors; i++) if (nf.e[i] >= k) P /= ipow(nf.f[i], nf.e[i] - (nf.e[i] % k)); return P; } UV powerfree_part_sum(UV n, uint32_t k) { UV j, nk, sum = 0; if (k < 2 || n <= 1) return (n >= 1); if (n >= (UVCONST(1) << (BITS_PER_WORD/2))) return 0; /* Overflow */ sum = T(n); nk = rootint(n,k); /* Using the factor iterator is overkill because of the limited range. */ if (nk <= 100) { for (j = 2; j <= nk; j++) sum += fprod(j,k) * T(n/ipow(j,k)); } else { UV P, *factors; factor_range_context_t fctx; int i, nfactors; fctx = factor_range_init(2, nk, 0); for (j = 2; j <= nk; j++) { nfactors = factor_range_next(&fctx); factors = fctx.factors; for (P = 1, i = 0; i < nfactors; i++) if (i == 0 || factors[i] != factors[i-1]) P *= 1 - ipow(factors[i], k); sum += P * T(n/ipow(j,k)); } factor_range_destroy(&fctx); } return sum; } #if BITS_PER_WORD == 64 #define MAX_PFC2 UVCONST(11214275663373200251) #define MAX_PFC3 UVCONST(15345982395028449439) #define MAX_PFC4 UVCONST(17043655258566511333) #else #define MAX_PFC2 UVCONST(2611027094) #define MAX_PFC3 UVCONST(3573014938) #define MAX_PFC4 UVCONST(3968285222) #endif UV nth_powerfree(UV n, uint32_t k) { long double zm; UV qk, count, diff, thresh, i; if (k < 2) return 0; if (n < 4) return n; /* Check for overflow. */ if (k == 2 && n > MAX_PFC2) return 0; if (k == 3 && n > MAX_PFC3) return 0; if (k >= 4 && n > MAX_PFC4) { if (k == 4) return 0; if (n > powerfree_count(UV_MAX,k)) return 0; } /* Step 1: Density ZM and expected value QK. */ zm = 1.0 + ld_riemann_zeta(k); qk = (UV)(zm * (long double) n + 0.5); thresh = (k <= 2) ? 200 : (k == 3) ? 60 : (k == 4) ? 2 : 1; for (i = 0; i < 10; i++) { /* Step 2: Initial count at QK and difference from goal. */ count = powerfree_count(qk, k); diff = (count >= n) ? count-n : n-count; /* Step 3: Update estimate using expected density. */ if (diff <= thresh) break; if (count > n) qk -= (UV)((long double)diff * zm); else qk += (UV)((long double)diff * zm); } /* Step 4: Get ourselves onto a powerfree number */ while (!is_powerfree(qk,k)) qk--; /* Step 5: Walk forwards or backwards until we get to the goal. */ while (count != n) { do { qk += (count < n) ? 1 : -1; } while (!is_powerfree(qk,k)); count += (count < n) ? 1 : -1; } return qk; } /******************************************************************************/ UV squarefree_kernel(UV n) { factored_t nf; UV P; uint32_t i; nf = factorint(n); for (P = 1, i = 0; i < nf.nfactors; i++) P *= nf.f[i]; return P; } Math-Prime-Util-0.74/perfect_powers.c000644 000765 000024 00000012314 15145577415 017602 0ustar00danastaff000000 000000 #include #include #include #include "ptypes.h" #include "constants.h" #include "perfect_powers.h" #define FUNC_log2floor 1 #define FUNC_ipow 1 #include "util.h" #include "inverse_interpolate.h" /******************************************************************************/ /* PERFECT POWERS */ /******************************************************************************/ bool is_perfect_power(UV n) { return (n <= 1 || powerof(n) > 1); } bool is_perfect_power_neg(UV n) { uint32_t k = powerof(n); /* An exponent other than 0,1,2,4,8,16,... is ok */ return (n <= 1 || (k > 2 && (k & (k-1)) != 0)); } bool is_perfect_power_iv(IV n) { if (n < -1) { uint32_t k = powerof(-n); return (k > 2 && (k & (k-1)) != 0); } return (n <= 1 || powerof(n) > 1); } static UV _next_perfect_power(UV n, bool only_oddpowers) { uint32_t k, kinit, kinc, log2n; UV best; if (n == 0) return 1; if (n == 1) return only_oddpowers ? 8 : 4; if (n >= MPU_MAX_PERFECT_POW) return 0; /* Overflow */ /* Should check for n >= max odd-power perfect power */ log2n = log2floor(n); kinit = only_oddpowers ? 3 : 2; kinc = only_oddpowers ? 2 : 1; best = ipow( rootint(n,kinit)+1, kinit); for (k = kinit+kinc; k <= 1+log2n; k += kinc) { UV c = ipow( rootint(n,k)+1, k); if (c < best && c > n) best = c; } return best; } static UV _prev_perfect_power(UV n, bool only_oddpowers) { uint32_t k, kinit, kinc, log2n; UV best; if (n <= 4) return (n > 1) - (n == 0); /* note possible -1 return */ if (n <= 8) return only_oddpowers ? 1 : 4; log2n = log2floor(n); kinit = only_oddpowers ? 3 : 2; kinc = only_oddpowers ? 2 : 1; best = 8; for (k = kinit; k <= log2n; k += kinc) { UV r = rootint(n,k); UV c = ipow(r,k); if (c >= n) c = ipow(r-1,k); if (c > best && c < n) best = c; } return best; } UV next_perfect_power(UV n) { return _next_perfect_power(n, 0); } UV next_perfect_power_neg(UV n) { return _prev_perfect_power(n, 1); } UV prev_perfect_power(UV n) { return _prev_perfect_power(n, 0); } UV prev_perfect_power_neg(UV n) { return _next_perfect_power(n, 1); } /* Should we have a generator / sieve? This is a common exercise using PQs. */ UV perfect_power_count_range(UV lo, UV hi) { if (hi < 1 || hi < lo) return 0; return perfect_power_count(hi) - ((lo <= 1) ? 0 : perfect_power_count(lo-1)); } static const signed char _moebius[65] = {0,1,-1,-1,0,-1,1,-1,0,0,1,-1,0,-1,1,1,0,-1,0,-1,0,1,1,-1,0,0,1,0,0,-1,-1,-1,0,1,1,1,0,-1,1,1,0,-1,-1,-1,0,0,1,-1,0,0,0,1,0,-1,0,1,0,1,1,-1,0,-1,1,0,0}; /* n A069623; 10^n A070428 */ UV perfect_power_count(UV n) { uint32_t k, log2n; UV sum; if (n < 8) return 0+(n>=1)+(n>=4); log2n = log2floor(n); for (sum = 1, k = 2; k <= log2n; k++) if (_moebius[k]) sum -= _moebius[k] * (rootint(n, k) - 1); return sum; } /* About 50 ns per call for exact, so not really worth truncation. */ UV perfect_power_count_lower(UV n) { return perfect_power_count(n); } UV perfect_power_count_upper(UV n) { return perfect_power_count(n); } UV perfect_power_count_approx(UV n) { return perfect_power_count(n); } UV nth_perfect_power_lower(UV n) { double pp; if (n <= 1) return n; if (n >= MPU_MAX_PERFECT_POW_IDX) return MPU_MAX_PERFECT_POW; pp = pow(n,2.) + (13./3.)*pow(n,4./3.) + (32./15.)*pow(n,16./15.); pp += -2*pow(n, 5./ 3.) - 2*pow(n, 7./ 5.) - 2*pow(n, 9./ 7.) + 2*pow(n,12./10.); pp += -2*pow(n,13./11.) - 2*pow(n,15./13.); pp += 5.5; if (pp >= UV_MAX) return UV_MAX; return (UV)pp; } UV nth_perfect_power_upper(UV n) { double pp; if (n <= 1) return n; if (n >= MPU_MAX_PERFECT_POW_IDX) return MPU_MAX_PERFECT_POW; pp = pow(n,2.) + (13./3.)*pow(n,4./3.) + (32./15.)*pow(n,16./15.); pp += -2*pow(n, 5./ 3.) - 2*pow(n, 7./ 5.) - 2*pow(n, 9./ 7.) + 2*pow(n,12./10.); pp += /* skip 11 and 13 */ 2*pow(n,16./14.); pp -= 3.5; if (pp >= UV_MAX) return UV_MAX; return (UV)pp; } UV nth_perfect_power_approx(UV n) { double pp; if (n <= 1) return n; if (n >= MPU_MAX_PERFECT_POW_IDX) return MPU_MAX_PERFECT_POW; pp = pow(n,2.) + (13./3.)*pow(n,4./3.) + (32./15.)*pow(n,16./15.); #if 0 uint32_t q; for (q = 3; q <= 26; q++) { int m = moebius(q); if (m == 0 || q == 2 || q == 6 || q == 30) continue; pp += m * 2.0 * pow(n, (double)(q+2)/(double)q); } #endif pp += -2*pow(n, 5./ 3.) - 2*pow(n, 7./ 5.) - 2*pow(n, 9./ 7.) + 2*pow(n,12./10.); pp += -2*pow(n,13./11.) - 2*pow(n,15./13.) + 2*pow(n,16./14.) + 2*pow(n,17./15.); pp -= 0.48 * pow(n,19.0/17.0); pp -= 1.5; if (pp >= UV_MAX) return UV_MAX; return (UV)pp; } UV nth_perfect_power(UV n) { UV g, count; if (n <= 1) return n; /* 1,4,8,9,16,25,... */ if (n >= MPU_MAX_PERFECT_POW_IDX) return MPU_MAX_PERFECT_POW; g = interpolate_with_approx(n, &count, 1000, &nth_perfect_power_approx, &perfect_power_count, 0); if (g > MPU_MAX_PERFECT_POW) g = MPU_MAX_PERFECT_POW; if (count >= n) { for (g = prev_perfect_power(g+1); count > n; count--) g = prev_perfect_power(g); } else { for (; count < n; count++) g = next_perfect_power(g); } return g; } Math-Prime-Util-0.74/mathl.h000644 000765 000024 00000004003 15150227056 015646 0ustar00danastaff000000 000000 #ifndef MPU_MATHL_H #define MPU_MATHL_H #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. A few * systems lacked support for years (e.g. NetBSD and FreeBSD). */ #undef HAS_LDBL_FUNCS #if defined(__FreeBSD__) && (__FreeBSD_version < 1000034) /* Added in 2013. */ #elif _MSC_VER || defined(__IBMC__) || defined(__IBMCPP__) # define HAS_LDBL_FUNCS 1 #elif defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L # define HAS_LDBL_FUNCS 1 #else /* We don't have them */ #endif #ifdef HAS_LDBL_FUNCS /* 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); * extern long double log1pl(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) ) #define log1pl(x) (long double) log1p( (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 #endif Math-Prime-Util-0.74/real.c000644 000765 000024 00000116143 15151725604 015473 0ustar00danastaff000000 000000 #include #include #include #define FUNC_log2floor 1 #include "ptypes.h" #include "sieve.h" #include "util.h" #include "real.h" #include "mathl.h" /* 1) Naive FP summation * 2) Kahan summation * 3) Neumaier, also called KBN or "improved Kahan–Babuška algorithm" * 4) Klein, also called KB2 or second-order Kahan-Babuška */ #define SUM_TYPE_NORMAL 0 #define SUM_TYPE_KAHAN 0 #define SUM_TYPE_NEUMAIER 1 #define SUM_TYPE_KLEIN 0 #if SUM_TYPE_NORMAL #define SUM_INIT(s) LNV s = 0.0; #define SUM_ADD(s, term) s = s + (term); #define SUM_FINAL(s) s #endif #if SUM_TYPE_KAHAN #define SUM_INIT(s) \ LNV s ## _y, s ## _t; \ LNV s ## _c = 0.0; \ LNV s = 0.0; #define SUM_ADD(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) #define SUM_FINAL(s) s #endif #if SUM_TYPE_NEUMAIER #define SUM_INIT(s) \ LNV s ## _c = 0.0; \ LNV s = 0.0; #define SUM_ADD(s, term) \ do { \ LNV _term = term; \ LNV _t = s + _term; \ if ( fabslnv(s) >= fabslnv(_term) ) \ s ## _c += (s - _t) + _term; \ else \ s ## _c += (_term - _t) + s; \ s = _t; \ } while (0) #define SUM_FINAL(s) (s + s ## _c) #endif #if SUM_TYPE_KLEIN #define SUM_INIT(s) \ LNV s ## _cs = 0.0; \ LNV s ## _ccs = 0.0; \ LNV s = 0.0; #define SUM_ADD(s, term) \ do { \ LNV _term = term; \ LNV _c, _cc, _t = s + _term; \ if ( fabslnv(s) >= fabslnv(_term) ) \ _c = (s - _t) + _term; \ else \ _c = (_term - _t) + s; \ s = _t; \ _t = s ## _cs + _c; \ if ( fabslnv(s ## _cs) >= fabslnv(_c) ) \ _cc = (s ## _cs - _t) + _c; \ else \ _cc = (_c - _t) + s ## _cs; \ s ## _cs = _t; \ s ## _ccs += _cc; \ } while (0) #define SUM_FINAL(s) (s + s ## _cs + s ## _ccs) #endif 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])) /******************************************************************************/ /* REAL FUNCTIONS (EI,LI,etc.) */ /******************************************************************************/ /* * 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. * "High-precision Computation of Uniform Asymptotic Expansions for Special Functions" * by Guillermo Navas-Palencia (2019) * * Any mistakes here are mine. This code has not been rigorously verified. * Alternates: Navas-Palencia, Boost, MPFR, Pari/GP, Arb. * * We are trying to get close to maximum precision for all x with double, long * double, and quadmath. Hence the rational Chebyshev approximations should * not be used with quadmath (unless they are are modified). * * Performance, i7-6700HQ, 2.6GHz, 1e-9 to 1000 step 0.001 * range x > 0: * 0.22 microseconds, NV = double max rel error 1.4e-14 * 0.19 microseconds, NV = long double max rel error 4.3e-17 * 18.97 microseconds, NV = quad max rel error 4.4e-32 * range x < 0: * 0.18 microseconds, NV = double max rel error 1.4e-14 * 0.15 microseconds, NV = long double max rel error 1.2e-17 * 9.31 microseconds, NV = quad max rel error 1.7e-32 * * The maximum error is near the root 0.3725074... * The relative error profile for double precision is essentially identical * to the Navas-Palencia expintei(x) function. * Using long double on x86 improves the results with no time penalty. * Using quadmath gives improved results at a substantial time penalty. */ static LNV const euler_mascheroni = LNVCONST(0.57721566490153286060651209008240243104215933593992); static LNV const li2 = LNVCONST(1.045163780117492784844588889194613136522615578151); /* Rational Chebyshev approximation (Cody, Thacher), good for -1 < x < 0 */ static LNV _ei_chebyshev_neg(const LNV x) { 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]))))); return loglnv(-x) - sumn/sumd; } /* Cody / Thacher rational Chebyshev for x > 24 */ static LNV _ei_chebyshev_pos24(const LNV x) { 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; uint32_t n; for (n = 0; n <= 8; n++) frac = Q2[n] / (P2[n] + x + frac); frac += P2[9]; return explnv(x) * (invx + invx*invx*frac); } #if 0 /* Continued fraction, good for x < -1 */ static LNV _ei_cfrac_neg(const LNV x) { LNV lc = 0, ld = LNV_ONE / (LNV_ONE - x); LNV val = ld * (-explnv(x)); uint32_t n; for (n = 1; n <= 20000; n++) { LNV old, t, n2 = n * n; t = (LNV)(2*n + 1) - x; 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; } return val; } #endif /* eint_v using Laguerre series, Navas-Palencia (2019). */ static LNV _eintv_laguerre_series(const LNV v, const LNV x) { LNV L_k = 1.0, L_k1 = x + v; LNV q, r, u = LNV_ONE, d = LNV_ONE; uint32_t k; SUM_INIT(sum); SUM_ADD(sum, (LNV_ONE/L_k1)); for (k = 1; k < 500; k++) { u *= v + k - 1; d *= 1 + k; q = L_k1 * (x + 2*k + v) / (k + 1) - L_k * (k + v - 1) / (k + 1); r = u / (d * (q * L_k1)); SUM_ADD(sum, r); L_k = L_k1; L_k1 = q; if (fabslnv(r) < 0.1 * LNV_EPSILON) break; } return SUM_FINAL(sum) * explnv(-x); } /* Convergent series for small negative x through medium positive x */ static LNV _ei_series_convergent(LNV const x) { LNV term, fact_n = x; uint32_t n; SUM_INIT(sum); for (n = 2; n <= 400; n++) { LNV invn = LNV_ONE / n; fact_n *= (LNV)x * invn; term = fact_n * invn; SUM_ADD(sum, term); /* printf("C after adding %.20Lf, val = %.20Lf\n", term, SUM_FINAL(sum)); */ if (fabslnv(term) < LNV_EPSILON*fabslnv(SUM_FINAL(sum))) break; } SUM_ADD(sum, euler_mascheroni); SUM_ADD(sum, loglnv(fabslnv(x))); SUM_ADD(sum, x); return SUM_FINAL(sum); } /* Asymptotic divergent series, for large positive x */ static LNV _ei_series_divergent(LNV const x) { LNV invx = LNV_ONE / x, term = invx; unsigned int n; SUM_INIT(sum); for (n = 2; n <= 400; n++) { LNV last_term = term; term = term * ( (LNV)n * invx ); if (term < LNV_EPSILON*SUM_FINAL(sum)) break; if (term < last_term) { SUM_ADD(sum, term); /* printf("A after adding %.20llf, sum = %.20llf\n", term, SUM_FINAL(sum)); */ } else { SUM_ADD(sum, (-last_term/1.07) ); /* printf("A after adding %.20llf, sum = %.20llf\n", -last_term/1.07, SUM_FINAL(sum)); */ break; } } SUM_ADD(sum, invx); SUM_ADD(sum, LNV_ONE); return explnv(x) * SUM_FINAL(sum) * invx; } NV Ei(NV x) { bool nv_is_quad = LNV_IS_QUAD; /* make C2X happy */ 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 < 0) { if (x >= -1.0 && !nv_is_quad) return _ei_chebyshev_neg(x); else if (x < -0.80) return -_eintv_laguerre_series(1, -x); else return _ei_series_convergent(x); } else { if (x < (-2 * loglnv(LNV_EPSILON))) return _ei_series_convergent(x); if (x >= 24 && (!nv_is_quad || x <= 43.2)) return _ei_chebyshev_pos24(x); else return _ei_series_divergent(x); } } 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)); } 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 if (Li(r) < lx) { 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, 1e-12) - 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 { SUM_INIT(sum); /* Simple defining series, works well. */ for (i = 5; i <= 1000000; i++) { long double term = powl(i, -x); SUM_ADD(sum, term); if (term < LDBL_EPSILON*SUM_FINAL(sum)) break; } SUM_ADD(sum, powl(4, -x) ); SUM_ADD(sum, powl(3, -x) ); SUM_ADD(sum, powl(2, -x) ); return SUM_FINAL(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 eps) { long double part_term, term, flogx, ki, old_sum; unsigned int k; SUM_INIT(sum); if (x <= 0) croak("Invalid input to RiemannR: x must be > 0"); if (eps < LDBL_EPSILON) eps = LDBL_EPSILON; if (x > 1e19) { const signed char* amob = range_moebius(0, 100); SUM_ADD(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_FINAL(sum); SUM_ADD(sum, term); if (fabslnv(SUM_FINAL(sum) - old_sum) <= eps) break; } Safefree(amob); return SUM_FINAL(sum); } SUM_ADD(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_FINAL(sum); SUM_ADD(sum, term); /* printf("R %5d after adding %.18Lg, sum = %.19Lg (%Lg)\n", k, term, sum, fabsl(sum-old_sum)); */ if (fabslnv(SUM_FINAL(sum) - old_sum) <= eps) break; } return SUM_FINAL(sum); } /* Options for LambertW initial approximation: * * - Four regions, we used before: * Pade(3,2), Winitzki 2003, Vargas 2013, Corless 1993 * Has issues near -1/e but ok around zero. * * - Iacono and Boyd (2017). Very simple function over whole range. * Doesn't work right very near -1/e and around zero. * * - Vazquez-Leal et al. (2019). Divides into four regions, power * series for each. Great results. Also has issues near -1/e and zero. * * We use known solutions for near -1/e and around zero. See Fukushima (2013) * and Johannson (2017,2020) for lots of discussion and solutions. * Use Vazquez-Leal (PSEM Approximations) for the rest. */ static long double _lambertw_approx(long double x) { long double w, k1, k2, k3; if (x < -0.312) { /* Use Puiseux series, e.g. Verberic 2009, Boost, Johannson (2020). */ /* Near the branch point. See Fukushima (2013) section 2.5. */ k2 = 2.0L * (1.0L + 2.7182818284590452353603L * x); if (k2 <= 0) return -1.0L + 1*LDBL_EPSILON; k1 = sqrtl(k2); w = -1.0L + (1.0L + (-1.0L/3.0L + (11.0L/72.0L + (-43.0L/540.0L + (769.0L/17280.0L + (-221.0L/8505.0L + (680863.0L/43545600.0L + (-1963.0L/204120.0L + 226287557.0L/37623398400.0L * k1) * k1) * k1) * k1) * k1) * k1) * k1) * k1) * k1; } else if (x > -0.14 && x < 0.085) { /* Around zero. See Fukushima (2013) section 2.6. */ w = (1.0L + (-1.0L + (3.0L/2.0L + (-8.0L/3.0L + (125.0L/24.0L + (-54.0L/5.0L + (16807.0L/720.0L + (-16384.0L/315.0L + 531441.0L/4480.0L * x) * x) * x) * x) * x) * x) * x) * x) * x; } else if (x < 1) { /* This and the rest from Vazquez-Leal et al. (2019). */ k1 = sqrtl(1.0L + 2.7182818284590452353603L * x); k2 = 0.33333333333333333333333L + 0.70710678118654752440084L / k1 - 0.058925565098878960366737L * k1 + (x + 0.36787944117144L) * (0.050248489761611L + (0.11138904851051 + 0.040744556245195L * x) * x) / (1.0L + (2.7090878606183L + (1.5510922597820L + 0.095477712183841L * x) * x) * x); w = -(k2-1)/k2; } else if (x < 40) { k1 = 1.0L + (5.950065500550155L + (13.96586471370701L + (10.52192021050505L + (3.065294254265870L + 0.1204576876518760L * x) * x) * x) * x) * x; w = 0.1600049638651493L * logl(k1); } else if (x < 20000) { k1 = 1.0L + (-3.16866642511229e11L + (3.420439800038598e10L + (-1.501433652432257e9L + (3.44887729947585e7L + (-4.453783741137856e5L + (3257.926478908996L + (-10.82545259305382L + (0.6898058947898353e-1L + 0.4703653406071575e-4L * x) * x) * x) * x) * x) * x) * x) * x) * x; w = 0.9898045358731312e-1L * logl(k1); } else { k1 = 1.0L / (1.0L + logl(1.0L + x)); k2 = 1.0L / k1; k3 = logl(k2); w = k2-1-k3+(1+k3+(-1/2+(1/2)*k3*k3 +(-1/6+(-1+(-1/2+ (1/3) * k3) * k3) * k3) * k1) * k1) * k1; } 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); /* TODO: this section might not be best for quad precision */ /* If input is too small, return .99999.... */ /* if (w <= -1.0L) return -1.0L + LDBL_EPSILON; */ /* For very small inputs, don't iterate, return approx directly. */ if (x < -0.36768) return w; #if 0 /* Halley */ long double 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; if (isnan(wen)) return 0; 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 /* With long double = 64-bit double, we have 15 digits precision * near the branch point, and 16 over the rest of the range. * With long double = x86 extended precision, we have over 17 digits * over the entire range. * Correcting to the exact LDBL_EPSILON does not improve this. */ return w; } /******************************************************************************/ /* Chebyshev PSI / THETA */ /******************************************************************************/ NV chebyshev_psi(UV n) { UV k; SUM_INIT(sum); for (k = log2floor(n); k > 0; k--) { SUM_ADD(sum, chebyshev_theta(rootint(n,k))); } return SUM_FINAL(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; SUM_INIT(sum); if (n < 500) { for (i = 1; (tp = primes_tiny[i]) <= n; i++) { SUM_ADD(sum, loglnv(tp)); } return SUM_FINAL(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 { SUM_ADD(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 ) { SUM_ADD(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)) { SUM_ADD(sum, loglnv(prod)); prod = LNV_ONE; i = 0; } } END_DO_FOR_EACH_SIEVE_PRIME } if (prod > 1.0) { SUM_ADD(sum, loglnv(prod)); prod = LNV_ONE; } #endif end_segment_primes(ctx); if (initial_sum > 0) SUM_ADD(sum, initial_sum); return SUM_FINAL(sum); } /******************************************************************************/ /* Other */ /******************************************************************************/ #if 0 /* This is the de Bruijn approximation, not exact! */ static long double dickman_rho(long double u) { int i; long double zeta; if (u <= 1) return 1; if (u <= 2) return 1-logl(u); /* Also see: * Granville 2008 https://dms.umontreal.ca/~andrew/PDF/msrire.pdf * Gorodetsky 2022 https://arxiv.org/pdf/2212.01949.pdf * van Hoek 2019 https://studenttheses.uu.nl/bitstream/handle/20.500.12932/32867/Masterscriptie%20Bart%20van%20Hoek.pdf */ /* Calculate zeta. See Bach and Sorenson (2013) page 10 */ zeta = 2*(u-1); for (i = 0; i < 7; i++) { long double uz1 = 1 + u*zeta; zeta = zeta - ( (zeta-logl(uz1))*uz1 ) / (uz1-u); } /* Alternately: zeta = -1/u - LambertW1(-exp(-1/u)/u) */ return expl(-u*zeta+Ei(zeta)) / (zeta * sqrtl(2*3.1415926535*u)); } #endif Math-Prime-Util-0.74/lucas_seq.c000644 000765 000024 00000016632 15154713505 016531 0ustar00danastaff000000 000000 #include #include #include #include #include "ptypes.h" #include "lucas_seq.h" #include "mulmod.h" #include "util.h" /* TODO: primality.c might be able to call these more often */ /* TODO: montmath version of fastest, e.g. lucasvmod */ /******************************************************************************/ /* 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 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; 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), addmod(Qh,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), addmod(Ql, 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), addmod(Ql, Ql, n), n); Ql = sqrmod(Ql, n); } *Uret = Uh; *Vret = Vl; } /* 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) { MPUassert(n > 0, "lucas_sequence: modulus n must be > 0"); if (n == 1) { *Uret = *Vret = *Qkret = 0; return; } lucasuvmod(Uret, Vret, ivmod(P,n), ivmod(Q,n), k, n); *Qkret = powmod(ivmod(Q,n), k, n); } void lucasuvmod(UV* Uret, UV* Vret, UV P, UV Q, UV k, UV n) { UV U, V, b, D, invD; MPUassert(n > 0, "lucasuvmod: modulus n must be > 0"); if (n == 1) { *Uret = *Vret = 0; return; } if (k == 0) { *Uret = 0; *Vret = 2 % n; return; } if (P >= n) P %= n; if (Q >= n) Q %= n; D = submod( mulmod(P, P, n), mulmod(4, Q, n), n); if (D == 0 && (b = divmod(P,2,n)) != 0) { *Uret = mulmod(k, powmod(b, k-1, n), n); *Vret = mulmod(2, powmod(b, k, n), n); return; } { UV v = k; b = 0; while (v >>= 1) b++; } U = 1; V = P; invD = modinverse(D, n); if (Q == 1 && invD != 0) { /* Inverting D: 2 mulmods/bit instead of 2-5 */ U = mulsubmod(P,P,2,n); while (b--) { UV T = mulsubmod(U, V, P, n); if ( (k >> b) & UVCONST(1) ) { V = T; U = mulsubmod(U, U, 2, n); } else { U = T; V = mulsubmod(V, V, 2, n); } } U = addmod(U,U,n); U = submod(U, mulmod(V,P,n), n); U = mulmod(U, invD, n); } else if (P == 1 && Q == (n-1)) { /* code for P=1 Q=-1 in here */ alt_lucas_seq(&U, &V, n, P, Q, k); } else if ((n & 1) && (Q == 1 || (Q == (n-1)))) { int qs = (Q==1); while (b--) { U = mulmod(U, V, n); V = muladdmod(V, V, (qs) ? n-2 : 2, n); qs = 1; if ( (k >> b) & UVCONST(1) ) { UV t2 = mulmod(U, D, n); if (P != 1) U = mulmod(U, P, n); U = addmod(U, V, n); if (U & 1) { U = (n>>1) + (U>>1) + 1; } else { U >>= 1; } if (P != 1) V = mulmod(V, P, n); V = addmod(V, t2, n); if (V & 1) { V = (n>>1) + (V>>1) + 1; } else { V >>= 1; } qs = (Q==1); } } } else if (n & 1) { UV Qk = Q; 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, D, n); U = muladdmod(U, P, V, n); if (U & 1) { U = (n>>1) + (U>>1) + 1; } else { U >>= 1; } V = muladdmod(V, P, t2, n); if (V & 1) { V = (n>>1) + (V>>1) + 1; } else { V >>= 1; } Qk = mulmod(Qk, Q, n); } } } else { /* This handles everything */ alt_lucas_seq(&U, &V, n, P, Q, k); } *Uret = U; *Vret = V; } UV lucasvmod(UV P, UV Q, UV k, UV n) { UV D, b, U, V, Qk; MPUassert(n > 0, "lucas_sequence: modulus n must be > 0"); if (n == 1) return 0; if (k == 0) return 2 % n; if (P >= n) P = P % n; if (Q >= n) Q = Q % n; D = submod(mulmod(P, P, n), mulmod(4, Q, n), n); if (D == 0 && (b = divmod(P,2,n)) != 0) return mulmod(2, powmod(b, k, n), n); { UV v = k; b = 0; while (v >>= 1) b++; } if (Q == 1) { V = P; U = mulsubmod(P, P, 2, n); while (b--) { UV T = mulsubmod(U, V, P, n); if ( (k >> b) & UVCONST(1) ) { V = T; U = mulsubmod(U, U, 2, n); } else { U = T; V = mulsubmod(V, V, 2, n); } } } else if ((n % 2) == 0) { alt_lucas_seq(&U, &V, n, P, Q, k); } else { U = 1; V = P; Qk = Q; 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, D, n); U = muladdmod(U, P, V, n); if (U & 1) { U = (n>>1) + (U>>1) + 1; } else { U >>= 1; } V = muladdmod(V, P, t2, n); if (V & 1) { V = (n>>1) + (V>>1) + 1; } else { V >>= 1; } Qk = mulmod(Qk, Q, n); } } } return V; } UV lucasumod(UV P, UV Q, UV k, UV n) { UV U, V; lucasuvmod(&U, &V, P, Q, k, n); return U; } #define OVERHALF(v) ( (UV)((v>=0)?v:-v) > (UVCONST(1) << (BITS_PER_WORD/2-1)) ) bool lucasuv(IV* U, IV *V, IV P, IV Q, UV k) { IV Uh, Vl, Vh, Ql, Qh; int j, s, n; if (k == 0) { if (U) *U = 0; if (V) *V = 2; 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; } if (U) *U = Uh; if (V) *V = Vl; return 1; } Math-Prime-Util-0.74/inverse_interpolate.h000644 000765 000024 00000002546 15145577415 020647 0ustar00danastaff000000 000000 #ifndef MPU_FINVERSE_H #define MPU_FINVERSE_H #include "ptypes.h" extern UV inverse_interpolate(UV lo, UV hi, UV n, UV (*func)(UV mid), UV threshold); extern UV inverse_interpolate_k(UV lo, UV hi, UV n, UV k, UV (*func)(UV mid, UV k), UV threshold); /* * We need to be given: * n we're trying to find nth_xxx(n) * gcount we'll fill this in with the exact count at the return value * tol how close we care about getting * fnth(n) a callback for nth_xxx_approx(n) (approx nth) * fcnt(g) a callback for xxx_count(g) (exact count at g) * fis(g) a callback for is_xxx(g) * returns g, the nth_xxx(n) value * * if fis(g) is set, then the result is exact. After we narrow in using the * count and approximations, we step to the correct spot using the is_xxx(g) * function. If it is not set, then we will return once within the tolerance, * with the exact count returned as well. The caller may then want to use * fast next / prev functions to quickly step to the right spot. * * * Each caller can have slightly different optimization considerations. * For example, perfect_power has a super fast count function, so we want * to narrow down quickly. It also has fast next/prev functions. */ extern UV interpolate_with_approx(UV n, UV *gcount, UV tol, UV (*fnth)(UV n), UV (*fcnt)(UV n), bool (*fis)(UV n)); #endif Math-Prime-Util-0.74/META.json000644 000765 000024 00000005603 15154713772 016031 0ustar00danastaff000000 000000 { "abstract" : "Utilities related to prime numbers, including fast sieves and factoring", "author" : [ "Dana A Jacobsen " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.76, CPAN::Meta::Converter version 2.150012", "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::GMPz" : "0.68", "Math::Prime::Util::GMP" : "0.53" }, "requires" : { "Carp" : "0", "Config" : "0", "Exporter" : "5.57", "Math::BigFloat" : "1.59", "Math::BigInt" : "1.999814", "Math::Prime::Util::GMP" : "0.50", "Tie::Array" : "0", "XSLoader" : "0.01", "base" : "0", "constant" : "0", "perl" : "5.006002" } }, "test" : { "requires" : { "Test::More" : "0.96", "bignum" : "0.65" }, "suggests" : { "Test::Warn" : "0" } } }, "provides" : { "Math::Prime::Util" : { "file" : "lib/Math/Prime/Util.pm", "version" : "0.74" }, "Math::Prime::Util::ChaCha" : { "file" : "lib/Math/Prime/Util/ChaCha.pm", "version" : "0.74" }, "Math::Prime::Util::Entropy" : { "file" : "lib/Math/Prime/Util/Entropy.pm", "version" : "0.74" }, "Math::Prime::Util::MemFree" : { "file" : "lib/Math/Prime/Util/MemFree.pm", "version" : "0.74" }, "Math::Prime::Util::PP" : { "file" : "lib/Math/Prime/Util/PP.pm", "version" : "0.74" }, "Math::Prime::Util::PrimeArray" : { "file" : "lib/Math/Prime/Util/PrimeArray.pm", "version" : "0.74" }, "Math::Prime::Util::PrimeIterator" : { "file" : "lib/Math/Prime/Util/PrimeIterator.pm", "version" : "0.74" }, "ntheory" : { "file" : "lib/ntheory.pm", "version" : "0.74" } }, "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.74", "x_serialization_backend" : "JSON::PP version 4.16" } Math-Prime-Util-0.74/lib/Math/000755 000765 000024 00000000000 15154713771 016042 5ustar00danastaff000000 000000 Math-Prime-Util-0.74/lib/ntheory.pm000644 000765 000024 00000071027 15153423067 017201 0ustar00danastaff000000 000000 package ntheory; use strict; use warnings; BEGIN { $ntheory::AUTHORITY = 'cpan:DANAJ'; $ntheory::VERSION = '0.74'; } 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 ALSO See L for complete documentation. =head1 QUICK REFERENCE Tags: :all to import all functions (other than NON-EXPORTED below) :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 is_gaussian_prime(a,b) is a+bi a Gaussian 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 prime_powers([start,] end) array ref of prime powers twin_primes([start,] end) array ref of twin primes semi_primes([start,] end) array ref of semiprimes almost_primes(k, [start,] end) array ref of k-almost-primes omega_primes(k, [start,] end) array ref of k-omega-primes 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 next_prime_power(n) next prime power > n prev_prime_power(n) previous prime power < 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 prime count prime_power_count(n) count of prime powers <= n prime_power_count(start, end) count of prime powers in range prime_power_count_lower(n) fast lower bound for prime power count prime_power_count_upper(n) fast upper bound for prime power count prime_power_count_approx(n) fast approximate prime power count 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 nth_prime_power(n) the nth prime power (n=1 returns 2) nth_prime_power_lower(n) fast lower bound for nth prime power nth_prime_power_upper(n) fast upper bound for nth prime power nth_prime_power_approx(n) fast approximate nth prime power 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 approximate twin prime count 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 semiprime count nth_semiprime(n) the nth semiprime nth_semiprime_approx(n) fast approximate nth semiprime almost_prime_count(k,n) count of k-almost-primes almost_prime_count_approx(k,n) fast approximate k-almost-prime count almost_prime_count_lower(k,n) fast k-almost-prime count lower bound almost_prime_count_upper(k,n) fast k-almost-prime count upper bound nth_almost_prime(k,n) the nth number with exactly k factors nth_almost_prime_approx(k,n) fast approximate nth k-almost prime nth_almost_prime_lower(k,n) fast nth k-almost prime lower bound nth_almost_prime_upper(k,n) fast nth k-almost prime upper bound omega_prime_count(k,n) count divisible by exactly k primes nth_omega_prime(k,n) the nth number div by exactly k primes 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 inverse_li_nv(x) float 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 =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 foralmostprimes {...} k,[beg,],end loop over k-almost-primes in range forfactored {...} [start,] end loop with factors forsquarefree {...} [start,] end loop with factors of square-free n forsquarefreeint {...} [start,] end loop over 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([start]) returns a simple prime iterator prime_iterator_object([start]) returns a prime iterator object lastfor stop iteration of for.... loop =head2 RANDOM NUMBERS irand() random 32-bit integer irand64() random UV-bit integer (64 or 32) 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_safe_prime(n) random safe 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 vecuniq(@list) remove duplicates from list of integers vecsingleton(@list) remove all items that aren't unique vecfreq(@list) return hash of item => count from list vecsort(@list) numerically sort a list of integers vecsorti(\@list) in-place numeric sort a list ref vecextract(\@list, mask) select from list based on mask vecequal(\@list1, \@list2) compare equality of two array refs 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 vecmex(@list) return least non-neg value not in list vecpmex(@list) return least positive value not in list vecsample(k,@list) return k random elements of list vecslide { ... } @list calls block for each pair in list toset(...) convert to int set (unique sorted aref) setinsert(\@A,$v) insert integer v into integer set A setinsert(\@A,\@B) insert list B values into integer set A setremove(\@A,$v) remove integer v from integer set A setremove(\@A,\@B) remove list B values from integer set A setinvert(\@A,$v) if v is in set A, remove, otherwise add setinvert(\@A,\@B) invert for all values in integer set B setcontains(\@A,...) are list values all in int set A setcontains(\@A,\@B) is int set B a subset of int set A setcontainsany(\@A,...) are any list values in int set A setcontainsany(\@A,\@B) is any value in B in int set A setbinop { ... } \@A[,\@B] apply operation to all a,b [a:A,b:B] sumset(\@A[,\@B]) apply a+b to all a,b [a:A,b:B] setunion(\@A,\@B) union of two integer lists setintersect(\@A,\@B) intersection of two integer lists setminus(\@A,\@B) difference of two integer lists setdelta(\@A,\@B) symmetric difference of two int lists is_sidon_set(\@L) is integer list L a Sidon set is_sumfree_set(\@L) is integer list L a sum-free set set_is_disjoint(\@A,\@B) is set B disjoint from set A set_is_equal(\@A,\@B) is set B equal to set A set_is_subset(\@A,\@B) is set B a subset of set A set_is_proper_subset(\@A,\@B) is set B a proper subset of set A set_is_superset(\@A,\@B) is set B a superset of set A set_is_proper_superset(\@A,\@B) is set B a proper superset of set A set_is_proper_intersection(\@A,\@B) is set B a proper intersection of set A =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 tozeckendorf(n) convert n to Zeckendorf/Fibbinary fromzeckendorf(str) convert Zeckendorf binary str to num is_odd(n) return 1 if n is odd, 0 otherwise is_even(n) return 1 if n is even, 0 otherwise is_divisible(n,d) return 1 if n divisible by d is_congruent(n,c,d) return 1 if n is congruent to c mod d is_qr(a,n) return 1 if a is quadratic residue mod n 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_perfect_power(n) return 1 if n = c^k for c != 0, k > 1 is_prime_power(n) return k if n = p^k for prime p, k > 0 is_prime_power(n,\$p) as above but also set $p to p is_square_free(n) return true if no repeated factors is_powerfree(n[,k]) is n free of any k-th powers is_cyclic(n) does n have only one group of order n 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_almost_prime(k,n) does n have exactly k prime factors is_omega_prime(k,n) is n divisible by exactly k primes is_chen_prime(n) is n prime and n+2 prime or semiprime is_polygonal(n,k) is n a k-polygonal number is_polygonal(n,k,\$root) as above but also set $root is_sum_of_squares(n[,k]) is n a sum of k (def 2) squares is_congruent_number(n) is n a congruent number is_perfect_number(n) is n equal to sum of its proper divisors is_fundamental(d) is d a fundamental discriminant is_totient(n) is n = euler_phi(x) for some x is_lucky(n) is n a lucky number is_happy(n) if n a happy number, returns height is_happy(n,base,exponent) if n a S_b_e happy number, returns height is_smooth(n,k) is n a k-smooth number is_rough(n,k) is n a k-rough number is_powerful(n[,k]) is n a k-powerful number is_practical(n) is n a practical number is_delicate_prime(n) is n a digitally delicate prime powint(a,b) signed integer a^b mulint(a,b) signed integer a * b addint(a,b) signed integer a + b subint(a,b) signed integer a - b add1int(n) signed integer n + 1 sub1int(n) signed integer n - 1 divint(a,b) signed integer a / b (floor) modint(a,b) signed integer a % b (floor) cdivint(a,b) signed integer a / b (ceilint) divrem(a,b) return (quot,rem) of a/b (Euclidian) fdivrem(a,b) return (quot,rem) of a/b (floored) cdivrem(a,b) return (quot,rem) of a/b (ceiling) tdivrem(a,b) return (quot,rem) of a/b (truncated) lshiftint(n,k) left shift n by k bits rshiftint(n,k) right shift n by k bits (truncate) rashiftint(n,k) right shift n by k bits (floor) absint(n) integer absolute value negint(n) integer negation cmpint(a,b) integer comparison (like <=>) signint(n) integer sign (-1,0,1) 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],...) CRT returning remainder chinese2([a,mod1],[b,mod2],...) CRT returning (remainder,LCM) frobenius_number(@list) Frobenius Number of a set 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 subfactorial(n) count of derangements of n objects binomial(n,k) binomial coefficient binomialmod(n,k,m) binomial(n,k) mod m falling_factorial(x,n) falling factorial rising_factorial(x,n) rising factorial 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 negmod(a,n) -a mod n addmod(a,b,n) a + b mod n submod(a,b,n) a - b mod n mulmod(a,b,n) a * b mod n muladdmod(a,b,c,n) a * b + c mod n mulsubmod(a,b,c,n) a * b - c 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 rootmod(a,k,n) modular k-th root allsqrtmod(a,n) list of all modular square roots allrootmod(a,k,n) list of all modular k-th roots cornacchia(d,n) find x,y for x^2 + d * y^2 = n prime_bigomega(n) number of prime factors prime_omega(n) number of distinct prime factors moebius(n) Moebius function of n moebius(beg, end) list 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(k,n) Jordan's totient sumtotient(n) sum of Euler totient for 1 to n carmichael_lambda(n) Carmichael's Lambda function ramanujan_sum(k,n) Ramanujan's sum exp_mangoldt(n) exponential of Mangoldt function liouville(n) Liouville function sumliouville(n) sum of Liouville for 1 to n znorder(a,n) multiplicative order of a mod n znprimroot(n) smallest primitive root znlog(a, g, p) solve k in a = g^k mod p qnr(n) least quadratic non-residue 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) lucasuv(P, Q, k) (U_k,V_k) for Lucas(P,Q) lucasumod(P, Q, k, n) U_k for Lucas(P,Q) mod n lucasvmod(P, Q, k, n) V_k for Lucas(P,Q) mod n lucasuvmod(P, Q, k, n) (U_k,V_k,Q^k) for Lucas(P,Q) mod n lucas_sequence(n,P,Q,k) deprecated, use lucasuvmod instead pisano_period(n) The period of Fibonacci numbers 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 fubini(n) Fubini (Ordered Bell) number 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 lucky_numbers(n) array ref of lucky sieve up to n lucky_count(n) count of lucky numbers <= n lucky_count(start, end) count of lucky numbers in range lucky_count_lower(n) fast lower bound for lucky count lucky_count_upper(n) fast upper bound for lucky count lucky_count_approx(n) fast approximate lucky count nth_lucky(n) nth entry in lucky sieve nth_lucky_lower(n) fast lower bound for nth lucky number nth_lucky_upper(n) fast upper bound for nth lucky number nth_lucky_approx(n) fast approximate nth lucky number minimal_goldbach_pair(n) least prime p where n-p is also prime goldbach_pair_count(n) count of how many prime pairs sum to n goldbach_pairs(n) array of all p where p and n-p are prime powerful_numbers([lo,]hi[,k]) array ref of k-powerful lo to hi powerful_count(n[,k]) count of k-powerful numbers <= n sumpowerful(n[,k]) sum of k-powerful numbers <= n nth_powerful(n[,k]) the nth k-powerful number next_perfect_power(n) the next perfect power > n prev_perfect_power(n) the previous perfect power < n perfect_power_count(n) count of perfect powers <= n perfect_power_count(start, end) count of perfect powers in range perfect_power_count_lower(n) fast lower bound for perf power count perfect_power_count_upper(n) fast upper bound for perf power count perfect_power_count_approx(n) fast approximate perfect power count nth_perfect_power(n) the nth perfect power nth_perfect_power_lower(n) fast lower bound for nth perfect power nth_perfect_power_upper(n) fast upper bound for nth perfect power nth_perfect_power_approx(n) fast approximate nth perfect power next_chen_prime(n) next Chen prime > n smooth_count(n,k) count of k-smooth numbers <= n rough_count(n,k) count of k-rough numbers <= n powerfree_count(n[,k]) count of k-powerfree numbers <= n nth_powerfree(n[,k]) the nth k-powerfree number powerfree_sum(n[,k]) sum of k-powerfree numbers <= n powerfree_part(n[,k]) remove excess powers so n is k-free powerfree_part_sum(n[,k]) sum of k-powerfree parts for 1 to n squarefree_kernel(n) integer radical of |n| powersum(n,k) sum of kth powers from 1 to n =head2 RATIONALS contfrac(n,d) list of continued fraction for n/d from_contfrac(@A) return (p,q) rational from cfrac list next_calkin_wilf(n,d) next breadth-first CW rational next_stern_brocot(n,d) next breadth-first SB rational calkin_wilf_n(n,d) index of breadth-first CW rational stern_brocot_n(n,d) index of breadth-first SB rational nth_calkin_wilf(n) CW rational at breadth-first index n nth_stern_brocot(n) SB rational at breadth-first index n nth_stern_diatomic(n) Stern's Diatomic series; fusc(n) farey(n) list of Farey sequence order n farey(n,k) k'th entry of Farey sequence order n next_farey(n,[p,q]) next order-n rational after p/q farey_rank(n,[p,q]) number of F_n less than p/q =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 =head2 ADDITIONAL NON-EXPORTED trial_factor(n[,limit]) factor using only trial division fermat_factor(n) factor using only Fermat's method holf_factor(n[,rounds]) factor using only Hart's OLF lehman_factor(n) factor using only Lehman (limited size) squfof_factor(n[,rounds]) factor using only SQUFOF prho_factor(n[,rounds]) factor using only Pollard's Rho pbrent_factor(n[,rounds]) factor using only Brent/Pollard Rho pminus1_factor(n[,B1[,B2]]) factor using only P-1 pplus1_factor(n[,B]) factor using only P+1 cheb_factor(n[,B1[,initx]]) factor using only Chebyshev ecm_factor(n[,B1[,B2[,curves]]]) factor using only ECM _uvbits size of UV in bits _uvsize size of UV in bytes _ivsize size of IV in bytes _nvsize size of NV in bytes _nvmantbits bits stored in NV mantissa _nvmantdigits count of whole decimal digits in NV =head2 ADDITIONAL NON-EXPORTED C ONLY _segment_pi(n) prime count using only sieving _legendre_pi(n) prime count with Legendre method _meissel_pi(n) prime count with Meissel method _lehmer_pi(n) prime count with Lehmer method _LMO_pi(n) prime count with LMO method _LMOS_pi(n) prime count with extended LMO method =head1 COPYRIGHT Copyright 2011-2026 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.74/lib/Math/Prime/000755 000765 000024 00000000000 15154713771 017116 5ustar00danastaff000000 000000 Math-Prime-Util-0.74/lib/Math/Prime/Util/000755 000765 000024 00000000000 15154713771 020033 5ustar00danastaff000000 000000 Math-Prime-Util-0.74/lib/Math/Prime/Util.pm000644 000765 000024 00001117433 15153553345 020401 0ustar00danastaff000000 000000 package 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.74'; } # 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_delicate_prime is_chen_prime is_odd is_even is_divisible is_congruent is_power is_prime_power is_perfect_power is_square is_square_free is_powerfree is_pillai is_polygonal is_congruent_number is_perfect_number is_semiprime is_almost_prime is_omega_prime is_primitive_root is_carmichael is_quasi_carmichael is_cyclic is_fundamental is_totient is_gaussian_prime is_sum_of_squares is_smooth is_rough is_powerful is_practical is_lucky is_happy sqrtint rootint logint lshiftint rshiftint rashiftint absint negint signint cmpint addint subint add1int sub1int mulint powint divint modint cdivint divrem fdivrem cdivrem tdivrem miller_rabin_random lucas_sequence lucasu lucasv lucasuv lucasumod lucasvmod lucasuvmod pisano_period primes twin_primes semi_primes almost_primes omega_primes ramanujan_primes sieve_prime_cluster sieve_range prime_powers lucky_numbers forprimes forcomposites foroddcomposites forsemiprimes foralmostprimes forpart forcomp forcomb forperm forderange formultiperm forsetproduct fordivisors forfactored forsquarefree forsquarefreeint lastfor numtoperm permtonum randperm shuffle vecsample prime_iterator prime_iterator_object next_prime prev_prime next_prime_power prev_prime_power next_perfect_power prev_perfect_power next_chen_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 inverse_li_nv twin_prime_count twin_prime_count_approx nth_twin_prime nth_twin_prime_approx semiprime_count semiprime_count_approx nth_semiprime nth_semiprime_approx almost_prime_count almost_prime_count_approx almost_prime_count_lower almost_prime_count_upper nth_almost_prime nth_almost_prime_approx nth_almost_prime_lower nth_almost_prime_upper omega_prime_count nth_omega_prime 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 powerful_count nth_powerful sumpowerful powerful_numbers prime_power_count prime_power_count_approx prime_power_count_lower prime_power_count_upper nth_prime_power nth_prime_power_approx nth_prime_power_lower nth_prime_power_upper perfect_power_count perfect_power_count_approx perfect_power_count_lower perfect_power_count_upper nth_perfect_power nth_perfect_power_approx nth_perfect_power_lower nth_perfect_power_upper nth_powerfree powerfree_count powerfree_sum squarefree_kernel powerfree_part powerfree_part_sum smooth_count rough_count powersum lucky_count lucky_count_approx lucky_count_lower lucky_count_upper nth_lucky nth_lucky_approx nth_lucky_lower nth_lucky_upper minimal_goldbach_pair goldbach_pairs goldbach_pair_count sum_primes print_primes random_prime random_ndigit_prime random_nbit_prime random_safe_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 chinese2 gcd lcm factor factor_exp divisors valuation hammingweight frobenius_number todigits fromdigits todigitstring sumdigits tozeckendorf fromzeckendorf sqrtmod allsqrtmod rootmod allrootmod cornacchia negmod invmod addmod submod mulmod divmod powmod muladdmod mulsubmod vecsum vecmin vecmax vecprod vecreduce vecextract vecequal vecuniq vecany vecall vecnotall vecnone vecfirst vecfirstidx vecmex vecpmex vecsort vecsorti vecfreq vecsingleton vecslide setbinop sumset toset setunion setintersect setminus setdelta setcontains setcontainsany setinsert setremove setinvert is_sidon_set is_sumfree_set set_is_disjoint set_is_equal set_is_proper_intersection set_is_subset set_is_proper_subset set_is_superset set_is_proper_superset moebius mertens liouville sumliouville prime_omega prime_bigomega euler_phi jordan_totient exp_mangoldt sumtotient partitions bernfrac bernreal harmfrac harmreal chebyshev_theta chebyshev_psi divisor_sum carmichael_lambda hclassno inverse_totient kronecker is_qr qnr ramanujan_tau ramanujan_sum stirling fubini znorder znprimroot znlog legendre_phi factorial factorialmod subfactorial binomial binomialmod falling_factorial rising_factorial contfrac from_contfrac next_calkin_wilf next_stern_brocot calkin_wilf_n stern_brocot_n nth_calkin_wilf nth_stern_brocot nth_stern_diatomic farey next_farey farey_rank 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 cheb_factor ecm_factor rand srand/); my %_Config; my %_GMPfunc; # 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; use constant INTMIN => -(INTMAX >> 1) - 1; 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(); }; $_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 + 1e-6); } 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)); } } # Alias PP and GMP if requested. Very convenient but a big hammer. if (defined $ENV{MPU_DEVNAMES} && $ENV{MPU_DEVNAMES} == 1) { no strict 'refs'; ## no critic(strict) *MPU:: = \*Math::Prime::Util::; *PP:: = \*Math::Prime::Util::PP:: if eval { require Math::Prime::Util::PP; Math::Prime::Util::PP->import(); 1; }; *GMP:: = \*Math::Prime::Util::GMP:: if $_Config{'gmp'}; } } croak "Perl and XS don't agree on bit size" if $_Config{'xs'} && MPU_MAXBITS != _XS_prime_maxbits(); $_Config{'maxparam'} = MPU_MAXPARAM; $_Config{'maxdigits'} = MPU_MAXDIGITS; $_Config{'maxprime'} = MPU_MAXPRIME; $_Config{'maxprimeidx'} = MPU_MAXPRIMEIDX; $_Config{'assume_rh'} = 0; $_Config{'verbose'} = 0; $_Config{'bigintclass'} = undef; # used for code like: # return _XS_foo($n) if $n <= $_XS_MAXVAL # which builds into one scalar whether XS is available and if we can call it. my $_XS_MAXVAL = $_Config{'xs'} ? MPU_MAXPARAM : -1; my $_HAVE_GMP = $_Config{'gmp'}; _XS_set_callgmp($_HAVE_GMP) if $_Config{'xs'}; our $_BIGINT = $_Config{'bigintclass'}; # 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 'bigint' || $param eq 'trybigint') { my $class = _load_bigint_class($value); if (defined $class) { $_BIGINT = $_Config{'bigintclass'} = $class; } else { carp "ntheory could not load bigint class from '$value'" unless $param =~ /try/; } } 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; } # Input: object, or comma separated list of class names # Output: class name or undef sub _load_bigint_class { my($val) = @_; my $class = undef; if (ref($val)) { # We are given an object, e.g. a Math::GMPz number $class = ref($val); } else { # Comma separated list of class names for my $name (split /,/, $val) { $name =~ s/^\s+|\s+$//g; (my $cfname="$name.pm")=~s|::|/|g; # Foo::Bar::Baz => Foo/Bar/Baz.pm if ($INC{$cfname} || eval { require $cfname; $name->import(); 1; }) { $class = $name; last; } } } if ($class) { # Check we can make a number with it $class = undef unless eval { $class->new(1) == 1 }; } return $class; } # This is for loading the default bigint class the very first time. sub _load_bigint { return $_BIGINT if defined $_BIGINT; # TODO: turn this on for next release #prime_set_config( trybigint => 'Math::GMPz,Math::GMP' ); #return $_BIGINT if defined $_BIGINT; do { require Math::BigInt; Math::BigInt->import(try=>"GMP,GMPz,LTM,Pari"); } unless defined $Math::BigInt::VERSION; $_BIGINT = $_Config{'bigintclass'} = 'Math::BigInt'; } sub _bigint_to_int { return (OLD_PERL_VERSION && $_[0] >= 0) ? unpack(UVPACKLET,pack(UVPACKLET,"$_[0]")) : int("$_[0]"); } sub _to_bigint { return undef unless defined($_[0]); _load_bigint() unless defined $_BIGINT; # We don't do any validation other than that the class is happy. my $n; if (ref($_[0]) eq $_BIGINT) { $n = $_[0]; } elsif (ref($_[0]) eq 'Math::BigFloat' && !$_[0]->is_int()) { $n = Math::BigInt->bnan; } elsif ($_BIGINT eq 'Math::Pari' && $_[0] =~ /^0[bx]/) { # Pari added support for this in 2.8, so not in Math::Pari do { require Math::BigInt; Math::BigInt->import(try=>"GMP,GMPz,LTM,Pari"); } unless defined $Math::BigInt::VERSION; $n = Math::BigInt->new("$_[0]"); $n = $_BIGINT->new("$n"); } else { $n = $_BIGINT->new("$_[0]"); } croak "Parameter '$_[0]' must be an integer" unless $_BIGINT ne 'Math::BigInt' || $n->is_int(); $n; } sub _to_bigint_nonneg { return undef unless defined($_[0]); _load_bigint() unless defined $_BIGINT; my $n; if (ref($_[0]) eq $_BIGINT) { $n = $_[0]; } elsif (ref($_[0]) eq 'Math::BigFloat' && !$_[0]->is_int()) { $n = Math::BigInt->bnan; } else { $n = $_BIGINT->new("$_[0]"); } croak "Parameter '$_[0]' must be a non-negative integer" unless ($_BIGINT ne 'Math::BigInt' || $n->is_int()) && $n >= 0; $n; } sub _to_bigint_abs { return undef unless defined($_[0]); my $n = _to_bigint($_[0]); return ($n < 0) ? -$n : $n; } sub _to_bigint_if_needed { return $_[0] if !defined $_[0] || ref($_[0]); if ($_[0] >= INTMAX || $_[0] <= INTMIN) { # Probably a bigint my $n = _to_bigint($_[0]); return $n if $n > INTMAX || $n < INTMIN; # Definitely a bigint } $_[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 undef unless defined $_[1]; my $ref0 = ref($_[0]); if (OLD_PERL_VERSION) { # Perl 5.6 truncates arguments to doubles if you look at them funny return "$_[1]" if "$_[1]" <= INTMAX && "$_[1]" >= INTMIN; } elsif ($_[1] >= 0) { return $_[1] if $_[1] < ~0; } else { return $_[1] if $_[1] > -(~0>>1); } my $bign; if ($ref0) { $bign = $ref0->new("$_[1]"); } else { _load_bigint() unless defined $_BIGINT; $bign = $_BIGINT->new("$_[1]"); } return $bign if $bign > INTMAX || $bign < INTMIN; 0+"$_[1]"; } sub _maybe_bigint_allargs { _load_bigint() unless defined $_BIGINT; for my $i (0..$#_) { next if !defined $_[$i] || ref($_[$i]); next if $_[$i] < INTMAX && $_[$i] > INTMIN; my $n = $_BIGINT->new("$_[$i]"); $_[$i] = $n if $n > INTMAX || $n < INTMIN; } @_; } ############################################################################# # 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); } ############################################################################# ############################################################################# # 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_integer_nonneg($bits); croak "random_maurer_prime bits must be >= 2" unless $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_integer_nonneg($bits); croak "random_shawe_taylor_prime bits must be >= 2" unless $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_integer_nonneg($bits); croak "random_proven_prime bits must be >= 2" unless $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); } ############################################################################# 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_integer_nonneg($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) && $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 = addint(0,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). ############################################################################# ############################################################################# # 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) = @_; _validate_integer($n); return 0 if $n < 2; 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 !ref($n) && $_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 !ref($n) && $_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 !ref($n) && $_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 (!ref($n) && $_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 !ref($x) && $_Config{'xs'}; require Math::Prime::Util::PP; return Math::Prime::Util::PP::LambertW($x); } 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) = map { _to_bigint($_) } bernfrac($n); return Math::BigFloat->bzero if $num == 0; scalar Math::BigFloat->new($num)->bdiv($den, $precision); } sub harmreal { my($n, $precision) = @_; _validate_integer_nonneg($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); } ############################################################################# 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 setwise =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.74 =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 including 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. use Math::Prime::Util::MemFree; 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_safe_prime(192); # random 192-bit safe 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 similarly 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>, 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>, 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. =head2 MPU_DEVNAMES If set to C<1>, the PP package will be loaded on startup rather than on demand, and the package aliases C, C, C will be used for the main, Perl, and GMP packages respectively. Normally you wouldn't want this both for aggressive namespace pollution and for performance (there is often no need to load the huge PP module). But it is convenient if one wants to call the different paths explicitly. Regarding performance, on a 2020 Macbook M1, normal startup time is about 10 milliseconds. With this option set it becomes 45 milliseconds. This is the reason the PP code is only loaded if needed. For many purposes this amount of time is trivial, but slower computers or more time critical short applications will care. =head1 BIGNUM SUPPORT By default all functions support bigints. For performance, you should install L which will be automatically used as a backend. The default bigint class is L, which is not particularly speedy but is available by default in all Perl distributions, and is well tested. If you want to try something different, you can install and use L or L which will be B faster. You can have this module use and return them using, for example: prime_set_config(bigint => Math::GMPz); my $n = next_prime(~0); say "$n ",ref($n); # 18446744073709551629 Math::GMPz If you use Math::BigInt, I highly recommend also installing one of L, L, or 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 C or C), then use C 'GMP,GMPz,LTM,Pari'> in your script, or on the command line e.g. C<-Mbigint=lib,GMP>. Large modular exponentiation is much faster using the better 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. Following the semantics used by Pari/GP, all primality test functions allow a negative primary argument, but will return false. All inputs must be integers or an error is raised. =head1 FUNCTIONS =head2 is_prime print "$n is prime" if is_prime($n); Given an integer C, returns 0 if 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 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 foralmostprimes foralmostprimes { say } 3, 1000,2000; # 3-almost-primes in [1000,2000] Similar to L, L, etc. but takes an additional first argument C and loops through the inclusive range for only those numbers with exactly C factors. If C these are the primes, if C these are the semiprimes, if C these are the integers in the range with exactly 3 prime factors, etc. This is functionally equivalent to: for ($a .. $b) { if (is_almost_prime($k,$_)) { ... } } # or for ($a .. $b) { if (prime_bigomega($_) == $k) { ... } } though B faster and avoids issues with large loop variables. =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 forsquarefreeint Similar to L, but only sieves for square-free integers in the range (in segments so very large ranges still use little memory). No factoring information is returned: the C<@_> variable is not set. In return it is 2 to 20 times faster. As with range functions such as L this can be B faster than calling L for each integer in a large range. =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 orderings 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 Returns a proven upper bound on the number of primes up to C. See L for details common to both functions. =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 a proven lower bound on the number of primes up to C. 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 is_prime_power Given an integer 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. It is related to Mathematica's C function. These all return zero/false for C. This is the L. =head2 prime_powers my $aref = prime_powers( 10**4 ); Given either two non-negative limits C, C, or one non-negative limit C, returns an array reference with all prime powers between the limits (inclusive). With only one input, the lower limit is C<2>. The array reference values will be all C where C<< lo <= p^e <= hi >> with C

prime and C<< e >= 1 >>. Hence this includes the primes as well as higher powers of primes. See also L and L. =head2 next_prime_power Given an integer C, returns the smallest prime power greater than C<|n|>. Similar to L, but also includes powers of primes. =head2 prev_prime_power Given an integer C, returns the greatest prime power less than C<|n|>. Similar to L, but also includes powers of primes. If given C<|n|> less than 3, C will be returned. =head2 prime_power_count Given a single non-negative integer C, returns the count of prime powers less than or equal to C. If given two non-negative integers C and C, returns the count of prime powers between C and C inclusive. These are prime powers with exponent greater than 0. I.e. the prime powers not including C<1>. This is L. =head2 prime_power_count_approx Given a non-negative integer C, quickly returns a good estimate of the count of prime powers less than or equal to C. =head2 prime_power_count_lower Given a non-negative integer C, quickly returns a lower bound of the count of prime powers less than or equal to C. The actual count will always be greater than or equal to the result. =head2 prime_power_count_upper Given a non-negative integer C, quickly returns an upper bound of the count of prime powers less than or equal to C. The actual count will always be less than or equal to the result. =head2 nth_prime_power Given a non-negative integer C, returns the C-th prime power. =head2 nth_prime_power_approx Given a non-negative integer C, quickly returns a good estimate of the C-th prime power. =head2 nth_prime_power_lower Given a non-negative integer C, quickly returns a lower bound of the C-th prime power. The actual value will always be greater than or equal to the result. =head2 nth_prime_power_upper Given a non-negative integer C, quickly returns an upper bound of the C-th prime power. The actual value will always be less than or equal to the result. =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

prime, and C prime, 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 square root accurate for native size inputs. The series of Crisan and Erban (2020) is used with a maximum of 19 terms. Truncation is performed at empirical good crossovers. Clamping is done as needed at crossovers to ensure monotonic results. =head2 almost_primes my $ref_to_3_almost_primes = almost_primes(3, 1000, 2000); Takes a non-negative integer argument C and either one or two additional non-negative integer arguments indicating the upper limit or lower and upper limits. The limits are inclusive. The k-almost-primes are integers which have exactly C prime factors. This works just like the L function. Like that function, an array reference is returned. With C these are the primes (L). With C these are the semiprimes (L). With C these are the 3-almost-primes (L). With C these are the 4-almost-primes (L). OEIS sequences can be found through C. =head2 almost_prime_count say almost_prime_count(3,10000); # number of 3-almost-primes <= 10000 Given non-negative integers C and C, returns the count of C-almost-prime numbers up to and including C. With C this is the standard prime count. With C this is the semiprime count. In general, this is the count of all integers through C that have exactly C prime factors. The implementation uses nested prime count sums, and caching along with LMO prime counts to get quite reasonable speeds. =head2 almost_prime_count_approx A fast approximation of the C-almost-prime count of C. The current implementation for C greater than 64-bit is not well tested. =head2 almost_prime_count_lower Quickly returns a lower bound for the C-almost-prime count of C. The actual count will be greater than or equal to this result. The current implementation for C greater than 64-bit is not well tested. =head2 almost_prime_count_upper Quickly returns an upper bound for the C-almost-prime count of C. The actual count will be less than or equal to this result. The current implementation for C greater than 64-bit is not well tested. =head2 omega_primes Takes a non-negative integer argument C and either one or two additional non-negative integer arguments indicating the upper limit or lower and upper limits. The limits are inclusive. The k-omega-primes are positive integers which have exactly C distinct prime factors, with possible multiplicity. Hence these numbers are divisible by exactly C different primes. The k-omega-primes (not a common term) are exactly those integers where C. Compare to k-almost-primes where C. With C these are the prime powers. With C these are L. With C these are L. =head2 omega_prime_count Given non-negative integers C and C, returns the count of C-omega-prime numbers from C<1> up to and including C. This is the count of all positive integers through C that are divisible by exactly C different primes. The implementation uses nested loops over prime powers. Though we have defined C, it is not included. =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<< x > Rn >> then L(n) - L(n/2) C<< >= n >>. 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 in it 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 smaller than itself and less than or equal to C. Hence a depth of 2 will remove all even numbers (other than 2 itself if it is in the range). A depth of 3 will remove all numbers divisible by 2 or 3 other than those primes themselves. =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 mix of small-table-enhanced sieve count for sums that fit in a UV, an efficient sieve count for small ranges, and a Legendre sum method, including XS support for 128-bit results. 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<< Pi(p) >= 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 Returns a proven upper bound on the Nth prime. See L for details common to both functions. =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 a proven 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. The approximation is orders of magnitude better than the simple C approximation for large C. E.g. for C the simple estimate is within 3.6%, but this function is within 0.000012%. =head2 nth_almost_prime say "500th number with exactly 3 factors: ", nth_almost_prime(3,500); A C-almost prime is a product of C prime numbers, counted with multiplicity. That is, there are exactly C prime factors (which do not have to be distinct from each other). Given non-negative integers C and C, returns the C-th C-almost prime. With C this is the nth prime. With C this is the nth semiprime. The implementation does a binary search lookup with L so is reasonably efficient for large values. C is returned for C and for all C other than C. =head2 nth_almost_prime_approx A fast approximation of the C-th C-almost prime. =head2 nth_almost_prime_lower Quickly returns a lower bound for the C-th C-almost prime. The actual nth k-almost-prime will be greater than or equal to this result. =head2 nth_almost_prime_upper Quickly returns an upper bound for the C-th C-almost prime. The actual nth k-almost-prime will be less than or equal to this result. =head2 nth_omega_prime Given non-negative integers C and C, returns the C-th C-omega prime. This is the C-th integer divisible by exactly C different primes. The implementation does a binary search lookup with L so is reasonably efficient for large values. C is returned for C and for all C other than 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 Given an integer C and zero or more positive bases, returns 1 if C is positive and a probable prime to each base, and returns 0 otherwise. This is the simple Fermat primality test. Removing primes, given base 2 this produces the sequence L. If no bases are given, base 2 is used. All bases must be 2 or greater. 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 Given an integer C and zero or more positive bases, returns 1 if C is positive and an Euler probable prime to each base, and returns 0 otherwise. This is the Euler test, sometimes called the Euler-Jacobi test. Removing primes, given base 2 this produces the sequence L. If no bases are given, base 2 is used. All bases must be 2 or greater. If 0 is returned, then the number really is a composite (for bases less than n). 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); my $probably_prime = is_strong_pseudoprime($n, 2, 3, 5, 7, 11, 13, 17); Given an integer C and zero or more positive bases, returns 1 if C is positive and a strong probable prime to each base, and returns 0 otherwise. If no bases are given, base 2 is used. All bases must be 2 or greater. If 0 is returned, then the number really is a composite (for any base). 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 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. Generally, bases of interest are between C<2> and C. Bases C<1> and C will return 1 for any odd composites. Most sources do not define the test for bases equal to C<0 mod n>, and many do not for any bases larger than C. We allow all bases, noting that the case C is defined as 1. This allows primes to return 1 regardless of the base. =head2 is_lucas_pseudoprime Given an integer C, returns 1 if C is positive and 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 Given an integer C, returns 1 if C is positive and 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 Given an integer C, returns 1 if C is positive and an extra strong Lucas probable prime 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: 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

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 Given an integer C, returns 1 if C is positive and passes Colin Plumb's Euler Criterion primality test, and returns 0 otherwise. 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 it is slightly more efficient than other probable prime tests. =head2 is_perrin_pseudoprime Given an integer C, returns 1 if C is positive and C divides C where C is the Perrin number of C, and returns 0 otherwise. 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 tested 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 Given an integer C, returns 1 if C is positive and C<< (-1)^{(n-1)/2} * C_{(n-1)/2} >> is congruent to 2 mod C, where C is the nth Catalan number, and returns 0 otherwise. 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 Given an integer C and two optional integer parameters C and C, returns 1 if C is positive and a Frobenius probable prime with respect to the polynomial C, and returns 0 otherwise. 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 Given an integer C, returns 1 if C is positive and passes the efficient Frobenius test of Paul Underwood, and returns 0 otherwise. 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 Given an integer C, returns 1 if C is positive and passes the Frobenius test of Sergey Khashin, and returns 0 otherwise. The test verifies 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 Given an integer C and a positive integer C, returns 1 if C is positive and passes C Miller-Rabin tests using uniform random bases selected between C<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) Given an integer C, returns 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 an integer C, 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; Given an integer C, returns 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 an integer C, 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 an integer C, 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); Given an integer C, returns 1 if C is positive and passes the Agrawal-Kayal-Saxena (AKS) primality test, and returns 0 otherwise. 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." This module also has 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); Given an integer C

, returns 1 if C

is positive and the Mersenne number C<2^p-1> is prime, and returns 0 otherwise. 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 Given an integer C, returns 1 if C is positive and is a Ramanujan prime, and returns 0 otherwise. Therefore, 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_gaussian_prime say is_gaussian_prime(3,0); # "2" : 3 => 3 mod 4 => prime say is_gaussian_prime(1,1); # "2" : 1+i => norm 2 => prime say is_gaussian_prime(5,0); # "0" : 5 => 1 mod 4 => (2+i)(2-i) Given two integers C and C, returns either 0, 1, or 2 to indicate whether C is, respectively, a Gaussian composite, probable Gaussian prime, or definite Gaussian prime. This is true if and only if one of: =over 4 =item C and |b| is a prime congruent to 3 modulo 4. =item C and |a| is a prime congruent to 3 modulo 4. =item C and C are nonzero and C is prime. =back =head2 is_delicate_prime Given an integer C, returns 1 if C is positive and is a digitally delicate prime, and returns 0 otherwise. These are numbers which are prime, but changing any single base-10 digit always produces a composite number. An optional second argument is the base C which must be at least 2. This is the base used for changing digits to check for compositeness. These are variously called "weakly prime" or "digitally delicate prime" numbers. Note that the first digit can be changed to a zero. Variations not considered here include making changing the first digit restricted to non-zero (OEIS A158124) and allowing leading zero digits to be changed ("widely DDPs"). This is the L. With different bases, this is L. =head2 is_odd Given an integer C, returns 1 if C is odd and 0 otherwise. =head2 is_even Given an integer C, returns 1 if C is even and 0 otherwise. =head2 is_divisible Given integers C and C, returns 1 if C<|n|> is exactly divisible by C<|d|>, and 0 otherwise. This corresponds to the GMP function C. This includes its semantics with C which returns 0 unless C. More than one divisor can be given, e.g. C, allowing one to test multiple divisors with one call. The result is 1 if C is exactly divisible by any of the C values, and 0 if it is divisible by none of them. =head2 is_congruent Given integers C, C, and C, returns 1 if C is congruent to C modulo C<|d|>, and 0 otherwise. This corresponds to the GMP function C. This includes its semantics with C which returns 0 unless C. =head2 is_perfect_number Given integer C, returns 1 if C is a positive integer that is the sum of its divisors excluding the number itself, or equivalently a number that is equal to its aliquot sum. =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 integer input C, returns k if C for some integer C<< r > 1, k > 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 an integer C and a non-negative integer 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 given, 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_square Given an integer C, returns 1 if C is a perfect square, and returns 0 otherwise. This is identical to C. This corresponds to Pari/GP's C function. =head2 is_sum_of_squares Given an integer C and an optional positive integer number of squares C, returns 1 if C<|n|> can be represented as the sum of exactly C squares. C defaults to 2. All positive integers can be represented by 4 or more squares, so only C and C are interesting cases. With C this produces the sequence L. With C this produces the sequence L. =head2 is_powerfree Given an integer C and an optional non-negative integer C, returns 1 if C<|n|> has no divisor C, and returns 0 otherwise. This determines if C<|n|> has any k-th (or higher) powers in the prime factorization. C defaults to 2. With C this produces the sequence of square-free integers L. With C this produces the sequence of cube-free integers L. With C this produces the sequence of biquadrate-free integers L. =head2 powerfree_count Given an integer C and an optional non-negative integer C, returns the number of k-powerfree positive integers less than or equal to C. C defaults to 2. With C this produces the sequence L. With C this produces the sequence L. =head2 nth_powerfree Given a non-negative integer C and an optional non-negative integer C, returns the C-th k-powerfree number. If C is omitted, C is used. Returns undef if C is less than 2 or C. Returns 1 for C. With C this produces the sequence L. With C this produces the sequence L. =head2 powerfree_sum Given an integer C and an optional non-negative integer C, returns the sum of k-powerfree positive integers less than or equal to C. C defaults to 2. With C this produces the sequence L. =head2 powerfree_part Given an integer C and an optional non-negative integer C, returns the k-powerfree part of C. This is done via removing "excess" powers, i.e. in the prime factorization of C, we reduce any exponents C from C to C. Alternately we can say all k-th powers are divided out. C defaults to 2. When C, this is also sometimes called C. It is the unique square-free integer C such that C is a square. With C this produces the sequence L. With C this produces the sequence L. With C (the default), this corresponds to Pari/GP's C function and Sage's C function. =head2 powerfree_part_sum Given an integer C and an optional non-negative integer C, returns the sum of k-powerfree parts of all positive integers C<< <= n >>. This is equivalent to vecsum(map { powerfree_part($_,$k) } 1..$n) but substantially faster. With C this produces the sequence L. =head2 squarefree_kernel Given an integer C, returns the square-free kernel of C. This is also known as the integer radical. It is the largest square-free divisor of C, which is also the product of the distinct primes dividing C. We choose to accept negative inputs, with the result matching the input sign. This is the L. =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 a 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<< r^k <= 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 "largest power of 2 less than or equal to 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<< b^e <= 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 lshiftint Given an integer C and an optional integer number of bits C, perform a left shift of C by C bits. If the second argument is not provided, it is assumed to be 1. This is equivalent to multiplying by C<2^k>. With negative C, this behaves as described above. This is similar to how Perl behaves with C or C, but raw Perl coerces the argument into an unsigned before left shifting, which is unlikely to ever be what is wanted. If C is negative, a right shift is performed by C<|k|> bits. This corresponds to Pari/GP's C function with a positive number of bits, and Mathematica's C function. =head2 rshiftint Given an integer C and an optional integer number of bits C, perform a right shift of C by C bits. If the second argument is not provided, it is assumed to be 1. This is equivalent to truncated division by C<2^k>. With a negative C, the result is equal to C<-rshiftint(-n,k)>. This means it is not "arithmetic right shift" or "logical right shift" as commonly used with fixed-width registers in a particular bit format, but instead treated as sign and magnitude, where the magnitude is right shifted. If C is negative, a left shift is performed by C<|k|> bits. For an interesting discussion of arithmetic right shift, see Guy Steele's 1977 article "Arithmetic Shift Considered Harmful". This corresponds to Pari/GP's C function with a negative number of bits, and Mathematica's C function. The result is equal to dividing by the power of 2 using L or GMP's C. =head2 rashiftint Given an integer C and an optional integer number of bits C, perform a signed arithmetic right shift of C by C bits. If the second argument is not provided, it is assumed to be 1. This is equivalent to floor division by C<2^k>. If C is negative, a left shift is performed by C<|k|> bits. For non-negative C, this is always equal to L. With negative arguments it is similar to L, Python, and Java's BigInteger, which use floor division by C<2^k>. The result is equal to dividing by the power of 2 using L or GMP's C. =head2 signint Given an integer C, returns the sign of C. Returns -1, 0, or 1 if C is negative, zero, or positive respectively. This corresponds to Pari/GP's C function, GMP's C function, Raku's C method, and Math::BigInt's C method. Some of those extend to non-integers. =head2 cmpint Given integers C and C, returns -1, 0, or 1 if C is respectively less than, equal to, or greater than C. The main value of this is to ensure Perl never silently converts the values to floating point, which can give wrong results, and also avoid having to manually convert everything to bigints. This corresponds to Pari/GP's C function, GMP's C function, Math::BigInt's C method, and Perl's << <=> >> operator. Prior to version 6.2, GMP could return negative or positive values other than -1 and 1. =head2 addint Given integers C and C, returns C. These integer arithmetic functions (C, C, C, C, C, C, C) exist to offer exact integer arithmetic without overflow or NV conversion, while returning native integers when they fit, and bigints only when needed. Other choices include: =over 4 =item * B This is fine with small numbers, but once large enough, values will be converted to floating point (NV). This means incorrect results. Values larger than 64-bit are completely unsupported. One might expect C<2^53> to be the usual point for "large enough", but not only is the NV type platform dependent, but very old 64-bit Perl will aggressively convert values to NV starting at C<2^49> even with NV being a IEEE-754 double. =item * B Gives exact integer math as if we were using C types in C. We are still left with 32-bit versus 64-bit platform differences, being restricted to signed type, and no support for larger values. =item * B If one knows large values will be used, this is a good idea. Use bigint objects for all values, and all operations are methods on the objects and give correct results. This is functionally a good solution, but it will be 10 to B<500> times slower as well as more memory. =back All these functions accept native integers (IV/UV), bigints, and string representations of integers. Results will be in native types if possible, and as objects of the chosen bigint class otherwise. Best performance will still be had by native operations within range, or by using fast classes like L if most operations need it. We give correct behavior while only paying the performance penalty when needed, although there is still some overhead since we are not built into the language like Raku or Python. =head2 subint Given integers C and C, returns C. =head2 add1int Given integer C, returns C. =head2 sub1int Given integer C, returns C. =head2 mulint Given integers C and C, returns C. =head2 powint Given an integer C and a non-negative integer C, returns C. C<0^0> will return 1. The exponent C is converted into an unsigned long. =head2 divint Given integers C and C, returns the quotient C. Floor division is used, so q is rounded towards C<-inf> and the remainder has the same sign as the divisor C. This is the same as modern L, GMP C functions, and Python's integer division. For negative inputs, this will not be identical to native Perl division, which oddly uses a truncated quotient and floored remainder. More importantly, consistent and correct 64-bit integer division in Perl is problematic. Pari/GP's C<\\> integer division operator uses Euclidean division, which matches their C function. Our C and C operators both use floor division, which matches Raku and Python. We also have Euclidean, truncated, and ceiling division available via L, L, and L respectively. =head2 modint Given integers C and C, returns the modulo C. r = a - b * floor(a / b) Floor division is used, so q is rounded towards C<-inf> and r has the same sign as the divisor C. This is the same as modern L and the GMP C functions. Like with C, we use floor division, while Pari/GP uses Euclidean for their C<%> integer remainder operator. =head2 cdivint Given integers C and C, returns the quotient C. Ceiling division is used, so q is rounded towards C<+inf> and the remainder has the opposite sign as the divisor C. =head2 divrem my($quo, $rem) = divrem($a, $b); Given integers C and C, returns a list of two items: the Euclidean quotient and the Euclidean remainder. The remainder is always non-negative (C<< 0 <= r < |b| >>), and the quotient is chosen to satisfy C<< a = b*q + r >>. This corresponds to Pari/GP's C function. There is no explicit function in L that gives this division method for signed inputs. =head2 tdivrem Given integers C and C, returns a list of two items: the truncated quotient and the truncated remainder. The resulting pair will match L and L. This matches C99 "truncation toward zero" semantics as well. =head2 fdivrem Given integers C and C, returns a list of two items: the floored quotient and the floored remainder. The results will match the individual L and L functions, since they also use floored division. This corresponds to Python's builtin C function, and Raku's builtin C

and C functions. The resulting pair will match L and L. =head2 cdivrem Given integers C and C, returns a list of two items: the ceiling quotient (rounded towards C<+inf>) and the ceiling remainder. The remainder has the opposite sign from the divisor C. This allows one to perform division with rounding up. =head2 absint Given integer C, return C<|n|>, i.e. the absolute value of C. =head2 negint Given integer C, return C<-n>. =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. Also see L for fast computation mod n. 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>). Also see L for fast computation mod n. This corresponds to OpenPFGW's C function and gmpy2's C function. =head2 lucasuv ($U, $V) = lucasuv(1,-2,17); # 17-th Jacobsthal, Jacobsthal-Lucas. Given integers C

, C, and the non-negative integer C, computes both C and C for the Lucas sequence defined by 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 Given an integer C, returns 0 if C is negative or not a quasi-Carmichael number, and returns the number of bases otherwise. These are square-free composites that satisfy C divides C for all prime factors C

of C and for one or more non-zero integer C. This is the L. =head2 is_semiprime Given an integer C, returns 1 if C is positive and a semiprime, and returns 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_almost_prime say is_almost_prime(6,2169229601); # True if n has exactly 6 factors Given non-negative integers C and C, returns 1 if C has exactly C prime factors, and 0 otherwise. With C, this is a standard primality test. With C, this is the same as L. Functionally identical but possibly faster than C. =head2 is_omega_prime say is_omega_prime(6,2169229601); # True if n has 6 distinct factors Given non-negative integers C and C, returns 1 if C has exactly C distinct prime factors (not counting multiplicity), and 0 otherwise. With C, this is the same as L. Functionally identical but possibly faster than C. =head2 is_chen_prime Given non-negative integer C return 1 if C is a Chen prime. That is, if C is prime and C is either a prime or semi-prime. =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 non-negative integer C, if there exists a C where C and C, then the least C is returned. Otherwise 0. For n prime, non-zero return values give L. The non-zero values returned produce L. =head2 is_polygonal Given an integer C and a positive integer C greater than 2, return 1 if x is an s-gonal number, and return 0 otherwise. 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 is_congruent_number Given a non-negative integer C, returns 1 if C is the area of a rational right triangle, and 0 otherwise. This function answers the B using Tunnell's theorem which relies on the Birch Swinnerton-Dyer conjecture. It uses an extensive filter for known non-congruent families, including the works of Bastien (1915), Lagrange (1974), Monsky (1990), Serf (1991), Iskra (1996), Feng (1996), Reinholz et al. (2013), Cheng and Guo (2018 and 2019), Das and Saikia (2020), and Evink (2021). =head2 cornacchia Given non-negative integers C and C, finds solutions C<(x,y)> to the equation C. C is returned if no solution exists. In the case of C a prime, this is done using Cornacchia's algorithm. For non-prime C, we use a combination of Cornacchia-Smith on all roots, as well as a loop to find solutions in the harder cases. This means we will always return a solution. There will often be multiple solutions, but only one is returned. =head2 contfrac my @CF = contfrac(415,93); # CF = (4,2,6,7) => 4+(1/(2+1/(6+1/7))) = 415/93 # ^ ^ ^ ^ Given an integer C and a positive integer C, returns a list with the simple continued fraction representation of the rational C. This corresponds to a subset of Pari's C function, Mathematica's C function, and Sage's C function. =head2 from_contfrac my($N,$D) = from_contfrac(4,2,6,7); # N = 415, D = 93 Given an array of integers representing the simple continued fraction, returns the rational C as two integers. The first input value represents the whole part, and may be zero or negative. All successive input values must be non-negative and non-zero. This corresponds to a subset of Pari's C function, Mathematica's C function, and one value of Sage's C method. =head2 next_calkin_wilf ($n,$d) = next_calkin_wilf($n,$d); Given two positive coprime integers C and C representing the rational C, returns the next value in the breadth-first traversal of the Calkin-Wilf tree of rationals as a two-element list. The Calkin-Wilf tree has an entry for all positive rationals in lowest form, with each one appearing only once. While it is not a binary search tree over the positive rationals like the Stern-Brocot tree, it is more efficient to traverse in both depth and breadth order. This corresponds to Julia's Nemo C function. This can efficiently iterate through L. =head2 next_stern_brocot ($n,$d) = next_stern_brocot($n,$d); Given two positive coprime integers C and C representing the rational C, returns the next value in the breadth-first traversal of the Stern-Brocot tree of rationals as a two-element list. The Stern-Brocot tree has an entry for all positive rationals in lowest form, with each one appearing only once. Read left-to-right on each row, the numbers appear in ascending order. It is a binary search tree over the positive rationals (this was exactly Brocot's motivation). It is not as efficient as L. This produces L (numerators) and L (denominators). =head2 calkin_wilf_n my $idx = calkin_wilf_n($n,$d); Given two positive coprime integers C and C representing the rational C, returns the index in the breadth-first traversal of the Calkin-Wilf tree of rationals. This corresponds to the C method in L with C 'CW'>. =head2 stern_brocot_n my $idx = stern_brocot_n($n,$d); Given two positive coprime integers C and C representing the rational C, returns the index in the breadth-first traversal of the Stern-Brocot tree of rationals. This corresponds to the C method in L with C 'SB'>. =head2 nth_calkin_wilf ($n,$d) = nth_calkin_wilf($idx); Given a positive integer C, returns the rational in the corresponding index in the breadth-first traversal of the Calkin-Wilf tree of rationals. This corresponds to the C method in L with C 'CW'>. =head2 nth_stern_brocot ($n,$d) = nth_stern_brocot($idx); Given a positive integer C, returns the rational in the corresponding index in the breadth-first traversal of the Stern-Brocot tree of rationals. This corresponds to the C method in L with C 'SB'>. =head2 nth_stern_diatomic $n = nth_stern_diatomic($idx); Given a non-negative integer C, returns the C-th Stern diatomic number. This is sometimes called C (Dijkstra), Stern's diatomic series, or the Stern-Brocot sequence. The latter can be easily confused with the Stern-Brocot tree. This corresponds to Sidef's C function. See also L where the sequence of numerators generates this sequence. This produces L. =head2 farey # F[3] = 0/1 1/3 1/2 2/3 1/1 # say scalar farey(3); # 5 my @F3 = farey(3); # ([0,1], [1,3], [1,2], [2,3], [1,1]) my $F33 = farey(3,3); # [2/3] = $F3[3] # Print the list in readable form say join " ",map { join "/",@$_ } farey(3); Given a single positive integer C returns the Farey sequence of order C. In scalar context, returns the length without computing terms. In array context, returns a list with each rational as a 2-entry array reference. Given two values: a positive integer C and a non-negative integer C, returns the C entry of the order C Farey sequence. The index starts at zero so it matches using the full list as an array. If C is larger than the number of entries, undef is returned. This corresponds to Mathematica's C function (their two argument version is 1-based rather than 0-based). The lengths are L. The numerators are L. The denominators are L. =head2 next_farey my $next = next_farey(9,[5,9]); # returns [4,7] Given a positive integer C and a 2-element array reference containing a non-negative integer C

and a positive integer C, returns the next rational appearing after C

in the order C Farey sequence. Returns undef if C

is greater than or equal to one. =head2 farey_rank my $rank = farey_rank(9,[5,9]); # returns 15 Given a positive integer C and a 2-element array reference containing a non-negative integer C

and a positive integer C, returns the number of rationals less than C

in the order C Farey sequence. The given fraction does not need to be an entry in the sequence, nor does it need to be in reduced form. A unit fraction will return the totient sum of C. Any fraction greater than one will return the length of the order C sequence, as expected. Many OEIS sequences can be produced from this, including L (E= 1), L (E= 1/2), L (E= 1/3), L (E= 1/4), ..., L (E= 1/k), =head2 prime_bigomega say "$n has ", prime_bigomega($n), " total factors"; Given a non-negative integer C, returns Ω(|n|), the prime Omega function. This is the total number of prime factors of C including multiplicities. The result is identical to C. The return value is a read-only constant. This corresponds to Pari's C function and Mathematica's C function. =head2 prime_omega say "$n has ", prime_omega($n), " distinct factors"; Given a non-negative integer C, returns ω(|n|), the prime omega function. This is the number of distinct prime factors of C. The result is identical to C. The return value is a read-only constant. This corresponds to Pari's C function and Mathematica'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)); Given a single integer C, returns μ(|n|), the Möbius function (also known as the Moebius, Mobius, or MoebiusMu function). 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 given two integers C and C, they define a range, and the function returns an array with the value of the Möbius function for every C<|n|> from C to C inclusive. Large values of C 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. Negative ranges are possible, e.g. C will return C for -30, -29, -28, ..., -20. 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 Given a non-negative integer C, return M(n), the Mertens function. This function is defined as C, but calculated more efficiently for large inputs. For example, computing Mertens(100M) takes: time approx mem 0.01s 0.1MB mertens(100_000_000) 1.3s 880MB vecsum(moebius(1,100_000_000)) 16s 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. Helfgott and Thompson (2020) give a fast method based on advanced prime count algorithms. =head2 euler_phi say "The Euler totient of $n is ", euler_phi($n); Given a single integer C, returns φ(n), the Euler totient function (also called Euler's phi or phi function). 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<< n < 1 >>. This follows the logic used by SAGE. Mathematica and Pari return C for C<< n < 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 integer arguments C and C, they define an inclusive range. The function returns a list with the totient of every n from low to high inclusive. =head2 inverse_totient In array context, given a non-negative 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); Given non-negative integers C and C, returns Jordan's k-th totient function for C. 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<< n < 1 >>. This function can be used to generate some other useful functions, such as the Dedekind psi function, where C. =head2 sumtotient Given a non-negative integer C, returns the summatory Euler totient function. This function is defined as C, but calculated much more efficiently. A sub-linear time recursion is implemented, using O(n^2/3) memory. Memory use is restricted so growth becomes approximately linear above C<10^13>. This is L. =head2 ramanujan_sum Given two non-negative integers C and C, returns Ramanujan's sum. This is the sum of the nth powers of the primitive k-th roots of unity. Note this is not related to Ramanujan summation for divergent series. =head2 exp_mangoldt say "exp(lambda($_)) = ", exp_mangoldt($_) for 1 .. 100; Given a non-negative integer C, returns EXP(Λ(n)), the exponential of the Mangoldt function (also known as von Mangoldt's function). 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 Given a non-negative integer C, returns λ(n), the Liouville function. This is -1 raised to Ω(n) (the total number of prime factors). This corresponds to Mathematica's C function. It can be computed in Pari/GP as C<(-1)^bigomega(n)>. =head2 sumliouville Given a non-negative integer C, returns L(n), the summatory Liouville function. This function is defined as C, but calculated much more efficiently. There are a number of relations to the L function. This is L. =head2 chebyshev_theta say chebyshev_theta(10000); Given a non-negative integer C, returns θ(n), the first Chebyshev function. This is the sum of the logarithm of each prime where C<< p <= n >>. Effectively: my $s = 0; forprimes { $s += log($_) } $n; return $s; but computed more efficiently and accurately. =head2 chebyshev_psi say chebyshev_psi(10000); Given a non-negative integer C, returns ψ(n), the second Chebyshev function. This is the sum of the logarithm of each prime power where C<< p^k <= n >> for an integer k. Effectively: my $s = 0; for (1..$n) { $s += log(exp_mangoldt($_)) } return $s; but computed more efficiently and accurately. We compute it as a Neumaier sum from C of C. =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); Given a single non-negative integer C, returns the sum of the divisors of C, including 1 and itself. We return 0 for C. An optional second non-negative integer C may be given, indicating the sum should use the C powers of the divisors. 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 Given an integer C, returns the value of Ramanujan's tau function. The result is a signed integer. Zero is returned for negative C. 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 Given a non-negative integer C, returns the primorial C, 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 often 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 Given a non-negative integer C, returns the primorial number C, 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 a non-negative integer C, 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. This is L. Matching that series, we define C. =head2 partitions Given an integer C, returns the partition function C. If C is negative, 0 is returned. This is the number of ways of writing the integer C 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++ } 15_000 MPU pure Perl partitions 280_000 MPU GMP partitions 35_000_000 Pari 2.6 numbpart 500_000_000 Jonathan Bober's partitions_c.cc v0.6 1_400_000_000 Pari 2.8 numbpart If you want the enumerated partitions, see L. =head2 lucky_numbers Given a single 32-/64-bit non-negative integer C, returns an array reference of values up to the input C (inclusive) which remain after the lucky number sieve originally defined by Gardiner, Lazarus, Metropolis, and Ulam. This is L. If given two non-negative integers C and C, returns sieve results between the two ranges inclusive. This is identical to the above but does not include any numbers less than C. Currently there is very little time savings, but it does use less memory. A surprising number of asymptotic properties of the primes are shared with this sieve, though the resulting sets are quite different. There is no current algorithm for efficiently sieving a segment, though the method used here is orders of magnitude faster than those linked on OEIS as of early 2023. CPU time growth is similar to prime sieving, about C. Memory use is linear with size and uses about C bytes for the internal sieve. =head2 is_lucky Given an integer C, returns C<1> if C is included in the set of lucky numbers and returns C<0> otherwise. The process used is analogous to trial division using the lucky numbers less than C. For inputs not quickly discarded, the performance is essentially the same as generating the nth lucky number nearest to the input. =head2 lucky_count Given a single non-negative integer C, returns the count of lucky numbers less than or equal to C. If given two non-negative integers C and C, returns the count of lucky numbers between C and C inclusive. =head2 lucky_count_approx Given a single non-negative integer C, quickly returns a good estimate of the count of lucky numbers less than or equal to C. =head2 lucky_count_lower Given a single non-negative integer C, quickly returns a lower bound of the count of lucky numbers less than or equal to C. The actual count will always be greater than or equal to the result. =head2 lucky_count_upper Given a single non-negative integer C, quickly returns an upper bound of the count of lucky numbers less than or equal to C. The actual count will always be less than or equal to the result. =head2 nth_lucky Given a non-negative integer C, returns the C-th lucky number. This is done by sieving lucky numbers to C then performing a reverse calculation to determine the value at the nth position. This is much more efficient than generating all the lucky numbers up to the nth position, but is much slower than L. =head2 nth_lucky_approx Given a single non-negative integer C, quickly returns a good estimate of the C-th lucky number. =head2 nth_lucky_lower Given a single non-negative integer C, quickly returns a lower bound of the C-th lucky number. The actual value will always be greater than or equal to the result. =head2 nth_lucky_upper Given a single non-negative integer C, quickly returns an upper bound of the C-th lucky number. The actual value will always be less than or equal to the result. =head2 minimal_goldbach_pair Given a single non-negative integer C, returns the smallest prime C

such that C

and both C

and C are primes. Only the single value C

is returned, with C and C<< p <= q >>. Both C

and C are prime. C is returned if no such C

exists. This will happen for values less than C<4> and for all odd C where C for a prime C. The Goldbach Conjecture famously states that a C

exists for all even C greater than C<2>. This function is reasonably fast even for larger values of C as it can terminate after the first pair is found. On Macbook M1, average time is under 1 microsecond for 32-bit even inputs, under 10 microseconds for 64-bit even inputs, and 1 millisecond for 105 bit even inputs. =head2 goldbach_pair_count Given a single non-negative integer C, returns the number of pairs of primes C

and C where C<< p <= q >> and C<< p + q = n >>. If no such pairs exist, C<0> is returned. =head2 goldbach_pairs Given a single non-negative integer C, returns a list containing each C

for all prime pairs C

and C where C<< p <= q >> and C

. The number of elements returned is the same as L. If no such pairs exist, an empty list is returned. =head2 is_happy Given a single non-negative integer C, returns the number of iterations required for the map of sum of squared base-10 digits to converge to C<1>, or C<0> if it does not converge to the value C<1>. This returns the height using the OEIS A090425 definition of height, which is zero for non-happy numbers, 1 for C, 2 for numbers that produce 1 after a single iteration, etc. This is one more than the definitions used in many papers (e.g. Cai and Zhou 2008) where C is considered to have height 0. An optional base and exponent may be given (default base 10 exponent 2). The base must be between 2 and 36, and the exponent between 0 and 10. The input C is read as a decimal number, so giving input such as "1001" will be treated as the decimal C<1001> regardless of base. With base 10 and exponent 2, non-zero values produce L. The values themselves produce L. =head2 is_smooth my $is_23_smooth = is_smooth($n, 23); Given two non-negative integer inputs C and C, returns C<1> if C<|n|> is C-smooth, and C<0> otherwise. This uses the OEIS definition: Returns true if no prime factors of C are larger than C. The values for C and C use the definition along with noting that C returns 0 and C returns an empty list. The result is identical to: sub is_smooth { my($n,$k)=@_; return 0+(vecnone { $_ > $k } factor($n)); } but shortcuts are taken to avoid fully factoring if possible. This corresponds to Mathematica's C resource function. =head2 is_rough my $is_23_rough = is_rough($n, 23); Given two non-negative integer inputs C and C, returns C<1> if C<|n|> is C-rough, and C<0> otherwise. This uses the OEIS definition: Returns true if no prime factors of C are smaller than C. The values for C and C use the definition along with noting that C returns 0 and C returns an empty list. The result is identical to: sub is_rough { my($n,$k)=@_; return 0+(vecnone { $_ < $k } factor($n)); } but shortcuts are taken to avoid fully factoring if possible. =head2 is_powerful my $all_factors_cubes_or_higher = is_powerful($n, 3); Given an integer C and an optional non-negative integer C, returns C<1> if C is C-powerful, and C<0> otherwise. If C is omitted, C is used. A k-powerful number is a positive integer where all prime factors appear at least C times. All positive integers are therefore 0- and 1-powerful. C is powerful for all C. C<0> is returned for all negative or zero values of C. With C this corresponds to Pari's C function for positive values of C. Pari chooses to define 0 as powerful and uses C. While we can easily code this as a one line function using L and L, this is significantly faster and doesn't need to fully factor the input. =head2 powerful_numbers my $arrayref_pn1 = powerful_numbers(20); # 1,4,8,9,16 my $arrayref_pn2 = powerful_numbers(20,40); # 25,27,32,36 my $arrayref_pn3 = powerful_numbers(1,70,3); # 1,8,16,27,32,64 Given a single non-negative integer C, returns an array reference with all 2-powerful integers from C<1> to C inclusive. Given two non-negative integers C and C, returns an array reference with all 2-powerful integers from C to C inclusive. Given three non-negative integers C, C, and C, returns an array reference with all C-powerful integers from C to C inclusive. # Alternate solutions for values 1-n # Simple, but very slow for high $n. for (1..$n) { say if is_powerful($_,$k); } # Not so bad, especially for high $k. for (1..powerful_count($n,$k)) { say nth_powerful($_,$k); } # Best by far. say for @{powerful_numbers(1,$n,$k)}; Note that C<< n <= 0 >> are non-powerful. =head2 powerful_count my $npowerful3 = powerful_count(2**32, 3); Given an integer C and an optional non-negative integer C, returns the total number of C-powerful numbers from C<1> to C inclusive. If C is omitted, C is used. =head2 sumpowerful Given an integer C and an optional non-negative integer C, returns the sum of positive integer C-powerful numbers less than or equal to C. That is, the sum for all C, C<< 1 <= x <= n >>, where C is a C-powerful number. If C is omitted, C is used. =head2 nth_powerful Given a non-negative integer C and an optional non-negative integer C, returns the C-th C-powerful number. If C is omitted, C is used. For all C, returns undef for C and 1 for C. =head2 is_perfect_power Given an integer C, returns C<1> if C is a perfect power, and C<0> otherwise. That is, if C for some integers C and C with C greater than 1. The results match the C function of GMP 4.0+. Following GMP, SAGE, and FLINT, we treat -1, 0, and 1 as perfect powers. For positive integers, this is L. =head2 next_perfect_power Given an integer C, returns the smallest perfect power greater than C. Similar in API to L, but returns the next perfect power with exponent greater than 1. Starting from C<0> this gives the sequence C<1,4,8,9,16,25,...>. Negative inputs are supported, with the result being the nearest value greater than C where C returns true. =head2 prev_perfect_power Given an integer C, returns the greatest perfect power less than C. Similar in API to L, but returns the previous perfect power with exponent greater than 1. Negative inputs are supported, with the result being the nearest value less than C where C returns true. =head2 perfect_power_count Given a non-negative integer C, returns the number of integers not exceeding C which are perfect powers. If given two non-negative integers C and C, returns the count of perfect powers between C and C inclusive. By convention, numbers less than 1 are not counted. This can be calculated extremely quickly (less than 100ns per call for native size integers), so in most cases there is no need for the approximations or bounds. This is L. =head2 perfect_power_count_approx Given a non-negative integer C, quickly returns a good estimate of the count of perfect powers less than or equal to C. =head2 perfect_power_count_lower Given a non-negative integer C, quickly returns a lower bound of the count of perfect powers less than or equal to C. The actual count will always be greater than or equal to the result. =head2 perfect_power_count_upper Given a non-negative integer C, quickly returns an upper bound of the count of perfect powers less than or equal to C. The actual count will always be less than or equal to the result. =head2 nth_perfect_power Given a non-negative integer C, returns the C-th perfect power. Since the perfect power count can be calculated extremely quickly, using inverse interpolation can calculate the C-th perfect power quite rapidly. Similar to L, the convention is to exclude all integers less than 1. Hence C returns undef and C returns 1. =head2 nth_perfect_power_approx Given a non-negative integer C, quickly returns a good estimate of the C-th perfect power. =head2 nth_perfect_power_lower Given a non-negative integer C, quickly returns a lower bound of the C-th perfect power. The actual value will always be greater than or equal to the result. =head2 nth_perfect_power_upper Given a non-negative integer C, quickly returns an upper bound of the C-th perfect power. The actual value will always be less than or equal to the result. =head2 next_chen_prime Given a non-negative integer C, return the smallest Chen prime strictly greater than C. This will be a prime C<< p: p > n >>, where C is either a prime or a semiprime. =head2 smooth_count Given non-negative integer inputs C and C, returns the number of integers between C<1> and C inclusive, that have no prime factor larger than C. For all C, C. For all C, C and C. This is equivalent to, but much faster than, C. =head2 rough_count Given non-negative integer inputs C and C, returns the number of integers between C<1> and C inclusive, that have no prime factor less than C. For all C, C. For all C, C and C. This is equivalent to, but much faster than, C. =head2 is_practical Given an integer C, returns 1 if C is a practical number, and returns 0 otherwise. A practical number is a positive integer C such that all smaller positive integers can be represented as sums of distinct divisors of C. This is L. =head2 carmichael_lambda Given a non-negative integer C, returns the Carmichael function (also called the reduced totient function, or Carmichael λ(n)). This is the smallest positive integer C such that C for every integer C coprime to C. This is L. This corresponds to Mathematica's C function. It can be computed in Pari/GP as C. =head2 kronecker Given two integers C and C, returns the Kronecker symbol C<(a|n)>. 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 (x^2 = a mod n for some x) -1 a is a quadratic non-residue mod n (no x where x^2 = a 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. If C is not an odd prime, then the result does not necessarily indicate whether C is a quadratic residue mod C. Using the function L will return correct results for any C, though could be slower. =head2 factorial Given a non-negative integer 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 subfactorial Given a non-negative integer C, returns the subfactorial of C, which is the number of derangements of C objects. This is the number of permutations of n items where each item is not allowed to stay in its starting position. This is L. This corresponds to Mathematica's C function. =head2 binomial Given two integers 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<< n < 0, k <= n >> extension and instead returns C<0> for this case. GMP's API does not allow negative C but otherwise matches. C version 1.999816 and later supports negative arguments with similar semantics. Prior to this, C<< n < 0, k > 0 >> was undefined. =head2 falling_factorial Given two integers C and C, with C non-negative, returns the falling factorial of C. falling_factorial(x,n) = x * (x-1) * (x-2) * ... * (x-(n-1)) This corresponds to Mathematica's C function. =head2 rising_factorial Given two integers C and C, with C non-negative, returns the rising factorial of C. rising_factorial(x,n) = x * (x+1) * (x+2) * ... * (x+(n-1)) This corresponds to Mathematica's C function. =head2 powersum say powersum(100,1); # 5050 = vecsum(1..100) say powersum(100,2); # 338350 = vecsum(map{powint($_,2)} 1..100) say powersum(100,3); # 25502500 = vecsum(map{powint($_,3)} 1..100) Given two non-negative integers C and C, returns the sum of C-th powers of the first C positive integers. With C this is (L). With C this is (L). With C this is (L). OEIS sequences can be found through C. This corresponds to the C function in L and Pari's C function using integer arguments. =head2 hclassno Given an integer C, returns 12 times the Hurwitz-Kronecker class number. This will always be an integer due to the pre-multiplication by 12. The result is C<0> for negative C and all C 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 my($num,$den) = bernfrac(12); # returns (-691,2730) Returns the Bernoulli number C for an integer argument C, as a rational number represented by two integers. B_1 is chosen as 1/2, which is the same as 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 Given a non-negative integer C, returns the Bernoulli number 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); Given two 32-/64-bit non-negative integers C and C, plus an optional third argument C (1, 2, or 3, with the default being 1), returns the Stirling number of the given kind. The third kind are the unsigned Lah numbers. 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 fubini Given a non-negative integer C, returns the Fubini number of n, also called the ordered Bell numbers, or the number of ordered partitions of C. It is the count of rankings of C items allowing for ties. This is the L. =head2 harmfrac my($num,$den) = harmfrac(12); # returns (86021,27720) Given a non-negative integer C, returns the Harmonic number C as a rational number represented by two integers. 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 Given a non-negative integer C, returns the Harmonic number C as a L object using the default precision. An optional second integer 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 legendre_phi $phi = legendre_phi(1000000000, 41); Given two non-negative integers C and C, returns the Legendre phi function (also called the Legendre sum). This is the count of positive integers C<< <= n >> which are not divisible by any of the first C primes. This corresponds to the C function in SAGE, and the C<--phi n a> feature of C. =head2 inverse_li $approx_prime_count = inverse_li(1000000000); Given a non-negative integer C, returns the least integer value C such that C<< Li(k) >= 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 inverse_li_nv $faster_approx_prime_count = inverse_li_nv(1000000000); With input C and output both in NV (floating point), computes the inverse of the logarithmic integral. This should be very fast, as everything is done in native long double precision, no Perl bigints or bigfloats are involved, and the computed result is returned as an NV. The L function uses this to start, then ensures the integer return value is the closest inverse of the integer result of the L function. While this is a small amount of extra time for small inputs, once we have to go to Perl and use BigInt / BigFloat, the extra time can be significant. =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 (Pari 2.6 and later use the same lexicographic ordering). =head2 permtonum $k = permtonum([1,8,2,7,6,5,3,4,9,0]); # $k = 654321 Given an array reference containing each integer from C<0> to C, in some ordering, returns the lexicographic permutation rank of the set. This is the inverse of the L function. 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 (Pari 2.6 and later use the same lexicographic ordering). =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 Given a single non-negative integer C, returns a random permutation of the integers from C<0> to C. Optionally takes a second non-negative integer argument C. The returned list will then have only C elements. This is more efficient than truncating the full shuffled list. The randomness comes from our CSPRNG. The slicing technique shown in the last example is similar to L. =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 fewer elements are needed (a "pick" or "sample") then L or slicing with L will be much more efficient. =head2 vecsample $oneof = vecsample(1,@data); # Select one random value @twoof = vecsample(2,@data); # Select two random values Takes a non-negative integer C and a list, and returns C randomly selected values from the list. The randomness comes from our CSPRNG. If the input is exactly two elements (C and one other) and the second value is an array reference, then we will use it as the input list: $oneof = vecsample(1, $arrayref); @twoof = vecsample(1, \@data); This can be a large performance increase if the input list is large (e.g. 2x at 1000 elements, can be 10x with more). While there might be confusion when sampling a list with exactly one element, where that element is an array reference, this is assumed to be a rare case. This is similar to C from L, C from Rust rand, and Raku's C. =head1 MODULAR ARITHMETIC =head2 OVERVIEW Functions for fast modular arithmetic are provided: add, subtract, multiply, divide, power, square root, nth root, inverse. Additionally, fast modular calculation of factorial, binomial, and Lucas sequences are provided. See L for more functions that operate mod n. Semantics mostly follow Pari/GP, though in some cases they will indicate an error while we return undef. We use the absolute value of the modulus. A modulus of zero returns undef. A modulus of 1 will return 0. If a modular result doesn't exist, we return undef. =head2 negmod Given two integers C and C, return C<-a mod |n|>. This is similar to C or C<$n ? modint(-$a,absint($n)) : undef>. =head2 addmod Given three integers C, C, and C, 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 submod Given three integers C, C, and C, return C<(a-b) mod |n|>. =head2 mulmod Given three integers C, C, and C, 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 muladdmod Given four integers C, C, C, and C, return C<(a*b+c) mod |n|>. =head2 mulsubmod Given four integers C, C, C, and C, return C<(a*b-c) mod |n|>. =head2 divmod Given three integers C, C, and C, 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<|n|> exists then undef is returned. =head2 powmod Given three integers C, C, and C, 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. C is calculated as C. If C<1/a mod |n|> does not exist, undef is returned. =head2 sqrtmod Given two integers C and C, return the square root of C mod C<|n|>. 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 |n|>. If the modulus is composite, one of possibly many square roots will be returned, and it will not necessarily be the smallest. =head2 allsqrtmod Given two integers C and C, returns a sorted list of all modular square roots of C mod C<|n|>. If no square root exists, an empty list is returned. Some inputs will return very many roots. For example, C for prime p, has many roots, and C has over 500 million. =head2 rootmod Given three integers C, C, and C, returns a C-th root of C modulo C<|n|>, or undef if one does not exist. If defined, the return value C will satisfy C. There is no guarantee that the smallest root will be returned. For some composites with large prime powers this may not be efficient. C is calculated as C. If C<1/a mod |n|> does not exist, undef is returned. =head2 allrootmod Given three integers C, C, and C, returns a sorted list of all modular C-th root of C modulo C<|n|>. If no root exists, an empty list is returned. Similar to L, some inputs have millions or billions of roots, so it might not be able to successfully return them all. =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<|n|>. If not defined, undef is returned. If defined, then the return value multiplied by C equals C<1> modulo C<|n|>. 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. Mathematica uses C, where C must be positive. =head2 factorialmod Given a non-negative integer C and an integer 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 implementation. This becomes noticeable for C<< n > 10^8 >> or so, and the O(n^.5) versus O(n) complexity is very apparent with large C. =head2 binomialmod Given integer arguments C, C, and C, returns C. This is much faster than computing the large C followed by a mod operation. C<|m|> does not need to be prime. The result is extended to negative C. Negative C will return zero. This corresponds to Mathematica's C function. It has similar functionality to Max Alekseyev's C Pari routine. =head2 lucasumod Given integers C

, C, the non-negative integer C, and the integer C, efficiently compute C. This corresponds to gmpy2's C function. When C<(P,Q) = (1,-1)> this returns the modular Fibonacci sequence. This corresponds to Sidef's C function. =head2 lucasvmod Given integers C

, C, the non-negative integer C, and the integer C, efficiently compute C. This corresponds to gmpy2's C function. =head2 lucasuvmod # Compute the 5000-th Fibonacci and Lucas numbers, mod 1001 ($U,$V) = lucasuvmod(1, -1, 5000, 1001); Given integers C

, C, the non-negative integer C, and the integer C, efficiently compute the k-th value of C and C. This is similar to the L function, but uses a more consistent argument order and does not return C. =head2 lucas_sequence my($U, $V, $Qk) = lucas_sequence($n, $P, $Q, $k); B Computes C, C, and C for the Lucas sequence defined by C

,C, modulo C<|n|>. The modular Lucas sequence is used in a number of primality tests and proofs. C must be non-negative, and C must be non-zero. =head2 pisano_period Given a non-negative integer C, returns the period of the Fibonacci sequence modulo C. The modular Fibonacci numbers can be produced using C. They are periodic for any integer C, and the Pisano period is the length of the repeating sequence. This is the L. =head1 MODULAR FUNCTIONS =head2 OVERVIEW More functions are provided that operate mod n. They use similar semantics with respect to the modulus: the absolute value is used, and a modulus of 0 will return undef. However the behavior with C is not always the same. =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 znorder $order = znorder(2, next_prime(10**16)-6); Given two positive integers C and C, returns the multiplicative order of C modulo C<|n|>. This is the smallest positive integer C such that C. Returns undef if C, C, or if C and C are not coprime, since no value can result in 1 mod n. Returns 1 if C or if C. Note the latter differs from other mod functions, because the return value is a positive integer, not an integer mod n. This corresponds to Pari's C function and Mathematica's C function. =head2 znprimroot Given an integer C, where C is treated as C<|n|>, returns the smallest primitive root of C<(Z/nZ)^*>, or C if no root exists. A root exists when C, which will be true only if C<< n is one of {2, 4, p^k, 2p^k} >> for odd prime p. Like other modular functions, if C the function returns undef. 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 integers C and C, returns C<1> if C is a primitive root modulo C<|n|>, and C<0> if not. If C is a primitive root, then C is the smallest C for which C. Like other modular functions, if C the function returns undef. =head2 qnr Given an integer C, returns the least quadratic non-residue modulo C<|n|>. This is the smallest integer C where there does not exist an integer C such that C. Like other modular functions, if C the function returns undef. This is L. For primes it is L. =head2 is_qr Given two integers C and C, returns 1 if C is a quadratic residue modulo C<|n|>, and 0 otherwise. A return value of 1 indicates there exists an C where C. For odd primes, this is similar to checking C. For all values, this will be equal to C, with possibly better performance. Like other modular functions, if C the function returns undef. =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 L. 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 this does not seem to be the case. The speed of C, C, and C is 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 any module. 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 is 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). On a 32-bit Perl, it returns the maximum UV bits, which will be only 32. =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 actual random bits will be equal to the number of mantissa bits in the NV type. For IEEE-754 doubles, this means 53 bits, and can go to 64 or 113 bits with long double / quadmath support. The L function allows seeing how many bits are used. 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_safe_prime my $bigprime = random_safe_prime(512); Produces an n-bit safe prime. This is a prime C

where C

and C is also prime. These types of primes are sometimes useful for discrete logarithm based cryptography, and can be generated more efficiently using simultaneous sieving. =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 makes the point moot. Third, due to key size growth and advances in factoring and attacks, for practical purposes, using large random primes offers 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 1995 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 cleaned up, you can use this. The object method might be a better choice for complicated uses. =head2 Math::Prime::Util::MemFree->new use Math::Prime::Util::MemFree; 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'}; # Print all configuration my $r=prime_get_config(); say "$_ $r->{$_}" for sort (keys %$r); Returns a reference to a hash of the current settings. The hash is a copy of the configuration, so changing it has no effect. The settings include: verbose verbose level. 1 or more will result in extra output. bigintclass the bigint type name (default Math::BigInt) 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 ); prime_set_config(bigint=>Math::GMPz); 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. bigint You can give either a single object (e.g. a value of the class you want), or a comma separated list of class names. The first class we can load will be used for all operations that use a bigint. A warning will be produced if one was not found. trybigint Exactly the same behavior as C but no warning will be output if we couldn't load anything from the list. 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 the 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<< use bigint try => '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 the 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 result 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 function for looping over the divisors. When C we return the empty set (zero in scalar context). An optional second positive integer argument C indicates that the results should not include any value larger than C. This is especially useful when the number has thousands of divisors and we may only be interested in the small ones. =head2 trial_factor my @factors = trial_factor($n); Produces the prime factors of a positive number input using trial division. The factors will be in numerical order. For large inputs this will be very slow. An optional second argument will indicate an upper limit for factors. Factors C<2>, C<3>, and C<5> are always pulled out. Factors larger than the second argument will not be found and hence the last value in the list might be composite. 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<< n < 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 Pollard's rho factoring algorithm. See L for the shared description of both functions. =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 cheb_factor my @factors = cheb_factor($n); my @factors = cheb_factor($n, 1_000); # set B1 smoothness Produces factors, not necessarily prime, of the positive number input. This uses the properties of Chebyshev polynomials (particularly that C) and their relationship with the Lucas sequence, to find factors if C or C is smooth. This generally works better than our L, but is slower than our L. =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. For non-BigFloat inputs, the result should be accurate to at least 14 digits. For 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<< x < -1 >>), rational Chebyshev approximation (C<< -1 < x < 0 >>), a convergent series (small positive C), or an asymptotic divergent series (large positive C). The accuracy() setting of the input is used to determine the output accuracy. =head2 LogarithmicIntegral my $li = LogarithmicIntegral($x); Given a non-negative 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. For non-BigFloat objects, the result should be accurate to at least 14 digits. For BigFloat inputs, full accuracy and performance is obtained only if L is installed. The accuracy() setting of the input is used to determine the output accuracy. =head2 RiemannZeta my $z = RiemannZeta($s); Given a non-negative floating point input C, 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 more properly the Euler Zeta function. For non-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 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. The accuracy() setting of the input is used to determine the output accuracy. =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. For non-BigFloat objects, the result should be accurate to at least 14 digits. For BigFloat inputs, full accuracy and performance is obtained only if L is installed. If that module is not available, accuracy should be 35 digits. The accuracy() setting of the input is used to determine the output accuracy. =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 from the principal branch. Pari/GP's C prior to 2.15 (2022) was a subset of this. Recent Pari/GP and Mathematica both have more complete functions with both branches, and support for complex arguments and results. Calculation will be done with C long doubles if the input is a standard scalar, but if the input is a BigFloat type, then extended precision results will be generated. The accuracy() setting of the input is used to determine the output accuracy. Speed of the native code is about half of the fastest native code (Veberic's C++), and about 10x 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, GMP is highly recommended. =head1 PLATFORM INTROSPECTION =head2 OVERVIEW We include a number of non-exported functions that are useful for internal use but can also be useful for users. These functions are subject to change or deletion in future revisions. =head2 _uvsize Returns the size of a UV in bytes (typically 4 or 8). The size of the basic integer type used in Perl and the C library. =head2 _uvbits Returns the size of a UV in bits (typically 32 or 64). =head2 _ivsize Returns the size of an IV in bytes (typically 4 or 8). This is going to be the same as L. =head2 _nvsize Returns the size of an NV in bytes (typically 4, 8, or 16). It's quite possible other sizes could be seen on non-standard configurations. Usually we won't care about this directly. =head2 _nvmantbits Returns the size of the mantissa of Perl's NV floating point type, in bits. This can vary widely, with C<23, 52, 112> all possible from mainstream platforms and other numbers possible. This gives the actual mantissa bits, not counting the implicit 1. The significand precision is therefore one higher than the value returned by this function. A typical IEEE-754 double will report 52 here, which means integers up to C<2^53-1> are able to be accurately stored. Perl prior to 5.23 did not configure this at build time. We will guess based on the byte size of the NV on an IEEE-754 machine. =head2 _nvmantdigits How many full decimal integer digits able to be stored in an NV. =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 'foroddcomposites { 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,vecfirst -E 'say vecfirst { /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/forcomposites 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, or our built-in and much faster L): sub ispowerful { (vecall { $_->[1] > 1 } factor_exp(shift)) ? 1 : 0; } 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 my_subfactorial { my $n = shift; vecsum(map{ vecprod((-1)**($n-$_),binomial($n,$_),factorial($_)) }0..$n); } Compute subfactorial (number of derangements) using simple recursion: sub my_subfactorial { my $n = shift; use bigint; ($n < 1) ? 1 : $n * subfactorial($n-1) + (-1)**$n; } Recognize Sidon and sum-free sets. We have specific functions L and L that are faster. sub is_sidon { my $set = shift; my $len = scalar(@$set); my $sumset = sumset($set); 0+(@$sumset==(($len*$len+$len)/2)); } sub is_sum_free { my $set = shift; 1 - setcontainsany($set,sumset($set)); } =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 35 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. All common contemporary usage is now some BPSW variant. =over 4 =item libtommath (previous to 1.1.0) As of version 1.1.0 (January 2019), this uses strong BPSW and even adds a base 3 strong pseudoprime test. Raku uses this so fixes one of my peeves I had with their design. =item GMP/MPIR (previous to 6.2.0) As of version 6.2.0 (January 2020), this uses strong BPSW and typically adds one random-base strong pseudoprime test in addition. =item L (previous to Pari 2.3.0) 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) and is highly susceptible to false positives. Pari 2.3.0 was released in May 2006 and it uses BPSW (or the APR-CL proof method), which are still used to this day in modern Pari/GP (a great ECPP implementation was added in 2.10 for even better proofs). =back Basically the problem with running C M-R tests is that it is too easy to get counterexamples, 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 45+ years and runs much faster. It can be enhanced with one or more random bases if one desires, and will I be much faster. =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. The block calls like L, L, etc. use C. We optimize away the per-call scope if it looks like it isn't needed. This solves the functional and memory problems seen in L and L, while still allowing higher performance on common simple blocks that don't create temporary variables or pass local references out of scope. Double braces for the function, e.g. C, can be used to force a separate scope. =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 returning 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.16 includes features such as computing the first C primes, the first C digits of Pi, base conversion, and factorial. With the latest versions it is reasonably fast for pure Perl. 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. The latest version, 0.02 from 2012, only correctly supports trial division. 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 enumerates fractions in various trees including the Calkin-Wilf and Stern-Brocot trees. All values must fit in native integers. There is a wealth of information in its documentation. 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 was written earlier, and our function is nearly identical to L). 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. Incidentally, 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 produces 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. For Python, the package L looks to have similar overall goals. =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 publicly 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 The gold standard is currently Kim Walisch's fantastic L. For single threaded computations with 64-bit C, this module is fairly close in performance. 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, so eventually we will use methods like LMO. =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) 2.9 Math::Prime::FastSieve 0.12 decent odd-number sieve 11.7 Math::Prime::XS 0.27 0.27 includes a count 15.0 Bit::Vector 7.2 48.9 Math::Prime::Util::PP 0.14 Perl (fastest I know of) 49.00 Math::Big 1.16 Uses efficient Perl 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 Python's SymPy 1.1 (2017) up to current 1.14.0 (2025) uses Legendre's method. This is vastly preferable to sieving used by earlier versions of SymPy and by MPMATH (as of v1.4.0). It is a little slower than our Lehmer and quite a bit slower than LMO, but is much simpler. =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, with 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 an 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). =head2 CONGRUENT NUMBERS The L function, combined with our L operator to loop over square free integers in a range, is quite fast compared to most public implementations. For computing many values, it is expected that fast theta series computations, such as demonstrated in Hart et al. (2009) (L), are significantly faster, albeit requiring more memory and disk space. All congruent numbers less than 300,000 can be identified in under 2 seconds. Giovanni Resta's list of 213318 square-free and C congruent numbers less than C<10^7> can be generated in 19 minutes on a single core of an M1 laptop. =head2 SETS Measuring the performance of various modules for set operations doesn't give a strict order. Many modules are fast at some operations and slow at others. Some have particular inputs they are very fast or very slow with. Each module has different functionality. We chose, following Pari and Mathematica, to represent sets as native Perl lists of sorted de-duplicated integers, rather than a dedicated object. This allows flexibility and use for other purposes, but it isn't ideal for general performance, especially with very large sets (100k+ elements) where we spend a large amount of time parsing and manipulating the Perl input array. While an opaque data structure would use 8 or fewer bytes per element, Perl arrays use approximately 32 bytes per integer. Still, this is quite favorable compared to Perl hashes at 120 to 220 (e.g. Set::Light, Set::Tiny, Set::Scalar, Set::Functional). For generic set use, I recommend L. The module source is B tiny, unlike this module. It offers an easy API for basic set functions and is fast. It is not limited to integers. On the other hand, with integers our module is typically faster (2-10x) and uses less memory, even with our choice of native Perl sorted arrays. Finding the sumset size of the first 10,000 primes. my %r; my $p = primes(nth_prime(10000)); 12.6s 15MB forsetproduct {$r{vecsum(@_)}=undef;} $p,$p; say scalar(keys %r); 9.4s 3900MB Pari/GP X=primes(10000); #setbinop((a,b)->a+b,X,X) 2.4s 3MB $s=setbinop { $a+$b } $p; say scalar @$s; 0.4s 3MB $s=sumset $p; say scalar @$s; Set intersection of C<[-1000..100]> and C<[-100..1000]>, with Perl 5.43.7. 4 uS Set::IntSpan::Fast::XS 5 uS setintersect <=========== this module 7 uS Pari/GP 2.17.0 14 uS Set::IntSpan::Fast 61 uS native Perl hash intersection /\ /\ /\ Faster 62 uS Set::Tiny 66 uS Set::Functional 105 uS PP::setintersect \/ \/ \/ Slower 200 uS Array::Set 310 uS Set::Object 332 uS Set::SortedArray 1508 uS Set::Scalar Set intersection of integers under 1000 divisible by 2 and 3 respectively. Sets are C<[grep{0==$_%2}0..999]> and C<[grep{0==$_%3}0..999]>: 3 uS setintersect <=========== this module 6 uS Pari/GP 2.17.0 31 uS Set::Tiny 32 uS native Perl hash intersection /\ /\ /\ Faster 34 uS Set::Functional 37 uS PP::setintersect \/ \/ \/ Slower 64 uS Set::IntSpan::Fast::XS 86 uS Array::Set 122 uS Set::SortedArray 138 uS Set::Object 615 uS Set::Scalar 3090 uS Set::IntSpan::Fast Set::IntSpan::Fast is very fast with the first example using single span sets, but gets quite slow with more spans as seen in the second example. The other modules are mostly unaffected by data patterns. Using our own set objects wrapping a C structure of some sort would be faster and lower memory. In particular, we often spend more time just reading the set values than we do performing the set operation. =head2 SORTING Perl's built-in sort is a cache-friendly stable merge sort. This is reasonably appropriate for the wide variety of uses expected. When sorting lists of integers, it could be improved. Perl 5.8 brought an in-place optimization, so C<@a=sort{$a<=>$b}@a> is done without copying. The numerical sort is recognized and short-cut so doesn't actually call the well-known comparison function. However, Perl's old 32-bit legacy lived on until 5.26 as the inputs were turned into doubles, which can lead to subtle bugs with large integers. Inputs that started as strings (e.g. input read from a file) will still get turned into doubles. Our vecsort tries to avoid these issues, making sure inputs are processed as only IV, UV, and/or bigints. Integer strings are converted to one of those. All inputs are validated to be integers. There is no need for separate interfaces for signed and unsigned numbers as Perl's representation stores this information explicitly and per-variable rather than per-array. Input lists that contain bigints, or both negative numbers and positive numbers larger than the maximum IV (C<2^63-1> for 64-bit), cannot be stored in a native array of a single type, therefore will be sorted using Perl's sort rather than our C code. This is B slower, but produces the correct results. Our sorting for native signed and unsigned integers is a combination of radix sort and quicksort (the latter using median of 9 partitioning, insertion sort for small partitions, and heapsort fallback if we detect repeated poor partitioning). It is quite fast and low overhead. L has a variety of algorithms. However there is no option for unsigned (UV), only signed integers (IV). Sort::Key offers a variety of interfaces including unsigned and signed integers, as well as in-place versions. The following table compares sorting random 64-bit unsigned integers and is shown as speedup relative to Perl's sort (higher is faster, v5.43.7). 10 100 1000 10000 100000 1M vecsort 2.0x 2.3x 4.7x 6.2x 6.9x 9.7x Sort::Key::Radix usort 1.4x 2.3x 3.4x 3.4x 4.7x 2.7x Sort::XS::quick_sort 1.2x 1.5x 1.8x 1.9x 2.0x 2.7x Sort::Key usort 1.2x 1.3x 1.3x 1.3x 1.3x 1.3x sort 1.0x 1.0x 1.0x 1.0x 1.0x 1.0x List::MoreUtils::qsort 0.6x 0.5x 0.4x 0.4x 0.4x 0.3x The implementation does not currently try to exploit patterns. Regarding the above timing, when given sorted or reverse sorted data, Perl's sort is much faster versus the random values used above, though still not faster than L and L (both of which use a radix sort). List::MoreUtils::qsort has very different goals in mind than standard sorting of integer lists, as mentioned in their documentation. In contrast, this is exactly (and only) what vecsort does, so it should not be a surprise that our function looks good on this benchmark. Different use cases would show things differently. =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, B. Van Pelt, and Kim Walisch all had useful ideas 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", I, 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 * Daan Leijen, "Division and Modulus for Computer Scientists", 2001. Paper discussing different div/mod methods. 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}}", I, v80, n276, pp 2381-2394, October 2011. L =back =head1 COPYRIGHT Copyright 2011-2026 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.74/lib/Math/Prime/Util/PrimeIterator.pm000644 000765 000024 00000015307 15151073560 023155 0ustar00danastaff000000 000000 package Math::Prime::Util::PrimeIterator; use strict; use warnings; BEGIN { $Math::Prime::Util::PrimeIterator::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::PrimeIterator::VERSION = '0.74'; } 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_integer_nonneg($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.74 =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.74/lib/Math/Prime/Util/ChaCha.pm000644 000765 000024 00000032353 15151073611 021473 0ustar00danastaff000000 000000 package 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.74'; } ############################################################################### # 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.74 =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.74/lib/Math/Prime/Util/ECAffinePoint.pm000644 000765 000024 00000014232 15152504165 022776 0ustar00danastaff000000 000000 package 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.74'; } BEGIN { do { require Math::BigInt; Math::BigInt->import(try=>"GMP,GMPz,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.74 =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.74/lib/Math/Prime/Util/PP.pm000644 000765 000024 00001346333 15153452253 020717 0ustar00danastaff000000 000000 package 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.74'; } our $BIGINTVERSION = 0.0; BEGIN { do { require Math::BigInt; Math::BigInt->import(try=>"GMP,GMPz,LTM,Pari"); } unless defined $Math::BigInt::VERSION; $BIGINTVERSION = $Math::BigInt::VERSION; $BIGINTVERSION =~ s/^(\d+)\.(\d+).*/$1.$2/; } # 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 INTMAX => (!OLD_PERL_VERSION || MPU_32BIT) ? ~0 : 562949953421312; use constant INTMIN => (MPU_32BIT ? -2147483648 : !OLD_PERL_VERSION ? -9223372036854775808 : -562949953421312); use constant SINTMAX => (INTMAX >> 1); use constant B_PRIM235 => Math::BigInt->new("30"); use constant PI_TIMES_8 => 25.13274122871834590770114707; } # TODO: Change this whole file to use this / tobigint our $_BIGINT; *_BIGINT = \$Math::Prime::Util::_BIGINT; # By using these aliases, we call into the main code instead of # to the PP function. # # If we have turned off XS, then this will call the PPFE or direct function. # This might be the same, but if the PPFE does input validation it will # be slower (albeit every call will be validated). # # Otherwise, we'll go to the XS function, which will either handle it # directly (e.g. we've broken down the input into smaller values which # the XS code can handle), or call the GMP backend, otherwise call here. # # For the usual case where we have XS, this is significantly faster. The # aliases make the code here much easier to read. An alternate # implementation would be to make the perl subs here use a pp_{...} prefix. *validate_integer = \&Math::Prime::Util::_validate_integer; *validate_integer_nonneg = \&Math::Prime::Util::_validate_integer_nonneg; *validate_integer_positive = \&Math::Prime::Util::_validate_integer_positive; *validate_integer_abs = \&Math::Prime::Util::_validate_integer_abs; *_bigint_to_int = \&Math::Prime::Util::_bigint_to_int; *reftyped = \&Math::Prime::Util::_reftyped; #*load_bigint = \&Math::Prime::Util::_load_bigint; *tobigint = \&Math::Prime::Util::_to_bigint; *maybetobigint = \&Math::Prime::Util::_to_bigint_if_needed; *maybetobigintall = \&Math::Prime::Util::_maybe_bigint_allargs; *getconfig = \&Math::Prime::Util::prime_get_config; *Maddint = \&Math::Prime::Util::addint; *Msubint = \&Math::Prime::Util::subint; *Madd1int = \&Math::Prime::Util::add1int; *Msub1int = \&Math::Prime::Util::sub1int; *Mmulint = \&Math::Prime::Util::mulint; *Mdivint = \&Math::Prime::Util::divint; *Mpowint = \&Math::Prime::Util::powint; *Mmodint = \&Math::Prime::Util::modint; *Mcdivint = \&Math::Prime::Util::cdivint; *Mabsint = \&Math::Prime::Util::absint; *Msqrtint = \&Math::Prime::Util::sqrtint; *Mrootint = \&Math::Prime::Util::rootint; *Mlogint = \&Math::Prime::Util::logint; *Mnegint = \&Math::Prime::Util::negint; *Mcmpint = \&Math::Prime::Util::cmpint; *Mlshiftint = \&Math::Prime::Util::lshiftint; *Mrshiftint = \&Math::Prime::Util::rshiftint; *Mdivrem = \&Math::Prime::Util::divrem; *Mtdivrem = \&Math::Prime::Util::tdivrem; *Maddmod = \&Math::Prime::Util::addmod; *Msubmod = \&Math::Prime::Util::submod; *Mmulmod = \&Math::Prime::Util::mulmod; *Mdivmod = \&Math::Prime::Util::divmod; *Mpowmod = \&Math::Prime::Util::powmod; *Minvmod = \&Math::Prime::Util::invmod; *Mrootmod = \&Math::Prime::Util::rootmod; *Mmuladdmod = \&Math::Prime::Util::muladdmod; *Mmulsubmod = \&Math::Prime::Util::mulsubmod; *Mgcd = \&Math::Prime::Util::gcd; *Mlcm = \&Math::Prime::Util::lcm; *Mgcdext = \&Math::Prime::Util::gcdext; *Mfactor = \&Math::Prime::Util::factor; *Mfactor_exp = \&Math::Prime::Util::factor_exp; *Mtrial_factor = \&Math::Prime::Util::trial_factor; *Mdivisors = \&Math::Prime::Util::divisors; *Mdivisor_sum = \&Math::Prime::Util::divisor_sum; *Mis_prime = \&Math::Prime::Util::is_prime; *Mis_semiprime = \&Math::Prime::Util::is_semiprime; *Mis_prime_power = \&Math::Prime::Util::is_prime_power; *Mis_power = \&Math::Prime::Util::is_power; *Mis_square_free = \&Math::Prime::Util::is_square_free; *Mis_odd = \&Math::Prime::Util::is_odd; *Mis_even = \&Math::Prime::Util::is_even; *Mis_congruent = \&Math::Prime::Util::is_congruent; *Mis_divisible = \&Math::Prime::Util::is_divisible; *Mchinese = \&Math::Prime::Util::chinese; *Mvaluation = \&Math::Prime::Util::valuation; *Mkronecker = \&Math::Prime::Util::kronecker; *Mmoebius = \&Math::Prime::Util::moebius; *Mtotient = \&Math::Prime::Util::euler_phi; *Mfactorial = \&Math::Prime::Util::factorial; *Mfalling_factorial = \&Math::Prime::Util::falling_factorial; *Mprimorial = \&Math::Prime::Util::primorial; *Mpn_primorial = \&Math::Prime::Util::pn_primorial; *Mbinomial = \&Math::Prime::Util::binomial; *Mstirling = \&Math::Prime::Util::stirling; *Mpowersum = \&Math::Prime::Util::powersum; *Murandomm = \&Math::Prime::Util::urandomm; *Murandomb = \&Math::Prime::Util::urandomb; *Mnext_prime = \&Math::Prime::Util::next_prime; *Mprev_prime = \&Math::Prime::Util::prev_prime; *Mprime_count = \&Math::Prime::Util::prime_count; *Mlucasumod = \&Math::Prime::Util::lucasumod; *Mznorder = \&Math::Prime::Util::znorder; *Mhclassno = \&Math::Prime::Util::hclassno; *Mvecall = \&Math::Prime::Util::vecall; *Mvecany = \&Math::Prime::Util::vecany; *Mvecnone = \&Math::Prime::Util::vecnone; *Mvecsum = \&Math::Prime::Util::vecsum; *Mvecprod = \&Math::Prime::Util::vecprod; *Mvecmin = \&Math::Prime::Util::vecmin; *Mvecmax = \&Math::Prime::Util::vecmax; *Mvecfirst = \&Math::Prime::Util::vecfirst; *Mvecsort = \&Math::Prime::Util::vecsort; *Mvecsorti = \&Math::Prime::Util::vecsorti; *Mvecslide = \&Math::Prime::Util::vecslide; *Mtoset = \&Math::Prime::Util::toset; *Msetinsert = \&Math::Prime::Util::setinsert; *Msetcontains = \&Math::Prime::Util::setcontains; *Msetunion = \&Math::Prime::Util::setunion; *Msetintersect = \&Math::Prime::Util::setintersect; *Mfromdigits = \&Math::Prime::Util::fromdigits; *Mtodigits = \&Math::Prime::Util::todigits; *Mtodigitstring = \&Math::Prime::Util::todigitstring; *Mprimes = \&Math::Prime::Util::primes; *Mfordivisors = \&Math::Prime::Util::fordivisors; *Mforprimes = \&Math::Prime::Util::forprimes; *MLi = \&Math::Prime::Util::LogarithmicIntegral; *Mprime_omega = \&Math::Prime::Util::prime_omega; *Mnth_prime_upper = \&Math::Prime::Util::nth_prime_upper; if (defined $Math::Prime::Util::GMP::VERSION && $Math::Prime::Util::GMP::VERSION >= 0.53) { *Saddint = \&Math::Prime::Util::GMP::addint; *Ssubint = \&Math::Prime::Util::GMP::subint; *Smulint = \&Math::Prime::Util::GMP::mulint; *Sdivint = \&Math::Prime::Util::GMP::divint; *Spowint = \&Math::Prime::Util::GMP::powint; } else { *Saddint = \&Math::Prime::Util::addint; *Ssubint = \&Math::Prime::Util::subint; *Smulint = \&Math::Prime::Util::mulint; *Sdivint = \&Math::Prime::Util::divint; *Spowint = \&Math::Prime::Util::powint; } # We don't have this function yet. Use a simple version for now. *Mtoint = \&_toint_simple; sub _is_nonneg_int { ((defined $_[0]) && $_[0] ne '' && ($_[0] !~ tr/0123456789//c)); } 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); $i = Math::BigInt->accuracy(); $f = defined $Math::BigFloat::VERSION ? Math::BigFloat->accuracy() : undef; return (($i > $f) ? $i : $f) if defined $i && defined $f; return $i if defined $i; return $f if defined $f; $i = Math::BigInt->div_scale(); $f = defined $Math::BigFloat::VERSION ? Math::BigFloat->div_scale() : undef; return (($i > $f) ? $i : $f) if defined $i && defined $f; return $i if defined $i; return $f if defined $f; return 18; } # Only used by RiemannZeta. TODO: refactor to remove this. 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_integer { if (OLD_PERL_VERSION && defined $_[0] && !ref($_[0])) { no warnings 'numeric'; $_[0] = "$_[0]" if "$_[0]" > 1e15 || "$_[0]" < -1e15; } my($n) = @_; croak "Parameter must be defined" if !defined $n; my $refn = ref($n); if (!$refn) { # Typical case, an integer or string croak "Parameter '$n' must be an integer" if $n eq '' || ($n =~ tr/0123456789//c && $n !~ /^([+-]?)\d+\z/); substr($_[0],0,1,'') if $1 && (substr($n,0,1) eq '+' || $n eq '-0'); $_[0] = maybetobigint($n) if $n >= INTMAX || $n <= INTMIN; } elsif ($refn eq 'Math::BigInt') { croak "Parameter '$n' must be an integer" unless $n->is_int; if ($n->is_negative) { $_[0]=_bigint_to_int($_[0]) if $n >= INTMIN; } else { $_[0]=_bigint_to_int($_[0]) if $n <= INTMAX; } } elsif ($refn =~ /^Math::/ && $refn ne 'Math::BigFloat') { $_[0] = _bigint_to_int($_[0]) if $n <= INTMAX && $n >= INTMIN; } elsif ($refn eq 'CODE') { $_[0] = $_[0]->(); return _validate_integer($_[0]); } else { $_[0] = "$_[0]"; return _validate_integer($_[0]); } $_[0]->upgrade(undef) if ref($_[0]) eq 'Math::BigInt' && $_[0]->upgrade(); 1; } sub _validate_integer_nonneg { if (OLD_PERL_VERSION && defined $_[0] && !ref($_[0])) { no warnings 'numeric'; $_[0] = "$_[0]" if "$_[0]" > 1e15; } my($n) = @_; croak "Parameter must be defined" if !defined $n; my $refn = ref($n); if (!$refn) { # Typical case, an integer or string croak "Parameter '$n' must be a non-negative integer" if $n eq '' || ($n =~ tr/0123456789//c && $n !~ /^(\+?)\d+\z/) || $n < 0; substr($_[0],0,1,'') if $1 && substr($n,0,1) eq '+'; # If probably a bigint, do the upgrade, then verify for edge cases. $_[0] = maybetobigint($n) if $n >= INTMAX; } elsif ($refn eq 'Math::BigInt') { croak "Parameter '$n' must be a non-negative integer" if !$n->is_int || $n->is_negative; $_[0] = _bigint_to_int($_[0]) if $n <= INTMAX; } elsif ($refn =~ /^Math::/ && $refn ne 'Math::BigFloat') { croak "Parameter '$n' must be a non-negative integer" if $n < 0; $_[0] = _bigint_to_int($_[0]) if $n <= INTMAX; } elsif ($refn eq 'CODE') { $_[0] = $_[0]->(); return _validate_integer_nonneg($_[0]); } else { $_[0] = "$_[0]"; return _validate_integer_nonneg($_[0]); } $_[0]->upgrade(undef) if ref($_[0]) eq 'Math::BigInt' && $_[0]->upgrade(); 1; } sub _validate_integer_positive { _validate_integer($_[0]); croak "Parameter '$_[0]' must be a positive integer" if "$_[0]" < 1; 1; } sub _validate_integer_abs { if (ref($_[0])) { $_[0] = -$_[0] if $_[0] < 0; } else { $_[0] =~ s/^-// if "$_[0]" < 0; } _validate_integer($_[0]); } sub _try_real_gmp_func { my($fref, $ver, $x) = @_; return undef unless defined $Math::Prime::Util::GMP::VERSION && $Math::Prime::Util::GMP::VERSION >= $ver; # For Math::BigInt input we could return Mtoint($str), FP, or full BigFloat. if (!ref($x) || ref($x) eq 'Math::BigInt') { my $fr = 0.0 + $fref->($x, 40); # enough for full long double return $fr if !ref($x) || ($fr < 1e15 && $fr > -1e15); } my $dig = _find_big_acc($x); my $str = $fref->($x, $dig); return _upgrade_to_float($str); } 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; } ################################################################################ # TODO: this is in progress. # It's TBD what should be done on failures (undef? croak?) # Handling of trivial floats is terrible. # A single native int should be as fast as possible sub _toint { my @v = @_; # copy them all my @out; for my $v (@v) { if (!defined $v) { push @out, 0; next; } if (ref($v)) { $v = $v->as_int() if ref($v) eq 'Math::BigFloat'; } elsif ($v =~ /^[+-]?\d+\z/) { # Good as-is } elsif ($v =~ /e/i || $v =~ /\./) { $v = _upgrade_to_float($v)->as_int(); } else { $v = int($v); } if ($v =~ /^nan\z/i) { push @out, undef; next; } validate_integer($v); push @out, $v; } @out; } sub _toint_simple { my($n) = @_; if ($n >= 0) { my $max = MPU_32BIT ? 4294967295 : 70368744177664; # 2^46 if ($n =~ /^[+]?\d+\z/) { return int("$n") if $n < $max; } elsif ($n < $max) { return int("$n"); } else { $n = "" . _upgrade_to_float("$n")->bfloor; } } else { my $min = MPU_32BIT ? -2147483648 : -35184372088832; # -2^45 if ($n =~ /^[-]\d+\z/) { return int($n) if $n > $min; } elsif ($n > $min) { return int($n); } else { $n = "" . _upgrade_to_float("$n")->bceil; } } validate_integer($n); $n = tobigint($n) if ref($n) && defined $_BIGINT && ref($n) ne $_BIGINT; $n; } sub _frombinary { my($bstr) = @_; $bstr =~ s/^0//; return oct('0b' . $bstr) if length($bstr) <= 32; # Avoid the useless portable warning that can't be silenced. if (MPU_MAXBITS >= 64 && length($bstr) <= 64) { # 64-bit Perl, 33-64 bit str my $low = substr($bstr,-32,32,''); return (oct('0b'.$bstr) << 32) + oct('0b'.$low); } # Length is bigger than word size, so must be a bigint if (!defined $_BIGINT) { return Math::BigInt->new("0b$bstr"); } elsif ($_BIGINT =~ /^Math::(BigInt|GMPz|GMP)$/) { return $_BIGINT->new("0b$bstr"); } else { return tobigint( Math::BigInt->new("0b$bstr") ); } } ################################################################################ ################################################################################ my($_precalc_size, @_primes_small) = (2,undef,2); { my $_init_precalc_size = 5003; _register_free_sub(sub { if ($_precalc_size > $_init_precalc_size) { ($_precalc_size, @_primes_small) = (2,undef,2); _expand_prime_cache($_init_precalc_size); } }); _expand_prime_cache($_init_precalc_size); } sub _expand_prime_cache { my($N) = @_; if ($N > $_precalc_size) { if ($_primes_small[-1] < 7) { @_primes_small = (0,2); my $sieveref = _sieve_erat_string($N); push @_primes_small, 2*pos($$sieveref)-1 while $$sieveref =~ m/0/g; } else { my($lo,$hi) = ($_primes_small[-1] + 2, $N | 0x1); my($BASE, $sieveref) = ($lo-2, _sieve_segment($lo, $hi)); push @_primes_small, $BASE+2*pos($$sieveref) while $$sieveref =~ m/0/g; } $_precalc_size = $N; } return $_primes_small[-1]; } 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) && $n <= INTMAX; if (ref($n)) { # Check div by 7,11,13,17,19,23,29; then by 31,37,...,109,113 return 0 unless Mgcd($n,215656441) == 1; return 0 unless Mgcd($n,'4885866070719029716366506343847722513') == 1; return 0 unless _miller_rabin_2($n); if (Mcmpint($n,"18446744073709551615") <= 0) { return is_almost_extra_strong_lucas_pseudoprime($n) ? 2 : 0; } return is_extra_strong_lucas_pseudoprime($n) ? 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 < 154639673381) { # BPSW seems to be faster after this # Deterministic set of Miller-Rabin tests. If the MR routines can handle # bases greater than n, this can be simplified. This covers all 64-bit # inputs, even though we restrict it to smaller inputs for performance. my @b; # n > 1_000_000 because of the previous block. if ($n < 19471033) {@b=(2,299417)} elsif ($n < 38010307) {@b=(2,9332593)} elsif ($n < 316349281) {@b=(11000544,31481107)} # 2 bases elsif ($n < 4759123141) {@b=(2,7,61)} elsif ($n < 154639673381) {@b=(15,176006322,4221622697)} # 3 bases elsif ($n < 47636622961201) {@b=(2,2570940,211991001,3749873356)}# 4 bases elsif ($n < 3770579582154547) {@b=(2,2570940,880937,610386380,4130785767)} else {@b=(2,325,9375,28178,450775,9780504,1795265022)} return is_strong_pseudoprime($n, @b) ? 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) = @_; validate_integer($n); return 0 if $n < 2; 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 ($n==2 || $n==3 || $n==5) ? 2 : 0 if $n < 7; return 0 unless $n % 2; 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_bpsw_prime { my($n) = @_; validate_integer($n); return _is_bpsw_prime($n); } sub is_provable_prime { my($n) = @_; validate_integer($n); return _is_bpsw_prime($n) if $n <= 18446744073709551615; 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 integrated with prime_precalc { 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; } _register_free_sub(sub { ($primary_sieve_size, $primary_sieve_ref) = (0,''); }); } sub _sieve_segment { my($beg,$end,$limit) = @_; ($beg, $end) = map { _bigint_to_int($_) } ($beg, $end) if ref($end) && $end <= INTMAX; 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 = Msqrtint($end); $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)); my $sieve_end = ($end - $beg) >> 1; while ( (my $nexts = 1 + index($$primesieveref, '0', $s)) > 0 ) { $p += 2 * ($nexts - $s); $s = $nexts; my $p2 = $p*$p; if ($p2 < $beg) { # Make p2 the next odd multiple of p >= beg if ($beg < 2**49) { my $f = int(($beg+$p-1)/$p); $p2 = $p * ($f + (1-($f&1))); } else { my $f = Mcdivint($beg,$p); $p2 = Mmulint($p, $f + (1-($f&1))); } } # Large bases and small segments often don't hit the segment at all. next if $p2 > $end; # Inner loop marking multiples of p, divide by 2 to keep loop simpler. for ($p2 = ($p2 - $beg) >> 1; $p2 <= $sieve_end; $p2 += $p) { substr($sieve, $p2, 1) = '1'; } } \$sieve; } sub trial_primes { my($low,$high) = @_; if (!defined $high) { $high = $low; $low = 2; } validate_integer_nonneg($low); validate_integer_nonneg($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 = Mnext_prime($low); while ($curprime <= $high) { push @primes, $curprime; $curprime = Mnext_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_integer_nonneg($low); $low = 2 if $low < 2; } else { ($low,$high) = (2, $low); } validate_integer_nonneg($high); my $sref = []; return $sref if ($low > $high) || ($high < 2); return [grep { $_ >= $low && $_ <= $high } @_primes_small] if $high <= $_primes_small[-1]; if ($Math::Prime::Util::_GMPfunc{"sieve_primes"} && $Math::Prime::Util::GMP::VERSION >= 0.34) { my @pr = Math::Prime::Util::GMP::sieve_primes($low, $high, 0); return ref($high) ? [maybetobigintall(@pr)] : \@pr; } # 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_integer_nonneg($n); validate_integer_nonneg($width); validate_integer_nonneg($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 = getconfig()->{'verbose'}; validate_integer_nonneg($lo); validate_integer_nonneg($hi); if ($Math::Prime::Util::_GMPfunc{"sieve_prime_cluster"}) { return maybetobigintall( Math::Prime::Util::GMP::sieve_prime_cluster($lo,$hi,@cl) ); } return @{Mprimes($lo,$hi)} if scalar(@cl) == 0; unshift @cl, 0; for my $i (1 .. $#cl) { validate_integer_nonneg($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, 3000); if (defined $_BIGINT && (ref($lo) || ref($hi))) { ($lo,$hi) = map {tobigint($_)} ($lo,$hi) if ref($lo) ne $_BIGINT || ref($hi) ne $_BIGINT; } $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 (@{Mprimes($lo,$sievelim)}) { my $ac = 1; for my $ci (1 .. $#cl) { if (!Mis_prime($n+$cl[$ci])) { $ac = 0; last; } } push @p, $n if $ac; } $lo = Mnext_prime($sievelim); } return @p if $lo > $hi; # Compute acceptable residues. my $pr = Mprimorial($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 { Mgcd($_+$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 = @{Mprimes( $p+1, $sievelim)}; my(@lorem,@vprem); for my $pidx (0..$#mprimes) { my $p = $mprimes[$pidx]; $lorem[$pidx] = _bigint_to_int($lo % $p); for my $c (@cl) { $vprem[$pidx]->[ ($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 for my $pidx (0 .. $#mprimes) { my $p = $mprimes[$pidx]; my $rem = $lorem[$pidx]; @racc = grep { !$vprem[$pidx]->[ ($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 (!Mis_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 (!_miller_rabin_2($p+$c)) { $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; if ($lo <= $hi) { # update native remainders $lorem[$_] = ($lorem[$_] + $pr) % $mprimes[$_] for 0..$#mprimes; } } print "cluster sieve ran $nummr MR and $numlucas Lucas tests\n" if $_verbose; @p; } sub prime_powers { my($low,$high) = @_; if (scalar @_ > 1) { validate_integer_nonneg($low); $low = 2 if $low < 2; } else { ($low,$high) = (2, $low); } validate_integer_nonneg($high); if ($high > 1e18 || ($high-$low) < 10) { my $sref = []; while ($low <= $high) { push @$sref, $low if Mis_prime_power($low); $low = Madd1int($low); } return $sref; } else { my @powers; for my $k (2 .. Mlogint($high,2)) { my $P = Mpowint(2,$k); push @powers, $P if $P >= $low; } for my $k (2 .. Mlogint($high,3)) { my $P = Mpowint(3,$k); push @powers, $P if $P >= $low; } for my $k (2 .. Mlogint($high,5)) { my $rootn = Mrootint($high, $k); Mforprimes( sub { my $P = Mpowint($_,$k); push @powers, $P if $P >= $low; }, 5, $rootn); } push @powers, @{Mprimes($low,$high)}; return Mvecsorti(\@powers); } } sub twin_primes { my($low,$high) = @_; if (scalar @_ > 1) { validate_integer_nonneg($low); $low = 2 if $low < 2; } else { ($low,$high) = (2, $low); } validate_integer_nonneg($high); my @tp; if ($Math::Prime::Util::_GMPfunc{"twin_twin_primes"}) { @tp = Math::Prime::Util::GMP::sieve_twin_primes($low, $high); } else { @tp = sieve_prime_cluster($low, $high, 2); } return ref($high) ? [maybetobigintall(@tp)] : \@tp; } sub semi_primes { my($low,$high) = @_; if (scalar @_ > 1) { validate_integer_nonneg($low); $low = 4 if $low < 4; } else { ($low,$high) = (4, $low); } validate_integer_nonneg($high); my @sp; Math::Prime::Util::forsemiprimes(sub { push @sp,$_; }, $low, $high); \@sp; } # TODO: Port n_range_ramanujan_primes to replace this. # export it as a function # # For now, let's ignore it, this is only used for the PP. sub _n_ramanujan_primes { my($n) = @_; return [] if $n <= 0; my $max = Mnth_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 Mis_prime($k); $L[$s] = $k+1 if $s < $n; $s-- if ($k&3) == 1 && Mis_prime(($k+1)>>1); $L[$s] = $k+2 if $s < $n; } \@L; } sub ramanujan_primes { my($low,$high) = @_; if (scalar @_ > 1) { validate_integer_nonneg($low); $low = 2 if $low < 2; } else { ($low,$high) = (2, $low); } validate_integer_nonneg($high); return [] if ($low > $high) || ($high < 2); my $nn = Math::Prime::Util::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 = Math::Prime::Util::ramanujan_primes($n,$n); return (scalar(@$L) > 0) ? 1 : 0; } sub nth_ramanujan_prime { my($n) = @_; validate_integer_nonneg($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_integer_nonneg($n); return $_prime_next_small[$n] if $n <= 0+$#_prime_next_small; # This turns out not to be faster. # return $_primes_small[1+_tiny_prime_count($n)] if $n < $_primes_small[-1]; return tobigint(MPU_32BIT ? "4294967311" : "18446744073709551629") if !ref($n) && $n >= MPU_MAXPRIME; # n is now either 1) not bigint and < maxprime, or (2) bigint and >= uvmax if ($n > 4294967295 && getconfig()->{'gmp'}) { return reftyped($_[0], Math::Prime::Util::GMP::next_prime($n)); } do { $n += $_wheeladvance30[$n%30]; } while !($n%7) || !_is_prime7($n); $n; } sub prev_prime { my($n) = @_; validate_integer_nonneg($n); return (undef,undef,undef,2,3,3,5,5,7,7,7,7)[$n] if $n <= 11; if ($n > 4294967295 && getconfig()->{'gmp'}) { return reftyped($_[0], Math::Prime::Util::GMP::prev_prime($n)); } do { $n -= $_wheelretreat30[$n%30]; } while !($n%7) || !_is_prime7($n); $n = _bigint_to_int($n) if ref($n) && $n <= INTMAX; $n; } sub next_prime_power { my($n) = @_; validate_integer_nonneg($n); return (2,2,3,4,5,7,7,8,9)[$n] if $n <= 8; while (1) { $n = Madd1int($n); return $n if Mis_prime_power($n); } } sub prev_prime_power { my($n) = @_; validate_integer_nonneg($n); return (undef,undef,undef,2,3,4,5,5,7)[$n] if $n <= 8; while (1) { $n = Msub1int($n); return $n if Mis_prime_power($n); } } sub partitions { my($n) = @_; validate_integer_nonneg($n); my $d = Msqrtint(Madd1int($n)); my @pent = (1, map { (($_*(3*$_+1))>>1, (($_+1)*(3*$_+2))>>1) } 1 .. $d); my $bigpn = (~0 > 4294967295) ? 400 : 270; my($ZERO,$ONE) = map { $n >= $bigpn ? tobigint($_) : $_ } (0,1); my @part = ($ONE); foreach my $j (scalar @part .. $n) { my ($psum1, $psum2) = ($ZERO, $ZERO); my $k = 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]; } my @_lf63 = (0,0,1,0,0,1,0,0,1,0,0,1,0,0,1,0,0,1,1,1,1,0,0,1,0,0,1,1,1,1,0,0,1,0,0,1,0,0,1,1,1,1,0,0,1,0,0,1,0,0,1,0,0,1,0,0,1,1,1,1,1,1,1,0,0); my @_small_lucky = (undef,1,3,7,9,13,15,21,25,31,33,37,43,49,51,63,67,69,73,75,79,87,93,99,105,111,115,127,129,133,135,141,151,159,163,169,171,189,193,195); sub lucky_numbers { my($lo,$hi) = @_; if (defined $hi) { validate_integer_nonneg($lo); } else { ($lo,$hi) = (1, $lo); } validate_integer_nonneg($hi); return [] if $hi < $lo || $hi == 0; my @lucky; # This wheel handles the evens and every 3rd by a mod 6 wheel, # then uses the mask to skip every 7th and 9th remaining value. for (my $k = 1; $k <= $hi; $k += 6) { my $m63 = $k % 63; push @lucky, $k unless $_lf63[$m63]; push @lucky, $k+2 unless $_lf63[$m63+2]; } delete $lucky[-1] if $lucky[-1] > $hi; # Do the standard lucky sieve. for (my $k = 4; $k <= $#lucky && $lucky[$k]-1 <= $#lucky; $k++) { for (my $skip = my $index = $lucky[$k]-1; $index <= $#lucky; $index += $skip) { splice(@lucky, $index, 1); } } if ($lo > 1) { @lucky = grep { $_ >= $lo } @lucky; } \@lucky; } sub lucky_count { my($lo,$hi) = @_; if (defined $hi) { validate_integer_nonneg($lo); } else { ($lo,$hi) = (1, $lo); } validate_integer_nonneg($hi); return 0 if $hi < $lo || $hi == 0; # Return from our static data if very small. return scalar(grep { defined $_ && $_ >= $lo && $_ <= $hi } @_small_lucky) if $hi <= $_small_lucky[-1]; # Trivial but slow way: # return scalar(@{Math::Prime::Util::lucky_numbers($lo, $hi)}); $lo-- if $lo & 1; $hi++ if $hi & 1; my $lsize = 1 + lucky_count_upper($hi); my ($locount, $hicount) = ($lo >> 1, $hi >> 1); my $ln = Math::Prime::Util::lucky_numbers($lsize); shift @$ln; if ($lo <= 1) { $hicount -= int($hicount / $_) for @$ln; } else { for my $l (@$ln) { last if $l > $hicount; $locount -= int($locount / $l) if $l <= $lo; $hicount -= int($hicount / $l); } } return $hicount - $locount; } sub _simple_lucky_count_approx { my($n) = @_; $n = "$n" if ref($n); return 0 + ($n > 0) + ($n > 2) if $n < 7; return 0.9957 * $n/log($n) if $n <= 1000000; return (1.03670 - log($n)/299) * $n/log($n); } sub _simple_lucky_count_upper { my($n) = @_; $n = "$n" if ref($n); return 0 + ($n > 0) + ($n > 2) if $n < 7; return int(5 + 1.039 * $n/log($n)) if $n <= 7000; my $a = ($n < 10017000) ? 0.58003 - 3.00e-9 * ($n-7000) : 0.55; return int($n/(1.065*log($n) - $a - 3.1/log($n) - 2.85/(log($n)*log($n)))); } sub _simple_lucky_count_lower { my($n) = @_; my $approx = _simple_lucky_count_approx($n); my $est = $approx * (($n <= 10000) ? 0.9 : 0.99); int($est); } sub lucky_count_approx { my($n) = @_; validate_integer_nonneg($n); return scalar(grep { defined $_ && $_ <= $n } @_small_lucky) if $n <= $_small_lucky[-1]; my($lo,$hi) = (_simple_lucky_count_lower($n), _simple_lucky_count_upper($n)); _binary_search($n, $lo, $hi, sub{Math::Prime::Util::nth_lucky_approx(shift)}); } sub lucky_count_upper { my($n) = @_; validate_integer_nonneg($n); return scalar(grep { defined $_ && $_ <= $n } @_small_lucky) if $n <= $_small_lucky[-1]; my($lo,$hi) = (_simple_lucky_count_lower($n), _simple_lucky_count_upper($n)); 1+_binary_search($n, $lo, $hi, sub{Math::Prime::Util::nth_lucky_lower(shift)}); } sub lucky_count_lower { my($n) = @_; validate_integer_nonneg($n); return scalar(grep { defined $_ && $_ <= $n } @_small_lucky) if $n <= $_small_lucky[-1]; my($lo,$hi) = (_simple_lucky_count_lower($n), _simple_lucky_count_upper($n)); _binary_search($n, $lo, $hi, sub{Math::Prime::Util::nth_lucky_upper(shift)}); } sub nth_lucky { my($n) = @_; validate_integer_nonneg($n); return $_small_lucky[$n] if $n <= 0+$#_small_lucky; my $k = $n-1; my $ln = lucky_numbers($n); shift @$ln; $k += int($k / ($_-1)) for reverse @$ln; 2*$k+1; } sub nth_lucky_approx { my($n) = @_; validate_integer_nonneg($n); return $_small_lucky[$n] if $n <= 0+$#_small_lucky; $n = "$n" if ref($n); my($logn, $loglogn, $mult) = (log($n), log(log($n)), 1); if ($n <= 80000) { my $c = ($n <= 10000) ? 0.2502 : 0.2581; $mult = $logn + 0.5 * $loglogn + $c * $loglogn * $loglogn; } else { my $c = ($n <= 10000) ? -0.0173 : ($n <= 100000) ? -0.0318 : ($n <= 1000000) ? -0.0384 : ($n <= 10000000) ? -0.0422 : -0.0440; $mult = $logn + (0.5 + $c) * $loglogn *$loglogn; } return int( $n * $mult + 0.5); } sub nth_lucky_upper { my($n) = @_; validate_integer_nonneg($n); return $_small_lucky[$n] if $n <= 0+$#_small_lucky; my $c = ($n <= 100) ? 1.05 : ($n <= 300) ? 1.03 : ($n <= 800) ? 1.01 : 1.0033; return 1 + int( $c * nth_lucky_approx($n) + 0.5 ); } sub nth_lucky_lower { my($n) = @_; validate_integer_nonneg($n); return $_small_lucky[$n] if $n <= 0+$#_small_lucky; my $c = ($n <= 130) ? 0.985 : ($n <= 1000) ? 0.992 : 0.996; return int( $c * nth_lucky_approx($n) ); } sub is_lucky { my($n) = @_; # Pretests return 0 if $n <= 0 || !($n % 2) || ($n % 6) == 5 || $_lf63[$n % 63]; return 1 if $n < 45; # Really simple but slow: # return lucky_numbers($n)->[-1] == $n; my $upper = int(200 + 0.994 * $n / log($n)); my $lucky = lucky_numbers($upper); my $pos = ($n+1) >> 1; my $i = 1; while (1) { my $l = ($i <= $#$lucky) ? $lucky->[$i++] : nth_lucky($i++); return 1 if $pos < $l; my $quo = int($pos / $l); return 0 if $pos == $quo * $l; $pos -= $quo; } } sub minimal_goldbach_pair { my($n) = @_; validate_integer_nonneg($n); return undef if $n < 4; return Mis_prime($n-2) ? 2 : undef if $n == 4 || Mis_odd($n); my($p,$H)=(3,Mrshiftint($n)); while ($p <= $H) { return $p if Mis_prime($n-$p); $p = next_prime($p); } undef; } sub goldbach_pair_count { my($n) = @_; validate_integer_nonneg($n); return 0 if $n < 4; return Mis_prime($n-2) ? 1 : 0 if $n == 4 || Mis_odd($n); my $s = 0; Mforprimes( sub { $s++ if Mis_prime($n-$_); }, Mrshiftint($n), $n-3); $s; } sub goldbach_pairs { my($n) = @_; return goldbach_pair_count($n) unless wantarray; validate_integer_nonneg($n); return () if $n < 4; return Mis_prime($n-2) ? (2) : () if $n & 1 || $n == 4; my @L; Mforprimes( sub { push @L,$n-$_ if Mis_prime($n-$_); }, Mrshiftint($n,1), $n-3); reverse @L; } sub primorial { my($n) = @_; my @plist = @{Mprimes($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++; } } Mvecprod(@plist); } sub pn_primorial { my($n) = @_; return (1,2,6,30,210,2310,30030,510510,9699690,223092870)[$n] if $n < 10; Mprimorial(nth_prime($n)); } sub consecutive_integer_lcm { my($n) = @_; validate_integer_nonneg($n); return (1,1,2)[$n] if $n <= 2; my @powers; for (my $p = 2; $p <= $n; $p = Mnext_prime($p)) { my($p_power, $pmin) = ($p, int($n/$p)); $p_power = Mmulint($p_power,$p) while $p_power <= $pmin; push @powers, $p_power; } my $pn = Mvecprod(@powers); $pn = _bigint_to_int($pn) if $pn <= INTMAX; return $pn; } sub frobenius_number { my(@A) = @_; return undef if scalar(@A) == 0; validate_integer_positive($_) for @A; Mvecsorti(\@A); return -1 if $A[0] == 1; return undef if $A[0] <= 1 || scalar(@A) <= 1; croak "Frobenius number set must be coprime" unless Mgcd(@A) == 1; return Msubint(Msubint(Mmulint($A[0],$A[1]),$A[0]),$A[1]) if scalar(@A) == 2; # Basic Round Robin algorithm from Böcker and Lipták # https://bio.informatik.uni-jena.de/wp/wp-content/uploads/2024/01/BoeckerLiptak_FastSimpleAlgorithm_reprint_2007.pdf my $nlen = $A[0]; my @N = (0, (undef) x ($nlen-1)); for my $i (1 .. $#A) { { # Optimization 3, skip redundant bases my $ai = $A[$i]; my $np = $N[Mmodint($ai,$nlen)]; next if defined $np && $np <= $ai; } my $d = Mgcd($A[0], $A[$i]); my $nlend = Mdivint($nlen,$d); for my $r (0 .. $d-1) { my $n = ($r == 0) ? 0 : Mvecmin(grep {defined} @N[map { $r+$_*$d } 0..$nlend]); if (defined $n) { if (Maddint($n,Mmulint($A[$i],$nlend-1)) <= INTMAX) { for (1 .. $nlend-1) { $n += $A[$i]; my $p = $n % $nlen; if (!defined $N[$p] || $N[$p] >= $n) {$N[$p]=$n;} else {$n=$N[$p];} } } else { for (1 .. $nlend-1) { $n = Maddint($n,$A[$i]); my $p = Mmodint($n,$nlen); if (!defined $N[$p] || $N[$p] >= $n) {$N[$p]=$n;} else {$n=$N[$p];} } } } } } my $max = Mvecmax(grep { defined } @N); $max -= $nlen if defined $max; $max; } sub jordan_totient { my($k, $n) = @_; validate_integer_nonneg($k); validate_integer_nonneg($n); return ($n == 1) ? 1 : 0 if $k == 0; return Mtotient($n) if $k == 1; return ($n == 1) ? 1 : 0 if $n <= 1; return reftyped($_[0], Math::Prime::Util::GMP::jordan_totient($k, $n)) if $Math::Prime::Util::_GMPfunc{"jordan_totient"}; my $totient = 1; foreach my $f (Mfactor_exp($n)) { my ($p, $e) = @$f; $p = Mpowint($p,$k); $totient = Mmulint($totient, $p-1); $totient = Mmulint($totient, $p) for 2 .. $e; } $totient; } sub euler_phi { return _euler_phi_range(@_) if scalar @_ > 1; my($n) = @_; return 0 if defined $n && $n < 0; return reftyped($_[0],Math::Prime::Util::GMP::totient($n)) if $Math::Prime::Util::_GMPfunc{"totient"}; validate_integer_nonneg($n); return $n if $n <= 1; my ($t2, $tot) = (1,1); if ($n % 2 == 0) { my $totk = 0; while (($n % 4) == 0) { $n >>= 1; $totk++; } $n >>= 1; $t2 = $totk < 32 ? 1 << $totk : Mlshiftint(1,$totk) if $totk > 0; } if ($n < INTMAX) { foreach my $f (Mfactor_exp($n)) { my ($p, $e) = @$f; $tot *= $p-1; $tot *= $p for 2 .. $e; } } else { foreach my $f (Mfactor_exp($n)) { my ($p, $e) = @$f; $tot = Mmulint($tot, $p-1); $tot = Mmulint($tot, $p) for 2 .. $e; } } Mmulint($t2, $tot); } sub inverse_totient { my($n) = @_; validate_integer_nonneg($n); return wantarray ? (1,2) : 2 if $n == 1; return wantarray ? () : 0 if $n < 1 || ($n & 1); if (Mis_prime($n >> 1)) { # Coleman Remark 3.3 (Thm 3.1) and Prop 6.2 my $np1 = Madd1int($n); return wantarray ? () : 0 if !Mis_prime($np1); return wantarray ? ($np1, Mmulint($np1,2)) : 2 if $n >= 10; } if (!wantarray) { my %r = ( 1 => 1 ); Mfordivisors(sub { my $d = $_; my $p = Madd1int($d); if (Mis_prime($p)) { my($dp,@sumi,@sumv) = ($d); for my $v (0 .. Mvaluation($n, $p)) { Mfordivisors(sub { my $d2 = $_; if (defined $r{$d2}) { push @sumi, Mmulint($d2,$dp); push @sumv, $r{$d2}; } }, Mdivint($n,$dp)); $dp = Mmulint($dp,$p); } $r{ $sumi[$_] } += $sumv[$_] for 0 .. $#sumi; } }, $n); return (defined $r{$n}) ? $r{$n} : 0; } else { # To save memory, we split this into two steps. my $_verbose = getconfig()->{'verbose'}; my %r = ( 1 => [1] ); my %needed = ( $n => 0 ); my @DIVINFO; # 1. For each divisor from 1 .. n, track which values are needed. for my $d (divisors($n)) { my $p = Madd1int($d); next unless Mis_prime($p); my @L; for my $v (0 .. Mvaluation($n, $p)) { my $pv = Mpowint($p, $v); my($dp,$pp) = map { Mmulint($_,$pv) } ($d,$p); Mfordivisors(sub { my $d2 = $_; my $F = Mmulint($d2,$dp); # In phase 2, we will look at the list in d2 to add to list in F. # If F isn't needed later then we ignore it completely. if (defined $needed{$F} && $needed{$F} < $d) { $needed{$d2} = $d unless defined $needed{$d2}; push @L, [$d2,$pp,$F]; } }, Mdivint($n, $dp)); } push @DIVINFO, [$d, @L]; } print " ... inverse_totient phase 1 complete ...\n" if $_verbose; # 2. Process the divisors in reverse order. for my $dinfo (reverse @DIVINFO) { my($d,@L) = @$dinfo; my %todelete; my @T; # Multiply through by $pp for my $dset (@L) { if (defined $r{$dset->[0]}) { my($d2,$pp,$F) = @$dset; push @T, [$F, [map { Mmulint($pp,$_) } @{$r{$d2}}]]; $todelete{$d2} = 1 if $needed{$d2} >= $d; } } # Delete intermediate data that isn't needed any more delete $r{$_} for keys %todelete; # Append the multiplied lists. push @{$r{$_->[0]}}, @{$_->[1]} for @T; } undef %needed; print " ... inverse_totient phase 2 complete ...\n" if $_verbose; return (defined $r{$n}) ? @{Mvecsorti($r{$n})} : (); } } 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) { ($lo,$hi) = (tobigint($lo),tobigint($hi)) if $hi > 2**49; push @totients, euler_phi($lo++) while $lo <= $hi; } 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 _sumtot { my($n, $cdata, $ecache) = @_; return $cdata->[$n] if $n <= 0+$#$cdata; return $ecache->{$n} if defined $ecache->{$n}; my $sum = Mmulint($n, $n+1) >> 1; my $s = sqrtint($n); my $lim = Mdivint($n, $s+1); my($x, $nextx) = ($n, Mdivint($n,2)); $sum -= Mmulint($x - $nextx, $cdata->[1]); for my $k (2 .. $lim) { ($x,$nextx) = ($nextx, Mdivint($n,$k+1)); $sum -= ($x <= 0+$#$cdata) ? $cdata->[$x] : _sumtot($x, $cdata, $ecache); $sum -= Mmulint($x - $nextx, ($k <= $#$cdata) ? $cdata->[$k] : _sumtot($k, $cdata, $ecache)); } if ($s > $lim) { ($x,$nextx) = ($nextx, Mdivint($n,$s+1)); $sum -= Mmulint($x - $nextx, ($s <= 0+$#$cdata) ? $cdata->[$s] : _sumtot($s, $cdata, $ecache)); } $ecache->{$n} = $sum; $sum; } sub sumtotient { my($n) = @_; validate_integer_nonneg($n); return $n if $n <= 2; if ($n < 900) { # Simple linear sum for small values. my $sum = 0; $sum += $_ for Mtotient(1,$n); return $sum; } my $cbrt = Mrootint($n,3); my $csize = Mvecprod(4, $cbrt, $cbrt); $csize = 50_000_000 if $csize > 50_000_000; # Limit memory use to ~2.5GB my @sumcache = Mtotient(0,$csize); $sumcache[$_] += $sumcache[$_-1] for 2 .. $csize; _sumtot($n, \@sumcache, {}); } sub prime_bigomega { my($n) = @_; validate_integer_abs($n); return scalar(Mfactor($n)); } sub prime_omega { my($n) = @_; validate_integer_abs($n); return scalar(Mfactor_exp($n)); } sub moebius { return _moebius_range(@_) if scalar @_ > 1; my($n) = @_; validate_integer_abs($n); return ($n == 1) ? 1 : 0 if $n <= 1; return 0 if ($n >= 49) && (!($n % 4) || !($n % 9) || !($n % 25) || !($n%49) ); my @factors = Mfactor($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 (Mmoebius($_[0]) != 0) ? 1 : 0; } sub is_odd { my($n) = @_; validate_integer($n); # Note: If n is a Math::BigInt (Calc), then performance: # 0.25x $n->is_odd() # method is fastest # 0.34x (substr($n,-1,1) =~ tr/13579/13579/) # Perl look at string # 0.46x is_odd($n) # XS looks at the string # 1.0x $n % 2 ? 1 : 0 # 1.6x $n & 1 : 1 : 0 # Using LTM backend: # 0.21 $n->is_odd # 0.41 (substr($n,-1,1) =~ tr/13579/13579/) # 0.64 is_odd($n) # 0.9 $n & 1 ? 1 : 0 # 1.0 $n % 2 ? 1 : 0 # # Math::GMPz (30x faster baseline) # 0.23 Math::GMPz::Rmpz_odd_p($n) # 0.73 (substr($n,-1,1) =~ tr/13579/13579/) # 0.95 $n & 1 ? 1 : 0 # 1.0 $n % 2 ? 1 : 0 # 1.5 is_odd($n) my $R = ref($n); return $n->is_odd() ? 1 : 0 if $R eq 'Math::BigInt'; return Math::GMPz::Rmpz_odd_p($n) ? 1 : 0 if $R eq 'Math::GMPz'; return (my $k = substr("$n",-1,1)) =~ tr/13579/13579/ if OLD_PERL_VERSION; return $n % 2 ? 1 : 0; } sub is_even { my($n) = @_; validate_integer($n); my $R = ref($n); return $n->is_even() ? 1 : 0 if $R eq 'Math::BigInt'; return Math::GMPz::Rmpz_even_p($n) ? 1 : 0 if $R eq 'Math::GMPz'; return (my $k = substr("$n",-1,1)) =~ tr/02468/02468/ if OLD_PERL_VERSION; return $n % 2 ? 0 : 1; } sub is_divisible { my($n,@d) = @_; validate_integer_abs($n); for my $d (@d) { validate_integer_abs($d); if ($d == 0) { return 1 if $n == 0; } else { return 1 if $n % $d == 0; } } 0; } sub is_congruent { my($n,$c,$d) = @_; validate_integer($n); validate_integer($c); validate_integer_abs($d); if ($d != 0) { $n = Mmodint($n,$d) if $n < 0 || $n >= $d; $c = Mmodint($c,$d) if $c < 0 || $c >= $d; } return 0+($n == $c); } sub is_smooth { my($n, $k) = @_; validate_integer_abs($n); validate_integer_nonneg($k); return 1 if $n <= 1; return 0 if $k <= 1; return 1 if $n <= $k; return Math::Prime::Util::GMP::is_smooth($n,$k) if $Math::Prime::Util::_GMPfunc{"is_smooth"}; if ($k <= 10000000) { my @f; while (1) { @f = Mtrial_factor($n, $k); last if scalar(@f) <= 1; return 0 if $f[-2] > $k; $n = $f[-1]; } return 0 + ($f[0] <= $k); } return (Mvecnone(sub { $_ > $k }, Mfactor($n))) ? 1 : 0; } sub is_rough { my($n, $k) = @_; validate_integer_abs($n); validate_integer_nonneg($k); return 0+($k == 0) if $n == 0; return 1 if $n == 1 || $k <= 1; return 0 if $k > $n; return 0+($n >= 1) if $k == 2; return Math::Prime::Util::GMP::is_rough($n,$k) if $Math::Prime::Util::_GMPfunc{"is_rough"}; if ($k < 50000) { my @f = Mtrial_factor($n, $k-1); return 0 + ($f[0] >= $k); } return (Mvecnone(sub { $_ < $k }, Mfactor($n))) ? 1 : 0; } sub is_powerful { my($n, $k) = @_; validate_integer($n); if (defined $k) { validate_integer_nonneg($k); } else { $k = 2; } return 0 if $n < 1; return 1 if $n == 1 || $k <= 1; return Math::Prime::Util::GMP::is_powerful($n,$k) if $Math::Prime::Util::_GMPfunc{"is_powerful"}; # First quick checks for inadmissibility. if ($k == 2) { return 0 if ($n%3) == 0 && ($n%9) != 0; return 0 if ($n%5) == 0 && ($n%25) != 0; return 0 if ($n%7) == 0 && ($n%49) != 0; return 0 if ($n%11) == 0 && ($n%121) != 0; } else { return 0 if ($n%3) == 0 && ($n%27) != 0; return 0 if ($n%5) == 0 && ($n%125) != 0; return 0 if ($n%7) == 0 && ($n%343) != 0; return 0 if ($n%11) == 0 && ($n%1331) != 0; } # Next, check and remove all primes under 149 with three 64-bit gcds. for my $GCD ("614889782588491410","3749562977351496827","4343678784233766587") { my $g = Mgcd($n, $GCD); if ($g != 1) { # Check anything that divides n also divides k times (and remove). my $gk = Mpowint($g, $k); return 0 if ($n % $gk) != 0; $n = Mdivint($n, $gk); # Now remove any possible further amounts of these divisors. $g = Mgcd($n, $g); while ($n > 1 && $g > 1) { $n = Mdivint($n, $g); $g = Mgcd($n, $g); } return 1 if $n == 1; } } # For small primes, check for perfect powers and thereby limit the search # to divisibiilty conditions on primes less than n^(1/(2k)). This is # usually faster than full factoring. # # But ... it's possible this will take far too long (e.g. n=2^256+1). So # limit to something reasonable. return 1 if $n == 1 || Mis_power($n) >= $k; return 0 if $n < Mpowint(149, 2*$k); my $lim_actual = Mrootint($n, 2*$k); my $lim_effect = ($lim_actual > 10000) ? 10000 : $lim_actual; if ($Math::Prime::Util::_GMPfunc{"trial_factor"}) { while (1) { my @fac = Math::Prime::Util::GMP::trial_factor($n, $lim_effect); last if scalar(@fac) <= 1; my $f = $fac[0]; my $fk = ($k==2) ? $f*$f : Mpowint($f,$k); return 0 if ($n % $fk) != 0; $n = Mdivint($n, $fk); $n = Mdivint($n, $f) while !($n % $f); return 1 if $n == 1 || Mis_power($n) >= $k; return 0 if $n < $fk*$fk; } } else { Mforprimes( sub { my $pk = ($k==2) ? $_*$_ : Mpowint($_,$k); Math::Prime::Util::lastfor(),return if $n < $pk*$pk; if (($n%$_) == 0) { Math::Prime::Util::lastfor(),return if ($n % $pk) != 0; $n = Mdivint($n, $pk); $n = Mdivint($n, $_) while ($n % $_) == 0; Math::Prime::Util::lastfor(),return if $n == 1 || Mis_power($n) >= $k; } }, 149, $lim_effect); } return 1 if $n == 1 || Mis_power($n) >= $k; return 0 if $n <= Mpowint($lim_effect, 2*$k); # Taking too long. Factor what is left. return (Mvecall(sub { $_->[1] >= $k }, Mfactor_exp($n))) ? 1 : 0; } sub _powerful_count_recurse { my($n, $k, $m, $r) = @_; my $lim = Mrootint(Mdivint($n, $m), $r); return $lim if $r <= $k; my $sum = 0; for my $i (1 .. $lim) { if (Mgcd($m,$i) == 1 && Mis_square_free($i)) { $sum += _powerful_count_recurse($n, $k, Mmulint($m,Mpowint($i,$r)), $r-1); } } $sum; } sub powerful_count { my($n, $k) = @_; validate_integer($n); $n = 0 if $n < 0; if (defined $k) { validate_integer_nonneg($k); } else { $k = 2; } return $n if $k <= 1 || $n <= 1; if ($k == 2) { my $sum = 0; # Simple but very slow for n > 2^64. # Math::Prime::Util::forsquarefreeint( # sub { $sum += Msqrtint(Mdivint($n,Mpowint($_,3))); }, # Mrootint($n,3) # ); my($l,$j) = (0,Msqrtint($n)); while ($j > 1) { my $k2 = Mrootint(Mdivint($n,Mmulint($j,$j)),3)+1; my $w = Math::Prime::Util::powerfree_count($k2-1,2); $sum += Mmulint($j,Msubint($w,$l)); $l = $w; $j = Msqrtint(Mdivint($n,Mpowint($k2,3))); } $sum += Math::Prime::Util::powerfree_count(Mrootint($n,3)) - $l; return $sum; } _powerful_count_recurse($n, $k, 1, 2*$k-1); } sub nth_powerful { my($n, $k) = @_; validate_integer_nonneg($n); if (defined $k) { validate_integer_nonneg($k); } else { $k = 2; } return undef if $n == 0; return $n if $k <= 1 || $n <= 1; return Mpowint(2,$k) if $n == 2; return Mpowint(2,$k+1) if $n == 3; # For small n, we can generate k-powerful numbers rapidly. But without # a reasonable upper limit, it's not clear how to effectively do it. # E.g. nth_powerful(100,60) = 11972515182562019788602740026717047105681 my $lo = Mpowint(2, $k+1); my $hi = ~0; if ($k == 2) { $lo = int( $n*$n/4.72303430688484 + 0.3 * $n**(5/3) ); $hi = int( $n*$n/4.72303430688484 + 0.5 * $n**(5/3) ); # for n >= 170 $hi = ~0 if $hi > ~0; $lo = $hi >> 1 if $lo > $hi; } # We should use some power estimate here. # hi could be too low. while (Math::Prime::Util::powerful_count($hi,$k) < $n) { $lo = Madd1int($hi); $hi = Mmulint($k, $hi); } # Simple binary search while ($lo < $hi) { my $mid = $lo + (($hi-$lo) >> 1); if (Math::Prime::Util::powerful_count($mid,$k) < $n) { $lo = $mid+1; } else { $hi = $mid; } } $hi; } sub _genpowerful { # uncoverable subroutine my($m, $r, $n, $k, $arr) = @_; if ($r < $k) { push @$arr, $m; return; } my $rootdiv = Mrootint(Mdivint($n, $m), $r); if ($r == $k) { push @$arr, Mmulint($m, Mpowint($_,$k)) for 1 .. $rootdiv; } else { for my $i (1 .. $rootdiv) { if (Mgcd($m,$i) == 1 && Mis_square_free($i)) { _genpowerful(Mmulint($m, Mpowint($i,$r)), $r-1, $n, $k, $arr); } } } } sub _sumpowerful { my($m, $r, $n, $k) = @_; return $m if $r < $k; my $rootdiv = Mrootint(Mdivint($n, $m), $r); return Mmulint($m, Mpowersum($rootdiv, $k)) if $r == $k; # Faster to generate the terms and add at the end my $R = $r-1; my @v = (_sumpowerful($m, $R, $n, $k)); for my $i (2 .. $rootdiv) { next unless Mgcd($m,$i) == 1 && Mis_square_free($i); my $M = Mmulint($m, Mpowint($i,$r)); push @v, $R == $k ? Mmulint($M,Mpowersum(Mrootint(Mdivint($n,$M),$k),$k)) : _sumpowerful($M, $R, $n, $k); } Mvecsum(@v); } sub _sumpowerful2 { my($n) = @_; my($lR,$lPS,@v) = (0,0); Math::Prime::Util::forsquarefreeint(sub { my $M = Mpowint($_,3); my $R = Msqrtint(Mdivint($n, $M)); ($lR,$lPS) = ($R,Mpowersum($R,2)) if $R != $lR; push @v, Mmulint($M, $lPS); },Mrootint($n,3)); Mvecsum(@v); } sub sumpowerful { my($n, $k) = @_; validate_integer($n); $n = 0 if $n < 0; if (defined $k) { validate_integer_nonneg($k); } else { $k = 2; } return $n if $n <= 1; return Mrshiftint(Mmulint($n,Madd1int($n))) if $k <= 1; return _sumpowerful2($n) if $k == 2; # Alternate method for testing. # my @a; _genpowerful(1, 2*$k-1, $n, $k, \@a); return Mvecsum(@a); return _sumpowerful(1, 2*$k-1, $n, $k); } # Generate k-powerful numbers. See Trizen, Feb 2020 and Feb 2024 sub _pcg { my($lo, $hi, $k, $m, $r, $pn) = @_; my($beg,$end) = (1, Mrootint(Mdivint($hi,$m), $r)); if ($r <= $k) { if ($lo > $m) { my $lom = Mcdivint($lo,$m); if ( ($lom >> $r) == 0) { $beg = 2; } else { $beg = Mrootint($lom,$r); $beg++ if Mpowint($beg,$r) != $lom; } } push @$pn, $m * Mpowint($_,$r) for ($beg .. $end); return; } for my $v ($beg .. $end) { _pcg($lo, $hi, $k, $m * Mpowint($v,$r), $r-1, $pn) if Mgcd($m,$v) == 1 && Mis_square_free($v); } } sub powerful_numbers { my($lo, $hi, $k) = @_; if (defined $k) { validate_integer_nonneg($k); } else { $k = 2; } if (defined $hi) { validate_integer_nonneg($lo); } else { ($lo, $hi) = (1, $lo); } validate_integer_nonneg($hi); return [] if $hi < $lo; return [$lo .. $hi] if $k <= 1; my $pn = []; _pcg($lo, $hi, $k, 1, 2*$k-1, $pn); Mvecsorti($pn); } sub is_powerfree { my($n, $k) = @_; validate_integer_abs($n); if (defined $k) { validate_integer_nonneg($k); } else { $k = 2; } return (($n == 1) ? 1 : 0) if $k < 2 || $n <= 1; #return 1 if $n < Mpowint(2,$k); return 1 if $n < 4; if ($k == 2) { return 0 if !($n % 4) || !($n % 9) || !($n % 25); return 1 if $n < 49; # 7^2 } elsif ($k == 3) { return 0 if !($n % 8) || !($n % 27) || !($n % 125); return 1 if $n < 343; # 7^3 } # return (Mvecall(sub { $_->[1] < $k }, Mfactor_exp($n))) ? 1 : 0; for my $pe (Mfactor_exp($n)) { return 0 if $pe->[1] >= $k; } 1; } sub powerfree_count { my($n, $k) = @_; validate_integer_abs($n); if (defined $k) { validate_integer_nonneg($k); } else { $k = 2; } return (($n >= 1) ? 1 : 0) if $k < 2 || $n <= 1; my $count = 0; my $nk = Mrootint($n, $k); # If we can do everything native, do that. if ($n < SINTMAX && $nk < 20000) { use integer; my @mu = Mmoebius(0, $nk); foreach my $i (2 .. $nk) { $count += $mu[$i] * $n/($i**$k) if $mu[$i]; } return Maddint($count,$n); } elsif ($n < SINTMAX && $nk < 1e8) { # Split out the trailing n/i^k = 1, saves memory and time if large enough. use integer; my $L1 = Mrootint($n/2,$k); my @mu = Mmoebius(0, $L1); foreach my $i (2 .. $L1) { $count += $mu[$i] * $n/($i**$k) if $mu[$i]; } #@mu = Mmoebius($L1+1, $nk); my $c1 = 0; $c1 += $_ for @mu; my $c1 = Math::Prime::Util::mertens($nk) - Math::Prime::Util::mertens($L1); return Mvecsum($count,$c1,$n); } # Simple way. All the bigint math kills performance. # Math::Prime::Util::forsquarefree( # sub { # my $t = Mdivint($n, Mpowint($_, $k)); # $count = (scalar(@_) & 1) ? Msubint($count,$t) : Maddint($count,$t); # }, # 2, $nk # ); # Optimization 1: pull out all the ranges at the end with small constant # multiplications. # Optimization 2: Use GMP basic arithmetic functions if possible, saving # all the bigint object overhead. Can be 10x faster. my $A = Msqrtint($nk); my @L = (0, $nk, map { Mrootint(Mdivint($n,$_),$k) } 2..$A); my @C; Math::Prime::Util::forsquarefree( sub { $count = (scalar(@_) & 1) ? Ssubint($count, Sdivint($n, Spowint($_, $k))) : Saddint($count, Sdivint($n, Spowint($_, $k))); }, 2, $L[$A] ); for my $i (2 .. $A) { my($c, $lo, $hi) = (0, $L[$i], $L[$i-1]); if ($i < 15) { $c = Math::Prime::Util::mertens($hi) - Math::Prime::Util::mertens($lo); } else { $c += $_ for Mmoebius( Madd1int($lo), $hi ); } push @C, $c * ($i-1); @C = (Mvecsum(@C)) if scalar(@C) > 100000; # Save/restrict memory. } my $ctot = Mvecsum(@C); # Can typically be done in native math. Mvecsum($count, $n, $ctot); } sub nth_powerfree { my($n, $k) = @_; validate_integer_nonneg($n); if (defined $k) { validate_integer_nonneg($k); } else { $k = 2; } return undef if $n == 0 || $k < 2; return $n if $n < 4; # 1. zm is the zeta multiplier (float), qk is the expected value (integer). my($zm, $qk); if ($n <= 2**52) { $zm = ($k == 2) ? 1.644934066848226 : 1.0 + RiemannZeta($k); } else { do { require Math::BigFloat; Math::BigFloat->import(); } if !defined $Math::BigFloat::VERSION; require Math::Prime::Util::ZetaBigFloat; my $acc = length("$n")+10; my $bk = Math::BigFloat->new($k); $bk->accuracy($acc); $zm = Math::Prime::Util::ZetaBigFloat::RiemannZeta($bk)->badd(1)->numify; } my $verbose = getconfig()->{'verbose'}; $qk = Mtoint($zm * "$n"); print "nth_powerfree: zm $zm qk $qk\n" if $verbose; my($count, $diff); # In practice this converges very rapidly, usually needing only one iteration. for (1 .. 10) { # 2. Get the actual count at qk and the difference from our goal. $count = Math::Prime::Util::powerfree_count($qk,$k); $diff = ($count >= $n) ? $count-$n : $n-$count; print "nth_powerfree: iter $_, count $count diff $diff\n" if $verbose; last if $diff <= 300; # Threshold could be improved. # 3. If not close, update the estimate using the expected density zm. my $delta = Mtoint($zm * "$diff"); $qk = $count > $n ? Msubint($qk,$delta) : Maddint($qk,$delta); } print "nth_powerfree: $qk, moving down to a powerfree number\n" if $verbose; # 4. Make sure we're on a powerfree number. $qk-- while !Math::Prime::Util::is_powerfree($qk,$k); print "nth_powerfree: $qk, need to move ",abs($n-$count)," steps\n" if $verbose; # 5. Walk forward or backward to next/prev powerfree number. my $adder = ($count < $n) ? 1 : -1; while ($count != $n) { do { $qk += $adder; } while !Math::Prime::Util::is_powerfree($qk,$k); $count += $adder; } $qk; } sub powerfree_sum { my($n, $k) = @_; validate_integer_nonneg($n); if (defined $k) { validate_integer_nonneg($k); } else { $k = 2; } return (($n >= 1) ? 1 : 0) if $k < 2 || $n <= 1; my $sum = 0; my($ik, $nik, $T); Math::Prime::Util::forsquarefree( sub { $ik = Mpowint($_, $k); $nik = Mdivint($n, $ik); $T = Mrshiftint(Mmulint($nik, Madd1int($nik))); $sum = (scalar(@_) & 1) ? Msubint($sum, Mmulint($ik,$T)) : Maddint($sum, Mmulint($ik,$T)); }, Mrootint($n, $k) ); $sum; } sub powerfree_part { my($n, $k) = @_; my $negmul = ($n < 0) ? -1 : 1; validate_integer_abs($n); if (defined $k) { validate_integer_nonneg($k); } else { $k = 2; } return $negmul if $n == 1; return 0 if $k < 2 || $n == 0; #return Mvecprod(map { Mpowint($_->[0], $_->[1] % $k) } Mfactor_exp($n)); # Rather than build with k-free section, we will remove excess powers my $P = $n; for my $pe (Mfactor_exp($n)) { $P = Mdivint($P, Mpowint($pe->[0], $pe->[1] - ($pe->[1] % $k))) if $pe->[1] >= $k; } $P = Mnegint($P) unless $negmul == 1; $P; } sub _T { my($n) = @_; return $n < 65536 ? ($n*($n+1))>>1 : Mrshiftint(Mmulint($n, Madd1int($n))); } sub _fprod { my($n,$k) = @_; Mvecprod(map { 1 - Mpowint($_->[0], $k) } Mfactor_exp($n)); } sub powerfree_part_sum { my($n, $k) = @_; validate_integer_abs($n); if (defined $k) { validate_integer_nonneg($k); } else { $k = 2; } return (($n >= 1) ? 1 : 0) if $k < 2 || $n <= 1; Mvecsum( _T($n), map { Mmulint(_fprod($_,$k), _T(Mdivint($n, Mpowint($_, $k)))) } 2 .. Mrootint($n,$k) ); } sub squarefree_kernel { my($n) = @_; validate_integer($n); return Mnegint(Mlcm(Mfactor(Mnegint($n)))) if $n < 0; Mlcm(Mfactor($n)); } sub is_perfect_power { my($n) = @_; validate_integer($n); if ($n < 0) { my $res = Mis_power(Mnegint($n)); return ($n == -1 || ($res > 2 && (($res & ($res-1)) != 0))) ? 1 : 0; } return (1,1,0,0,1,0,0,0,1,1)[$n] if $n <= 9; return (Mis_power($n) > 1) ? 1 : 0; } sub _perfect_power_count { my($n) = @_; return 0+($n>=1)+($n>=4) if $n < 8; #return reftyped($_[0], Math::Prime::Util::GMP::perfect_power_count($n)) # if $Math::Prime::Util::_GMPfunc{"perfect_power_count"}; my @T = (1); my $log2n = Mlogint($n,2); for my $k (2 .. $log2n) { my $m = Mmoebius($k); next if $m == 0; push @T, Mmulint(-$m, Msub1int(Mrootint($n,$k))); } Mvecsum(@T); } sub perfect_power_count { my($lo,$hi) = @_; if (defined $hi) { validate_integer_nonneg($lo); } else { ($lo,$hi) = (1, $lo); } validate_integer_nonneg($hi); return 0 if $hi < $lo || $hi == 0; return _perfect_power_count($hi) - (($lo <= 1) ? 0 : _perfect_power_count($lo-1)); } sub perfect_power_count_approx { my($n) = @_; validate_integer_nonneg($n); _perfect_power_count($n); } sub perfect_power_count_lower { my($n) = @_; validate_integer_nonneg($n); _perfect_power_count($n); } sub perfect_power_count_upper { my($n) = @_; validate_integer_nonneg($n); _perfect_power_count($n); } sub _next_perfect_power { my($n, $only_oddpowers) = @_; croak "_npp must have positive n" if $n < 0; return 1 if $n == 0; return ($only_oddpowers ? 8 : 4) if $n == 1; my $log2n = Mlogint($n,2); my $kinit = $only_oddpowers ? 3 : 2; my $kinc = $only_oddpowers ? 2 : 1; my $best = Mpowint(Madd1int(Mrootint($n,$kinit)),$kinit); for (my $k = $kinit+$kinc; $k <= 1+$log2n; $k += $kinc) { my $r = Mrootint($n,$k); my $c = Mpowint(Madd1int($r),$k); $best = addint($c,0) if $c < $best && $c > $n; # OLD_PERL_VERSION } $best; } sub _prev_perfect_power { my($n, $only_oddpowers) = @_; croak "_ppp must have positive n" if $n < 0; return 0 + ($n>1) - ($n==0) if $n <= 4; return $only_oddpowers ? 1 : 4 if $n <= 8; my $log2n = Mlogint($n,2); my $kinit = $only_oddpowers ? 3 : 2; my $kinc = $only_oddpowers ? 2 : 1; my $best = 8; for (my $k = $kinit; $k <= $log2n; $k += $kinc) { my $r = Mrootint($n,$k); if ($r > 1) { my $c = Mpowint($r,$k); $c = Mpowint(Msub1int($r),$k) if $c >= $n; $best = addint($c,0) if $c > $best && $c < $n; # OLD_PERL_VERSION } } $best; } sub next_perfect_power { my($n) = @_; validate_integer($n); return 0 + ($n>=0) - ($n<-1) if $n < 1 && $n >= -4; return Mnegint( _prev_perfect_power( Mnegint($n), 1 ) ) if $n < 0; _next_perfect_power($n, 0); } sub prev_perfect_power { my($n) = @_; validate_integer($n); return 0 + ($n>1) - ($n==0) if $n <= 4 && $n >= 0; return Mnegint( _next_perfect_power( Mnegint($n), 1 ) ) if $n < 0; _prev_perfect_power($n, 0); } sub nth_perfect_power_approx { my($n) = @_; validate_integer_nonneg($n); return (undef,1,4,8,9,16,25,27)[$n] if $n < 8; # See https://www.emis.de/journals/JIS/VOL15/Jakimczuk/jak29.pdf # See https://www.researchgate.net/publication/268998744_Sums_of_perfect_powers # This is more accurate and about 200x faster than using BigFloat. if ($n > 2**32 && $Math::Prime::Util::_GMPfunc{"powreal"}) { *Gaddreal = \&Math::Prime::Util::GMP::addreal; *Gmulreal = \&Math::Prime::Util::GMP::mulreal; *Gpowreal = \&Math::Prime::Util::GMP::powreal; my $d = 2 * length($n) + 2; my $pp = Gmulreal($n,$n,$d); $pp = Gaddreal($pp, Gmulreal(13/3 ,Gpowreal($n, 4/3 ,$d),$d),$d); $pp = Gaddreal($pp, Gmulreal(32/15,Gpowreal($n,16/15,$d),$d),$d); $pp = Gaddreal($pp, Gmulreal(-2 ,Gpowreal($n, 5/3 ,$d),$d),$d); $pp = Gaddreal($pp, Gmulreal(-2 ,Gpowreal($n, 7/5 ,$d),$d),$d); $pp = Gaddreal($pp, Gmulreal(-2 ,Gpowreal($n, 9/7 ,$d),$d),$d); $pp = Gaddreal($pp, Gmulreal( 2 ,Gpowreal($n,12/10,$d),$d),$d); $pp = Gaddreal($pp, Gmulreal(-2 ,Gpowreal($n,13/11,$d),$d),$d); $pp = Gaddreal($pp, Gmulreal(-2 ,Gpowreal($n,15/13,$d),$d),$d); $pp = Gaddreal($pp, Gmulreal( 2 ,Gpowreal($n,16/14,$d),$d),$d); $pp = Gaddreal($pp, Gmulreal( 2 ,Gpowreal($n,17/15,$d),$d),$d); $pp = Gaddreal($pp, Gmulreal(-0.48,Gpowreal($n,19/17,$d),$d),$d); $pp = Gaddreal($pp, -1.5,$d); $pp =~ s/\..*//; return Mtoint("$pp"); } # Without this upgrade, it will return non-integers. $n = _upgrade_to_float($n) if $n > 2**32; if (!ref($n)) { my $pp = $n*$n + (13/3)*$n**(4/3) + (32/15)*$n**(16/15); $pp += -2*$n**( 5/ 3) + -2*$n**( 7/ 5); $pp += -2*$n**( 9/ 7) + 2*$n**(12/10); $pp += -2*$n**(13/11) + -2*$n**(15/13); $pp += 2*$n**(16/14) + 2*$n**(17/15); $pp -= 0.48*$n**(19/17); return Mtoint($pp - 1.5); } # Taking roots is very expensive with Math::BigFloat, so minimize. my $n143 = $n->copy->broot(143); my $n105 = $n->copy->broot(105); my $n15 = $n105->copy->bpow(7); my $n13 = $n143->copy->bpow(11); my $n11 = $n143->copy->bpow(13); my $n7 = $n105->copy->bpow(15); my $n5 = $n105->copy->bpow(21); my $n3 = $n105->copy->bpow(35); my $pp = $n*$n + (13/3)*$n*$n3 + (32/15)*$n*$n15; $pp += -2*$n*$n3**2 + -2*$n*$n5**2; $pp += -2*$n*$n7**2 + 2*$n*$n5; $pp += -2*$n*$n11**2 + -2*$n*$n13**2; $pp += 2*$n*$n7 + 2*$n*$n15**2; $pp -= 0.48*$n*$n143**16.82352941176470588; # close to 2/17 $pp -= 1.5; $pp = $pp->as_int(); Mtoint($pp); } sub nth_perfect_power_lower { my($n) = @_; validate_integer_nonneg($n); return (undef,1,4,8,9,16,25,27)[$n] if $n < 8; $n = _upgrade_to_float($n) if ref($n) || $n > 2**32; my $pp = $n*$n + (13/3)*$n**(4/3) + (32/15)*$n**(16/15); $pp += -2*$n**( 5/ 3) + -2*$n**( 7/ 5); $pp += -2*$n**( 9/ 7) + 2*$n**(12/10); $pp += -2*$n**(13/11) + -2*$n**(15/13); $pp += 1.5; Mtoint($pp); } sub nth_perfect_power_upper { my($n) = @_; validate_integer_nonneg($n); return (undef,1,4,8,9,16,25,27)[$n] if $n < 8; $n = _upgrade_to_float($n) if ref($n) || $n > 2**32; my $pp = $n*$n + (13/3)*$n**(4/3) + (32/15)*$n**(16/15); $pp += -2*$n**( 5/ 3) + -2*$n**( 7/ 5); $pp += -2*$n**( 9/ 7) + 2*$n**(12/10); $pp += 2*$n**(16/14); $pp -= 3.5; Mtoint($pp); } sub nth_perfect_power { my($n) = @_; validate_integer_nonneg($n); return (undef,1,4,8,9,16,25,27)[$n] if $n < 8; my($g,$c,$apn,$gn); $gn = 1; $g = $apn = nth_perfect_power_approx($n); $c = _perfect_power_count($g); while ($n != $c && abs($n-$c) > 1000) { $g += $apn - nth_perfect_power_approx($c); $c = _perfect_power_count($g); last if $gn++ >= 20; } if ($c >= $n) { for ($g = Math::Prime::Util::prev_perfect_power($g+1); $c > $n; $c--) { $g = Math::Prime::Util::prev_perfect_power($g); } } else { for ( ; $c < $n; $c++) { $g = Math::Prime::Util::next_perfect_power($g); } } $g; } sub _prime_power_count { my($n) = @_; return (0,0,1,2,3,4)[$n] if $n <= 5; Mvecsum( map { Mprime_count( Mrootint($n, $_)) } 1 .. Mlogint($n,2) ); } sub prime_power_count { my($lo,$hi) = @_; if (defined $hi) { validate_integer_nonneg($lo); } else { ($lo,$hi) = (2, $lo); } validate_integer_nonneg($hi); return 0 if $hi < $lo || $hi == 0; return _prime_power_count($hi) - (($lo <= 2) ? 0 : _prime_power_count($lo-1)); } sub prime_power_count_lower { my($n) = @_; validate_integer_nonneg($n); return (0,0,1,2,3,4)[$n] if $n <= 5; Mvecsum( map { Math::Prime::Util::prime_count_lower( Mrootint($n, $_)) } 1 .. Mlogint($n,2) ); } sub prime_power_count_upper { my($n) = @_; validate_integer_nonneg($n); return (0,0,1,2,3,4)[$n] if $n <= 5; Mvecsum( map { Math::Prime::Util::prime_count_upper( Mrootint($n, $_)) } 1 .. Mlogint($n,2) ); } sub prime_power_count_approx { my($n) = @_; validate_integer_nonneg($n); return (0,0,1,2,3,4)[$n] if $n <= 5; Mvecsum( map { Math::Prime::Util::prime_count_approx( Mrootint($n, $_)) } 1 .. Mlogint($n,2) ); } sub _simple_nth_prime_power_upper { my($n) = @_; Mnth_prime_upper($n); } sub _simple_nth_prime_power_lower { my $n = shift; return nth_prime_lower(int(0.65*$n)) if $n < 90; int( 0.98 * Math::Prime::Util::nth_prime_lower($n) - 400 ); } sub nth_prime_power_lower { my($n) = @_; validate_integer_nonneg($n); return (undef,2,3,4,5,7,8,9)[$n] if $n < 8; my($lo,$hi) = (_simple_nth_prime_power_lower($n), _simple_nth_prime_power_upper($n)); _binary_search($n, $lo, $hi, sub{Math::Prime::Util::prime_power_count_upper(shift)}); } sub nth_prime_power_upper { my($n) = @_; validate_integer_nonneg($n); return (undef,2,3,4,5,7,8,9)[$n] if $n < 8; my($lo,$hi) = (_simple_nth_prime_power_lower($n), _simple_nth_prime_power_upper($n)); 1+_binary_search($n, $lo, $hi, sub{Math::Prime::Util::prime_power_count_lower(shift)}); } sub nth_prime_power_approx { my($n) = @_; validate_integer_nonneg($n); return (undef,2,3,4,5,7,8,9)[$n] if $n < 8; my($lo,$hi) = (_simple_nth_prime_power_lower($n), _simple_nth_prime_power_upper($n)); _binary_search($n, $lo, $hi, sub{Math::Prime::Util::prime_power_count_approx(shift)}); } sub nth_prime_power { my($n) = @_; validate_integer_nonneg($n); return (undef,2,3,4,5,7,8,9)[$n] if $n < 8; # TODO: This is a good candidte for the approx interpolation method my($lo,$hi) = (_simple_nth_prime_power_lower($n), _simple_nth_prime_power_upper($n)); 1+_binary_search($n, $lo, $hi, sub{Math::Prime::Util::prime_power_count(shift)}); } sub smooth_count { my($n, $k) = @_; validate_integer_nonneg($n); validate_integer_nonneg($k); return 0 if $n < 1; return 1 if $k <= 1; return $n if $k >= $n; my $sum = 1 + Mlogint($n,2); if ($k >= 3) { my $n3 = Mdivint($n, 3); while ($n3 > 3) { $sum += 1 + Mlogint($n3,2); $n3 = Mdivint($n3, 3); } $sum += $n3; } if ($k >= 5) { my $n5 = Mdivint($n, 5); while ($n5 > 5) { $sum += 1 + Mlogint($n5,2); my $n3 = Mdivint($n5, 3); while ($n3 > 3) { $sum += 1 + Mlogint($n3,2); $n3 = Mdivint($n3, 3); } $sum += $n3; $n5 = Mdivint($n5, 5); } $sum += $n5; } my $p = 7; while ($p <= $k) { my $np = Mdivint($n, $p); $sum += ($p >= $np) ? $np : Math::Prime::Util::smooth_count($np, $p); $p = Mnext_prime($p); } $sum; } sub rough_count { my($n, $k) = @_; validate_integer_nonneg($n); validate_integer_nonneg($k); return $n if $k <= 2; return $n-($n>>1) if $k <= 3; Math::Prime::Util::legendre_phi($n, Mprime_count($k-1)); } # Recursive almost primes from Trizen. sub _genkap { my($A, $B, $k, $m, $p, $cb) = @_; if ($k == 1) { Mforprimes( sub { $cb->(Mmulint($m, $_)); }, Mvecmax($p, Mcdivint($A, $m)), Mdivint($B, $m)); } else { my $s = Mrootint(Mdivint($B, $m), $k); while ($p <= $s) { my $t = mulint($m, $p); _genkap($A, $B, $k-1, $t, $p, $cb) if Mcdivint($A, $t) <= Mdivint($B, $t); # Faster for tight ranges $p = next_prime($p); } } } sub _generate_almost_primes { my($A, $B, $k, $cb) = @_; $A = Mvecmax($A, Mpowint(2, $k)); _genkap($A, $B, $k, 1, 2, $cb) if $A <= $B; } sub almost_primes { my($k, $low, $high) = @_; validate_integer_nonneg($k); if (defined $high) { validate_integer_nonneg($low); } else { ($low,$high) = (1, $low); } validate_integer_nonneg($high); if ($k == 0) { return ($low <= 1 && $high >= 1) ? [1] : [] } if ($k == 1) { return Mprimes($low,$high); } # Don't call this, we could end up back here #if ($k == 2) { return Math::Prime::Util::semi_primes($low,$high); } my $minlow = Mpowint(2,$k); $low = $minlow if $low < $minlow; return [] if $low > $high; my @ap; if ($low > 1e9) { #while ($low <= $high) { # push @ap, $low if is_almost_prime($k, $low); # $low = add1int($low); #} Math::Prime::Util::forfactored(sub { push @ap,$_ if scalar(@_) == $k }, $low, $high); return \@ap; } _generate_almost_primes($low, $high, $k, sub { push @ap,$_[0]; }); Mvecsorti(\@ap); } sub _rec_omega_primes { my($k, $lo, $hi, $m, $p, $opl) = @_; my $s = Mrootint(Mdivint($hi, $m), $k); foreach my $q (@{Mprimes($p, $s)}) { next if $m % $q == 0; for (my $v = Mmulint($m, $q); $v <= $hi ; $v = Mmulint($v, $q)) { if ($k == 1) { push @$opl, $v if $v >= $lo; } else { _rec_omega_primes($k-1,$lo,$hi,$v,$q,$opl) if Mmulint($v,$q) <= $hi; } } } } sub omega_primes { my($k, $low, $high) = @_; validate_integer_nonneg($k); if (defined $high) { validate_integer_nonneg($low); } else { ($low,$high) = (1, $low); } validate_integer_nonneg($high); if ($k == 0) { return ($low <= 1 && $high >= 1) ? [1] : [] } if ($k == 1) { return Math::Prime::Util::prime_powers($low,$high); } $low = Mvecmax($low, Mpn_primorial($k)); return [] if $low > $high; my $opl = []; if ($high-$low > 1000000000 || ($k >= 10 && $high-$low > 10000000)) { # Recursive method from trizen _rec_omega_primes($k, $low, $high, 1, 2, $opl); Mvecsorti($opl); } else { # Simple iteration while ($low <= $high) { push @$opl, $low if Mprime_omega($low) == $k; $low++; } } $opl; } sub is_semiprime { my($n) = @_; validate_integer($n); return 0+($n == 4) if $n < 6; if ($n > 15) { return 0 if ($n % 4) == 0 || ($n % 6) == 0 || ($n % 9) == 0 || ($n % 10) == 0 || ($n % 14) == 0 || ($n % 15) == 0; } 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; if (0) { # TODO: This is all REALLY slow without GMP # TODO: Something with GMP. If nothing else, just factor. { 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(Mfactor($n)) == 2) ? 1 : 0; } sub is_almost_prime { my($k, $n) = @_; validate_integer_nonneg($k); validate_integer($n); return 0 if $n <= 0; return 0+($n==1) if $k == 0; return (Mis_prime($n) ? 1 : 0) if $k == 1; return Mis_semiprime($n) if $k == 2; return 0 if ($n >> $k) == 0; # TODO: Optimization here if (0) { # This seems to just be slower while ($k > 0 && !($n % 2)) { $k--; $n >>= 1; } while ($k > 0 && !($n % 3)) { $k--; $n /= 3; } while ($k > 0 && !($n % 5)) { $k--; $n /= 5; } while ($k > 0 && !($n % 7)) { $k--; $n /= 7; } return 0+($n == 1) if $k == 0; return (Mis_prime($n) ? 1 : 0) if $k == 1; return Mis_semiprime($n) if $k == 2; return 0 if $n < Mpowint(11,$k); } return (scalar(Mfactor($n)) == $k) ? 1 : 0; } sub is_chen_prime { my($n) = @_; validate_integer($n); return 0 if $n < 2; my $n2 = Maddint($n,2); return (Mis_prime($n) && (Mis_prime($n2) || Mis_semiprime($n2))); } sub next_chen_prime { my($n) = @_; validate_integer_nonneg($n); $n = Mnext_prime($n); while (1) { my $n2 = Maddint($n,2); return $n if Mis_prime($n2) || Mis_semiprime($n2); $n = Mnext_prime($n2); } } sub is_omega_prime { my($k, $n) = @_; validate_integer_nonneg($k); validate_integer($n); return 0 if $n <= 0; return 0+($n==1) if $k == 0; return (Mprime_omega($n) == $k) ? 1 : 0; } sub is_practical { my($n) = @_; validate_integer($n); return 0 if $n <= 0; return $n==1?1:0 if $n % 2; return 1 if ($n & ($n-1)) == 0; return 0 if ($n % 6) && ($n % 20) && ($n % 28) && ($n % 88) && ($n % 104) && ($n % 16); my $prod = 1; my @pe = Mfactor_exp($n); for my $i (1 .. $#pe) { my($f,$e) = @{$pe[$i-1]}; my $fmult = $f + 1; if ($e >= 2) { my $pke = $f; for (2 .. $e) { $pke = Mmulint($pke, $f); $fmult = Maddint($fmult, $pke); } } $prod = Mmulint($prod, $fmult); return 0 if $pe[$i]->[0] > (1 + $prod); } 1; } sub is_delicate_prime { my($n, $b) = @_; validate_integer_nonneg($n); if (defined $b) { validate_integer_nonneg($b); croak "is_delicate_prime base must be >= 2" if $b < 2; } else { $b = 10; } return 0 if $b == 10 && $n < 100; # Easy shown. return 1 if $b == 3 && $n == 2; return 0 unless Mis_prime($n); if ($b == 10) { # String replacement method. Faster in Perl. my $ndigits = length($n); for my $d (0 .. $ndigits-1) { my $N = "$n"; my $dold = substr($N,$d,1); for my $dnew (0 .. 9) { next if $dnew == $dold; if ($d == 0 && $dnew == 0) { # Leading zeros (my $T = substr($N,1)) =~ s/^0*//; return 0 if Mis_prime($T); } else { substr($N,$d,1) = $dnew; return 0 if Mis_prime($N); } } } } else { # Using todigitstring is slightly faster for bases < 10, but this is # decent and works for all 32-bit bases. # This is faster than Stamm's algorithm (in Perl, for possible bigints). my $D = [Mtodigits($n, $b)]; for my $d (0 .. $#$D) { my $dold = $D->[$d]; for my $dnew (0 .. $b-1) { next if $dnew == $dold; $D->[$d] = $dnew; return 0 if Mis_prime(Mfromdigits($D,$b)); } $D->[$d] = $dold; } } 1; } sub _totpred { my($n, $maxd) = @_; return 0 if $maxd <= 1 || Mis_odd($n); return 1 if ($n & ($n-1)) == 0; $n >>= 1; return 1 if $n == 1 || ($n < $maxd && Mis_prime(2*$n+1)); for my $d (Mdivisors($n)) { last if $d >= $maxd; my $p = ($d < (INTMAX >> 2)) ? ($d << 1) + 1 : Madd1int(Mlshiftint($d)); next unless Mis_prime($p); my $r = Mdivint($n,$d); while (1) { return 1 if $r == $p || _totpred($r, $d); my($Q,$R) = divrem($r,$p); last if $R != 0; $r = $Q; } } 0; } sub is_totient { my($n) = @_; validate_integer($n); return 0+($n==1) if $n <= 1; 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)); } } my @mu; if ($hi > 2**32) { ($lo,$hi) = (tobigint($lo),tobigint($hi)) if $hi > 2**49; push @mu, moebius($lo++) while $lo <= $hi; return @mu; } for (my $i = $lo; $i <= $hi; $i++) { push @mu, 1; } $mu[0] = 0 if $lo == 0; my($p, $sqrtn) = (2, Msqrtint($hi)); 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 = Mnext_prime($p); } for (my $i = $lo; $i <= $hi; $i++) { my $m = $mu[$i-$lo]; $m *= -1 if abs($m) != $i; $mu[$i-$lo] = ($m>0) - ($m<0); } return @mu; } sub _omertens { 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, Mmoebius(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 _rmertens { my($n, $Mref, $Href, $size) = @_; return $Mref->[$n] if $n <= $size; return $Href->{$n} if exists $Href->{$n}; my $s = Msqrtint($n); my $ns = int($n/($s+1)); my ($nk, $nk1) = ($n, Mrshiftint($n)); my $SUM = Msubint(1,Msubint($nk,$nk1)); my @S; foreach my $k (2 .. $ns) { ($nk, $nk1) = ($nk1, Mdivint($n,$k+1)); push @S, ($nk <= $size) ? $Mref->[$nk] : _rmertens($nk, $Mref, $Href, $size); push @S, $Mref->[$k] * ($nk - $nk1); } push @S, Mmulint($Mref->[$s], Mdivint($n,$s) - $ns) if $s > $ns; $SUM = Msubint($SUM, Mvecsum(@S)); $Href->{$n} = $SUM; $SUM; } sub mertens { my($n) = @_; validate_integer_nonneg($n); return _omertens($n) if $n < 20000; # Larger size would be faster, but more memory. my $size = (Mrootint($n, 3)**2) >> 2; $size = Msqrtint($n) if $size < Msqrtint($n); my @M = (0); push @M, $M[-1] + $_ for Mmoebius(1, $size); my %seen; return _rmertens($n, \@M, \%seen, $size); } sub ramanujan_sum { my($k,$n) = @_; validate_integer_nonneg($k); validate_integer_nonneg($n); return 0 if $k < 1 || $n < 1; my $g = $k / Mgcd($k,$n); my $m = Mmoebius($g); return $m if $m == 0 || $k == $g; $m * (Mtotient($k) / Mtotient($g)); } sub liouville { my($n) = @_; validate_integer_nonneg($n); return (scalar Mfactor($n)) & 1 ? -1 : 1; } sub sumliouville { my($n) = @_; validate_integer_nonneg($n); return (0,1,0,-1,0,-1,0,-1,-2,-1,0,-1,-2,-3,-2,-1)[$n] if $n < 16; # Build the Mertens lookup info once. my $sqrtn = Msqrtint($n); my $size = (Mrootint($n, 3)**2) >> 2; $size = $sqrtn if $size < $sqrtn; my %seen; my @M = (0); push @M, $M[-1] + $_ for Mmoebius(1, $size); # L(n) = sum[k=1..sqrt(n)](Mertens(n/(k^2))) my $L = 0; for my $k (1 .. $sqrtn) { #my $nk = Mdivint($n, Mmulint($k,$k)); my $nk = int($n/($k*$k)); return Mvecsum($L, $sqrtn, -$k, 1) if $nk == 1; $L = Maddint($L,($nk <= $size) ? $M[$nk] : _rmertens($nk,\@M,\%seen,$size)); } return $L; } # Exponential of Mangoldt function (A014963). # Return p if n = p^m [p prime, m >= 1], 1 otherwise. sub exp_mangoldt { my($n) = @_; validate_integer_nonneg($n); return 1 if $n <= 1; if (Mis_prime_power($n, \my $p)) { return $p; } 1; } sub carmichael_lambda { my($n) = @_; validate_integer_nonneg($n); return Mtotient($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 = Mfactor_exp($n); $pe[0]->[1]-- if $pe[0]->[0] == 2 && $pe[0]->[1] > 2; Mlcm( map { Mmulint(Mpowint($_->[0],$_->[1]-1),$_->[0]-1) } @pe ); } sub is_cyclic { my($n) = @_; validate_integer($n); return 0+($n > 0) if $n < 4; return 0 if ($n % 2) == 0; return 0 if (!($n % 9) || !($n%25) || !($n%49) || !($n%121)); return 0 if (!($n %21) || !($n%39) || !($n%55) || !($n%57) || !($n%93)); return 1 if Mgcd($n,Mtotient($n)) == 1; 0; } sub is_carmichael { my($n) = @_; validate_integer($n); return 0 if $n < 561 || ($n % 2) == 0; return reftyped($_[0], Math::Prime::Util::GMP::is_carmichael($n)) if $Math::Prime::Util::_GMPfunc{"is_carmichael"}; # This works fine, but very slow # return !is_prime($n) && ($n % carmichael_lambda($n)) == 1; 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 Mpowmod(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 Mis_prime($n); for my $t (13 .. 150) { my $a = $_primes_small[$t]; my $gcd = Mgcd($a, $fn); if ($gcd == 1) { return 0 if Mpowmod($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 = Mfactor_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_integer_nonneg($n); return 0 if $n < 35; return 0 if (!($n % 4) || !($n % 9) || !($n % 25) || !($n%49) || !($n%121)); my @pe = Mfactor_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 Mvecall(sub { $nb % ($_-$b) == 0 }, @f); } if (scalar(@f) > 2) { for my $b (1 .. $lim-1) { my $nb = $n + $b; $nbases++ if Mvecall(sub { $nb % ($_+$b) == 0 }, @f); } } } else { my($spf,$lpf) = ($f[0], $f[-1]); if (scalar(@f) == 2) { foreach my $d (Mdivisors($n/$spf - 1)) { my $k = $spf - $d; my $p = $n - $k; last if $d >= $spf; $nbases++ if Mvecall(sub { my $j = $_-$k; $j && ($p % $j) == 0 }, @f); } } else { foreach my $d (Mdivisors($lpf * ($n/$lpf - 1))) { my $k = $lpf - $d; my $p = $n - $k; next if $k == 0 || $k >= $spf; $nbases++ if Mvecall(sub { my $j = $_-$k; $j && ($p % $j) == 0 }, @f); } } } $nbases; } sub is_pillai { my($p) = @_; validate_integer($p); return 0 if $p < 23; return 0 unless $p % 2 && $p % 3 && $p % 5 && $p % 7; my $pm1 = $p-1; my $nfac = 5040 % $p; for (my $n = 8; $n < $p; $n++) { $nfac = Mmulmod($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 : Mis_square_free($n >> 2)) if $r4 == 0; return Mis_square_free($n) if $r4 == 1; } else { return (($r == 12) ? 0 : Mis_square_free($n >> 2)) if $r4 == 0; return Mis_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) = @_; validate_integer_nonneg($n); return 0 if $n == 0; if (defined $k && ref($k) eq 'CODE') { my $sum = $n-$n; my $refn = ref($n); foreach my $d (Mdivisors($n)) { $sum += $k->( $refn ? $refn->new("$d") : $d ); } return $sum; } return 1 if $n == 1; croak "Second argument must be a code ref or number" unless !defined $k || validate_integer_nonneg($k); $k = 1 if !defined $k; return reftyped($_[0], Math::Prime::Util::GMP::sigma($n, $k)) if $Math::Prime::Util::_GMPfunc{"sigma"}; my @factors = Mfactor_exp($n); return Mvecprod(map { $_->[1]+1 } @factors) if $k == 0; my @prod; if ($k == 1) { foreach my $f (@factors) { my ($p, $e) = @$f; if ($e == 1) { push @prod, $p+1; } elsif ($e == 2 && $p < 65536) { push @prod, ($p+1) + $p * $p; } else { push @prod, Mvecsum($p+1, map { Mpowint($p,$_) } 2..$e); } } } else { foreach my $f (@factors) { my ($p, $e) = @$f; my $pk = Mpowint($p,$k); if ($e == 1) { push @prod, Madd1int($pk); } else { push @prod, Mvecsum(Madd1int($pk), map { Mpowint($pk,$_) } 2..$e); } } } return $prod[0] if @prod == 1; if ($k == 1 && $n < 845404560) { # divisor_sum(n) < 2^32 my $r = 1; $r *= $_ for @prod; return $r; } return Mmulint($prod[0],$prod[1]) if @prod == 2; Mvecprod(@prod); } ############################################################################# # 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); my(@_s3,@_s4); my @_pred5 = (1,0,1,2,3,4,5,0,1,2,3,0,1,0,1,2,3,0,1,0,1,2,3,0,1,2,3,4,5,0); 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) = @_; validate_integer_nonneg($x); validate_integer_nonneg($a); if ($#_s3 == -1) { @_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); @_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); } return _tablephi($x,$a) if $a <= 6; $primes = Mprimes(Mnth_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); $sval -= $_pred5[$sval % 30]; # Reduce sval to one with same phi. 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) = @_; return (0,0,1,2,2,3,3)[$high] if $high < 7; $high-- unless ($high % 2); 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 % 2); 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) = @_; return _sieve_prime_count($x) if $x < 1_000; my $z = Msqrtint($x); my $a = _lehmer_pi(Msqrtint($z)); my $b = _lehmer_pi($z); my $c = _lehmer_pi(Mrootint($x,3)); # Generate at least b primes. my $bth_prime_upper = ($b <= 10) ? 29 : int("$b"*(log("$b")+log(log("$b")))) + 1; my $primes = Mprimes( $bth_prime_upper ); my $sum = Mmulint(Mvecsum($b,$a,-2),Mvecsum($b,-$a,1)) >> 1; $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( Mdivint(Mdivint($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) { validate_integer_nonneg($low); } else { ($low,$high) = (2, $low); } validate_integer_nonneg($high); return 0 if $high < 2 || $low > $high; return reftyped($high, Math::Prime::Util::GMP::prime_count($low,$high)) if $Math::Prime::Util::_GMPfunc{"prime_count"} && (ref($high) eq 'Math::BigInt' || ($high-$low) < int($low/1_000_000)); 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 = Mnext_prime($low-1); while ($curprime <= $high) { $count++; $curprime = Mnext_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_integer_nonneg($n); return undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) return $_primes_small[$n] if $n <= 0+$#_primes_small; $n = _upgrade_to_float($n) if ref($n) || $n > MPU_MAXPRIMEIDX || $n > 2**45; 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_integer_nonneg($n); return undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) return $_primes_small[$n] if $n <= 0+$#_primes_small; $n = _upgrade_to_float($n) if ref($n) || $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 ); } Mtoint($upper + 1.0); } # The nth prime will be greater than or equal to this number sub nth_prime_lower { my($n) = @_; validate_integer_nonneg($n); return undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) return $_primes_small[$n] if $n <= 0+$#_primes_small; $n = _upgrade_to_float($n) if ref($n) || $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)) ); my $plower = Mtoint($lower + 0.999999999); # We clamp to the max UV representable. if (MPU_32BIT) { $plower = 4294967291 if $n >= 203280221 && $plower < 4294967291; } else { $plower = 18446744073709551557 if $n >= 425656284035217743 && $plower < 18446744073709551557; } $plower; } sub inverse_li_nv { my($n) = @_; $n = 0.0 + "$n"; my $t = $n * log($n); # Iterate Halley's method until error term grows my $old_term = MPU_INFINITY; for my $iter (1 .. 10000) { my $dn = MLi($t) - $n; $dn = 0.0 + "$dn" if ref($dn); 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; } $t; } sub inverse_li { my($n) = @_; validate_integer_nonneg($n); return (0,2,3,5,6,8)[$n] if $n <= 5; my $t = Math::Prime::Util::inverse_li_nv(0.0 + "$n"); $t = Mtoint($t + 0.5); # Make it an exact answer my $inc = ($n > 4e16) ? 2048 : 128; if (int(MLi($t-1)) >= $n) { $t -= $inc while int(MLi($t-$inc)) >= $n; for ($inc = $inc >> 1; $inc > 0; $inc >>= 1) { $t -= $inc if int(MLi($t-$inc)) >= $n; } } elsif (int(MLi($t)) < $n) { $t += $inc while int(MLi($t+$inc-1)) < $n; for ($inc = $inc >> 1; $inc > 0; $inc >>= 1) { $t += $inc if int(MLi($t+$inc-1)) < $n; } } $t; } sub _inverse_R { # uncoverable subroutine my($n) = @_; validate_integer_nonneg($n); return (0,2,3,5,6,8)[$n] if $n <= 5; $n = _upgrade_to_float($n) if ref($n) || $n > MPU_MAXPRIMEIDX || $n > 2**45; my $t = $n * log($n); # Iterate 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; } Mtoint( ref($t) ? $t->bceil->bstr : $t+0.99999 ); } sub nth_prime_approx { my($n) = @_; validate_integer_nonneg($n); return undef if $n <= 0; ## no critic qw(ProhibitExplicitReturnUndef) return $_primes_small[$n] if $n <= 0+$#_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) || $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. Mtoint($approx + 0.5); } ############################################################################# sub prime_count_approx { my($x) = @_; validate_integer_nonneg($x); #return (0,0,1,2,2,3,3,4,4,4,4,5,5,6,6,6)[$x] if $x < 16; return _tiny_prime_count($x) if $x < $_primes_small[-1]; # Turn on high precision FP if needed (TODO assumes NV >= double prec) $x = _upgrade_to_float($x) if $x > 10000000000000000; my $floatx = ref($x) eq 'Math::BigFloat'; $x = "$x" if ref($x) && !$floatx; # 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 $floatx; 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 { $result = $floatx ? Math::BigFloat->bzero : 0; $result->accuracy($x->accuracy) if $floatx; $result += MLi($x); $result -= MLi(sqrt($x))/2; my $intx = $floatx ? tobigint($x->bfround(0)) : $x; for my $k (3 .. 1000) { my $m = Mmoebius($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( "" . Mrootint($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 = MLi(Mrootint($intx,$k)) / $k; last if $term < .25; if ($m == 1) { $result += $term; } else { $result -= $term; } } } Mtoint($result+0.5); } sub prime_count_lower { my($x) = @_; validate_integer_nonneg($x); return _tiny_prime_count($x) if $x < $_primes_small[-1]; return reftyped($_[0], Math::Prime::Util::GMP::prime_count_lower($x)) if $Math::Prime::Util::_GMPfunc{"prime_count_lower"}; $x = _upgrade_to_float($x) if $x > 10000000000000000; my $floatx = ref($x) eq 'Math::BigFloat'; $x = "$x" if ref($x) && !$floatx; my($result,$a); my $fl1 = log($x); my $fl2 = $fl1*$fl1; my $one = $floatx ? $x->copy->bone : 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 # Johnston 2021 Cor3.3 li(x)-logx*sqrtx/8Pi x > 2657, x <= 1.101 * 10^26 # Also see Dusart 2018: if RH and x >= 5639, # |pi(x)-li(x)|<= x * (logx-loglogx)/(8*Pi*sqrtx) # TODO: evaluate this 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.1e26 || getconfig()->{'assume_rh'}){ # Büthe 2014/2015 my $lix = MLi($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); } # This will truncate bigfloat or floats to native int or bigint class. Mtoint($result); } sub prime_count_upper { my($x) = @_; validate_integer_nonneg($x); # Give an exact answer for what we have in our little table. return _tiny_prime_count($x) if $x < $_primes_small[-1]; return reftyped($_[0], Math::Prime::Util::GMP::prime_count_upper($x)) if $Math::Prime::Util::_GMPfunc{"prime_count_upper"}; $x = _upgrade_to_float($x) if $x > 10000000000000000; my $floatx = ref($x) eq 'Math::BigFloat'; $x = "$x" if ref($x) && !$floatx; # 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 # Dusart 2018: x/lx*(1+1/lx+2/lxlx+7.59/lxlxlx) x > 1 # 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 # Johnston 2021 Cor 3.3 Schoenfeld bounds hold to x <= 1.0e26 # Skewes li(x) x < 1e14 # TODO: Also look at these from Dusart (2018) [paywalled]. # 1 If RH and x >= 5639, |pi(x)-li(x)|<= x * (logx-loglogx)/(8*Pi*sqrtx) # 2 pi(x) <= li(x) for all 2 <= x <= 10^20 # 3 [li(x) - 2sqrt(x)/log(x)] <= pi(x) for 1090877 <= x <= 10^20 # # See https://arxiv.org/pdf/2404.17165 page 9 for Mossinghoff and Trudgian. # Page 26 also points out the Dusart 2018 improvement to Schoenfeld. # https://math.colgate.edu/~integers/y34/y34.pdf # Axler 2022: # https://arxiv.org/pdf/2203.05917 my($result,$a); my $fl1 = log($x); my $fl2 = $fl1 * $fl1; my $one = $floatx ? $x->copy->bone : 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 = MLi($x) - $a * $fl1*sqrt($x)/PI_TIMES_8; } elsif ($x < 1.1e26 || getconfig()->{'assume_rh'}) { # Schoenfeld / Büthe 2014 Th 7.4 my $lix = MLi($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); } # This will truncate bigfloat or floats to native int or bigint class. Mtoint($result); } sub twin_prime_count { my($low,$high) = @_; if (defined $high) { validate_integer_nonneg($low); } else { ($low,$high) = (2, $low); } validate_integer_nonneg($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) = @_; my($sum,$pc) = (0,0); Mforprimes( sub { $sum += Mprime_count(int($n/$_))-$pc++; }, Msqrtint($n)); $sum; } sub semiprime_count { my($lo,$hi) = @_; if (defined $hi) { validate_integer_nonneg($lo); } else { ($lo,$hi) = (2, $lo); } validate_integer_nonneg($hi); # todo: threshold of fast count vs. walk if (($hi-$lo+1) < $hi / (sqrt($hi)/4)) { my $sum = 0; while ($lo <= $hi) { $sum++ if Mis_semiprime($lo); $lo++; } return $sum; } my $sum = _semiprime_count($hi) - (($lo < 4) ? 0 : semiprime_count($lo-1)); $sum; } sub _kap_reduce_count { # returns new k and n my($k, $n) = @_; my $pow3k = Mpowint(3, $k); while ($n < $pow3k) { $n = Mdivint($n, 2); $k--; $pow3k = Mdivint($pow3k, 3); } ($k, $n); } sub _kapc_final { # k = 2 my($n, $pdiv, $lo) = @_; my($sum, $hi, $pc) = (0, Msqrtint(Mdivint($n,$pdiv)), Mprime_count($lo)-1); my $nlim = int(INTMAX / $pdiv); Mforprimes( sub { my $npp = ($_<=$nlim) ? int($n/($pdiv*$_)) : Mdivint($n,Mmulint($pdiv,$_)); $sum += Mprime_count($npp)-$pc++; }, $lo, $hi); $sum; } sub _kapc_count { my($n, $pdiv, $lo, $k) = @_; return _kapc_final($n, $pdiv, $lo) if $k == 2; my($sum, $hi) = (0, Mrootint(Mdivint($n,$pdiv),$k)); Mforprimes( ($k == 3) ? sub { $sum += _kapc_final($n, Mmulint($pdiv,$_), $_); } : sub { $sum += _kapc_count($n, Mmulint($pdiv,$_), $_, $k-1); }, $lo, $hi ); $sum; } sub almost_prime_count { my($k,$n) = @_; validate_integer_nonneg($k); validate_integer_nonneg($n); return ($n >= 1) if $k == 0; my $ok = $k; ($k, $n) = _kap_reduce_count($k, $n); return $n if $k == 0; # If we reduced parameters, try again if XS might be able to do it. return Math::Prime::Util::almost_prime_count($k,$n) if $ok != $k && !ref($n) && getconfig()->{'xs'}; return Mprime_count($n) if $k == 1; return Math::Prime::Util::semiprime_count($n) if $k == 2; return 0 if ($n >> $k) == 0; _kapc_count($n, 1, 2, $k); } sub _omega_prime_count_rec { my($k, $n, $m, $p, $s, $j) = @_; $s = Mrootint(Mdivint($n,$m),$k) unless defined $s; $j = 1 unless defined $j; my $count = 0; if ($k == 2) { for (; $p <= $s ; ++$j) { my $r = Mnext_prime($p); for (my $t = Mmulint($m, $p) ; $t <= $n ; $t = Mmulint($t, $p)) { my $w = Mdivint($n, $t); last if $r > $w; $count += Mprime_count($w) - $j; for (my $r2 = $r ; $r2 <= $w ; $r2 = Mnext_prime($r2)) { my $u = Mvecprod($t, $r2, $r2); last if $u > $n; for (; $u <= $n ; $u = Mmulint($u, $r2)) { ++$count; } } } $p = $r; } } else { for (; $p <= $s ; ++$j) { my $r = Mnext_prime($p); for (my $t = Mmulint($m, $p) ; $t <= $n ; $t = Mmulint($t, $p)) { my $s = Mrootint(Mdivint($n, $t), $k - 1); last if $r > $s; $count += _omega_prime_count_rec($k-1, $n, $t, $r, $s, $j+1); } $p = $r; } } $count; } sub omega_prime_count { my($k,$n) = @_; validate_integer_nonneg($k); validate_integer_nonneg($n); return ($n >= 1) ? 1 : 0 if $k == 0; return prime_power_count($n) if $k == 1; # find a simple formula for k=2. # Naive method # my ($sum, $low) = (0, Mpn_primorial($k)); # for (my $i = $low; $i <= $n; $i++) { # $sum++ if Mprime_omega($i) == $k; # } # return $sum; # Recursive method from trizen return _omega_prime_count_rec($k, $n, 1, 2); } sub ramanujan_prime_count { my($low,$high) = @_; if (defined $high) { validate_integer_nonneg($low); } else { ($low,$high) = (2, $low); } validate_integer_nonneg($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) = @_; validate_integer_nonneg($n); return twin_prime_count(3,$n) if $n < 2000; # Remove bigint / bigfloat. Everything here will be done with native NV. $n = 0.0+"$n" if ref($n); my $logn = log($n); 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) = @_; validate_integer_nonneg($n); return 0 if $n < 4; $n = "$n" + 0.00000001; my $l1 = log($n); my $l2 = log($l1); #my $est = $n * $l2 / $l1; #my $est = $n * ($l2 + 0.302) / $l1; my $est = ($n/$l1) * (0.11147910114 + 0.00223801350*$l1 + 0.44233207922*$l2 + 1.65236647896*log($l2)); Mtoint($est + 0.5); } sub almost_prime_count_approx { my($k,$n) = @_; validate_integer_nonneg($k); validate_integer_nonneg($n); return ($n >= 1) if $k == 0; return Math::Prime::Util::prime_count_approx($n) if $k == 1; return Math::Prime::Util::semiprime_count_approx($n) if $k == 2; return 0 if ($n >> $k) == 0; my $lo = Math::Prime::Util::almost_prime_count_lower($k, $n); my $hi = Math::Prime::Util::almost_prime_count_upper($k, $n); if ($k == 3) { my $x = 0.0 + "$n"; my $l1 = log($x); my $l2 = log($l1); my($a,$s) = (1.0,2.0); if ($x <= 638) { $s = 1.554688; $a = 0.865814; } elsif ($x <= 1544) { $s = 1.050000; $a = 0.822256; } elsif ($x <= 1927) { $s = 0.625000; $a = 0.791747; } elsif ($x <= 486586) { $s = 2.865611; $a = 1.004090; } elsif ($x <= 1913680) { $s = 2.790963; $a = 0.999618; } elsif ($x <= 22347532) { $s = 2.719238; $a = 0.995635; } elsif ($x <= 2.95e8) { $s = 2.584473; $a = 0.988802; } elsif ($x <= 4.20e9) { $s = 2.457108; $a = 0.983098; } elsif ($x <= 7.07e10) { $s = 2.352818; $a = 0.978931; } elsif ($x <= 1.36e12) { $s = 2.269745; $a = 0.975953; } elsif ($x <= 4.1e13) { $s = 2.203002; $a = 0.973796; } elsif ($x <= 9.2e14) { $s = 2.148463; $a = 0.972213; } else { $s = 2.119279; $a = 0.971438; } my $est = 0.5*$a*$x*(($l2+0.26153)*($l2+0.26153)) / ($l1+$s) + 0.5; return $est < $lo ? $lo : $est > $hi ? $hi : Mtoint($est); } { my $mult = 0.5; if ($n < 2**32 && $k < 13) { $mult = 0.9; } elsif ($k > 11) { $mult = 0.20; } else { $mult = 0.76; } return Mtoint($lo + ($hi - $lo) * $mult + 0.5) unless ref($lo) || ref($hi); my $imult = int($mult * (1<<16)); my $est = Maddint( Mlshiftint($lo,16), Mmulint(Msubint($hi,$lo),$imult) ); return Mrshiftint($est,16); } } 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_integer_nonneg($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) = @_; validate_integer_nonneg($n); return (undef,4,6,9,10,14,15,21,22)[$n] if $n <= 8; my $x = "$n" + 0.000000001; # Get rid of bigint so we can safely call log my $logx = log($x); my $loglogx = log($logx); my $a = ($n < 1000) ? 1.027 : ($n < 10000) ? 0.995 : 0.966; my $est = $a * $x * $logx / $loglogx; my $lo = ($n < 20000) ? int(0.97*$est)-1 : int(0.98*$est)-1; my $hi = ($n < 20000) ? int(1.07*$est)+1 : int(1.02*$est)+1; 1+_binary_search($n,$lo,$hi, sub{Math::Prime::Util::semiprime_count(shift)}); } sub nth_semiprime_approx { my($n) = @_; validate_integer_nonneg($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; Mtoint($est+0.5); } sub _almost_prime_count_asymptotic { # uncoverable subroutine my($k, $n) = @_; return 0 if ($n >> $k) == 0; return ($n >= 1) if $k == 0; my $x; if (ref($n) || $n > ~0) { $x = _upgrade_to_float($n); } else { $x = 0.0 + "$n"; } my $logx = log($x); my $loglogx = log($logx); my $est = $x / $logx; my $numk = $k - ( ($k<7) ? 1 : ($k<12) ? 2 : ($k-6)>>2 ); $est *= ($loglogx/$_) for 1 .. $numk; $est; # Returns FP } sub _almost_prime_nth_asymptotic { my($k, $n) = @_; return 0 if $k == 0 || $n == 0; return Mpowint(2,$k) if $n == 1; my $x; if (ref($n) || $n > ~0) { require Math::BigFloat; Math::BigFloat->import(); $x = Math::BigFloat->new($n); } else { $x = 0.0 + "$n"; } my $logx = log($x); my $loglogx = log($logx); my $est = $x * $logx; my $numk = $k - ( ($k<7) ? 1 : ($k<12) ? 2 : ($k-6)>>2 ); $est *= ($_/$loglogx) for 1 .. $numk; $est; # Returns FP } sub almost_prime_count_lower { my($k, $n) = @_; validate_integer_nonneg($k); validate_integer_nonneg($n); return 0 if ($n >> $k) == 0; ($k, $n) = _kap_reduce_count($k, $n); return ($n >= 1) if $k == 0; return Math::Prime::Util::prime_count_lower($n) if $k == 1; my $bound = 0; my $x = 0.0 + "$n"; my $logx = log($x); my $loglogx = log($logx); my $logplus = $loglogx + 0.26153; my @lower20 = (0,0, 0.8197, 0.8418, 0.5242, 0.5154,0.3053,0.1901,0.1253,0.0892,0.06551,0.05082,0.04101); my @lower32 = (0,0, 1.004, 0.7383, 0.6828, 0.5939,0.3594,0.2222,0.1438,0.09754,0.06981,0.05245,0.04151, 0.03461,0.03006,0.02709,0.02553,0.02502,0.02552,0.02697,0.02945); my @lower64 = (0,0,1.011,0.8093,0.7484,0.6465,0.3982,0.2463,0.1571,0.1048,0.07363,0.0545,0.0422, 0.0331,0.0270,0.0232,0.0208,0.0194,0.0190,0.0193,0.0203, 0.0222,0.0252,0.0295,0.0356,0.0444,0.0570,0.0753,0.102,0.14,0.20,0.297,0.44,0.68,1.07,1.71,2.8,4.7,8.0,13.89,23.98); # TODO: These are likely still too high my @lower = (0,0,1.011,0.8093,0.7484,0.6465,0.3982,0.2463,0.1571,0.1048,0.07363,0.0545,0.0422, 0.0331,0.0270, 0.0230,0.0200,0.0187,0.018,0.018,0.019,0.020,0.020,0.027,0.032,0.040,0.051,0.068,0.090,0.12,0.18,0.26,0.355); my $multl; my $isn64bit = Mrshiftint($n,64) == 0; if ($n <= 1048575) { $multl = $lower20[$k]; } elsif ($n <= 4294967295) { $multl = $lower32[$k]; } elsif ($isn64bit) { $multl = $lower64[$k]; } else { push @lower, 1.5 * $lower[$#lower] until defined $lower[$k]; $multl = $lower[$k]; } if ($k == 2) { if ($x <= 1e12) { $bound = $x * ($loglogx + 0.261536) / $logx; } else { # Bayless Theorem 5.2 $bound = ($x * ($loglogx+0.1769)/$logx) * (1 + 0.4232/$logx); $multl = 1; } } elsif ($k == 3) { # Kinlaw Theorem 1, using custom multipliers for 64-bit n $bound = $x * $loglogx * $loglogx / (2*$logx); if ($n < 638) { $multl = 0.8418; } elsif ($n < 1927) { my $dist = ($x - 638) / (1926 - 638); $multl = (1.0-$dist) * 0.8939 + $dist * 0.9233; } elsif ($n < 500194) { my $dist = ($x - 1927) / (500194 - 1927); $multl = (1.0-$dist) * 0.9233 + $dist * 1.000; } elsif ($n <= 3184393786) { my $dist = ($x - 500194) / (3184393786 - 500194); $multl = (1.0-$dist) * 1.0000 + $dist * 1.039; } else { $multl = $isn64bit ? 1.0004 : 1.0; } } elsif ($k == 4) { $bound = $x * $logplus*$logplus*$logplus / (6*$logx); $multl = 0.4999 if !$isn64bit; } else { $bound = $x / $logx; $logplus = $loglogx + (log("$k") * log(log("$k")) - 0.504377); $bound *= $logplus/$_ for 1 .. $k-1; } $bound *= $multl; $bound = 1 if $bound < 1; # We would have returned zero earlier Mtoint($bound) } sub almost_prime_count_upper { my($k, $n) = @_; validate_integer_nonneg($k); validate_integer_nonneg($n); return 0 if ($n >> $k) == 0; ($k, $n) = _kap_reduce_count($k, $n); return ($n >= 1) if $k == 0; return Math::Prime::Util::prime_count_upper($n) if $k == 1; # In theory we might have reduced k/n to where XS can handle it. # We should consider handling that, especially for k >= 5. my $bound = 0; my $x = 0.0 + "$n"; my $logx = log($x); my $loglogx = log($logx); my $logplus = $loglogx + 0.26153; my @upper20 = (0,0, 1.006,0.7385,0.6830,0.5940,0.3596,0.2227,0.1439, 0.09785,0.07016,0.05303,0.04202); my @upper32 = (0,0, 1.013,0.8094,0.7485, 0.6467,0.3984,0.2464,0.1572,0.1049,0.07364,0.05452,0.04266, 0.03542,0.03082,0.02798,0.02642,0.02585,0.02615,0.02808,0.03054); my @upper64 = (0,0, 1.028, 1.028, 1.3043, 0.72208, 0.46609, 0.29340,0.18571,0.12063,0.0815,0.0575,0.0427, 0.03490, 0.03007, 0.02710, 0.02554, 0.02504, 0.02554, 0.02699, 0.02954, 0.03294, 0.03779, 0.04453, 0.05393, 0.06703, 0.08543, 0.1117, 0.1494, 0.205,0.287,0.410, 0.60,0.90,1.36,2.12,3.35,5.38,8.83,14.75,25.07); # TODO: These bounds are likely to not be accurate for large inputs my $multu; my $isn64bit = Mrshiftint($n,64) == 0; if ($n <= 1048575) { $multu = $upper20[$k]; } elsif ($n <= 4294967295) { $multu = $upper32[$k]; } else { push @upper64, 2.1 * $upper64[$#upper64] until defined $upper64[$k]; $multu = $upper64[$k]; } if ($k == 2) { # Bayless Corollary 5.1 $bound = 1.028 * $x * ($loglogx + 0.261536) / $logx; } elsif ($k == 3) { # Bayless Theorem 5.3 $bound = $x * ($logplus * $logplus + 1.055852) / (2*$logx); $multu = 0.8711 if $n > 4294967295 && $isn64bit; } elsif ($k == 4) { # Bayless Theorem 5.4 part 1, multu = 1.3043 $bound = $x * $logplus*$logplus*$logplus / (6*$logx); if ($x >= 1e12) { # part 2 $bound += + 0.511977 * $x * (log(log($x/4)) + 0.261536) / $logx; $multu = 1.028; } if ($isn64bit) { $multu = 0.780 if $n > 4294967295; $multu = 0.6921 if $x > 1e12; } } else { # We could use Bayless (2018) Theorem 3.5: # # First we have Pi_k(x) -- the upper bound for the square free kaps. # $bound = 1.028 * $x / $logx; # $bound *= ($logplus/$_) for 1..$k-1; # # Second, turn into Tau_k(x) using the paragraph before Theorem 5.4. # my $sigmalim = Msqrtint(Mdivint($n, Mpowint(2,$k-2))); # my $ix = Math::BigInt->new("$x"); # Mforprimes( sub { # $bound += almost_prime_count_upper($k-2, Mdivint($ix,Mmulint($_,$_))); # }, 2, $sigmalim); # # This is incredibly slow. ) # # Or use theorem 1 from: # Erdős & Sárközy, "On the number of prime factors of integers", 1980. # # Or Hildebrand & Tenenbaum 1988: # https://www.researchgate.net/publication/38333551_On_the_number_of_prime_factors_of_an_integer # Section 1 has lots of info. Corollary 2 (page 476) is what we want. $bound = $x / $logx; $logplus = $loglogx + (log("$k") * log(log("$k")) - 0.504377); $bound *= $logplus/$_ for 1 .. $k-1; } $bound *= $multu; $bound = 1 if $bound < 1; # We would have returned zero earlier Mtoint($bound + 1) } sub _kap_reduce_nth { # returns reduction amount r my($k, $n) = @_; return 0 if $k <= 1; # We could calculate new values as needed. my @A078843 = (1, 2, 3, 5, 8, 14, 23, 39, 64, 103, 169, 269, 427, 676, 1065, 1669, 2628, 4104, 6414, 10023, 15608, 24281, 37733, 58503, 90616, 140187, 216625, 334527, 516126, 795632, 1225641, 1886570, 2901796, 4460359, 6851532, 10518476, 16138642, 24748319, 37932129, 58110457, 88981343, 136192537, 208364721, 318653143, 487128905, 744398307, 1137129971, 1736461477, 2650785552, 4045250962, 6171386419, 9412197641, 14350773978, 21874583987, 33334053149, 50783701654, 77348521640, 117780873397, 179306456282, 272909472119, 415284741506); my $r = 0; if ($k > $#A078843) { return 0 if $n >= $A078843[-1]; $r = $k - $#A078843; } $r++ while $n < $A078843[$k-$r]; $r; } sub _fast_small_nth_almost_prime { my($k,$n) = @_; croak "Internal kap out of range error" if $n >= 8 || $k < 2; return (0, 4, 6, 9, 10, 14, 15, 21)[$n] if $k == 2; return Mmulint((0, 8, 12, 18, 20, 27, 28, 30)[$n], Mlshiftint(1,$k-3)); } sub nth_almost_prime_upper { my($k, $n) = @_; return undef if $n == 0; return (($n == 1) ? 1 : 0) if $k == 0; return Mnth_prime_upper($n) if $k == 1; return _fast_small_nth_almost_prime($k,$n) if $n < 8; my $r = _kap_reduce_nth($k,$n); if ($r > 0) { my $nth = Math::Prime::Util::nth_almost_prime_upper($k-$r, $n); return Mlshiftint($nth, $r); } my $lo = Mlshiftint(5,$k); # $k >= 1, $n >= 8 my $hi = Mtoint(1 + _almost_prime_nth_asymptotic($k, $n)); # We just guessed at hi, so bump it up until it's in range my $rhi = almost_prime_count_lower($k, $hi); while ($rhi < $n) { $lo = Madd1int($hi); $hi = Mvecsum($hi, int(1.02 * ("$hi"/"$rhi") * ("$n"-"$rhi")), 100); $rhi = almost_prime_count_lower($k, $hi); } while ($lo < $hi) { my $mid = $lo + (($hi-$lo) >> 1); if (almost_prime_count_lower($k,$mid) < $n) { $lo = $mid+1; } else { $hi = $mid; } } $lo; } sub nth_almost_prime_lower { my($k, $n) = @_; return undef if $n == 0; return (($n == 1) ? 1 : 0) if $k == 0; return Math::Prime::Util::nth_prime_lower($n) if $k == 1; return _fast_small_nth_almost_prime($k,$n) if $n < 8; my $r = _kap_reduce_nth($k,$n); if ($r > 0) { my $nth = Math::Prime::Util::nth_almost_prime_lower($k-$r, $n); return Mlshiftint($nth, $r); } my $lo = Mlshiftint(5,$k); # $k >= 1, $n >= 8 my $hi = Mtoint(1 + _almost_prime_nth_asymptotic($k, $n)); # We just guessed at hi, so bump it up until it's in range my $rhi = almost_prime_count_upper($k, $hi); while ($rhi < $n) { $lo = Madd1int($hi); $hi = Mvecsum($hi, int(1.02 * ("$hi"/"$rhi") * ("$n"-"$rhi")), 100); $rhi = almost_prime_count_upper($k, $hi); } while ($lo < $hi) { my $mid = $lo + (($hi-$lo) >> 1); if (almost_prime_count_upper($k,$mid) < $n) { $lo = $mid+1; } else { $hi = $mid; } } $lo; } sub nth_almost_prime_approx { my($k, $n) = @_; return undef if $n == 0; return Mlshiftint(1,$k) if $n == 1; return undef if $k == 0; # n==1 already returned return Math::Prime::Util::nth_prime_approx($n) if $k == 1; return Math::Prime::Util::nth_semiprime_approx($n) if $k == 2; return _fast_small_nth_almost_prime($k,$n) if $n < 8; my $r = _kap_reduce_nth($k,$n); if ($r > 0) { my $nth = Math::Prime::Util::nth_almost_prime_approx($k-$r, $n); return Mmulint($nth, Mpowint(2,$r)); } my $lo = Math::Prime::Util::nth_almost_prime_lower($k, $n); my $hi = Math::Prime::Util::nth_almost_prime_upper($k, $n); # TODO: Add interpolation speedup steps while ($lo < $hi) { my $mid = $lo + (($hi-$lo) >> 1); if (almost_prime_count_approx($k,$mid) < $n) { $lo = $mid+1; } else { $hi = $mid; } } $lo; } sub _interp_linear { my($n, $rlo, $rhi, $lo, $hi) = @_; #return int( ($n-$rlo) * ($hi-$lo) / ($rhi-$rlo) ); my $num = Mmulint( Msubint($n,$rlo), Msubint($hi,$lo) ); my $den = Msubint($rhi, $rlo); return Mdivint(Maddint($num,$den>>1), $den); #return divint($num, $den); } sub _inverse_interpolate { my($lo, $hi, $n, $k, $callback) = @_; my($mid, $rmid, $rlo, $rhi); $rlo = $callback->($k, $lo); croak "interp: bad lower bound" if $rlo > $n; return $lo if $rlo == $n; # If lo wasn't small enough, this could be wrong. # We have the exact value (rlo) at lo. #print "1 $lo $hi ",$hi-$lo,"\n"; $rhi = $callback->($k, $hi) if $hi != 0; while ($hi == 0) { # Use lo/rlo to make an estimate # Make an estimate of where we will end up my $estf = ($rlo == 0) ? 1 : Mdivint(Mlshiftint($n,8),$rlo) - 1; # slightly lower $estf = 1+(1<<8) if $estf <= (1<<8); $estf = (8<<8) if $estf > (8<<8); $mid = Mrshiftint(Mmulint($estf,$lo),8); # rmid is the exact count at this estimate $rmid = $callback->($k, $mid); # Either we have a hi value, or we pull in lo and do it again. if ($rmid >= $n) { $hi = $mid; $rhi = $rmid; } else { $lo = $mid; $rlo = $rmid; } #print "2 $lo $hi ",$hi-$lo,"\n"; } croak "interp bad initial" unless $rlo <= $n && $rhi >= $n; return $lo if $rlo == $n; return (($rlo==$n || ($rlo<$n && $rhi>$n)) ? $lo : $hi) if $hi-$lo <= 1; # Step 1. Linear interpolation while it centers. $mid = ($n == $rhi) ? $hi-1 : Maddint($lo, _interp_linear($n,$rlo,$rhi,$lo,$hi)); if ($mid == $lo) { $mid++; } elsif ($mid == $hi) { $mid--; } while ($rhi > $n && ($hi-$lo) > 1) { croak "interp: need 3 unique points" unless $lo < $mid && $mid < $hi; #print "I $lo $hi ",$hi-$lo,"\n"; $rmid = $callback->($k, $mid); if ($rmid >= $n) { ($hi,$rhi) = ($mid,$rmid); } else { ($lo,$rlo) = ($mid,$rmid); } last if $rhi == $n; my $num = Mmulint(Msubint($n,$rmid),Msubint($hi,$lo)); my $den = Msubint($rhi,$rlo); $mid = Maddint($mid, Mdivint($num, $den)); # Fairly crude way of pulling in opposite side so we bracket. if ($mid <= $lo) { $mid = Maddint($lo, Mdivint(Msubint($hi,$lo),100)); } elsif ($mid >= $hi) { $mid = Msubint($hi, Mdivint(Msubint($hi,$lo),100)); } if ($mid == $lo) { $mid++; } elsif ($mid == $hi) { $mid--; } croak "interp: range error" unless $lo <= $mid && $mid <= $hi; } return $lo if $rlo == $n; return (($rlo==$n || ($rlo<$n && $rhi>$n)) ? $lo : $hi) if $hi-$lo <= 1; croak "interp: bad step 1 interpolation" unless $rlo < $n && $rhi == $n; # Step 2. Ridder's method until we're very close. croak "interp: Ridder initial assumption error" unless $rlo<$n && $rhi>=$n; #print "F $lo $hi ",$hi-$lo,"\n"; while (($hi-$lo > 8) && ($hi-$lo) > 1) { my($x0, $x2, $x1) = ($lo, $hi, Maddint($lo, Msubint($hi,$lo)>>1)); my($rx1) = $callback->($k, $x1); my($fx0, $fx1, $fx2) = (Msubint($rlo,$n), Msubint($rx1,$n), Msubint($rhi,$n)+1); # Calculate new point using false position method #my $pos = (($x1-$x0) * "$fx1") / sqrt( "$fx1"*"$fx1" - "$fx0"*"$fx2" ); #my $x3 = $x1 - int($pos+0.5); # Rather convoluted so it's all in integer. my $num = Mmulint($fx1, Msubint($x1,$x0)); my $d1 = Msubint(Mmulint($fx1,$fx1),Mmulint($fx0,$fx2)); my $den = Msqrtint(Mlshiftint($d1,64)); $num = Mlshiftint($num, 32); my $pos = Mdivint(Maddint($num,$den>>1), $den); my $x3 = Msubint($x1, $pos); # print " Ridder mid = $x1 - $pos = $x3\n"; # print " $lo $x1 $x3 $hi\n"; if ($x3 >= $hi || $x3 <= $lo || $x3 == $x1) { # The new point hasn't given us anything. Just bisect. if ($rx1 >= $n) { $hi = $x1; $rhi = $rx1; } else { $lo = $x1; $rlo = $rx1; } } else { my $rx3 = $callback->($k,$x3); if ($rx1 > $rx3) { ($x1,$x3,$rx1,$rx3) = ($x3,$x1,$rx3,$rx1); } if ($rx1 >= $n) { $hi = $x1; $rhi = $rx1; } elsif ($rx3 >= $n) { $lo = $x1; $rlo = $rx1; $hi = $x3; $rhi = $rx3; } else { $lo = $x3; $rlo = $rx3; } } #print "R $lo $hi ",$hi-$lo,"\n"; croak "interp: Ridder step error" unless $rlo < $n && $rhi >= $n; } # Step 3. Binary search. Invariant: f(lo) < n, f(hi) >= n while ($hi-$lo > 1) { $mid = $lo + (($hi-$lo) >> 1); $rmid = $callback->($k, $mid); if ($rmid < $n) { $lo = $mid; } else { $hi = $mid; } #print "B $lo $hi ",$hi-$lo,"\n"; } $hi; } sub nth_almost_prime { my($k, $n) = @_; return undef if $n == 0; return Mlshiftint(1,$k) if $n == 1; return undef if $k == 0; # n==1 already returned return Math::Prime::Util::nth_prime($n) if $k == 1; return Math::Prime::Util::nth_semiprime($n) if $k == 2; return _fast_small_nth_almost_prime($k,$n) if $n < 8; my $r = _kap_reduce_nth($k,$n); if ($r > 0) { my $nth = Math::Prime::Util::nth_almost_prime($k-$r, $n); return Mmulint($nth, Mpowint(2,$r)); } my $lo = Math::Prime::Util::nth_almost_prime_lower($k, $n); return _inverse_interpolate($lo, 0, $n, $k, sub { Math::Prime::Util::almost_prime_count($_[0],$_[1]); }); #my $ncalls = 0; #my $res = _inverse_interpolate($lo, 0, $n, $k, sub { $ncalls++; Math::Prime::Util::almost_prime_count($_[0],$_[1]); }); #print "ncalls: $ncalls\n"; #return $ncalls; #return $res; } sub nth_omega_prime { my($k, $n) = @_; return undef if $n == 0; return Mpn_primorial($k) if $n == 1; return undef if $k == 0; # n==1 already returned # Very inefficient algorithm. my $i = Mpn_primorial($k); while (1) { $i++ while Mprime_omega($i) != $k; return $i if --$n == 0; $i++; } } sub nth_ramanujan_prime_upper { my($n) = @_; validate_integer_nonneg($n); return (0,2,11)[$n] if $n <= 2; if ($n < 50) { return Mnth_prime_upper(int(2.6*$n)) if $n <= 20; return 33+((310*Mnth_prime_upper(2*$n))>>8); } my $nth = Mnth_prime_upper(Mmulint($n,3)); return 115+((727*$nth) >> 10) if $n < 647; # TODO: Ideally these would all be adjusted to make smooth transitions. my($add,$mul) = $n < 16000 ? ( 271,358) : $n < 1200000 ? (9450,350) : $n < 7000000 ? (5000,349) : $n < 90000000 ? ( 0,348) : $n < 3100000000 ? ( 0,347) : ( 0,346); my $ret = Mrshiftint(Mmulint($mul,$nth),9); $ret = Maddint($ret,$add) if $add != 0; $ret; } sub nth_ramanujan_prime_lower { my($n) = @_; validate_integer_nonneg($n); return (0,2,11)[$n] if $n <= 2; my $nth = Math::Prime::Util::nth_prime_lower(Mmulint($n,2)); return Mdivint(Mmulint(275,$nth),256) if $n < 10000; return Mdivint(Mmulint(262,$nth),256) if $n < 1e10; $nth; } sub nth_ramanujan_prime_approx { my($n) = @_; validate_integer_nonneg($n); 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) = @_; validate_integer_nonneg($n); return (($n < 2) ? 0 : 1) if $n < 11; my $lo = Mdivint(prime_count_lower($n),3); my $hi = Mrshiftint(prime_count_upper($n)); 1+_binary_search($n, $lo, $hi, sub{Math::Prime::Util::nth_ramanujan_prime_lower(shift)}); } sub ramanujan_prime_count_lower { my($n) = @_; validate_integer_nonneg($n); 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) = @_; validate_integer_nonneg($n); 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) = @_; return (0,0,2,5,5)[$n] if $n < 5; my $r = Msqrtint($n); my $r2 = $r + Mdivint($n, $r+1); my(@V,@S); for my $k (0 .. $r2) { my $v = ($k <= $r) ? $k : Mdivint($n,($r2-$k+1)); $V[$k] = $v; $S[$k] = Maddint( Mrshiftint(Mmulint($v, $v-1)), $v-1); } for my $p (2 .. $r) { next unless $S[$p] > $S[$p-1]; my $sp = $S[$p-1]; my $p2 = Mmulint($p,$p); for my $v (reverse @V) { last if $v < $p2; my($a,$b) = ($v,Mdivint($v,$p)); $a = $r2 - Mdivint($n,$a) + 1 if $a > $r; $b = $r2 - Mdivint($n,$b) + 1 if $b > $r; $S[$a] -= Mmulint($p, $S[$b]-$sp); #$S[$a] = Msubint($S[$a], Mmulint($p, Msubint($S[$b],$sp))); } } $S[$r2]; } sub sum_primes { my($low,$high) = @_; if (defined $high) { validate_integer_nonneg($low); } else { ($low,$high) = (2, $low); } validate_integer_nonneg($high); my $sum = 0; return $sum if $high < $low; # It's very possible we're here because they've counted too high. Skip fwd. if ($low <= 2 && $high >= 29505444491) { ($low, $sum) = (29505444503, tobigint("18446744087046669523")); } return $sum if $low > $high; # Easy, not unreasonable, but seems slower than the windowed sum. # return _sum_primes_n($high) if $low <= 2; # Performance decision, which to use. if ( $high <= ~0 && $high > (MPU_64BIT ? 2000000 : 320000) && ($high-$low) > $high/50 && !getconfig()->{'xs'}) { my $hsum = _sum_primes_n($high); my $lsum = ($low <= 2) ? 0 : _sum_primes_n($low - 1); return $hsum - $lsum; } # Sum in windows. # TODO: consider some skipping forward with small tables. my $xssum = (MPU_64BIT && $high < 6e14 && getconfig()->{'xs'}); my $step = ($xssum && $high > 5e13) ? 1_000_000 : 11_000_000; Math::Prime::Util::prime_precalc(Msqrtint($high)); while ($low <= $high) { my $next = Maddint($low, $step) - 1; $next = $high if $next > $high; $sum = Maddint($sum, ($xssum) ? Math::Prime::Util::sum_primes($low,$next) : Mvecsum( @{Mprimes($low,$next)} )); last if $next == $high; $low = Madd1int($next); } $sum; } sub print_primes { my($low,$high,$fd) = @_; if (defined $high) { validate_integer_nonneg($low); } else { ($low,$high) = (2, $low); } validate_integer_nonneg($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 @{Mprimes($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; } sub powint { my($a, $b) = @_; validate_integer($a); validate_integer($b); return reftyped($_[0], Math::Prime::Util::GMP::powint($a,$b)) if $Math::Prime::Util::_GMPfunc{"powint"}; croak "powint: exponent must be >= 0" if $b < 0; # Special cases for small a and b if ($a >= -1 && $a <= 4) { return ($b == 0) ? 1 : 0 if $a == 0; return 1 if $a == 1; return ($b % 2) ? -1 : 1 if $a == -1; if ($a == 2) { return ($b < MPU_MAXBITS) ? 1<<$b : Mlshiftint(1,$b); } if ($a == 4) { return 1 << (2*$b) if $b < MPU_MAXBITS/2; return Mlshiftint(1,2*$b) if $b < 4000000000; } } return 1 if $b == 0; return $a if $b == 1; if ($b == 2) { return int("$a")*int("$a") if abs($a) < MPU_HALFWORD; return Mmulint($a,$a); } if (!ref($a) && !ref($b) && $b < MPU_MAXBITS) { if ($b == 3) { return int($a*$a*$a) if $a <= 99999; return Mmulint(int($a*$a), $a) if $a <= 31622776; } else { # Check if inside limit of int on 32-bit my $r = $a ** $b; return int($r) if $r < 1000000000000000 && $r > -1000000000000000; # Try to complete using a single mulint if we can $r = $a ** (($b+1)>>1); if ($r < 1000000000000000 && $r > -1000000000000000) { return Mmulint(int($r), $b&1 ? int($a**($b>>1)) : int($r)); } } # Fall through } return Mmulint(Mmulint($a,$a),$a) if $b == 3; my $r = tobigint($a) ** tobigint($b); return $r <= INTMAX && $r >= INTMIN ? _bigint_to_int($r) : $r; } sub mulint { my($a, $b) = @_; validate_integer($a); validate_integer($b); return 0 if $a == 0 || $b == 0; return reftyped($_[0], Math::Prime::Util::GMP::mulint($a,$b)) if $Math::Prime::Util::_GMPfunc{"mulint"}; my $r = $a * $b; if (!ref($r)) { return $r if $r < INTMAX && $r > INTMIN; $r = tobigint($a) * $b; } return $r <= INTMAX && $r >= INTMIN ? _bigint_to_int($r) : $r; } sub addint { my($a, $b) = @_; validate_integer($a); validate_integer($b); return reftyped($_[0], Math::Prime::Util::GMP::addint($a,$b)) if $Math::Prime::Util::_GMPfunc{"addint"}; my $r = $a + $b; if (!ref($r)) { return $r if $r < INTMAX && $r > INTMIN; $r = tobigint($a) + $b; } return $r <= INTMAX && $r >= INTMIN ? _bigint_to_int($r) : $r; } sub subint { my($a, $b) = @_; validate_integer($a); validate_integer($b); return reftyped($_[0], Math::Prime::Util::GMP::subint($a,$b)) if $Math::Prime::Util::_GMPfunc{"subint"}; my $r = $a - $b; if (!ref($r)) { return $r if $r < INTMAX && $r > INTMIN; $r = tobigint($a) - $b; } return $r <= INTMAX && $r >= INTMIN ? _bigint_to_int($r) : $r; } sub add1int { my($a) = @_; validate_integer($a); my $r = $a+1; if (!ref($r)) { return $r if $r < INTMAX; $r = tobigint($a) + 1; } return $r <= INTMAX && $r >= INTMIN ? _bigint_to_int($r) : $r; } sub sub1int { my($a) = @_; validate_integer($a); my $r = $a-1; if (!ref($r)) { return $r if $r < INTMAX; $r = tobigint($a) - 1; } return $r <= INTMAX && $r >= INTMIN ? _bigint_to_int($r) : $r; } # For division / modulo, see: # # https://www.researchgate.net/publication/234829884_The_Euclidean_definition_of_the_functions_div_and_mod # # https://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/divmodnote-letter.pdf sub _tquotient { my($a,$b) = @_; return $a if $b == 1; $a = tobigint($a) if ($a >= SINTMAX || $a <= INTMIN) && !ref($a); $b = tobigint($b) if ($b >= SINTMAX || $b <= INTMIN) && !ref($b); my($refa,$refb) = (ref($a),ref($b)); if (!$refa && !$refb) { # Both numbers are in signed range, so we can negate them. use integer; # This is >>> SIGNED <<< integer. # Signed division is implementation defined in C89. return -(-$a / $b) if $a < 0 && $b > 0; return -( $a / -$b) if $b < 0 && $a > 0; return (-$a / -$b) if $a < 0 && $b < 0; return ( $a / $b); } my $q; # set this, turn into int and return at end if ($refa eq 'Math::GMPz' || $refb eq 'Math::GMPz') { $q = Math::GMPz->new(); $a = Math::GMPz->new($a) unless $refa eq 'Math::GMPz'; $b = Math::GMPz->new($b) unless $refb eq 'Math::GMPz'; Math::GMPz::Rmpz_tdiv_q($q,$a,$b); } elsif ($refa eq 'Math::GMP' || $refb eq 'Math::GMP') { $a = Math::GMP->new($a) unless $refa eq 'Math::GMP'; $b = Math::GMP->new($b) unless $refb eq 'Math::GMP'; # op_div => mpz_div function (obsolete!). bdiv => tdiv_qr ($q) = $a->bdiv($b); } elsif ($refa eq 'Math::Pari' || $refb eq 'Math::Pari') { $a = Math::Pari->new("$a") unless $refa eq 'Math::Pari'; $b = Math::Pari->new("$b") unless $refb eq 'Math::Pari'; $q = Math::Pari::gdivent(abs($a),abs($b)); $q = Math::Pari::gneg($q) if ($a < 0) != ($b < 0); } else { # Force no upgrade so 'use bignum' won't screw us over. my $A = Math::BigInt->new("$a")->upgrade(undef); my $B = Math::BigInt->new("$b")->upgrade(undef); $q = abs($a) / abs($b); $q = -$q if ($a < 0) != ($b < 0); $q = $refa->new("$q") if $refa ne 'Math::BigInt' && $refb ne 'Math::BigInt'; } $q; #return $q <= INTMAX && $q >= INTMIN ? _bigint_to_int($q) : $q; } # Truncated Division sub tdivrem { my($a,$b) = @_; validate_integer($a); validate_integer($b); croak "tdivrem: divide by zero" if $b == 0; my($q,$r); if (!ref($a) && !ref($b) && $a>=0 && $b>=0 && $a= INTMIN; $r = _bigint_to_int($r) if ref($r) && $r <= INTMAX && $r >= INTMIN; } ($q,$r); } # Floored Division sub fdivrem { my($a,$b) = @_; validate_integer($a); validate_integer($b); croak "fdivrem: divide by zero" if $b == 0; my($q,$r); if (!ref($a) && !ref($b) && $a>=0 && $b>=0 && $a= 0) ? 0 : (b>0) ? 1 : -1; # qf = qt-I rf = rt+I*d I = (signum(rt) = -signum(b)) 1 : 0 if ( ($r < 0 && $b > 0) || ($r > 0 && $b < 0) ) { $q--; $r += $b; } $q = _bigint_to_int($q) if ref($q) && $q <= INTMAX && $q >= INTMIN; $r = _bigint_to_int($r) if ref($r) && $r <= INTMAX && $r >= INTMIN; ($q,$r); } # Ceiling Division sub cdivrem { my($a,$b) = @_; validate_integer($a); validate_integer($b); croak "cdivrem: divide by zero" if $b == 0; my($q,$r); if (!ref($a) && !ref($b) && $a>=0 && $b>=0 && $a= 0) == ($b >= 0))) { $q++; $r -= $b; } $q = _bigint_to_int($q) if ref($q) && $q <= INTMAX && $q >= INTMIN; $r = _bigint_to_int($r) if ref($r) && $r <= INTMAX && $r >= INTMIN; ($q,$r); } # Euclidean Division sub divrem { my($a,$b) = @_; validate_integer($a); validate_integer($b); croak "divrem: divide by zero" if $b == 0; my($q,$r); if (!ref($a) && !ref($b) && $a>=0 && $b>=0 && $a 0) { $q--; $r += $b; } else { $q++; $r -= $b; } } $q = _bigint_to_int($q) if ref($q) && $q <= INTMAX && $q >= INTMIN; $r = _bigint_to_int($r) if ref($r) && $r <= INTMAX && $r >= INTMIN; ($q,$r); } sub divint { if (!OLD_PERL_VERSION && $_[1] > 0 && $_[0] >= 0) { # Simple no-error all positive case my($a,$b) = @_; my $q; if (!ref($a) && !ref($b) && $a 0 && $_[0] >= 0; my($a,$b) = @_; validate_integer($a); validate_integer($b); my $r; if (ref($b) || ref($a)) { $r = $a % $b; $r = _bigint_to_int($r) if $r <= INTMAX; } elsif ($b < INTMAX && $a < INTMAX) { $r = $a % $b; } else { $r = tobigint($a) % tobigint($b); $r = _bigint_to_int($r) if $r <= INTMAX; } $r; } sub modint { # Fast processing for simple cases if ($_[1] > 0 && $_[0] >= 0) { return _posmodint(@_); } elsif ($_[1] < 0 && $_[0] >= 0) { if ($_[0] < INTMAX && -$_[1] < INTMAX) { my $r = _posmodint($_[0],-$_[1]); return $r == 0 ? 0 : $_[1]+$r; } } elsif ($_[1] > 0 && $_[0] <= 0) { if (-$_[0] < INTMAX && $_[1] < INTMAX) { my $r = _posmodint(-$_[0],$_[1]); return $r == 0 ? 0 : $_[1]-$r; } } elsif ($_[1] < 0 && $_[0] <= 0) { if (-$_[0] < INTMAX && -$_[1] < INTMAX) { my $r = _posmodint(-$_[0],-$_[1]); return $r == 0 ? 0 : -$r; } } (fdivrem(@_))[1]; } sub cdivint { if ($_[1] > 0 && $_[0] >= 0) { # Simple no-error all positive case my($a,$b) = @_; validate_integer($a); validate_integer($b); my $q; if (!ref($a) && !ref($b) && $a -$n = -0 return -$n if ref($n) || $n < SINTMAX; if ($n > 0) { $n = "-$n"; } else { $n =~ s/^-//; } reftyped($_[0], $n); } sub signint { my($n) = @_; validate_integer($n); # -1,0,1 Native ints, Math::BigInt, Math::GMP, Math::GMPz 0.68+ # neg,0,pos Math::GMPz 0.67 and earlier # -1 or 4294967295, 0, 1 Math::Pari my $r = $n <=> 0; $r = -1 if $r == 4294967295 && ref($n) eq 'Math::Pari'; return $r < 0 ? -1 : $r > 0 ? 1 : 0; } sub cmpint { my($a, $b) = @_; validate_integer($a); validate_integer($b); my $r = $a <=> $b; $r = -1 if $r == 4294967295 && (ref($a) eq 'Math::Pari' || ref($b) eq 'Math::Pari'); return $r < 0 ? -1 : $r > 0 ? 1 : 0; } sub lshiftint { my($n, $k) = @_; validate_integer($n); if (!defined $k) { $k = 1; } else { validate_integer($k); } return rshiftint($n, Mnegint($k)) if $k < 0; return Mnegint(lshiftint(Mnegint($n),$k)) if $n < 0; if (!ref($n)) { return $n << $k if $n < INTMAX && $k < MPU_MAXBITS && $n == ($n<<$k)>>$k; $n = tobigint($n); } $n = $n << $k; return $n <= INTMAX ? _bigint_to_int($n) : $n; #my $k2 = (!defined $k) ? 2 : ($k < MPU_MAXBITS) ? (1<<$k) : Mpowint(2,$k); #Mmulint($n, $k2); } sub rshiftint { my($n, $k) = @_; validate_integer($n); if (!defined $k) { $k = 1; } else { validate_integer($k); } return lshiftint($n, Mnegint($k)) if $k < 0; return Mnegint(rshiftint(Mnegint($n),$k)) if $n < 0; if (!ref($n)) { # Pre 5.24.0, large right shifts were undefined. return $k < MPU_MAXBITS ? $n >> $k : 0 if $n < INTMAX; $n = tobigint($n); } $n = $n >> $k; return $n <= INTMAX ? _bigint_to_int($n) : $n; #my $k2 = (!defined $k) ? 2 : ($k < MPU_MAXBITS) ? (1<<$k) : Mpowint(2,$k); #(Mtdivrem($n, $k2))[0]; } sub rashiftint { my($n, $k) = @_; validate_integer($n); if (!defined $k) { $k = 1; } else { validate_integer($k); } return lshiftint($n, Mnegint($k)) if $k < 0; my $k2 = $k < MPU_MAXBITS ? (1<<$k) : Mpowint(2,$k); Mdivint($n, $k2); } sub powersum { my($n, $k) = @_; validate_integer_nonneg($n); validate_integer_nonneg($k); return $n if $n <= 1 || $k == 0; return Mdivint(Mvecprod($n, Madd1int($n), Madd1int(Mmulint($n,2))),6) if $k==2; return Mdivint(Mvecprod( $n, Madd1int($n), Madd1int(Mmulint($n,2)), Mvecsum( Mmulint(3,Mpowint($n,2)), Mmulint(3,$n), -1 ) ),30) if $k==4; my $a = Mrshiftint(Mmulint($n,Madd1int($n))); return $a if $k == 1; return Mmulint($a,$a) if $k == 3; return Mdivint(Msubint(Mmulint(4,Mpowint($a,3)),Mmulint($a,$a)),3) if $k == 5; my @v; if ($k < $n) { for my $j (1..$k) { my $F = Mfactorial($j); my $B = Mbinomial($n+1,$j+1); my $S = Mstirling($k,$j,2); push @v, Mvecprod($F,$B,$S); } } else { @v = map { Mpowint($_,$k) } 1..$n; } Mvecsum(@v); } # Make sure to work around RT71548, Math::BigInt::Lite, # and use correct lcm semantics. sub gcd { my $REF = undef; for my $n (@_) { my $refn = ref($n); if ($refn) { $REF = $refn; last; } } # Try all-native if all inputs are native ints. if (!$REF) { my($x,$y) = (shift || 0, 0); $x = -$x if $x < 0; while (@_) { $y = shift; while ($y) { ($x,$y) = ($y, $x % $y); } $x = -$x if $x < 0; } return $x; } my @N = map { ref($_) eq $REF ? $_ : $REF->new("$_") } @_; my $gcd; if ($REF eq 'Math::BigInt') { $gcd = Math::BigInt::bgcd(@N); } elsif ($REF eq 'Math::GMPz') { $gcd = Math::GMPz->new(shift(@N)); Math::GMPz::Rmpz_gcd($gcd,$gcd,$_) for @N; } elsif ($REF eq 'Math::GMP') { $gcd = Math::GMP->new(shift(@N)); $gcd = Math::GMP::gcd($gcd,$_) for @N; } else { $gcd = Math::BigInt::bgcd(map { Math::BigInt->new("$_") } @N); $gcd = tobigint($gcd); } $gcd = _bigint_to_int($gcd) if $gcd <= INTMAX; $gcd; } sub lcm { my(@v) = @_; return 1 unless @v > 0; my $lcm; for my $y (@v) { validate_integer($y); if ($y <= 0) { return 0 if $y == 0; $y = Mabsint($y); } $lcm = defined $lcm ? Mmulint($lcm, Mdivint($y, Mgcd($lcm,$y))) : $y; } return $lcm; } sub gcdext { my($x,$y) = @_; validate_integer($x); validate_integer($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 = reftyped($_[0], $a); $b = reftyped($_[0], $b); $g = 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); $y = _bigint_to_int($y) if ref($y); ($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) = (1,0,$x,0,1,$y); while ($w != 0) { my($q,$r) = Mdivrem($g,$w); ($a,$b,$g,$u,$v,$w) = ($u, $v, $w, Msubint($a,Mmulint($q,$u)), Msubint($b,Mmulint($q,$v)), $r); } } if ($g < 0) { ($a,$b,$g) = (-$a,-$b,-$g); } return ($a,$b,$g); } sub chinese2 { return (0,0) unless scalar @_; my($lcm, $sum); if ($Math::Prime::Util::_GMPfunc{"chinese2"} && $Math::Prime::Util::GMP::VERSION >= 0.53) { return maybetobigintall( Math::Prime::Util::GMP::chinese2(@_) ); } # Validate, copy, and do abs on the inputs. my @items; foreach my $aref (@_) { die "chinese arguments are two-element array references" unless ref($aref) eq 'ARRAY' && scalar @$aref == 2; my($a,$n) = @$aref; validate_integer($a); validate_integer($n); return (undef,undef) if $n == 0; $n = Mabsint($n); $a = Mmodint($a,$n); if (OLD_PERL_VERSION) { ($a,$n) = ("$a","$n"); } push @items, [$a,$n]; } return @{$items[0]} if scalar @items == 1; @items = sort { $b->[1] <=> $a->[1] } @items; ($sum, $lcm) = @{shift @items}; foreach my $aref (@items) { my($ai, $ni) = @$aref; # gcdext my($u,$v,$g,$s,$t,$w) = (1,0,$lcm,0,1,$ni); while ($w != 0) { my($q,$r) = Mdivrem($g,$w); ($u,$v,$g,$s,$t,$w) = ($s, $t, $w, Msubint($u,Mmulint($q,$s)), Msubint($v,Mmulint($q,$t)), $r); } #($u,$v,$g) = (-$u,-$v,-$g) if $g < 0; ($u,$v,$g) = map { Mnegint($_) } ($u,$v,$g) if $g < 0; return (undef,undef) if $g != 1 && ($sum % $g) != ($ai % $g); # Not co-prime $s = Mnegint($s) if "$s" < 0; $t = Mnegint($t) if "$t" < 0; $lcm = Mmulint($lcm, $s); $u = Maddint($u, $lcm) if "$u" < 0; $v = Maddint($v, $lcm) if "$v" < 0; my $vs = Mmulmod($v,$s,$lcm); my $ut = Mmulmod($u,$t,$lcm); my $m1 = Mmulmod($sum,$vs,$lcm); my $m2 = Mmulmod($ut,$ai,$lcm); $sum = Maddmod($m1, $m2, $lcm); } ($sum,$lcm); } sub chinese { (chinese2(@_))[0]; } sub _from_128 { my($hi, $lo) = @_; return 0 unless defined $hi && defined $lo; Maddint(Mlshiftint($hi,MPU_MAXBITS), $lo); } sub vecsum { return reftyped($_[0], @_ ? $_[0] : 0) if @_ <= 1; return reftyped($_[0], Math::Prime::Util::GMP::vecsum(@_)) if $Math::Prime::Util::_GMPfunc{"vecsum"}; my $sum = 0; if (OLD_PERL_VERSION) { $_="$_" for @_ }; foreach my $v (@_) { $sum += $v; if ($sum > (INTMAX-250) || $sum < (INTMIN+250)) { # Sum again from the start using bigint sum $sum = tobigint(0); if (ref($sum) eq 'Math::Pari') { $sum += "$_" for @_; } else { $sum += $_ for @_; } $sum = _bigint_to_int($sum) if $sum <= INTMAX && $sum >= INTMIN; return $sum; } } $sum; } sub _product_mulint { my($a, $b, $r) = @_; return $r->[$a] if $b <= $a; return Mmulint($r->[$a], $r->[$b]) if $b == $a+1; return Mmulint(Mmulint($r->[$a], $r->[$a+1]), $r->[$a+2]) if $b == $a+2; my $c = $a + (($b-$a+1)>>1); Mmulint( _product_mulint($a, $c-1, $r), _product_mulint($c, $b, $r) ); } sub _product_mult { my($a, $b, $r) = @_; return $r->[$a] if $b <= $a; return $r->[$a] * $r->[$a+1] if $b == $a+1; return $r->[$a] * $r->[$a+1] * $r->[$a+2] if $b == $a+2; my $c = $a + (($b-$a+1)>>1); _product_mult($a, $c-1, $r) * _product_mult($c, $b, $r); } sub vecprod { return 1 unless @_; return reftyped($_[0], Math::Prime::Util::GMP::vecprod(@_)) if $Math::Prime::Util::_GMPfunc{"vecprod"}; return $_[0] if @_ == 1; # Argh, Perl 5.6.2. if (OLD_PERL_VERSION) { my $prod = _product_mult(0, $#_, [map { tobigint($_) } @_]); $prod = _bigint_to_int($prod) if ref($prod) && $prod <= INTMAX && $prod >= INTMIN; return $prod; } # Try native for non-negative/non-zero inputs if ($_[0] > 0 && $_[0] <= INTMAX && $_[1] > 0 && $_[1] <= INTMAX) { my $prod = shift @_; $prod *= shift @_ while @_ && $_[0] > 0 && $_[0] <= INTMAX && int(INTMAX/$prod) > $_[0]; return $prod if @_ == 0; unshift @_, $prod if $prod > 1; } return mulint($_[0], $_[1]) if @_ == 2; # Product tree # my $prod = _product_mulint(0, $#_, \@_); my $prod = _product_mult(0, $#_, [map { tobigint($_) } @_]); $prod = _bigint_to_int($prod) if ref($prod) && $prod <= INTMAX && $prod >= INTMIN; $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 vecequal { my($aref, $bref) = @_; croak "vecequal element not scalar or array reference" unless ref($aref) eq 'ARRAY' && ref($bref) eq 'ARRAY'; return 0 unless $#$aref == $#$bref; my $i = 0; for my $av (@$aref) { my $bv = $bref->[$i++]; next if !defined $av && !defined $bv; return 0 if !defined $av || !defined $bv; if (ref($av) && ref($bv) && (ref($av) =~ /^(ARRAY|HASH|CODE|FORMAT|IO|REGEXP)$/i || ref($bv) =~ /^(ARRAY|HASH|CODE|FORMAT|IO|REGEXP)$/i) ) { next if (ref($av) eq ref($bv)) && vecequal($av, $bv); return 0; } # About 7x faster if we skip the validates. # validate_integer($av); # validate_integer($bv); return 0 unless "$av" eq "$bv"; } 1; } sub vecmex { my $items = scalar(@_); my @seen; for (@_) { $seen[$_] = 0 if $_ < $items; } for (0 .. $items-1) { return $_ unless defined $seen[$_]; } return $items; } sub vecpmex { my $items = scalar(@_); my @seen; for (@_) { $seen[$_] = 0 if $_ <= $items; } for (1 .. $items) { return $_ unless defined $seen[$_]; } return $items+1; } 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 is_happy { my($n, $base, $k) = @_; validate_integer_nonneg($n); my $h = 1; if (!defined $base && !defined $k) { # default base 10 exponent 2 while ($n > 1 && $n != 4) { my $sum = 0; $sum += $_*$_ for (split(//,$n)); $n = $sum; $h++; } return ($n == 1) ? $h : 0; } if (defined $base) { validate_integer_nonneg($base); croak "is_happy: invalid base $base" if $base < 2 || $base > 36; } else { $base = 10; } if (defined $k) { validate_integer_nonneg($k); croak "is_happy: invalid exponent $k" if $k > 10; } else { $k = 2; } my %seen; while ($n > 1 && !exists $seen{$n}) { $seen{$n} = undef; if ($base == 10) { my $sum = 0; $sum += $_ ** $k for (split(//,$n)); $n = $sum; } else { my @d; while ($n >= 1) { my $rem = $n % $base; push @d, ($k <= 6) ? int($rem ** $k) : Mpowint($rem,$k); #push @d, Mpowint($rem,$k); $n = ($n-$rem)/$base; # Always an exact division } $n = Mvecsum(@d); } $h++; } return ($n == 1) ? $h : 0; } # Tonelli-Shanks sub _sqrtmod_prime { my($a, $p) = @_; my($x, $q, $e, $t, $z, $r, $m, $b); my $Q = Msub1int($p); if (($p % 4) == 3) { $r = Mpowmod($a, Mrshiftint(Madd1int($p),2), $p); return undef unless Mmulmod($r,$r,$p) == $a; return $r; } if (($p % 8) == 5) { $m = Maddmod($a,$a,$p); $t = Mpowmod($m, Mrshiftint(Msubint($p,5),3), $p); $z = Mmulmod($m, Mmulmod($t,$t,$p), $p); $r = Mmulmod($t, Mmulmod($a, Msubmod($z,1,$p), $p), $p); return undef unless Mmulmod($r,$r,$p) == $a; return $r; } # Verify Euler's criterion for odd p return undef if $p != 2 && Mpowmod($a, Mrshiftint($Q), $p) != 1; # Cohen Algorithm 1.5.1. Tonelli-Shanks. $e = Mvaluation($Q, 2); $q = Mdivint($Q, Mpowint(2,$e)); $t = 3; while (Mkronecker($t,$p) != -1) { $t += 2; return undef if $t == 201 && !Mis_prime($p); } $z = Mpowmod($t, $q, $p); $b = Mpowmod($a, $q, $p); $r = $e; $q = ($q+1) >> 1; $x = Mpowmod($a, $q, $p); while ($b != 1) { $t = $b; for ($m = 0; $m < $r && $t != 1; $m++) { $t = Mmulmod($t, $t, $p); } $t = Mpowmod($z, Mlshiftint(1, $r-$m-1), $p); $x = Mmulmod($x, $t, $p); $z = Mmulmod($t, $t, $p); $b = Mmulmod($b, $z, $p); $r = $m; } # Expected to always be true. return undef unless Mmulmod($x,$x,$p) == $a; return $x; } sub _sqrtmod_prime_power { my($a,$p,$e) = @_; my($r,$s); if ($e == 1) { $a %= $p if $a >= $p; return $a if $p == 2 || $a == 0; $r = _sqrtmod_prime($a,$p); return (defined $r && (Mmulmod($r,$r,$p) == $a) ? $r : undef); } my $n = Mpowint($p,$e); my $pk = Mmulint($p,$p); return 0 if ($a % $n) == 0; if (($a % $pk) == 0) { my $apk = Mdivint($a, $pk); $s = _sqrtmod_prime_power($apk, $p, $e-2); return undef unless defined $s; return Mmulint($s,$p); } return undef if ($a % $p) == 0; my $ered = ($p > 2 || $e < 5) ? ($e+1) >> 1 : ($e+3) >> 1; $s = _sqrtmod_prime_power($a,$p,$ered); return undef unless defined $s; my $np = ($p == 2) ? Mmulint($n,$p) : $n; my $t1 = Msubmod($a, Mmulmod($s,$s,$np), $np); my $t2 = Maddmod($s, $s, $np); my $gcd = Mgcd($t1, $t2); $r = Maddmod($s, Mdivmod(Mdivint($t1,$gcd),Mdivint($t2,$gcd),$n), $n); return ((Mmulmod($r,$r,$n) == ($a % $n)) ? $r : undef); } sub _sqrtmod_composite { my($a,$n) = @_; return undef if $n <= 0; $a %= $n if $a >= $n; return $a if $n <= 2 || $a <= 1; return Msqrtint($a) if _is_perfect_square($a); my $N = 1; my $r = 0; foreach my $F (Mfactor_exp($n)) { my($f,$e) = @$F; my $fe = Mpowint($f, $e); my $s = _sqrtmod_prime_power($a, $f, $e); return undef unless defined $s; my $inv = Minvmod($N, $fe); my $t = Mmulmod($inv, Msubmod($s % $fe, $r % $fe, $fe), $fe); $r = Mmuladdmod($N, $t, $r, $n); $N = Mmulint($N, $fe); } #croak "Bad _sqrtmod_composite root $a,$n" unless Mmulmod($r,$r,$n) == $a; $r; } sub sqrtmod { my($a,$n) = @_; validate_integer($a); validate_integer_abs($n); return (undef,0)[$n] if $n <= 1; #return Mmodint(Msqrtint($a),$n) if _is_perfect_square($a); $a = Mmodint($a,$n); return $a if $a <= 1; my $r = Mis_prime($n) ? _sqrtmod_prime($a,$n) : _sqrtmod_composite($a,$n); if (defined $r) { $r = $n-$r if $n-$r < $r; $r = _bigint_to_int($r) if ref($r) && $r <= INTMAX; } #croak "Bad _sqrtmod_composite root $a,$n" unless Mmulmod($r,$r,$n) == $a; $r; } # helper function for allsqrtmod() - return list of all square roots of # a (mod p^k), assuming a integer, p prime, k positive integer. sub _allsqrtmodpk { my($a,$p,$k) = @_; my $pk = Mpowint($p,$k); unless ($a % $p) { unless ($a % ($pk)) { # if p^k divides a, we need the square roots of zero, satisfied by # ip^j with 0 <= i < p^{floor(k/2)}, j = p^{ceil(k/2)} my $low = Mpowint($p,$k >> 1); my $high = ($k % 2) ? Mmulint($low, $p) : $low; return map Mmulint($high, $_), 0 .. $low - 1; } # p divides a, p^2 does not my $a2 = Mdivint($a,$p); return () if $a2 % $p; my $pj = Mdivint($pk, $p); return map { my $qp = Mmulint($_,$p); map Maddint($qp,Mmulint($_,$pj)), 0 .. $p - 1; } _allsqrtmodpk(Mdivint($a2,$p), $p, $k - 2); } my $q = _sqrtmod_prime_power($a,$p,$k); return () unless defined $q; return ($q, $pk - $q) if $p != 2; return ($q) if $k == 1; return ($q, $pk - $q) if $k == 2; my $pj = Mdivint($pk,$p); my $q2 = ($q * ($pj - 1)) % $pk; return ($q, $pk - $q, $q2, $pk - $q2); } # helper function for allsqrtmod() - return list of all square roots of # a (mod p^k), assuming a integer, n positive integer > 1, f arrayref # of [ p, k ] pairs representing factorization of n. Destroys f. sub _allsqrtmodfact { my($a,$n,$f) = @_; my($p,$k) = @{ shift @$f }; my @q = _allsqrtmodpk($a, $p, $k); return @q unless @$f; my $pk = Mpowint($p, $k); my $n2 = Mdivint($n, $pk); return map { my $q2 = $_; map Mchinese([ $q2, $n2 ], [ $_, $pk ]), @q; } _allsqrtmodfact($a, $n2, $f); } sub allsqrtmod { my($A,$n) = @_; validate_integer($A); validate_integer_abs($n); return $n ? (0) : () if $n <= 1; $A = Mmodint($A,$n); my @R = Mis_prime($n) ? _allsqrtmodpk($A,$n,1) : _allsqrtmodfact($A, $n, [Mfactor_exp($n)]); Mvecsort(@R); } ############################################################################### # Tonelli-Shanks kth roots ############################################################################### # Algorithm 3.3, step 2 "Find generator" sub _find_ts_generator { my ($a, $k, $p) = @_; # Assume: k > 2, 1 < a < p, p > 2, k prime, p prime my($e,$r) = (0, $p-1); while (!($r % $k)) { $e++; $r /= $k; } my $ke1 = Mpowint($k, $e-1); my($x,$m,$y) = (2,1); while ($m == 1) { $y = Mpowmod($x, $r, $p); $m = Mpowmod($y, $ke1, $p) if $y != 1; croak "bad T-S input" if $x >= $p; $x++; } ($y, $m); } sub _ts_rootmod { my($a, $k, $p, $y, $m) = @_; my($e,$r) = (0, $p-1); while (!($r % $k)) { $e++; $r /= $k; } # p-1 = r * k^e my $x = Mpowmod($a, Minvmod($k % $r, $r), $p); my $A = ($a == 0) ? 0 : Mmulmod(Mpowmod($x,$k,$p), Minvmod($a,$p), $p); ($y,$m) = _find_ts_generator($a,$k,$p) if $y == 0 && $A != 1; while ($A != 1) { my ($l,$T,$z) = (1,$A); while ($T != 1) { return 0 if $l >= $e; $z = $T; $T = Mpowmod($T, $k, $p); $l++; } # We want a znlog that takes gorder as well (k=znorder(m,p)) my $kz = _negmod(znlog($z, $m, $p), $k); $m = Mpowmod($m, $kz, $p); $T = Mpowmod($y, Mmulint($kz,Mpowint($k,$e-$l)), $p); # In the loop we always end with l < e, so e always gets smaller $e = $l-1; $x = Mmulmod($x, $T, $p); $y = Mpowmod($T, $k, $p); return 0 if $y <= 1; # In theory this will never be hit. $A = Mmulmod($A, $y, $p); } $x; } sub _compute_generator { # uncoverable subroutine my($l, $e, $r, $p) = @_; my($m, $lem1, $y) = (1, Mpowint($l, $e-1)); for (my $x = 2; $m == 1; $x++) { $y = Mpowmod($x, $r, $p); next if $y == 1; $m = Mpowmod($y, $lem1, $p); } $y; } sub _rootmod_prime_splitk { my($a, $k, $p, $refzeta) = @_; $$refzeta = 1 if defined $refzeta; $a = Mmodint($a, $p) if $a >= $p; return $a if $a == 0 || ($a == 1 && !defined $refzeta); my $p1 = Msub1int($p); if ($k == 2) { my $r = _sqrtmod_prime($a,$p); $$refzeta = (defined $r) ? $p1 : 0 if defined $refzeta; return $r; } # See Algorithm 2.1 of van de Woestijne (2006), or Lindhurst (1997). # The latter's proposition 7 generalizes to composite p. my $g = Mgcd($k, $p1); my $r = $a; if ($g != 1) { foreach my $fac (Mfactor_exp($g)) { my($F,$E) = @$fac; last if $r == 0; # uncoverable branch true if (defined $refzeta) { my $V = Mvaluation($p1, $F); my $REM = Mdivint($p1, Mpowint($F,$V)); my $Y = _compute_generator($F, $V, $REM, $p); $$refzeta = Mmulmod($$refzeta, Mpowmod($Y, Mpowint($F, $V-$E), $p), $p); } my ($y,$m) = _find_ts_generator($r, $F, $p); while ($E-- > 0) { $r = _ts_rootmod($r, $F, $p, $y, $m); } } } if ($g != $k) { my($kg, $pg) = (Mdivint($k,$g), Mdivint($p1,$g)); $r = Mpowmod($r, Minvmod($kg % $pg, $pg), $p); } return $r if Mpowmod($r, $k, $p) == $a; $$refzeta = 0 if defined $refzeta; undef; } sub _rootmod_composite1 { my($a,$k,$n) = @_; my $r; croak "_rootmod_composite1 bad parameters" if $a < 1 || $k < 2 || $n < 2; if (Mis_power($a, $k, \$r)) { return $r; } if (Mis_prime($n)) { return _rootmod_prime_splitk($a,$k,$n,undef); } # We should do this iteratively using cprod my @rootmap; foreach my $fac (Mfactor_exp($n)) { my($F,$E) = @$fac; my $FE = Mpowint($F,$E); my $A = $a % $FE; if ($E == 1) { $r = _rootmod_prime_splitk($A,$k,$F,undef) } else { # TODO: Fix this. We should do this directly. $r = (allrootmod($A, $k, $FE))[0]; } return undef unless defined $r && Mpowmod($r, $k, $FE) == $A; push @rootmap, [ $r, $FE ]; } $r = Mchinese(@rootmap) if @rootmap > 1; #return (defined $r && Mpowmod($r, $k, $n) == ($a % $n)) ? $r : undef; croak "Bad _rootmod_composite1 root $a,$k,$n" unless defined $r && Mpowmod($r,$k,$n) == ($a % $n); $r; } ############################################################################### # Tonelli-Shanks kth roots alternate version ############################################################################### sub _ts_prime { my($a, $k, $p, $refzeta) = @_; my($e,$r) = (0, $p-1); while (!($r % $k)) { $e++; $r /= $k; } my $ke = Mdivint($p-1, $r); my $x = Mpowmod($a, Minvmod($k % $r, $r), $p); my $B = Mmulmod(Mpowmod($x, $k, $p), Minvmod($a, $p), $p); my($T,$y,$t,$A) = (2,1); while ($y == 1) { $t = Mpowmod($T, $r, $p); $y = Mpowmod($t, Mdivint($ke,$k), $p); $T++; } while ($ke != $k) { $ke = Mdivint($ke, $k); $T = $t; $t = Mpowmod($t, $k, $p); $A = Mpowmod($B, Mdivint($ke,$k), $p); while ($A != 1) { $x = Mmulmod($x, $T, $p); $B = Mmulmod($B, $t, $p); $A = Mmulmod($A, $y, $p); } } $$refzeta = $t if defined $refzeta; $x; } sub _rootmod_prime { # uncoverable subroutine my($a, $k, $p) = @_; # p must be a prime, k must be a prime. Otherwise UNDEFINED. $a %= $p if $a >= $p; return $a if $p == 2 || $a == 0; return _sqrtmod_prime($a, $p) if $k == 2; # If co-prime, there is exactly one root. my $g = Mgcd($k, $p-1); return Mpowmod($a, Minvmod($k % ($p-1), $p-1), $p) if $g == 1; # Check generalized Euler's criterion return undef if Mpowmod($a, Mdivint($p-1, $g), $p) != 1; _ts_prime($a, $k, $p); } sub _rootmod_prime_power { # uncoverable subroutine my($a,$k,$p,$e) = @_; # prime k, prime p return _sqrtmod_prime_power($a, $p, $e) if $k == 2; return _rootmod_prime($a, $k, $p) if $e == 1; my $n = Mpowint($p,$e); my $pk = Mpowint($p,$k); return 0 if ($a % $n) == 0; if (($a % $pk) == 0) { my $apk = Mdivint($a, $pk); my $s = _rootmod_prime_power($apk, $k, $p, $e-$k); return (defined $s) ? Mmulint($s,$p) : undef; } return undef if ($a % $p) == 0; my $ered = ($p > 2 || $e < 5) ? ($e+1) >> 1 : ($e+3) >> 1; my $s = _rootmod_prime_power($a, $k, $p, $ered); return undef if !defined $s; my $np = ($p == $k) ? Mmulint($n,$p) : $n; my $t = Mpowmod($s, $k-1, $np); my $t1 = Msubmod($a, Mmulmod($t,$s,$np), $np); my $t2 = Mmulmod($k, $t, $np); my $gcd = Mgcd($t1, $t2); my $r = Maddmod($s,Mdivmod(Mdivint($t1,$gcd),Mdivint($t2,$gcd),$n),$n); return ((Mpowmod($r,$k,$n) == ($a % $n)) ? $r : undef); } sub _rootmod_kprime { # uncoverable subroutine my($a,$k,$n,@nf) = @_; # k prime, n factored into f^e,f^e,... my($N,$r) = (1,0); foreach my $F (@nf) { my($f,$e) = @$F; my $fe = Mpowint($f, $e); my $s = _rootmod_prime_power($a, $k, $f, $e); return undef unless defined $s; my $inv = Minvmod($N, $fe); my $t = Mmulmod($inv, Msubmod($s % $fe, $r % $fe, $fe), $fe); $r = Mmuladdmod($N, $t, $r, $n); $N = Mmulint($N, $fe); } $r; } sub _rootmod_composite2 { # uncoverable subroutine my($a,$k,$n) = @_; croak "_rootmod_composite2 bad parameters" if $a < 1 || $k < 2 || $n < 2; my @nf = Mfactor_exp($n); return _rootmod_kprime($a, $k, $n, @nf) if Mis_prime($k); my $r = $a; foreach my $kf (Mfactor($k)) { $r = _rootmod_kprime($r, $kf, $n, @nf); if (!defined $r) { # Choose one. The former is faster but makes more intertwined code. return _rootmod_composite1($a,$k,$n); #return (allrootmod($a,$k,$n))[0]; } } croak "Bad _rootmod_composite2 root $a,$k,$n" unless defined $r && Mpowmod($r,$k,$n) == ($a % $n); $r; } ############################################################################### # Modular k-th root ############################################################################### sub rootmod { my($a,$k,$n) = @_; validate_integer($a); validate_integer($k); validate_integer_abs($n); return (undef,0)[$n] if $n <= 1; $a = Mmodint($a,$n); # Be careful with zeros, as we can't divide or invert them. if ($a == 0) { return ($k <= 0) ? undef : 0; } if ($k < 0) { $a = Minvmod($a, $n); return undef unless defined $a && $a > 0; $k = -$k; } return undef if $k == 0 && $a != 1; return 1 if $k == 0 || $a == 1; return $a if $k == 1; # Choose either one based on performance. my $r = _rootmod_composite1($a, $k, $n); #my $r = _rootmod_composite2($a, $k, $n); $r = $n-$r if defined $r && $k == 2 && ($n-$r) < $r; # Select smallest root $r; } ############################################################################### # All modular k-th roots ############################################################################### sub _allrootmod_cprod { my($aroots1, $p1, $aroots2, $p2) = @_; my($t, $n, $inv); $n = mulint($p1, $p2); $inv = Minvmod($p1, $p2); croak("CRT has undefined inverse") unless defined $inv; my @roots; for my $q1 (@$aroots1) { for my $q2 (@$aroots2) { $t = Mmulmod($inv, Msubmod($q2, $q1, $p2), $p2); $t = Mmuladdmod($p1, $t, $q1, $n); push @roots, $t; } } return @roots; } sub _allrootmod_prime { my($a,$k,$p) = @_; # prime k, prime p $a %= $p if $a >= $p; #$a = Mmodint($a,$p) if $a >= $p; return ($a) if $p == 2 || $a == 0; # If co-prime, there is exactly one root. my $g = Mgcd($k, $p-1); if ($g == 1) { my $r = Mpowmod($a, Minvmod($k % ($p-1), $p-1), $p); return ($r); } # Check generalized Euler's criterion return () if Mpowmod($a, Mdivint($p-1, $g), $p) != 1; # Special case for p=3 for performance return (1,2) if $p == 3; # A trivial brute force search: # return grep { Mpowmod($_,$k,$p) == $a } 0 .. $p-1; # Call one of the general TS solvers that also allow us to get all the roots. my $z; #my $r = _rootmod_prime_splitk($a, $k, $p, \$z); my $r = _ts_prime($a, $k, $p, \$z); croak "allrootmod: failed to find root" if $z==0 || Mpowmod($r,$k,$p) != $a; my @roots = ($r); my $r2 = Mmulmod($r,$z,$p); while ($r2 != $r && @roots < $k) { push @roots, $r2; $r2 = Mmulmod($r2, $z, $p); } croak "allrootmod: excess roots found" if $r2 != $r; return @roots; } sub _allrootmod_prime_power { my($a,$k,$p,$e) = @_; # prime k, prime p return _allrootmod_prime($a, $k, $p) if $e == 1; my $n = ($e<=13 && $p<=13)||($e<=5 && $p<=1000) ?int($p**$e):Mpowint($p,$e); my $pk = ($k<=13 && $p<=13)||($k<=5 && $p<=1000) ?int($p**$k):Mpowint($p,$k); my @roots; if (($a % $n) == 0) { my $t = Mdivint($e-1, $k) + 1; my $nt = Mpowint($p, $t); my $nr = Mpowint($p, $e-$t); @roots = map { Mmulmod($_, $nt, $n) } 0 .. $nr-1; return @roots; } if (($a % $pk) == 0) { my $apk = Mdivint($a, $pk); my $pe1 = Mpowint($p, $k-1); my $pek = Mpowint($p, $e-$k+1); my @roots2 = _allrootmod_prime_power($apk, $k, $p, $e-$k); for my $r (@roots2) { my $rp = Mmulmod($r, $p, $n); push @roots, Mmuladdmod($_, $pek, $rp, $n) for 0 .. $pe1-1; } return @roots; } return () if ($a % $p) == 0; my $np = Mmulint($n,$p); my $ered = ($p > 2 || $e < 5) ? ($e+1) >> 1 : ($e+3) >> 1; my @roots2 = _allrootmod_prime_power($a, $k, $p, $ered); if ($k != $p) { for my $s (@roots2) { my $t = Mpowmod($s, $k-1, $n); my $t1 = Msubmod($a, Mmulmod($t,$s,$n), $n); my $t2 = Mmulmod($k, $t, $n); my $gcd = Mgcd($t1, $t2); my $r = Maddmod($s,Mdivmod(Mdivint($t1,$gcd),Mdivint($t2,$gcd),$n),$n); push @roots, $r; } } else { my @rootst; for my $s (@roots2) { my $t = Mpowmod($s, $k-1, $np); my $t1 = Msubmod($a, Mmulmod($t,$s,$np), $np); my $t2 = Mmulmod($k, $t, $np); my $gcd = Mgcd($t1, $t2); my $r = Maddmod($s,Mdivmod(Mdivint($t1,$gcd), Mdivint($t2,$gcd),$n),$n); push @rootst, $r if Mpowmod($r, $k, $n) == ($a % $n); } my $ndivp = Mdivint($n,$p); my $rset = []; for my $r (@rootst) { Msetinsert($rset, Mmulmod($r, Mmuladdmod($_, $ndivp, 1, $n), $n)) for 0 .. $k-1; } @roots = @$rset; } return @roots; } sub _allrootmod_kprime { my($a,$k,$n,@nf) = @_; # k prime, n factored into f^e,f^e,... return _allsqrtmodfact($a, $n, \@nf) if $k == 2; my $N = 1; my @roots; foreach my $F (@nf) { my($f,$e) = @$F; my @roots2 = ($e==1) ? _allrootmod_prime($a, $k, $f) : _allrootmod_prime_power($a, $k, $f, $e); return () unless @roots2; my $fe = ($e <= 13 && $f <= 13) ? int($f**$e) : Mpowint($f, $e); if (scalar(@roots) == 0) { @roots = @roots2; } else { @roots = _allrootmod_cprod(\@roots, $N, \@roots2, $fe); } $N = Mmulint($N, $fe); } return @roots; } sub allrootmod { my($A,$k,$n) = @_; validate_integer($A); validate_integer($k); validate_integer_abs($n); return () if $n == 0; $A = Mmodint($A,$n); return () if $k <= 0 && $A == 0; if ($k < 0) { $A = Minvmod($A, $n); return () unless defined $A && $A > 0; $k = -$k; } # TODO: For testing #my @roots = sort { $a <=> $b } # grep { Mpowmod($_,$k,$n) == $A } 0 .. $n-1; #return @roots; return ($A) if $n <= 2 || $k == 1; return ($A == 1) ? (0..$n-1) : () if $k == 0; my @roots; my @nf = Mis_prime($n) ? ([$n,1]) : Mfactor_exp($n); if (Mis_prime($k)) { @roots = _allrootmod_kprime($A, $k, $n, @nf); } else { @roots = ($A); for my $primek (Mfactor($k)) { my @rootsnew = (); for my $r (@roots) { push @rootsnew, _allrootmod_kprime($r, $primek, $n, @nf); } @roots = @rootsnew; } } Mvecsort(@roots); } ################################################################################ ################################################################################ sub _modabsint { my($a, $n) = @_; if ($n <= 1) { if ($n < 0) { $n = tobigint($n) if $n <= INTMIN && !ref($n); $n = -$n; } return (undef,0)[$n] if $n <= 1; } if ($n < INTMAX && $a < INTMAX && $a > INTMIN) { $a = $n - ((-$a) % $n) if $a < 0; $a %= $n if $a >= $n; } else { $a = tobigint($a) % $n; $a = _bigint_to_int($a) if $a <= INTMAX; } $a; } sub addmod { my($a, $b, $n) = @_; if ($n <= 1) { if ($n < 0) { $n = tobigint($n) if $n <= INTMIN && !ref($n); $n = -$n; } return (undef,0)[$n] if $n <= 1; } if ($n <= INTMAX && $a <= INTMAX && $b <= INTMAX && $a >= INTMIN && $b >= INTMIN) { $a = $n - ((-$a) % $n) if $a < 0; $b = $n - ((-$b) % $n) if $b < 0; $a %= $n if $a >= $n; $b %= $n if $b >= $n; return $n-$a > $b ? $a+$b : $a > $b ? ($a-$n)+$b : ($b-$n)+$a; } # Impl 1. Make $a a bigint and let things promote. Fastest. $a = tobigint($a); if (ref($a) eq 'Math::Pari') { $b = tobigint($b); $n = tobigint($n); } my $r = ($a + $b) % $n; return $r <= INTMAX ? _bigint_to_int($r) : $r; # Impl 2. Use Maddint but mod with a $n as a bigint. #my $r = Maddint($a,$b) % tobigint($n); #return $r <= INTMAX ? _bigint_to_int($r) : $r; # Impl 3. Prefered, but slowest. Probably fine when we use amagic in XS. #Mmodint(Maddint($a,$b),$n); } sub submod { my($a, $b, $n) = @_; if ($n <= 1) { if ($n < 0) { $n = tobigint($n) if $n <= INTMIN && !ref($n); $n = -$n; } return (undef,0)[$n] if $n <= 1; } if ($n <= INTMAX && $a <= INTMAX && $b <= INTMAX && $a >= INTMIN && $b >= INTMIN) { $a = $n - ((-$a) % $n) if $a < 0; $b = $n - ((-$b) % $n) if $b < 0; $a %= $n if $a >= $n; $b %= $n if $b >= $n; $b = $n-$b; # negate b then we add as above return $n-$a > $b ? $a+$b : $a > $b ? ($a-$n)+$b : ($b-$n)+$a; } $a = tobigint($a); if (ref($a) eq 'Math::Pari') { $b = tobigint($b); $n = tobigint($n); } my $r = ($a - $b) % $n; return $r <= INTMAX ? _bigint_to_int($r) : $r; } sub mulmod { my($a, $b, $n) = @_; #if ($n <= 1) { # ABS(n) and handle mod 0 | mod 1. # if ($n < 0) { $n = tobigint($n) if $n <= INTMIN && !ref($n); $n = -$n; } # return (undef,0)[$n] if $n <= 1; #} if ($n <= 1) { return (undef,0)[$n] if $n >= 0; $n = tobigint($n) if $n <= INTMIN && !ref($n); $n = -$n; return 0 if $n == 1; } # If n is a native int, we can reduce a and b then do everything native if ($n < INTMAX) { if ($a >= INTMAX || $a < 0 || $b >= INTMAX || $b < 0) { $a = _bigint_to_int(tobigint($a) % $n) if $a >= INTMAX || $a < 0; $b = _bigint_to_int(tobigint($b) % $n) if $b >= INTMAX || $b < 0; } return _mulmod($a,$b,$n); } # Try GMP return reftyped($_[0], Math::Prime::Util::GMP::mulmod($a,$b,$n)) if $Math::Prime::Util::_GMPfunc{"mulmod"}; my $refn = ref($n); if (!$refn) { $n = tobigint($n); $refn = ref($n); } $a = $refn->new("$a") unless ref($a) eq $refn; $b = $refn->new("$b") unless ref($b) eq $refn; my $r = ($a * $b) % $n; return $r <= INTMAX ? _bigint_to_int($r) : $r; } sub _bi_powmod { my($a, $b, $n) = @_; croak "_bi_powmod must have positive exponent" if $b < 0; croak "_bi_powmod must have n > 1" if $n <= 1; my $refn = ref($n); if (!$refn) { $n = tobigint($n); $refn = ref($n); } $b = $refn->new($b) unless ref($b) eq $refn; my $r = $refn->new($a); if ($refn eq 'Math::GMPz') { Math::GMPz::Rmpz_powm($r, $r, $b, $n); } elsif ($refn eq 'Math::GMP') { $r = $r->powm_gmp($b,$n); } elsif ($refn eq 'Math::BigInt') { $r->bmod($n) if $BIGINTVERSION < 1.999; $r->bmodpow($b,$n); } elsif ($refn eq 'Math::Pari') { $a = $refn->new("$a") unless ref($a) eq $refn; $b = $refn->new("$b") unless ref($b) eq $refn; if ($n <= 4294967295 && $b > 4294967295) { $b = $b % Math::Prime::Util::carmichael_lambda($n); } $r = Math::Pari::lift(Math::Pari::gpow(Math::Pari::Mod($a,$n),$b)); } else { $r->bmodpow("$b","$n"); } $r; } sub powmod { my($a, $b, $n) = @_; if ($n <= 1) { if ($n < 0) { $n = tobigint($n) if $n <= INTMIN && !ref($n); $n = -$n; } return (undef,0)[$n] if $n <= 1; } return ($b > 0) ? 0 : 1 if $a == 0; if ($Math::Prime::Util::_GMPfunc{"powmod"}) { my $r = Math::Prime::Util::GMP::powmod($a,$b,$n); return (defined $r) ? reftyped($_[0], $r) : undef; } # If the exponent is negative: a=1/a ; b=-b if ($b < 0) { $a = Minvmod($a,$n); return undef unless defined $a; $b = tobigint($b) if $b <= INTMIN && !ref($b); $b = -$b; } if ($b <= 8) { return 1 if $b == 0; return _modabsint($a,$n) if $b == 1; return Mmulmod($a,$a,$n) if $b == 2; # For exponents 3-8, this can be 20x faster for native n if (!ref($n) && $a <= 31622776 && $a >= -31622776) { my $a2 = int($a*$a); return Mmulmod($a2,$a,$n) if $b == 3; my $a4 = Mmulmod($a2,$a2,$n); return $a4 if $b == 4; return Mmulmod($a4,$a,$n) if $b == 5; return Mmulmod($a4,$a2,$n) if $b == 6; return Mmulmod($a4,Mmulmod($a2,$a,$n),$n) if $b == 7; return Mmulmod($a4,$a4,$n) if $b == 8; } } my $r = _bi_powmod($a,$b,$n); return $r <= INTMAX ? _bigint_to_int($r) : $r; } sub muladdmod { my($a, $b, $c, $n) = @_; if ($n <= 1) { $n = Mnegint($n) if $n < 0; return (undef,0)[$n] if $n <= 1; } if (!ref($n) && $n <= INTMAX && $a <= INTMAX && $b <= INTMAX && $c <= INTMAX && $a >= INTMIN && $b >= INTMIN && $c >= INTMIN) { $a = $n - ((-$a) % $n) if $a < 0; $b = $n - ((-$b) % $n) if $b < 0; $c = $n - ((-$c) % $n) if $c < 0; #$c %= $n if $c >= $n; # For mulsubmod return _addmod(_mulmod($a,$b,$n),$c,$n); } return reftyped($_[0], Math::Prime::Util::GMP::muladdmod($a,$b,$c,$n)) if $Math::Prime::Util::_GMPfunc{"muladdmod"}; $n = tobigint($n) unless ref($n); if (ref($n) eq 'Math::Pari') { $a = tobigint("$a") unless ref($a) eq 'Math::Pari'; $b = tobigint("$b") unless ref($b) eq 'Math::Pari'; } else { $a = tobigint($a) unless ref($a) || ref($b); } $c = tobigint($c) unless ref($c); my $r = (($a * $b) + $c) % $n; return $r <= INTMAX ? _bigint_to_int($r) : $r; } sub mulsubmod { my($a, $b, $c, $n) = @_; if ($n <= 1) { $n = Mnegint($n) if $n < 0; return (undef,0)[$n] if $n <= 1; } if (!ref($n) && $n <= INTMAX && $a <= INTMAX && $b <= INTMAX && $c <= INTMAX && $a >= INTMIN && $b >= INTMIN && $c >= INTMIN) { $a = $n - ((-$a) % $n) if $a < 0; $b = $n - ((-$b) % $n) if $b < 0; $c = $n - ((-$c) % $n) if $c < 0; $c = ($c < $n) ? $n-$c : $n-($c % $n); # $c = -$c (mod n) return _addmod(_mulmod($a,$b,$n),$c,$n); } return reftyped($_[0], Math::Prime::Util::GMP::mulsubmod($a,$b,$c,$n)) if $Math::Prime::Util::_GMPfunc{"mulsubmod"}; # return Msubmod(Mmulmod($a,$b,$n),$c,$n); $n = tobigint($n) unless ref($n); if (ref($n) eq 'Math::Pari') { $a = tobigint("$a") unless ref($a) eq 'Math::Pari'; $b = tobigint("$b") unless ref($b) eq 'Math::Pari'; } else { $a = tobigint($a) unless ref($a) || ref($b); } $c = tobigint($c) unless ref($c); my $r = (($a * $b) - $c) % $n; return $r <= INTMAX ? _bigint_to_int($r) : $r; } sub invmod { my($a,$n) = @_; if ($n <= 1) { if ($n < 0) { $n = tobigint($n) if $n <= INTMIN && !ref($n); $n = -$n; } return (undef,0)[$n] if $n <= 1; } return if $a == 0; if ($n < INTMAX) { # Fast all native math my($t,$nt,$r,$nr) = (0, 1, $n, _modabsint($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 $r > 1 ? undef : $t < 0 ? $t+$n : $t; } $n = tobigint($n); $a = tobigint($a) % $n; my $refn = ref($n); my $I; if ($refn eq 'Math::BigInt') { $I = $a->copy->bmodinv($n); $I = undef if defined $I && !$I->is_int(); } elsif ($refn eq 'Math::GMPz') { $I = Math::GMPz->new(); Math::GMPz::Rmpz_invert($I, $a, $n); $I = undef if defined $I && $I == 0; } elsif ($refn eq 'Math::GMP') { $I = $a->gmp_copy->bmodinv($n); $I = undef if defined $I && $I == 0; } elsif ($refn eq 'Math::Pari') { $I = eval{1/Math::Pari::Mod($a,$n)}; $I = defined $I && $I != 0 ? Math::Pari::lift($I) : undef; } else { $I = Math::BigInt->new("$a")->bmodinv("$n"); $I = undef if defined $I && !$I->is_int(); $I = tobigint("$I") if defined $I; } $I = _bigint_to_int($I) if defined $I && $I <= INTMAX; return $I; } sub divmod { my($a, $b, $n) = @_; if ($n <= 1) { if ($n < 0) { $n = tobigint($n) if $n <= INTMIN && !ref($n); $n = -$n; } return (undef,0)[$n] if $n <= 1; } my $invb = Minvmod($b,$n); return undef unless defined $invb; return Mmulmod($a,$invb,$n); } sub negmod { my($a,$n) = @_; validate_integer($a); validate_integer($n); if ($n <= 0) { return undef if $n == 0; # standard mod behavior with n = 0 $n = tobigint($n) if $n <= INTMIN && !ref($n); $n = -$n; # we use |n|, unlike modint } # Easy: # Msubmod(0, $a, $n); $a = Mmodint($a,$n) if $a >= $n || $a < 0; return $a ? $n-$a : 0; } # No validation. sub _negmod { my($a,$n) = @_; if ($n <= 0) { return undef if $n == 0; $n = tobigint($n) if $n <= INTMIN && !ref($n); $n = -$n; } $a = Mmodint($a,$n) if $a >= $n || $a < 0; return $a ? $n-$a : 0; } ################################################################################ ################################################################################ # 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 _powerof_ret { my($n, $refp) = @_; my $k = 2; while (1) { my $rk; my $r = Mrootint($n, $k, \$rk); return 0 if $r == 1; if ($rk == $n) { my $next = _powerof_ret($r, $refp); $$refp = $r if !$next && defined $refp; $k *= $next if $next != 0; return $k; } $k = Mnext_prime($k); } 0; } sub is_power { my ($n, $a, $refp) = @_; validate_integer($n); if (!defined $a) { $a = 0; } else { validate_integer_nonneg($a); } croak("is_power third argument not a scalar reference") if defined($refp) && !ref($refp); 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))) { 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 = Mrootint($n, $a); $$refp = reftyped($_[0], $$refp) if $$refp > INTMAX; $$refp = Mnegint($$refp) if $isneg; } return $k; } if ($a != 0) { if ($a == 1) { $$refp = $n if defined $refp; return 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 = Msqrtint($n) if defined $refp; return 1; } } else { my @rootmask = ( 0x00000000,0x00000000,0xfdfcfdec,0x54555454,0xfffcfffc, # 0-4 0x55555554,0xfdfdfdfc,0x55555554,0xfffffffc,0x55555554,0xfdfdfdfc,# 5-10 0x55555554,0xfffdfffc,0xd5555556,0xfdfdfdfc,0xf57d57d6,0xfffffffc,# 11-16 0xffffd556,0xfdfdfdfe,0xd57ffffe,0xfffdfffc,0xffd7ff7e,0xfdfdfdfe,# 17-22 0xffffd7fe,0xfffffffc,0xffffffd6,0xfdfffdfe,0xd7fffffe,0xfffdfffe,# 23-28 0xfff7fffe,0xfdfffffe,0xfffff7fe,0xfffffffc,0xfffffff6,0xfffffdfe,# 29-34 0xf7fffffe,0xfffdfffe,0xfff7fffe,0xfdfffffe,0xfffff7fe,0xfffffffc # 35-40 ); if ($a <= 40) { my $n32 = 1 << (ref($n) ? Mmodint($n,32) : $n & 31); return 0 if $n32 & $rootmask[$a]; } my $RK; if ($n >= 0) { my $root = Mrootint($n, $a, \$RK); if ($RK == $n) { $$refp = $root if defined $refp; return 1; } } else { my $N = Mnegint($n); my $root = Mrootint($N, $a, \$RK); if ($RK == $N) { $$refp = Mnegint($root) if defined $refp; return 1; } } } return 0; } my $negn = $n < 0; $n = Mnegint($n) if $negn; my $r; my $k = _powerof_ret($n, defined $refp ? \$r : undef); return 0 if $k < 2; if ($negn && $k % 2 == 0) { my $v = Mvaluation($k, 2); $k >>= $v; return 0 if $k < 2; $r = Mpowint($r, Mpowint(2,$v)) if defined $r; } $$refp = $negn ? Mnegint($r) : $r if defined $refp && $k > 0; $k; } sub is_square { my($n) = @_; return 0 if $n < 0; #Mis_power($n,2); validate_integer($n); _is_perfect_square($n); } sub is_prime_power { my ($n, $refp) = @_; validate_integer($n); croak("is_prime_power second argument not a scalar reference") if defined($refp) && !ref($refp); return 0 if $n <= 1; if (Mis_prime($n)) { $$refp = $n if defined $refp; return 1; } my $r; my $k = Mis_power($n,0,\$r); if ($k) { $r = _bigint_to_int($r) if ref($r) && $r <= INTMAX; return 0 unless Mis_prime($r); $$refp = $r if defined $refp; } $k; } sub is_gaussian_prime { my($a,$b) = @_; validate_integer_abs($a); validate_integer_abs($b); return ((($b % 4) == 3) ? Mis_prime($b) : 0) if $a == 0; return ((($a % 4) == 3) ? Mis_prime($a) : 0) if $b == 0; Mis_prime( Maddint( Mmulint($a,$a), Mmulint($b,$b) ) ); } sub is_polygonal { my ($n, $k, $refp) = @_; validate_integer($n); validate_integer_nonneg($k); 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 = $n 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; $$refp = reftyped($_[0], $nth) if defined $refp; return 1; } my($D,$R); if ($k == 4) { return 0 unless _is_perfect_square($n); $$refp = Msqrtint($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 + Msqrtint($D); $R = 2*$k-4; } else { if ($k == 3) { $D = Maddint(1, Mmulint($n, 8)); } else { $D = Maddint(Mmulint($n, Mmulint(8, $k) - 16), Mmulint($k-4,$k-4)); } return 0 unless _is_perfect_square($D); $D = Maddint( Msqrtint($D), $k-4 ); $R = Mmulint(2, $k) - 4; } return 0 if ($D % $R) != 0; $$refp = $D / $R if defined $refp; 1; } sub is_sum_of_squares { my($n, $k) = @_; validate_integer_abs($n); if (defined $k) { validate_integer_nonneg($k); } else { $k = 2; } return ($n == 0) ? 1 : 0 if $k == 0; return 1 if $k > 3; return _is_perfect_square($n) if $k == 1; return 1 if $n < 3; if ($k == 3) { my $tz = Mvaluation($n,2); return 1 if ($tz & 1) == 1; return 1 unless Mis_congruent(Mrshiftint($n,$tz), 7, 8); return 0; } # k = 2 while (($n % 2) == 0) { $n >>= 1; } return 0 if ($n % 4) == 3; foreach my $F (Mfactor_exp($n)) { my($f,$e) = @$F; return 0 if ($e & 1) == 1 && ($f % 4) == 3; } 1; } sub cornacchia { my($d, $n) = @_; validate_integer_nonneg($d); validate_integer_nonneg($n); return (0,0) if $n == 0; if ($d == 0) { return undef unless _is_perfect_square($n); return (Msqrtint($n), 0); } if (Mis_prime($n)) { my ($u,$rk); my $negd = _negmod($d,$n); return undef if Mkronecker($negd, $n) == -1; $u = _sqrtmod_prime($negd, $n); return undef unless defined $u; $u = $n-$u if $u > ($n>>1); { my $l = Msqrtint($n); my($a, $b) = ($n, $u); while ($a > $l) { ($a,$b) = ($b, $a % $b); } $rk = $a; } $u = _negmod(Mmulmod($rk,$rk,$n),$n); $u = (($u % $d) == 0) ? Mdivint($u,$d) : 0; return ($rk, Msqrtint($u)) if $u && _is_perfect_square($u); return undef; } my $limu = Msqrtint(Mdivint($n,$d)); for my $u (0 .. $limu) { my $t = $n - Mvecprod($d,$u,$u); return (Msqrtint($t), $u) if _is_perfect_square($t); } undef; } sub is_congruent_number { my($n) = @_; validate_integer_nonneg($n); return ($n >= 5 && $n <= 7) if $n < 13; my $n8 = $n % 8; return 1 if $n8 == 5 || $n8 == 6 || $n8 == 7; if (!Mis_square_free($n)) { my $N = 1; foreach my $f (Mfactor_exp($n)) { my($p,$e) = @$f; $N = Mmulint($N,$p) if ($e % 2) == 1; } return is_congruent_number($N); } my $ndiv2 = Mrshiftint($n); if (Mis_even($n) && Mis_prime($ndiv2)) { my $p = $ndiv2; my $p8 = $p % 8; return 1 if $p8 == 3 || $p8 == 7; return 0 if $p8 == 5 || ($p % 16) == 9; } elsif (Mis_prime($n)) { return 0 if $n8 == 3; return 1 if $n8 == 5 || $n8 == 7; my $r = _sqrtmod_prime(2, $n); return 0 if defined $r && Mkronecker(1+$r, $n) == -1; } elsif (1) { my @factors = Mfactor($n); if (scalar(@factors) == 2) { my($p, $q) = ($factors[0], $factors[1]); my($p8, $q8) = ($p % 8, $q %8); return 0 if $p8 == 3 && $q8 == 3; return 0 if $p8 == 1 && $q8 == 3 && kronecker($p,$q) == -1; return 0 if $p8 == 3 && $q8 == 1 && kronecker($q,$p) == -1; } elsif (scalar(@factors) == 3 && $factors[0] == 2) { my($p, $q) = ($factors[1], $factors[2]); my($p8, $q8) = ($p % 8, $q %8); return 0 if $p8 == 5 && $q8 == 5; return 0 if $p8 == 1 && $q8 == 5 && kronecker($p,$q) == -1; return 0 if $p8 == 5 && $q8 == 1 && kronecker($q,$p) == -1; } } # General test my @sols = (0,0); if (Mis_odd($n)) { my $limz = Msqrtint($n >> 3); foreach my $z (0 .. $limz) { my $zsols = 0; my $n8z = $n - 8*$z*$z; my $limy = Msqrtint($n8z >> 1); foreach my $y (0 .. $limy) { my $x = $n8z - 2*$y*$y; $zsols += 1 << (1 + ($y>0) + ($z>0)) if _is_perfect_square($x); } $sols[$z % 2] += $zsols; } } else { my $limz = Msqrtint($ndiv2 >> 3); foreach my $z (0 .. $limz) { my $zsols = 0; my $n8z = $ndiv2 - 8*$z*$z; # ndiv2 odd => n8z is odd my $limx = Msqrtint($n8z); for (my $x = 1; $x <= $limx; $x += 2) { my $y = $n8z - $x*$x; $zsols += 1 << (1 + ($y>0) + ($z>0)) if $y == 0 || _is_perfect_square($y); } $sols[$z % 2] += $zsols; } } return ($sols[0] == $sols[1]) ? 1 : 0; } sub is_perfect_number { my($n) = @_; validate_integer($n); return 0 if $n <= 0; if (Mis_even($n)) { my $v = Mvaluation($n,2); my $m = Mrshiftint($n, $v); return 0 if Mrshiftint($m,$v) != 1; return 0 if Math::Prime::Util::hammingweight($m) != $v+1; return Math::Prime::Util::is_mersenne_prime($v+1); } # N is odd. See https://www.lirmm.fr/~ochem/opn/ return 0 if length($n) <= 2200; return 0 unless Mis_divisible($n, 105); return 0 unless Mis_congruent($n, 1, 12) || Mis_congruent($n,117,468) || Mis_congruent($n, 81, 324); Mcmpint($n,Msubint(Mdivisor_sum($n),$n)) == 0; } sub valuation { my($n, $k) = @_; # The validation in PP is 2x more time than our actual work. validate_integer_abs($n); validate_integer_positive($k); croak "valuation: k must be > 1" if $k <= 1; return if $k < 2; return (undef,0)[$n] if $n <= 1; my $v = 0; if ($k == 2) { # Accelerate power of 2 my $s; if (!ref($n)) { return 0 if $n & 1; return 1 if $n & 2; return 2 if $n & 4; $s = sprintf("%b","$n"); } elsif (ref($n) eq 'Math::BigInt') { $s = $n->as_bin; } elsif (ref($n) eq 'Math::GMPz') { return Math::GMPz::Rmpz_scan1($n,0); } else { $s = Math::BigInt->new("$n")->as_bin; } return length($s) - rindex($s,'1') - 1; } while ( !($n % $k) ) { $n /= $k; $v++; } $v; } sub hammingweight { return 0 + (Mtodigitstring($_[0],2) =~ 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 validate_integer_nonneg($n); 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 { # The validation turned n into a bigint if necessary 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) = @_; validate_integer_abs($n); $base = 10 unless defined $base; $len = -1 unless defined $len; die "Invalid base: $base" if $base < 2; return if $n == 0; _splitdigits($n, $base, $len); } sub _tobinarystring { my($n) = @_; $n =~ s/^-//; return "" if $n == 0; return sprintf("%b",$n) if $n < INTMAX; $n = tobigint($n) unless ref($n); my $refn = ref($n); return Math::GMPz::Rmpz_get_str($n,2) if $refn eq 'Math::GMPz'; return Math::GMP::get_str_gmp($n,2) if $refn eq 'Math::GMP'; if ($BIGINTVERSION >= 1.999814) { $n = Math::BigInt->new("$n") if $refn ne 'Math::BigInt'; return $n->to_base(2); } return join("", _splitdigits($n, 2, -1)); } sub todigitstring { my($n,$base,$len) = @_; validate_integer($n); $base = 10 unless defined $base; return _tobinarystring($n) if $base == 2 && !defined $len; croak "Invalid base for string: $base" if $base < 2 || $base > 36; $len = -1 unless defined $len; $n =~ s/^-//; return "" if $len == 0 || $n == 0; if ($n < INTMAX) { if ($base != 2 && $base != 8 && $base != 16) { return join "", _splitdigits($n, $base, $len) if $base <= 10; return join "", map { $_digitmap[$_] } _splitdigits($n, $base, $len); } my $s; $s = sprintf("%b",$n) if $base == 2; $s = sprintf("%o",$n) if $base == 8; $s = sprintf("%x",$n) if $base == 16; if ($len > 0) { $s = substr($s,0,$len); $s = '0' x ($len-length($s)) . $s if length($s) < $len; } return $s; } $n = tobigint($n) unless ref($n); my $refn = ref($n); my $s; if ($refn eq 'Math::GMPz') { $s = Math::GMPz::Rmpz_get_str($n,$base); } elsif ($refn eq 'Math::GMP') { $s = Math::GMP::get_str_gmp($n,$base); } elsif ($BIGINTVERSION >= 1.999814) { $n = Math::BigInt->new("$n") if $refn ne 'Math::BigInt'; $s = $n->to_base($base); } else { my @d = ($n == 0) ? () : _splitdigits($n, $base, -1); if ($base <= 10) { $s = join("", @d); } else { die "Invalid base for string: $base" if $base > 36; $s = join("", map { $_digitmap[$_] } @d); } } if ($len > 0) { $s = substr($s,0,$len); $s = '0' x ($len-length($s)) . $s if length($s) < $len; } return lc($s); } sub _FastIntegerInput { my($digits, $B) = @_; return 0 if scalar(@$digits) == 0; return $digits->[0] if scalar(@$digits) == 1; my $L = [reverse @$digits]; my $k = scalar(@$L); while ($k > 1) { my @T; for my $i (1 .. $k>>1) { my $x = $L->[2*$i-2]; my $y = $L->[2*$i-1]; push(@T, Maddint($x, Mmulint($B, $y))); } push(@T, $L->[$k-1]) if ($k&1); $L = \@T; $B = Mmulint($B, $B); $k = ($k+1) >> 1; } $L->[0]; } sub fromdigits { my($r, $base) = @_; $base = 10 unless defined $base; my $refr = ref($r); if ($refr && $refr !~ /^Math::/) { croak "fromdigits: first argument must be a string or array reference" unless $refr eq 'ARRAY'; # Math::BigInt->from_base_num is identical but slower return _FastIntegerInput($r,$base); } my $n; $r =~ s/^0*//; return 0 if $r eq ""; { # Validate string my $cmap = substr("0123456789abcdefghijklmnopqrstuvwxyz",0,$base); croak "Invalid digit for base $base" if $r =~ /[^$cmap]/i; } if (defined $_BIGINT && $_BIGINT =~ /^Math::(GMPz|GMP)$/) { $n = $_BIGINT->new($r, $base); } elsif ($BIGINTVERSION < 1.999814) { $n=_FastIntegerInput([map{index("0123456789abcdefghijklmnopqrstuvwxyz",$_)}split(//,lc($r))],$base); } else { # from_base is 2x slower than calling the method directly (TODO file an RT) if ($base == 2) { $n = Math::BigInt->from_bin($r); } elsif ($base == 8) { $n = Math::BigInt->from_oct($r); } elsif ($base == 10) { $n = Math::BigInt->new($r); } elsif ($base == 16) { $n = Math::BigInt->from_hex($r); } else { $n = Math::BigInt->from_base($r,$base); } $n = tobigint($n) if defined $_BIGINT && $_BIGINT ne 'Math::BigInt'; } return $n <= INTMAX ? _bigint_to_int($n) : $n; } sub _validate_zeckendorf { my($s) = @_; if ($s ne '0') { croak "fromzeckendorf: expected binary string" unless $s =~ /^1[01]*\z/; croak "fromzeckendorf: expected binary string in canonical Zeckendorf form" if $s =~ /11/; } 1; } sub fromzeckendorf { my($s) = @_; _validate_zeckendorf($s); my($n, $fb, $fc) = (0, 1, 1); for my $c (split(//,reverse $s)) { $n = Maddint($n,$fc) if $c eq '1'; ($fb, $fc) = ($fc, Maddint($fb,$fc)); } $n; } sub tozeckendorf { my($n) = @_; validate_integer_nonneg($n); return '0' if $n == 0; my($rn, $s, $fa, $fb, $fc) = ($n, '', 0, 1, 1); my($i, $k); for ($k = 2; $fc <= $rn; $k++) { ($fa, $fb, $fc) = ($fb, $fc, Maddint($fb,$fc)); } for ($i = $k-1; $i >= 2; $i--) { ($fc, $fb, $fa) = ($fb, $fa, Msubint($fb,$fa)); if ($fc <= $rn) { $rn = Msubint($rn, $fc); $s .= '1'; } else { $s .= '0'; } } # croak "wrong tozeckendorf $n" unless $n == fromzeckendorf($s); $s; } sub sqrtint { my($n) = @_; validate_integer_nonneg($n); return int(sqrt("$n")) if $n <= 562949953421312; # 2^49 safe everywhere my $refn = ref($n); my $R; if ($refn eq 'Math::BigInt') { $R = $n->copy->bsqrt; } elsif ($refn eq 'Math::GMPz') { $R = Math::GMPz->new(); Math::GMPz::Rmpz_sqrt($R, $n); } elsif ($refn eq 'Math::GMP') { $R = $n->bsqrt(); } else { $R = Math::BigInt->new("$n")->bsqrt; } $R = _bigint_to_int($R) if $R <= INTMAX; $R; } sub rootint { my ($n, $k, $refp) = @_; validate_integer_nonneg($n); validate_integer_positive($k); croak("rootint: third argument not a scalar reference") if defined $refp && !ref($refp); if ($k == 1) { $$refp = $n if defined $refp; return $n; } if (!ref($n)) { # native integer if ($n == 0) { $$refp = 0 if defined $refp; return 0; } if ($k == 2 && $n <= 562949953421312) { my $R = int(sqrt($n)); $$refp = $R*$R if defined $refp; return $R; } if ($k >= MPU_MAXBITS || $n >> $k == 0) { $$refp = 1 if defined $refp; return 1; } my $R = int($n ** (1/$k)); # Could be off by +/-1. my $F = $n <= 562949953421312 ? $R**$k : powint($R,$k); if ($F > $n) { $R--; $F = $n <= 562949953421312 ? $R**$k : powint($R,$k); } else { my $F1 = $n <= 562949953421312 ? ($R+1)**$k : powint($R+1,$k); if ($F1 <= $n) { $R++; $F = $F1; } } $$refp = $F if defined $refp; return $R; } # It's unclear whether we should add GMPfunc here. We want it in logint # because it's slow or not included in Perl bigint classes. my $refn = ref($n); my $R; if ($refn eq 'Math::BigInt') { $R = $n->copy->broot($k); } elsif ($refn eq 'Math::GMPz') { $R = Math::GMPz->new(); Math::GMPz::Rmpz_root($R, $n, $k); } elsif ($refn eq 'Math::GMP') { $R = $n->broot($k); } else { $R = Math::BigInt->new("$n")->broot($k); } $R = _bigint_to_int($R) if $R <= INTMAX; $$refp = Mpowint($R,$k) if defined $refp; $R; } sub _logint { my($n,$b) = @_; return 0 if $n < $b; return length("$n")-1 if $b == 10; if ($n < INTMAX) { return length(sprintf("%b",$n))-1 if $b == 2; return length(sprintf("%o",$n))-1 if $b == 8; return length(sprintf("%x",$n))-1 if $b == 16; } my $l; if (length("$n") > 150) { # Reduce size so native log works my $N = substr($n,0,80); my $reddigits = length("$n") - length($N); $l = log($N) + 2.302585092994045684*$reddigits; } else { $l = log("$n"); } $l /= log($b); # Just in case something failed, escape via using Math::BigInt's blog if ($l == MPU_INFINITY || !defined($l<=>MPU_INFINITY)) { my $R = Math::BigInt->new("$n")->copy->blog($b); $R = _bigint_to_int($R) if $R <= INTMAX; return $R; } my $R = int($l); if ($R != int($l+1e-7) || $R != int($l-1e-7)) { my $BR = Mpowint($b,$R); if ($BR > $n) { $R--; } elsif ($BR < $n) { my $BRB = Mmulint($BR, $b); $R++ if $BRB <= $n; } } $R; } sub logint { my ($n, $b, $refp) = @_; validate_integer_positive($n); validate_integer_nonneg($b); croak "logint: base must be > 1" if $b <= 1; 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) { # logint in 0.47, powmod in 0.36, powint in 0.52 my $r = Math::Prime::Util::GMP::powmod($b, $e, $n); $r = $n if $r == 0; $$refp = reftyped($_[0], $r); } return reftyped($_[0], $e); } my $log = _logint($n,$b); $$refp = Mpowint($b,$log) if defined $refp; return $log; } # Seidel (Luschny), core using Trizen's simplications from Math::AnyNum. # 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 @D = (0, 1, map { 0} 1 .. ($n>>1)-1); my ($h, $w) = (1, 1); foreach my $i (0 .. $n-1) { if ($w ^= 1) { $D[$_] = Maddint($D[$_],$D[$_-1]) for 1.. $h-1; } else { $w = $h++; $D[$w] = Maddint($D[$w],$D[$w+1]) while --$w; } } my $num = $D[$h-1]; my $den = Msubint(Mpowint(2,$n+1),2); my $gcd = Mgcd($num,$den); ($num,$den) = map { Mdivint($_,$gcd) } ($num,$den) if $gcd > 1; $num = Mnegint($num) if ($n % 4) == 0; ($num,$den); } sub bernfrac { my($n) = @_; validate_integer_nonneg($n); return (1,1) if $n == 0; return (1,2) if $n == 1; # We're choosing 1/2 instead of -1/2 return (0,1) 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 Mfactorial($n) if $type == 3; return Mfactorial($n-1) if $n & 1; return Mvecprod(-1, Mfactorial($n-1)); } return 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 = Mvecprod( Mbinomial($n,$m), Mbinomial($n-1,$m-1), Mfactorial($n-$m) ); } elsif ($type == 2) { return Mbinomial($n,2) if $m==$n-1; my @terms; for my $j (1 .. $m) { my $t = Mmulint( Mpowint($j,$n), Mbinomial($m,$j) ); $t = Mnegint($t) if ($m-$j) & 1; push @terms, $t; } $s = Mdivint(vecsum(@terms),Mfactorial($m)); } else { my $M = $n-$m; # Both work on all inputs, but perform differently. Select one. if ($n <= 21 || $m < $M) { # Simple direct (see Arndt) my @S = (0)x($n+1); $S[1]=1; for my $k (2 .. $n) { $S[$_] = addint($S[$_-1],mulint($k-1,$S[$_])) for reverse(1..$k); } $s = $S[$m]; } else { # Concrete Mathematics, eq 6.27 my @terms = map { Mvecprod( Mbinomial($M-$n, $M+$_), Mbinomial($M+$n, $M-$_), Mstirling($M+$_, $_, 2) ) } 1 .. $M; $s = vecsum(@terms); } $s = Mnegint($s) if is_odd($n-$m); } $s; } sub _harmonic_split { # From Fredrik Johansson my($a,$b) = @_; return (1, $a) if $b-$a == 1; return (Mvecsum($a,$a,1), Maddint(Mmulint($a,$a),$a)) if $b-$a == 2; my $m = Mrshiftint(Maddint($a,$b)); my ($p,$q) = _harmonic_split($a, $m); my ($r,$s) = _harmonic_split($m, $b); (Maddint(Mmulint($p,$s),Mmulint($q,$r)), Mmulint($q,$s)); } sub harmfrac { my($n) = @_; validate_integer_nonneg($n); return (0,1) if $n <= 0; my($p,$q) = _harmonic_split(1, Madd1int($n)); my $gcd = Mgcd($p,$q); ($p,$q) = map { Mdivint($_,$gcd) } ($p,$q) if $gcd > 1; ($p,$q); } 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) = @_; validate_integer($n); return 0 if $n < 0; @bases = (2) if scalar(@bases) == 0; return 0+($n >= 2) if $n < 3; foreach my $a (@bases) { croak "Base $a is invalid" if $a < 2; $a = $a % $n if $a >= $n; return 0 unless $a == 1 || Mpowmod($a, $n-1, $n) == 1; } 1; } sub is_euler_pseudoprime { my($n, @bases) = @_; validate_integer($n); return 0 if $n < 0; @bases = (2) if scalar(@bases) == 0; return 0+($n >= 2) if $n < 3; return 0 if ($n % 2) == 0; foreach my $a (@bases) { croak "Base $a is invalid" if $a < 2; $a = $a % $n if $a >= $n; my $j = Mkronecker($a, $n); return 0 if $j == 0; # gcd(a,n) != 1 $j = ($j > 0) ? 1 : $n-1; return 0 unless Mpowmod($a, ($n-1)>>1, $n) == $j; } 1; } sub is_euler_plumb_pseudoprime { my($n) = @_; validate_integer($n); return 0 if $n < 0; return 0+($n >= 2) if $n < 4; return 0 if ($n % 2) == 0; my $nmod8 = $n % 8; my $exp = 1 + ($nmod8 == 1); my $ap = Mpowmod(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) = @_; return 0 if $n < 0; return 0+($n >= 2) if $n < 4; return 0 if ($n % 2) == 0; if (ref($n)) { if (!defined $nm1) { $nm1 = Msub1int($n); $s = valuation($nm1,2); $d = rshiftint($nm1,$s); } my $x = _bi_powmod(2,$d,$n); return 1 if $x == 1 || $x == $nm1; foreach my $r (1 .. $s-1) { $x = Mmulmod($x,$x,$n); last if $x == 1; return 1 if $x == $nm1; } } 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) = @_; validate_integer($n); return 0 if $n < 0; return _miller_rabin_2($n) if scalar(@bases) == 0; return 0+($n >= 2) if $n < 4; return 0 if ($n % 2) == 0; my @newbases; for my $a (@bases) { croak "Base $a is invalid" if $a < 2; $a %= $n if $a >= $n; next if $a <= 1 || $a == $n-1; if ($a == 2) { return 0 unless _miller_rabin_2($n); next; } push @newbases, $a; } return 1 if scalar(@newbases) == 0; @bases = @newbases; if (ref($n)) { my $nm1 = Msub1int($n); my $s = Mvaluation($nm1,2); my $d = Mrshiftint($nm1,$s); foreach my $ma (@bases) { my $x = Mpowmod($ma,$d,$n); next if $x == 1 || $x == $nm1; foreach my $r (1 .. $s-1) { $x = Mmulmod($x,$x,$n); return 0 if $x == 1; last if $x == $nm1; } return 0 if $x != $nm1; } } 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) && $b <= INTMAX; $a = _bigint_to_int($a) if ref($a) && $a <= INTMAX; # 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. return $k * kronecker(_bigint_to_int($a),_bigint_to_int($b)) if $a <= INTMAX && $b <= INTMAX && ref($a) && ref($b); } return ($b == 1) ? $k : 0; } sub is_qr { my($a, $n) = @_; validate_integer($a); validate_integer_abs($n); # return (defined Math::Prime::Util::sqrtmod($a,$n)) ? 1 : 0; return (undef,1,1)[$n] if $n <= 2; $a = Mmodint($a,$n) if $a >= $n || $a < 0;; return 1 if $a <= 1; foreach my $f (Mfactor_exp($n)) { my($p,$e) = @$f; next if $e == 1 && Mkronecker($a,$p) == 1; return 0 unless defined _sqrtmod_prime_power($a,$p,$e); } 1; } 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(INTMAX/$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(INTMAX/$nr); $r *= $nr; $r = int($r/$dr); } else { $r *= $n; $r = int($r/$d); } $n--; } $r; } sub binomial { my($n, $k) = @_; validate_integer($n); validate_integer($k); # 1. Try GMP return reftyped($_[0], Math::Prime::Util::GMP::binomial($n,$k)) if $Math::Prime::Util::_GMPfunc{"binomial"} && ($Math::Prime::Util::GMP::VERSION >= 0.53 || ($n >= 0 && $k >= 0 && $n < 4294967296 && $k < 4294967296)); # 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; # TODO: consider reflection for large k (e.g. k=n-2 => k=2) # Also, be careful with large n and k with bigints. my $r; # 3. Try to do in integer Perl if (!ref($n)) { if ($n >= 0) { $r = _binomialu($n, $k); return $r if $r > 0 && $r eq int($r); } else { $r = _binomialu(-$n+$k-1, $k); if ($r > 0 && $r eq int($r)) { return $r if !($k & 1); return Mnegint($r); } } } # 4. Overflow. Solve using Math::BigInt return 1 if $k == 0; # Work around bug in old return $n if $k == 1 || $k == $n-1; # Math::BigInt (fixed in 1.90) my $R; $n = tobigint($n) unless ref($n); # Older Math::BigInt isn't right for negative n. Adjust now. my $negate = 0; if ($n < 0) { $n = -$n + ($k-1); $negate = 1 if $k & 1; } if (defined $Math::GMPz::VERSION) { $R = Math::GMPz->new(); Math::GMPz::Rmpz_bin_ui($R, Math::GMPz->new($n), $k); } elsif (defined $Math::GMP::VERSION && $Math::GMP::VERSION >= 2.23 && $n < 4294967296) { # This will silently coerce inputs to C 'long' type. $R = Math::GMP::bnok("$n","$k"); } elsif ($n > INTMAX && $k < 100) { # Incomplete work around problem with Math::BigInt not liking bigint n. # Fixed in 2.003003. $R = Mdivint(Mfalling_factorial($n,$k),Mfactorial($k)); } else { $R = Math::BigInt::bnok("$n","$k"); } $R = -$R if $negate; return $R <= INTMAX && $R >= INTMIN ? _bigint_to_int($R) : defined $_BIGINT && $_BIGINT eq ref($R) ? $R : tobigint($R); } sub binomialmod { my($n,$k,$m) = @_; validate_integer($n); validate_integer($k); validate_integer_abs($m); return (undef,0)[$m] if $m <= 1; return reftyped($_[0], Math::Prime::Util::GMP::binomialmod($n,$k,$m)) if $Math::Prime::Util::_GMPfunc{"binomialmod"}; # Avoid the possible enormously slow bigint creation. if ($Math::Prime::Util::_GMPfunc{"binomial"} && $Math::Prime::Util::_GMPfunc{"modint"}) { if ($Math::Prime::Util::GMP::VERSION >= 0.53 || ($n >= 0 && $k >= 0 && $n < 4294967296 && $k < 4294967296)) { return reftyped($_[2], Math::Prime::Util::GMP::modint(Math::Prime::Util::GMP::binomial($n,$k),$m)); } } return 1 if $k == 0 || $k == $n; return 0 if $n >= 0 && ($k < 0 || $k > $n); return 0 if $n < 0 && ($k < 0 && $k > $n); return 0+!(($n-$k) & $k) if $m == 2; # TODO: Lucas split, etc. # 1. factorexp # 2. bin[i] = _binomial_lucas_mod_prime_power(n, k, $f, $e) # 2a. _factorialmod_without_prime # 3. chinese(bin, p^e) # we can just run the more general code path. # Give up. return Mmodint(Mbinomial($n,$k),$m); } sub _falling_factorial { my($n,$m) = @_; if ($m <= 1) { return ($m == 0) ? 1 : $n } return 0 if $n >= 0 && $m > $n; return Mvecprod($n,map { Msubint($n,$_) } 1 .. Msubint($m,1)) if $m < 250; Mmulint(Mbinomial($n,$m),Mfactorial($m)); } sub falling_factorial { my($n,$m) = @_; validate_integer($n); validate_integer_nonneg($m); _falling_factorial($n,$m); } sub rising_factorial { my($n,$m) = @_; validate_integer($n); validate_integer_nonneg($m); _falling_factorial(Mvecsum($n,$m,-1),$m); } 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 && getconfig()->{'gmp'}) { $r = Math::Prime::Util::GMP::factorial($n); } return reftyped($_[0], $r) if defined $r; } # maybe roll our own: https://oeis.org/A000142/a000142.pdf my $r = Math::BigInt->new($n)->bfac(); $r = _bigint_to_int($r) if $r <= INTMAX; $r; } sub factorialmod { my($n,$m) = @_; validate_integer($n); validate_integer_abs($m); return (undef,0)[$m] if $m <= 1; return reftyped($_[1], Math::Prime::Util::GMP::factorialmod($n,$m)) if $Math::Prime::Util::_GMPfunc{"factorialmod"} && $n < ~0; return 0 if $n >= $m || $m == 1; return factorial($n) % $m if $n <= 10; my($F, $N, $m_prime) = (1, $n, Mis_prime($m)); # Check for Wilson's theorem letting us go backwards $n = $m-$n-1 if $m_prime && $n > Mrshiftint($m); return ($n == 0) ? ($m-1) : 1 if $n < 2; if ($n > 100 && !$m_prime) { # Check for a composite that leads to zero my $maxpk = 0; foreach my $f (Mfactor_exp($m)) { my $pk = Mmulint($f->[0],$f->[1]); $maxpk = $pk if $pk > $maxpk; } return 0 if $n >= $maxpk; } my($t,$e); Mforprimes( sub { ($t,$e) = ($n,0); while ($t > 0) { $t = int($t/$_); $e += $t; } $F = Mmulmod($F,Mpowmod($_,$e,$m),$m); }, 2, $n >> 1); Mforprimes( sub { $F = Mmulmod($F, $_, $m); }, ($n >> 1)+1, $n); # Adjust for Wilson's theorem if we used it if ($n != $N && $F != 0) { $F = Msubmod($m, $F, $m) if !($n & 1); $F = Minvmod($F, $m); } $F; } sub subfactorial { my($n) = @_; validate_integer_nonneg($n); if ($n <= 3) { return ($n == 0) ? 1 : $n-1; } my $r = 0; for my $k (2..$n) { $r = Mmulint($r,$k); if ($k&1) { $r--; } else { $r++; } } $r; } my $_fubinis = [1,1,3,13,75]; sub _add_fubini { # Add the next Fubini sequence term to an array reference. my($A)= @_; my $N = @$A; # Faster method from Daniel Șuteu. # 1..400 no-GMP GMP Math::GMPz # old 51.82 13.95 0.804 # new 35.73 3.79 0.380 my($t,$x) = (1); push @$A, Mvecsum(map { $x = Smulint($t, $A->[$_]); $t = Smulint($t, $N - $_); $t = Sdivint($t, $_+1); $x } 0..$N-1); } _register_free_sub(sub { $_fubinis = [1,1,3,13,75]; }); sub fubini { my($n) = @_; validate_integer_nonneg($n); my $cmax = $n < 500 ? $n : 500; _add_fubini($_fubinis) until defined $_fubinis->[$cmax]; return $_fubinis->[$n] if defined $_fubinis->[$n]; my @F = @$_fubinis; # copy the cached values to our own. _add_fubini(\@F) until defined $F[$n]; return $F[$n]; } # Rational maps sub _rational_cfrac { my($num,$den,$non_reduce_ok) = @_; my @CF; while ($den > 0) { my($quo,$rem) = Mtdivrem($num,$den); ($num,$den) = ($den,$rem); push @CF, $quo; } croak "Rational must be reduced" unless $num == 1 || $non_reduce_ok; @CF; } # https://kconrad.math.uconn.edu/blurbs/ugradnumthy/contfrac-neg-invert.pdf sub _negcfrac { my(@CF) = @_; my $neg0 = Mnegint($CF[0]); if (@CF == 1) { $CF[0] = $neg0; } elsif ($CF[1] == 1) { splice(@CF, 0, 3, Msub1int($neg0), Madd1int($CF[2])); } else { splice(@CF, 0, 2, Msub1int($neg0), 1, Msub1int($CF[1])); } @CF; } sub contfrac { my($num,$den) = @_; validate_integer($num); validate_integer_positive($den); my @CF = _rational_cfrac(Mabsint($num),$den,1); return ($num >= 0) ? @CF : _negcfrac(@CF); } sub from_contfrac { return (0,1) unless @_; my $b0 = shift @_; validate_integer($b0); my($A0,$A1,$B0,$B1) = (1,$b0,0,1); while (@_) { my $bi = shift @_; validate_integer_positive($bi); ($A0,$A1) = ($A1, Maddint(Mmulint($bi,$A1),$A0)); ($B0,$B1) = ($B1, Maddint(Mmulint($bi,$B1),$B0)); } return ($A1,$B1); } sub next_calkin_wilf { my($num,$den) = @_; validate_integer_positive($num); validate_integer_positive($den); # Check gcd to ensure a valid CW entry? ($den, Mvecprod(2,$den,Mdivint($num,$den)) + $den - $num); } sub next_stern_brocot { my($num,$den) = @_; validate_integer_positive($num); validate_integer_positive($den); # There should be a better solution nth_stern_brocot(Madd1int(stern_brocot_n($num,$den))); } sub calkin_wilf_n { my($num,$den) = @_; validate_integer_positive($num); validate_integer_positive($den); my @CF = _rational_cfrac($num,$den); # Note: vecsum(@CF) gives the number of bits in the output $CF[-1]--; my $bitstr = '1'; $bitstr .= (1-($_%2)) x $CF[$_] for reverse 0 .. $#CF; return Mfromdigits($bitstr,2); } sub stern_brocot_n { my($num,$den) = @_; validate_integer_positive($num); validate_integer_positive($den); my @CF = _rational_cfrac($num,$den); $CF[-1]--; my $bitstr = '1'; $bitstr .= (1-($_%2)) x $CF[$_] for 0 .. $#CF; return Mfromdigits($bitstr,2); } sub nth_calkin_wilf { my($n) = @_; validate_integer_positive($n); my @M = (1,0); $M[$_] = Mvecsum(@M) for split(//, Mtodigitstring($n,2)); ($M[1],$M[0]); } sub nth_stern_brocot { my($n) = @_; validate_integer_positive($n); my @M = (1,0); my @bits = split(//,Mtodigitstring($n,2)); $M[$_] = Mvecsum(@M) for 1,reverse(@bits[1..$#bits]); ($M[1],$M[0]); } sub nth_stern_diatomic { my ($n) = @_; validate_integer_nonneg($n); my @M = (1,0); $M[$_] = Mvecsum(@M) for split(//, Mtodigitstring($n,2)); $M[1]; } sub farey { my($n,$k) = @_; validate_integer_positive($n); my $len = Madd1int(Math::Prime::Util::sumtotient($n)); my($p0, $q0, $p1, $q1, $p2, $q2, $j) = (0,1,1,$n); if (defined $k) { validate_integer_nonneg($k); return undef if $k >= $len; for (1 .. $k) { $j = Mdivint(($q0 + $n), $q1); $p2 = Mmulint($j, $p1) - $p0; $q2 = Mmulint($j, $q1) - $q0; ($p0, $q0, $p1, $q1) = ($p1, $q1, $p2, $q2); } return [$p0,$q0]; } return $len unless wantarray; my @V; for (1 .. $len) { push @V, [$p0, $q0]; $j = Mdivint(($q0 + $n), $q1); $p2 = Mmulint($j, $p1) - $p0; $q2 = Mmulint($j, $q1) - $q0; ($p0, $q0, $p1, $q1) = ($p1, $q1, $p2, $q2); } @V; } # Uses gcdext to find next entry with only one point. sub next_farey { my($n,$frac) = @_; validate_integer_positive($n); croak "next_farey second argument not an array reference" unless ref($frac) eq 'ARRAY'; my($p,$q) = @$frac; validate_integer_nonneg($p); validate_integer_positive($q); return undef if $p >= $q; my($u,$v,$g) = Mgcdext($p,$q); ($p,$q) = (Mdivint($p,$g),Mdivint($q,$g)) if $g != 1; my $d = Mmulint(Mdivint(($n+$u),$q),$q) - $u; my $c = Mdivint((Mmulint($d,$p)+1),$q); [$c,$d]; } sub farey_rank { my($n,$frac) = @_; validate_integer_positive($n); croak "next_farey second argument not an array reference" unless ref($frac) eq 'ARRAY'; my($p,$q) = @$frac; validate_integer_nonneg($p); validate_integer_positive($q); return 0 if $p == 0; my $g = Mgcd($p,$q); ($p,$q) = (Mdivint($p,$g),Mdivint($q,$g)) if $g != 1; my @count = (0,0,map { Mdivint(Mmulint($p,$_)-1,$q); } 2..$n); my $sum = 1; for my $i (2 .. $n) { my $icount = $count[$i]; for (my $j = Mmulint($i,2); $j <= $n; $j = Maddint($j,$i)) { $count[$j] -= $icount; } $sum += $icount; } $sum; } # End of Rational maps sub _is_perfect_square { my($n) = @_; return (1,1,0,0,1)[$n] if $n <= 4; if (ref($n)) { return 0 if ((1 << Mmodint($n,32)) & 0xfdfcfdec); my $sq = Msqrtint($n); return 1 if Mmulint($sq,$sq) == $n; } else { return 0 if (1 << ($n & 31)) & 0xfdfcfdec; my $sq = $n < 562949953421312 ? int(sqrt($n)) : Msqrtint($n); return 1 if ($sq*$sq) == $n; } 0; } sub is_primitive_root { my($a, $n) = @_; validate_integer($a); validate_integer_abs($n); return (undef,1)[$n] if $n <= 1; $a = Mmodint($a, $n) if $a < 0 || $a >= $n; return 0+($a == $n-1) if $n <= 4; return 0 if $a <= 1; return Math::Prime::Util::GMP::is_primitive_root($a,$n) if $Math::Prime::Util::_GMPfunc{"is_primitive_root"}; # my $order = Mznorder($a,$n); return 0 unless defined $order; return 0+($order == Mtotient($n)); if (Mis_even($n)) { return 0 if ($n % 4) == 0; # n can't still be even after we shift it return 0 if Mis_even($a); # n and a cannot both be even $n = Mrshiftint($n); # a is odd, so it is a primroot of p^k also } return 0 if Mgcd($a, $n) != 1; return 0 if _is_perfect_square($a); my ($p,$k,$phi); $k = Mis_prime_power($n,\$p); return 0 if !$k; $n = $p; $phi = Msub1int($n); return 0 if $k > 1 && Mpowmod($a, $phi, Mmulint($p,$p)) == 1; return 0 if Mkronecker($a,$n) != -1; return 0 if ($phi % 3) == 0 && Mpowmod($a,Mdivint($phi,3),$n) == 1; return 0 if ($phi % 5) == 0 && Mpowmod($a,Mdivint($phi,5),$n) == 1; foreach my $f (Mfactor_exp($phi)) { my $fp = $f->[0]; return 0 if $fp > 5 && Mpowmod($a, Mdivint($phi,$fp), $n) == 1; } 1; } sub znorder { my($a, $n) = @_; validate_integer_abs($n); return (undef,1)[$n] if $n <= 1; $a = Mmodint($a, $n); return undef if $a <= 0; return 1 if $a == 1; return reftyped($_[0], Math::Prime::Util::GMP::znorder($a,$n)) if $Math::Prime::Util::_GMPfunc{"znorder"}; return undef if Mgcd($a, $n) > 1; # Factor n, compute znorder mod each prime power, LCM the results. # This is much faster than working mod n because each p^e is smaller. my $order = 1; foreach my $fn (Mfactor_exp($n)) { my($p, $e) = @$fn; my $pe = ($e == 1) ? $p : Mpowint($p, $e); my $amod = Mmodint($a, $pe); next if $amod <= 1; # phi(p^e) = (p-1) * p^(e-1) my $pm1 = Msubint($p, 1); my $phi = ($e == 1) ? $pm1 : Mmulint($pm1, Mpowint($p, $e-1)); # For small phi, enumerate sorted divisors directly. if ($phi < 2 ** MPU_MAXBITS) { my $found = 0; foreach my $d (Mdivisors($phi)) { if (Mpowmod($amod, $d, $pe) == 1) { $order = Mlcm($order, $d); $found = 1; last; } } return undef unless $found; next; } # Algorithm 1.7 from A. Das applied to phi(p^e). my $k = 1; foreach my $f (Mfactor_exp($phi)) { my($pi, $ei, $enum) = ($f->[0], $f->[1], 0); my $phidiv = Mdivint($phi, Mpowint($pi, $ei)); my $b = Mpowmod($amod, $phidiv, $pe); while ($b != 1) { return undef if $enum++ >= $ei; $b = Mpowmod($b, $pi, $pe); $k = Mmulint($k, $pi); } } $order = Mlcm($order, $k); } $order; } sub _dlp_trial { my ($a,$g,$p,$limit) = @_; $limit = $p if !defined $limit || $limit > $p; if ($limit < 1_000_000_000) { my $t = $g; for my $k (1 .. $limit) { return $k if $t == $a; $t = Mmulmod($t, $g, $p); } return 0; } ($a, $g, $p, $limit) = map { tobigint($_) } ($a, $g, $p, $limit); my $t = tobigint($g); for (my $k = tobigint(1); $k < $limit; $k++) { return Maddint($k,0) if $t == $a; $t *= $g; $t %= $p; } 0; } sub _dlp_bsgs { my ($a,$g,$p,$_verbose) = @_; my $invg = Minvmod($g, $p); return 0 unless defined $invg; my $N = Madd1int(Msqrtint($p-1)); # Limit for time and space. my $b = $N > 4_000_000 ? 4_000_000 : $N; my %hash; my $am = 1; my $gm = Mpowmod($invg, $N, $p); my $key = $a; my $r; print " BSGS starting $b loops\n" if $_verbose > 1; foreach my $m (0 .. $b) { # Baby Step if ($m <= $N) { $r = $hash{"$am"}; if (defined $r) { print " bsgs found in stage 1 after $m tries\n" if $_verbose; $r = Mmuladdmod($r, $N, $m, $p); return $r; } $hash{"$am"} = $m; $am = Mmulmod($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 = Mmuladdmod($m, $N, $r, $p); return $r; } $hash{"$key"} = $m; $key = Mmulmod($key,$gm,$p); } 0; } sub znlog { my($a, $g, $n) = @_; validate_integer($a); validate_integer($g); validate_integer_abs($n); return (undef,0,1)[$n] if $n <= 1; $a = Mmodint($a, $n); $g = Mmodint($g, $n); return 0 if $a == 1 || $g == 0 || $n < 2; my $_verbose = getconfig()->{'verbose'}; # For large p, znorder can be very slow. Do a small trial test first. my $x = _dlp_trial($a, $g, $n, 200); if ($x == 0) { ($a,$g,$n) = map { tobigint($_) } ($a,$g,$n); $x = _dlp_bsgs($a, $g, $n, $_verbose); $x = _bigint_to_int($x) if ref($x) && $x <= INTMAX; return $x if $x > 0 && Mpowmod($g,$x,$n) == $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,$n); } $x = _bigint_to_int($x) if ref($x) && $x <= INTMAX; return ($x == 0) ? undef : $x; } sub znprimroot { my($n) = @_; validate_integer_abs($n); return (undef,0,1,2,3)[$n] if $n <= 4; return if $n % 4 == 0; my $iseven = Mis_even($n); $n = Mrshiftint($n) if $iseven; my($k,$p); $k = Mis_prime_power($n, \$p); return if $k < 1; return 5 if $p == 3 && $iseven; my $ispow = ($k > 1); my $phi = $p-1; my $psquared = $ispow ? Mmulint($p,$p) : 0; my @phidivfac = map { Mdivint($phi, $_) } grep { $_ > 2 } map { $_->[0] } Mfactor_exp($phi); my $a = 1; while (1) { $a += $iseven ? 2 : 1; return if $a >= $p; next if $a == 4 || $a == 8 || $a == 9; next if Mkronecker($a,$p) != -1; next if Mvecany(sub { Mpowmod($a,$_,$p) == 1 }, @phidivfac); return $a unless $ispow && Mpowmod($a,$phi,$psquared) == 1; } } sub qnr { my($n) = @_; validate_integer_abs($n); return (undef,1,2)[$n] if $n <= 2; return 2 if Mkronecker(2,$n) == -1; if (Mis_prime($n)) { for (my $a = 3; $a < $n; $a = Mnext_prime($a)) { return $a if Mkronecker($a,$n) == -1; } } else { if ($n % 2 == 0) { my $e = Mvaluation($n, 2); $n >>= $e; return 2 if $n == 1 || $e >= 2; } return 2 if !($n%3) || !($n%5) || !($n%11) || !($n%13) || !($n%19); my @F = Mfactor_exp($n); for (my $a = 2; $a < $n; $a = Mnext_prime($a)) { for my $pe (@F) { my $p = $pe->[0]; return $a if $a < $p && Mkronecker($a,$p) == -1; } } } 0; } # 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 = Mgcd($d, $n); return (0,0,0) if $gcd > 1 && $gcd != $n; # Found divisor $d my $j = Mkronecker($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; croak "internal lucas, increment $increment" if $increment < 1; my ($P, $Q, $D) = (3, 1, 5); while (1) { my $gcd = Mgcd($D, $n); return (0,0,0) if $gcd > 1 && $gcd != $n; # Found divisor $d last if Mkronecker($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 > 0" if $n < 1; croak "lucas_sequence: k must be >= 0" if $k < 0; return (0,0,0) if $n == 1; if ($Math::Prime::Util::_GMPfunc{"lucas_sequence"} && $Math::Prime::Util::GMP::VERSION >= 0.30 && !ref($P) && !ref($Q)) { return maybetobigintall( Math::Prime::Util::GMP::lucas_sequence($n, $P, $Q, $k) ); } return (lucasuvmod($P,$Q,$k,$n), Mpowmod($Q,$k,$n)); } sub lucasuv { my($P, $Q, $k) = @_; croak "lucasuv: k must be >= 0" if $k < 0; return (0,2) if $k == 0; if ($Math::Prime::Util::_GMPfunc{"lucasuv"} && $Math::Prime::Util::GMP::VERSION >= 0.53) { return maybetobigintall( Math::Prime::Util::GMP::lucasuv($P, $Q, $k) ); } # Do this very generic. Optimize later if needed (D=0,Q=1,Q=-1,n odd). ($P,$Q) = map { tobigint($_) } ($P,$Q); my($Uh, $Vl, $Vh, $Ql, $Qh) = map { tobigint($_) } (1, 2, $P, 1, 1); my $s = 0; my @kbits = Mtodigits($k, 2); while ($kbits[-1] == 0) { $s++; pop @kbits; } # Remove trailing zeros. pop @kbits; # Remove trailing 1. foreach my $bit (@kbits) { $Ql *= $Qh; if ($bit) { $Qh = $Ql * $Q; $Uh = $Uh * $Vh; $Vl = $Vh * $Vl - $P * $Ql; $Vh = $Vh * $Vh - ($Qh+$Qh); } else { $Qh = $Ql; $Uh = $Uh * $Vl - $Ql; $Vh = $Vh * $Vl - $P * $Ql; $Vl = $Vl * $Vl - ($Ql+$Ql); } } $Ql *= $Qh; $Qh = $Ql * $Q; $Uh = $Uh * $Vl - $Ql; $Vl = $Vh * $Vl - $P * $Ql; $Ql *= $Qh; for (1 .. $s) { $Uh *= $Vl; $Vl = $Vl * $Vl - ($Ql+$Ql); $Ql *= $Ql; } $Uh = _bigint_to_int($Uh) if $Uh <= INTMAX && $Uh >= INTMIN; $Vl = _bigint_to_int($Vl) if $Vl <= INTMAX && $Vl >= INTMIN; ($Uh, $Vl); } sub lucasuvmod { my($P, $Q, $k, $n) = @_; validate_integer($P); validate_integer($Q); validate_integer_nonneg($k); validate_integer_abs($n); return if $n == 0; return (0,0) if $n == 1; return (0, Mmodint(2,$n)) if $k == 0; if ($Math::Prime::Util::_GMPfunc{"lucasuvmod"} && $Math::Prime::Util::GMP::VERSION >= 0.53) { return maybetobigintall( Math::Prime::Util::GMP::lucasuvmod($P, $Q, $k, $n) ); } $P = Mmodint($P,$n) if $P < 0 || $P >= $n; $Q = Mmodint($Q,$n) if $Q < 0 || $Q >= $n; my $D = Mmulsubmod($P, $P, Mmulmod(4,$Q,$n), $n); if ($D == 0) { my $S = Mdivmod($P, 2, $n); if ($S) { my $U = Mmulmod($k, Mpowmod($S, $k-1, $n), $n); my $V = Mmulmod(2, Mpowmod($S, $k, $n), $n); return ($U, $V); } } my @kbits = Mtodigits($k, 2); shift @kbits; # Remove leading 1 my $U = 1; my $V = $P; my $invD = Minvmod($D, $n); my $nisodd = Mis_odd($n); if ($Q == 1 && $invD) { $U = Mmulsubmod($P, $P, 2, $n); foreach my $bit (@kbits) { my $T = Mmulsubmod($U, $V, $P, $n); if ($bit) { $V = $T; $U = Mmulsubmod($U, $U, 2, $n); } else { $U = $T; $V = Mmulsubmod($V, $V, 2, $n); } } $V = Mmodint($V,$n); $U = Maddmod($U, $U, $n); $U = Msubmod($U, Mmulmod($V, $P, $n), $n); $U = Mmulmod($U, $invD, $n); } elsif ($nisodd && ($Q == 1 || $Q == ($n-1))) { my $ps = ($P == 1); my $qs = ($Q == 1); my $halfn = Madd1int(Mrshiftint($n)); foreach my $bit (@kbits) { $U = Mmulmod($U, $V, $n); $V = ($qs) ? Mmulsubmod($V,$V,2,$n) : Mmuladdmod($V,$V,2,$n); $qs = 1; if ($bit) { my $t = Mmulmod($U, $D, $n); $U = (!$ps) ? Mmuladdmod($U,$P,$V,$n) : Maddmod($U,$V,$n); if (Mis_odd($U)) { $U = Maddint(Mrshiftint($U), $halfn); } else { $U = Mrshiftint($U); } $V = (!$ps) ? Mmuladdmod($V,$P,$t,$n) : Maddmod($V,$t,$n); if (Mis_odd($V)) { $V = Maddint(Mrshiftint($V), $halfn); } else { $V = Mrshiftint($V); } $qs = ($Q==1); } } } elsif ($nisodd) { my $Qk = $Q; my $halfn = Madd1int(Mrshiftint($n)); foreach my $bit (@kbits) { $U = Mmulmod($U, $V, $n); $V = Mmulsubmod($V, $V, Maddmod($Qk, $Qk, $n), $n); $Qk = Mmulmod($Qk, $Qk, $n); if ($bit) { my $t = Mmulmod($U, $D, $n); $U = Mmuladdmod($U, $P, $V, $n); if (Mis_odd($U)) { $U = Maddint(Mrshiftint($U), $halfn); } else { $U = Mrshiftint($U); } $V = Mmuladdmod($V, $P, $t, $n); if (Mis_odd($V)) { $V = Maddint(Mrshiftint($V), $halfn); } else { $V = Mrshiftint($V); } $Qk = Mmulmod($Qk, $Q, $n); } } } else { my ($s, $Uh, $Vl, $Vh, $Ql, $Qh) = (0, 1, 2, $P, 1, 1); unshift @kbits, 1; # Add back leading 1. while ($kbits[-1] == 0) { $s++; pop @kbits; } # Remove trailing zeros. pop @kbits; # Remove trailing 1. foreach my $bit (@kbits) { $Ql = Mmulmod($Ql, $Qh, $n); if ($bit) { $Qh = Mmulmod($Ql, $Q, $n); $Uh = Mmulmod($Uh, $Vh, $n); $Vl = Mmulsubmod($Vh, $Vl, Mmulmod($P, $Ql, $n), $n); $Vh = Mmulsubmod($Vh, $Vh, Maddmod($Qh, $Qh, $n), $n); } else { $Qh = $Ql; $Uh = Mmulsubmod($Uh, $Vl, $Ql, $n); $Vh = Mmulsubmod($Vh, $Vl, Mmulmod($P, $Ql, $n), $n); $Vl = Mmulsubmod($Vl, $Vl, Maddmod($Ql, $Ql, $n), $n); } } $Ql = Mmulmod($Ql, $Qh, $n); $Qh = Mmulmod($Ql, $Q, $n); $Uh = Mmulsubmod($Uh, $Vl, $Ql, $n); $Vl = Mmulsubmod($Vh, $Vl, Mmulmod($P, $Ql, $n), $n); $Ql = Mmulmod($Ql, $Qh, $n); for (1 .. $s) { $Uh = Mmulmod($Uh, $Vl, $n); $Vl = Mmulsubmod($Vl, $Vl, Maddmod($Ql, $Ql, $n), $n); $Ql = Mmulmod($Ql, $Ql, $n); } ($U, $V) = ($Uh, $Vl); } ($U,$V); } sub lucasu { return maybetobigint( Math::Prime::Util::GMP::lucasu($_[0], $_[1], $_[2]) ) if $Math::Prime::Util::_GMPfunc{"lucasu"}; (lucasuv(@_))[0]; } sub lucasv { return maybetobigint( Math::Prime::Util::GMP::lucasv($_[0], $_[1], $_[2]) ) if $Math::Prime::Util::_GMPfunc{"lucasv"}; (lucasuv(@_))[1]; } sub lucasumod { return maybetobigint( Math::Prime::Util::GMP::lucasumod($_[0], $_[1], $_[2], $_[3]) ) if $Math::Prime::Util::_GMPfunc{"lucasumod"}; (lucasuvmod(@_))[0]; } sub lucasvmod { my($P, $Q, $k, $n) = @_; return maybetobigint( Math::Prime::Util::GMP::lucasvmod($P, $Q, $k, $n) ) if $Math::Prime::Util::_GMPfunc{"lucasvmod"}; validate_integer($P); validate_integer($Q); validate_integer_nonneg($k); validate_integer_abs($n); return if $n == 0; return (lucasuvmod($P, $Q, $k, $n))[1] if $Q != 1; # Fast algorithm for Q=1 $P = Mmodint($P, $n); my $V = 2; my $U = $P; foreach my $bit (Mtodigits($k, 2)) { my $T = Mmulsubmod($U, $V, $P, $n); if ($bit) { $V = $T; $U = Mmulsubmod($U, $U, 2, $n); } else { $U = $T; $V = Mmulsubmod($V, $V, 2, $n); } } return $V; } my %_ppc = (3 => 8, 5 => 20, 7 => 16, 11 => 10, 13 => 28, 17 => 36, 19 => 18); _register_free_sub(sub { %_ppc = (3 => 8, 5 => 20, 7 => 16, 11 => 10, 13 => 28, 17 => 36, 19 => 18); }); sub _pisano_pp { my($p,$e) = @_; return 1 if $e == 0; return 3 << ($e-1) if $p == 2 && $e < 32; return Mlshiftint(3,$e-1) if $p == 2; my $k = $_ppc{$p}; if (!defined $k) { $k = Msubint($p, Mkronecker(5,$p)); for my $f (Mfactor_exp($k)) { my($fac,$exp) = @$f; for my $j (1 .. $exp) { my $rk = Mdivint($k,$fac); last if Mlucasumod(1, $p-1, $rk, $p) != 0; $k = $rk; } } $_ppc{$p} = $k; } $k = Mmulint($k, Mpowint($p, $e-1)) if $e > 1; $k; } sub pisano_period { my($n) = @_; validate_integer_nonneg($n); return 0 if $n < 0; return (0,1,3,8,6,20,24,16,12,24,60)[$n] if $n <= 10; my $k = Mlcm(map { _pisano_pp($_->[0],$_->[1]) } Mfactor_exp($n)); my $lim = Mmulint(6,$n); for (my $ret = $k; $ret <= $lim; $ret = Maddint($ret,$k)) { return $ret if Mlucasumod(1, -1, Msub1int($ret), $n) == 1; } undef; } 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) = lucasuvmod($P, $Q, $n+1, $n); 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) = lucasuvmod($P, $Q, $k, $n); return 1 if $U == 0; my $Qk = Mpowmod($Q,$k,$n); foreach my $r (0 .. $s-1) { return 1 if $V == 0; if ($r < ($s-1)) { $V = Mmulsubmod($V, $V, Maddmod($Qk,$Qk,$n), $n); $Qk = Mmulmod($Qk, $Qk, $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); # This would be a great place to use a factor remove function my($s, $k) = (0, Madd1int($n)); while (Mis_even($k) && $k != 0) { $s++; $k = Mrshiftint($k); } my($U, $V) = lucasuvmod($P, $Q, $k, $n); return 1 if $U == 0 && ($V == 2 || $V == Msubint($n,2)); foreach my $r (0 .. $s-2) { return 1 if $V == 0; $V = Mmulsubmod($V, $V, 2, $n); } return 0; } sub is_almost_extra_strong_lucas_pseudoprime { my($n, $incr) = @_; if (defined $incr) { validate_integer($incr); croak "Invalid lucas parameter increment: $incr" if $incr<1 || $incr>256; } else { $incr = 1; } 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, $incr); 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($s, $k) = (0, Madd1int($n)); while (Mis_even($k) && $k != 0) { $s++; $k = Mrshiftint($k); } my @kbits = Mtodigits($k, 2); shift @kbits; # Remove leading 1 my($V,$W) = ($P,$P*$P-2); foreach my $bit (@kbits) { if ($bit) { $V = Mmulsubmod($V, $W, $P, $n); $W = Mmulsubmod($W, $W, 2, $n); } else { $W = Mmulsubmod($W, $V, $P, $n); $V = Mmulsubmod($V, $V, 2, $n); } } return 1 if $V == 2 || Msubint($n,$V) == 2; foreach my $r (0 .. $s-2) { return 1 if $V == 0; $V = Mmulsubmod($V, $V, 2, $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 = tobigint($n); my($k,$c) = (2,1); if ($n % 4 == 3) { $c = $n-1; } elsif ($n % 8 == 5) { $c = 2; } else { do { $c += 2; $k = Mkronecker($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 != 0) { if ($d % 2 == 1) { ($ra, $rb) = ( (($ra*$a)%$n + ((($rb*$b)%$n)*$c)%$n) % $n, (($rb*$a)%$n + ($ra*$b)%$n) % $n ); } $d >>= 1; if ($d != 0) { ($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 = Mkronecker($a*$a - 4, $n); last if $j == -1; return 0 if $j == 0 || ($a == 20 && _is_perfect_square($n)); } } $temp1 = Mgcd(($a+4)*(2*$a+5), $n); return 0 if $temp1 != 1 && $temp1 != $n; $n = tobigint($n); my($s, $t, $ap2) = map { tobigint($_) } (1, 2, $a+2); my $np1string = todigitstring($n+1,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 = $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 = Mtodigits($n,2); shift @nbin; while (@nbin) { my @SUB = map { Maddmod($n-$S[5-$_], $n-$S[5-$_],$n) } 0..5; my @T = map { Mmuladdmod($S[$_], $S[$_], $SUB[$_], $n); } 0..5; my $T01 = Msubmod($T[2], $T[1], $n); my $T34 = Msubmod($T[5], $T[4], $n); my $T45 = Maddmod($T34, $T[3], $n); if (shift @nbin) { @S = ($T[0], $T01, $T[1], $T[4], $T45, $T[5]); } else { @S = ($T01, $T[1], Maddmod($T01,$T[0],$n), $T34, $T[4], $T45); } } @S; } sub is_perrin_pseudoprime { my($n, $restrict) = @_; validate_integer($n); if (defined $restrict) { validate_integer_nonneg($restrict); } else { $restrict = 0; } return 0+($n >= 2) if $n < 4; return 0 if $restrict > 2 && ($n % 2) == 0; my @S = _perrin_signature($n); return 0 unless $S[4] == 0; return 1 if $restrict == 0; return 0 unless $S[1] == Msub1int($n); return 1 if $restrict == 1; my $j = Mkronecker(-23,$n); if ($j == -1) { my $B = $S[2]; my $B2 = Mmulmod($B,$B,$n); my $A = Msubmod(Mmuladdmod(3, $B, 1, $n), $B2, $n); my $C = Mmulsubmod(3,$B2,2,$n); return 1 if $S[0] == $A && $S[2] == $B && $S[3] == $B && $S[5] == $C && $B != 3 && Mmulsubmod($B2,$B,$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] && Maddmod($S[2],$S[3],$n) == $n-3 && Mmulmod(Msubmod($S[2],$S[3],$n),Msubmod($S[2],$S[3],$n),$n) == $n-(23%$n); } 0; } # Aebi and Cairns (2008) sub _catgamma { my($n,$mod) = @_; # Theorem 6, allowing us to possibly reduce n if ($mod < $n) { my $NP = Mdivint($n,$mod); if ($NP & 1) { # odd return $mod*$NP == $n ? _catgamma($NP,$mod) : 0; } else { return Mmulmod(_catgamma($NP+1,$mod),_catgamma($n-$mod*$NP,$mod),$mod); } } # Section 5 rephrases Theorem 2 into the middle binomial. my $N = Msub1int($n); my $m = Mrshiftint($N); my $r = Math::Prime::Util::binomialmod($N, $m, $mod); return ($m & 1) ? $mod-$r : $r; } sub _catvtest { my($n,$p) = @_; while ($n = int($n/$p)) { return 1 if $n % 2; } 0; } sub is_catalan_pseudoprime { my($n) = @_; return 0+($n >= 2) if $n < 4; return 0 unless $n & 1; { my @f = Mtrial_factor($n, 10000); if (@f == 2 && is_prime($f[1]) && $f[0] != $f[1]) { my($p,$q) = ($f[0],$f[1]); # two primes, q > p return 0 if 2*$p+1 >= $q; # by Theorem 6(a) # Proposition 3 (semiprimes) return 0 unless _catgamma($q,$p) == 1 && _catgamma($p,$q) == 1; } if (is_prime($f[-1])) { # fully factored for my $F (vecuniq(@f)) { return 0 if _catvtest($n-1,$F); } } } return _catgamma($n,$n) == 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 = tobigint($n); return 0 if Mis_even($n); 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 = Mkronecker($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 (Mis_prime($n) ? 1 : 0) if $n <= $Du || $n <= abs($Q) || $n <= abs($P); return 0 if Mgcd(abs($P*$Q*$D), $n) > 1; if ($k == 0) { $k = Mkronecker($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) = lucasuvmod($P, $Q, $n-$k, $n); 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,77232917,82589933,136279841}; sub is_mersenne_prime { my($p) = @_; # Use the known Mersenne primes return 1 if exists $_mersenne_primes{$p}; return 0 if $p < 79711549; # GIMPS has tested and verified 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 = Msub1int(Mlshiftint(1,$p)); # Definitely faster than using Math::BigInt that doesn't have GMP. return (0 == (Math::Prime::Util::GMP::lucasuvmod(4, 1, $mp+1, $mp))[0]) if $Math::Prime::Util::_GMPfunc{"lucasuvmod"}; my $V = 4; for my $k (3 .. $p) { $V = Mmulsubmod($V, $V, 2, $mp); } return $V == 0; } sub _poly_new { my($refn, @poly) = @_; push @poly, 0 unless scalar @poly; @poly = map { tobigint("$_") } @poly if $refn; 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 = ref($n) ? map { tobigint(0) } 0..$r-1 : map { 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; 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(ref($mod), 1); my $p = $power; while ($p) { $res = _poly_mod_mul($res, $pn, $r, $mod) if ($p % 2) != 0; $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(ref($n), $a, 1), $n, $r, $n); my $nr = $n % $r; $pp->[$nr] = (($pp->[$nr] || 0) - 1) % $n; # subtract X^(n%r) $pp->[ 0] = (($pp->[ 0] || 0) - $a) % $n; # subtract a return 0 if scalar grep { $_ } @$pp; 1; } sub _log_gamma { my($x) = @_; my @lanczos = (0.99999999999980993, 676.5203681218851, -1259.1392167224028, 771.32342877765313, -176.61502916214059, 12.507343278686905, -0.13857109526572012, 9.9843695780195716e-6, 1.5056327351493116e-7); my($base,$sum) = ($x+7.5, 0); $sum += $lanczos[$_] / ($x + $_) for (8,7,6,5,4,3,2,1); $sum += $lanczos[0]; return 0.91893853320467274178 + log($sum/$x) + (($x+0.5)*log($base)-$base); } sub _log_binomial { my($n,$k) = @_; return 0 if $n < $k; return _log_gamma($n+1) - _log_gamma($k+1) - _log_gamma($n-$k+1); } sub _log_bern41_binomial { my($r,$d,$i,$j,$s) = @_; return _log_binomial( 2*$s, $i) + _log_binomial( $d, $i) + _log_binomial( 2*$s-$i, $j) + _log_binomial( $r-2-$d, $j); } sub _bern41_acceptable { my($n,$r,$s) = @_; my $scmp = int(sqrt(($r-1)/3.0) + 0.99999) * log($n); my $d = int(0.5 * ($r-1)); my $i = int(0.475 * ($r-1)); my $j = $i; $d = $r-2 if $d > $r-2; $i = $d if $i > $d; $j = $r-2-$d if $j > ($r-2-$d); return _log_bern41_binomial($r,$d,$i,$j,$s) >= $scmp; } sub is_aks_prime { my($n) = @_; validate_integer($n); return 0 if $n < 2 || Mis_power($n); return 1 if $n == 2; if ($n > 11) { return 0 if Mis_divisible($n,2,3,5,7,11); } my($starta, $s); my $_verbose = getconfig()->{'verbose'}; my $log2n = log($n)/log(2) + 0.0001; # Error on large side. my $r0 = ($log2n > 32 ? 0.010 : 0.003) * $log2n * $log2n; my $rmult = $log2n > 32 ? 6 : 30; my $r = Mnext_prime($r0 < 2 ? 2 : Mtoint($r0)); while ( !Math::Prime::Util::is_primitive_root($n,$r) || !_bern41_acceptable($n,$r,$rmult * ($r-1))) { $r = next_prime($r); } { my $bi = 1; my $bj = $rmult * ($r-1); while ($bi < $bj) { $s = $bi + (($bj-$bi) >> 1); if (!_bern41_acceptable($n, $r, $s)) { $bi = $s+1; } else { $bj = $s; } } $s = $bj; croak "AKS: internal error bad s" unless _bern41_acceptable($n, $r, $s); # S will range from 2 to s+1 $starta = 2; $s = $s+1; } my $slim = $s * ($s-1); print "# aks trial to $slim\n" if $_verbose >= 2; { my @f = Mtrial_factor($n, $slim); return 0 if @f >= 2; } return 1 if Mmulint($slim,$slim) >= $n; # Check b^(n-1) = 1 mod n for b in [2..s] for my $a (2 .. $s) { return 0 if Mpowmod($a, $n-1, $n) != 1; } if ($n < (MPU_HALFWORD-1) ) { $n = _bigint_to_int($n) if ref($n); } else { $n = tobigint($n); } print "# aks r = $r s = $s\n" if $_verbose; local $| = 1 if $_verbose > 1; for (my $a = $starta; $a <= $s; $a++) { return 0 unless _test_anr($a, $n, $r); print "." if $_verbose > 1; } print "\n" if $_verbose > 1; return 1; } ################################################################################ sub factor_exp { my($n) = @_; validate_integer_nonneg($n); my %exponents; my @factors = grep { !$exponents{$_}++ } Mfactor($n); return scalar @factors unless wantarray; return (map { [$_, $exponents{$_}] } @factors); } sub _basic_factor { # MODIFIES INPUT SCALAR return ($_[0] == 1) ? () : ($_[0]) if $_[0] < 4; my @factors; if (!ref($_[0])) { 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 { if (Mgcd($_[0], 30) != 1) { while ($_[0] % 2 == 0) { push @factors, 2; $_[0] >>= 1; } while ($_[0] % 3 == 0) { push @factors, 3; $_[0] = Mdivint($_[0],3); } while ($_[0] % 5 == 0) { push @factors, 5; $_[0] = Mdivint($_[0],5); } } } if ($_[0] > 1 && _is_prime7($_[0])) { push @factors, $_[0]; $_[0] = 1; } @factors; } # Assume $f divides $n. Remove all occurances, add them to @$flist. Return $n. sub _remove_factor { my($n, $f, $flist) = @_; while (1) { push @$flist, $f; $n = Mdivint($n,$f); last unless Mis_divisible($n,$f); } # Better for many repeated factors #if ($n % ($f*$f)) { # push @$flist, $f; # $n = Mdivint($n,$f); #} else { # my($k,$fk,$fk1) = (2,$f*$f,Mmulint($f*$f,$f)); # while (!($n % $fk1)) { $k++; ($fk,$fk1)=($fk1,Mmulint($fk1,$f)); } # $n = Mdivint($n,$fk); # push @$flist, map { $f } 1..$k; #} $n = addint($n,0) if OLD_PERL_VERSION; $n; } sub trial_factor { my($n, $limit) = @_; validate_integer_nonneg($n); validate_integer_nonneg($limit) if defined $limit; return ($n==1) ? () : ($n) if $n < 4; return ($n) if defined $limit && $limit < 2; if ($Math::Prime::Util::_GMPfunc{"trial_factor"} && $Math::Prime::Util::GMP::VERSION >= 0.22) { # Not the same API -- other than 2/3/5, returns a single factor my @F = (); while (1) { my @f = defined $limit ? Math::Prime::Util::GMP::trial_factor($n,$limit) : Math::Prime::Util::GMP::trial_factor($n); # Pull off the factors of 2,3,5 that are done fully. push @F,shift(@f) while @f && $f[0] <= 5; push @F,$f[0] if @f == 1; last if @f <= 1; # Store the small factor we found, then keep factoring the remainder. $n = pop(@f); push @F,@f; } return ref($_[0]) ? maybetobigintall(@F) : @F; } my @factors; # Don't use _basic_factor here -- they want a trial forced. # For 32-bit n, we can simplify things a lot. if ($n <= 4294967295) { my $sqrtn = int(sqrt($n)); $limit = $sqrtn if !defined $limit || $limit > $sqrtn; if ($limit >= 2 && ($n % 2 == 0)) { do { push @factors, 2; $n >>= 1; } while ($n % 2) == 0; $sqrtn = int(sqrt($n)); $limit = $sqrtn if $sqrtn < $limit; } for my $p (3,5,7,11,13,17,19,23,29,31,37,41,43,47,53) { last if $n == 1 || $p > $limit; if ($n % $p == 0) { do { push @factors, $p; $n = int($n/$p); } while ($n % $p) == 0; $sqrtn = int(sqrt($n)); $limit = $sqrtn if $sqrtn < $limit; } } return @factors if $n == 1; return (@factors,$n) if $limit < 59; _expand_prime_cache($limit+72) if $limit > $_primes_small[-1];; for my $i (17 .. $#_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; $sqrtn = int(sqrt($n)); $limit = $sqrtn if $sqrtn < $limit; } } push @factors, $n if $n > 1; return @factors; } # STEP 1 Pull out factors of 2 if (!ref($n)) { while ($n % 2 == 0) { push @factors, 2; $n >>= 1; } } elsif (ref($n) eq 'Math::BigInt') { my $k = 0; if ($n->is_even) { my $s = substr($n->as_bin(),2); $k = length($s) - rindex($s,'1') - 1; } if ($k > 0) { push @factors, (2) x $k; $n = Mrshiftint($n,$k); } } elsif ($n % 2 == 0) { my $k = Mvaluation($n,2); if ($k > 0) { push @factors, (2) x $k; $n = Mrshiftint($n,$k); } } # STEP 2 Defined and accurate $limit, add more small primes $limit = Msqrtint($n) if !defined $limit || $limit*$limit > $n; # Add more primes if we might use them. Maybe wait until needed? _expand_prime_cache(100_003) if $_primes_small[-1] < 100_000 && $limit > $_primes_small[-1]; my $I = 2; # small prime index, start at p=3 # STEP 3: Math::BigInt using small primes list until native or no more if (ref($n) eq 'Math::BigInt') { # n is a odd positive Math::BigInt with at least 32 bits. # Batch primes and use gcd to check. If using Math::BigInt, 2-5x faster. while ($I+3 <= $#_primes_small && $_primes_small[$I+3] <= $limit && $I <= 1951956) { my($f1,$f2,$f3,$f4) = @_primes_small[$I .. $I+3]; my $g = $n->bgcd($f1<=5581 ? $f1*$f2*$f3*$f4 : Mmulint($f1*$f4,$f2*$f3)); $I += 4; next if $g->is_one; my $G = _bigint_to_int($g); # Native int (or larger) $G = $g if $G >= INTMAX; # Must use original if multiples found. $n = _remove_factor($n, $f1, \@factors) unless $G % $f1; $n = _remove_factor($n, $f2, \@factors) unless $G % $f2; $n = _remove_factor($n, $f3, \@factors) unless $G % $f3; $n = _remove_factor($n, $f4, \@factors) unless $G % $f4; if ($limit*$limit >= $n) { my $sqrtn = Msqrtint($n); $limit = $sqrtn if $limit > $sqrtn; } last if !ref($n); } # n is either a bigint and > INTMAX, or a native type <= INTMAX; return @factors if $n == 1; my $f = $I > $#_primes_small ? $_primes_small[-1]+2 : $_primes_small[$I]; return (@factors,$n) if $f > $limit; } # STEP 4: any bigint, small primes list until native or no more if (ref($n)) { while ($I <= $#_primes_small) { my $f = $_primes_small[$I]; last if $f > $limit; $I++; next if $n % $f; $n = _remove_factor($n, $f, \@factors); if ($limit*$limit >= $n) { my $sqrtn = Msqrtint($n); $limit = $sqrtn if $limit > $sqrtn; } last if !ref($n); } return @factors if $n == 1; my $f = $I > $#_primes_small ? $_primes_small[-1]+2 : $_primes_small[$I]; return (@factors,$n) if $f > $limit; } # STEP 5: Still a bigint. Wheel (mod 2310) starting from last small prime. if (ref($n)) { my $f = $_primes_small[-1]; my($s,$w) = ($_primes_small[-1], 2*3*5*7*11); my @wheel = Mvecslide(sub{$b-$a}, grep { Mgcd($_,$w)==1 } $s+0..$s+$w); SEARCH: while ($f <= $limit) { for my $inc (@wheel) { $f += $inc; if ($f <= $limit && !($n % $f)) { $n = _remove_factor($n, $f, \@factors); last SEARCH if $n == 1; if ($limit*$limit >= $n) { my $sqrtn = Msqrtint($n); $limit = $sqrtn if $limit > $sqrtn; } } } } push @factors, $n if $n > 1; return @factors; } # STEP 6: native small primes list for my $i ($I .. $#_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; } } return @factors if $n == 1; # STEP 7: native wheel (mod 30) 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); } } push @factors, $n if $n > 1; @factors; } my $_holf_r; my @_fsublist = ( [ "power", sub { _power_factor (shift) } ], [ "pbrent 8k", sub { pbrent_factor (shift, 8*1024, 1, 1) } ], [ "p-1 16k", sub { pminus1_factor(shift, 16_384, 16_384, 1); } ], [ "ECM 500", sub { ecm_factor (shift, 500, 10_000, 10) } ], [ "ECM 4k", sub { ecm_factor (shift, 4_000, 20_000, 20) } ], [ "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_integer_nonneg($n); my @factors; if ($n < 4) { @factors = ($n == 1) ? () : ($n); return @factors; } if ($Math::Prime::Util::_GMPfunc{"factor"}) { my @factors = Math::Prime::Util::GMP::factor($n); return ref($_[0]) ? maybetobigintall(@factors) : @factors; } $n = Maddint($n,0) if ref($n); # Ensure we have a copy 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, Mtrial_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) && $n <= INTMAX; #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 getconfig()->{'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) && $n <= INTMAX; push @nstack, @ftry; } else { #warn "trial factor $n\n"; push @factors, Mtrial_factor($n); #print " trial into ", join(",",@factors), "\n"; $n = 1; last; } } push @factors, $n if $n != 1; } Mvecsort(@factors); } sub _found_factor { my($f, $n, $what, @factors) = @_; if ($f == 1 || $f == $n) { push @factors, $n; } else { my $f2 = Mdivint($n,$f); croak "internal error in $what" unless Mmulint($f,$f2) == $n; ($f,$f2) = ($f2,$f) if $f > $f2; push @factors, $f, $f2; # MPU::GMP prints this type of message if verbose, so do the same. print "$what found factor $f\n" if getconfig()->{'verbose'} > 0; } @factors; } ################################################################################ # TODO: sub squfof_factor { Mtrial_factor(@_) } sub lehman_factor { Mtrial_factor(@_) } sub pplus1_factor { pminus1_factor(@_) } sub _power_factor { my $r; my $k = Mis_power($_[0],0,\$r); return ($_[0]) unless $k > 1; print "power found factor $r\n" if getconfig()->{'verbose'} > 0; map { $r } 1..$k; } sub prho_factor { my($n, $rounds, $pa, $skipbasic) = @_; validate_integer_nonneg($n); if (defined $rounds) { validate_integer_nonneg($rounds); } else { $rounds = 4*1024*1024; } if (defined $pa) { validate_integer_nonneg($pa); } else { $pa = 3; } my @factors; if (!$skipbasic) { @factors = _basic_factor($n); return @factors if $n < 4; } my($U,$V) = (7,7); if (ref($n) || $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 = Mmuladdmod($U, $U, $pa, $n); $V = Mmuladdmod($V, $V, $pa, $n); $V = Mmuladdmod($V, $V, $pa, $n); $f = ($U > $V) ? Msubint($U,$V) : Msubint($V,$U); $m = Mmulmod($m,$f,$n); } $f = Mgcd($m,$n); next if $f == 1; if ($f == $n) { ($U, $V) = ($oldU, $oldV); for my $i (1 .. $inner) { $U = Mmuladdmod($U, $U, $pa, $n); $V = Mmuladdmod($V, $V, $pa, $n); $V = Mmuladdmod($V, $V, $pa, $n); $f = ($U > $V) ? Msubint($U,$V) : Msubint($V,$U); $f = Mgcd($f, $n); last if $f != 1; } last if $f == 1 || $f == $n; } return _found_factor($f, $n, "prho-bigint", @factors); } } else { 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-32", @factors); } } push @factors, $n; @factors; } sub pbrent_factor { my($n, $rounds, $pa, $skipbasic) = @_; validate_integer_nonneg($n); if (defined $rounds) { validate_integer_nonneg($rounds); } else { $rounds = 4*1024*1024; } if (defined $pa) { validate_integer_nonneg($pa); } else { $pa = 3; } my @factors; if (!$skipbasic) { @factors = _basic_factor($n); return @factors if $n < 4; } my($Xi,$Xm) = (2,2); if (ref($n) || $n >= MPU_HALFWORD) { # 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,$r,$saveXi,$f) = (32,1); while ($rounds > 0) { my $rleft = ($r > $rounds) ? $rounds : $r; while ($rleft > 0) { my $dorounds = ($rleft > $inner) ? $inner : $rleft; my $m = 1; $saveXi = Maddint($Xi,0); foreach my $i (1 .. $dorounds) { $Xi = Mmuladdmod($Xi, $Xi, $pa, $n); if (OLD_PERL_VERSION) { $m=mulmod($m,subint($Xi,$Xm),$n); next; } $m = Mmulmod($m, $Xi > $Xm ? $Xi-$Xm : $Xm-$Xi,$n); } $rleft -= $dorounds; $rounds -= $dorounds; $f = Mgcd($m,$n); last unless $f == 1; } if ($f == 1) { $r *= 2; $Xm = Maddint($Xi,0); next; } if ($f == $n) { # back up to determine the factor $Xi = Maddint($saveXi,0); do { $Xi = Mmuladdmod($Xi, $Xi, $pa, $n); $f = Mgcd($Xi > $Xm ? $Xi-$Xm : $Xm-$Xi, $n); } while ($f == 1 && $r-- != 0); last if $f == 1 || $f == $n; } return _found_factor($f, $n, "pbrent", @factors); } } else { # 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) % $n; $Xi += $pa; $Xi -= $n if $Xi >= $n; my $f = _gcd_ui( ($Xi>$Xm) ? $Xi-$Xm : $Xm-$Xi, $n); return _found_factor($f, $n, "pbrent-32",@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) = @_; validate_integer_nonneg($n); validate_integer_nonneg($B1) if defined $B1; validate_integer_nonneg($B2) if defined $B2; my @factors; if (!$skipbasic) { @factors = _basic_factor($n); return @factors if $n < 4; } $n = tobigint($n) if OLD_PERL_VERSION && !ref($n) && $n > INTMAX; if (!ref($n)) { # Stage 1 only my $sqrtn = Msqrtint($n); $B1 = $sqrtn if !defined $B1 || $B1 > $sqrtn; my $sqrtb1 = int(sqrt($B1)); my($pc_beg, $pc_end) = (2, 6_000-1); my $pa = 2; while (1) { $pc_end = $B1 if $pc_end > $B1; foreach my $q (@{Mprimes($pc_beg, $pc_end)}) { my $k = $q; if ($q <= $sqrtb1) { my $kmin = int($B1 / $q); while ($k <= $kmin) { $k *= $q; } } $pa = Mpowmod($pa, $k, $n); if ($pa == 0) { push @factors, $n; return @factors; } my $f = Mgcd($pa-1, $n); return _found_factor($f, $n, "pminus1-64", @factors) if $f != 1; } last if $pc_end >= $B1; ($pc_beg, $pc_end) = ($pc_end+1, $pc_end+18000); } push @factors, $n; return @factors; } 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; $n = tobigint($n) if !ref($n) || (defined $_BIGINT && $_BIGINT ne ref($n)); # bigints: n, pa, t, savea, [stage2] b, bm my ($j, $q, $saveq) = (32, 2, 2); my $pa = tobigint(2); my $t = tobigint(1); my $savea = $pa+0; my $f = 1; my($pc_beg, $pc_end) = (2, 2+100_000); while (1) { $pc_end = $B1 if $pc_end > $B1; my @bprimes = @{ Mprimes($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 = _bi_powmod($pa, $t, $n); $t = tobigint(1); if ($pa == 0) { push @factors, $n; return @factors; } $f = Mgcd($pa-1, $n); last if $f == $n; return _found_factor($f, $n, "pminus1-bigint $B1", @factors) unless $f == 1; $saveq = $q; $savea = $pa+0; } } $q = $bprimes[-1]; last if $f != 1 || $pc_end >= $B1; ($pc_beg, $pc_end) = (Madd1int($pc_end), Maddint($pc_end,500_000)); } $pa = _bi_powmod($pa, $t, $n); if ($pa == 0) { push @factors, $n; return @factors; } $f = Mgcd($pa-1, $n); if ($f == $n) { $q = $saveq; $pa = $savea+0; while ($q <= $B1) { my ($k, $kmin) = ($q, int($B1 / $q)); while ($k <= $kmin) { $k *= $q; } $pa = _bi_powmod($pa, $k, $n); $f = Mgcd($pa-1, $n); if ($f == $n) { push @factors, $n; return @factors; } last if $f != 1; $q = Mnext_prime($q); } } # STAGE 2 if ($f == 1 && $B2 > $B1) { my $bm = $pa + 0; my $b = tobigint(1); my @precomp_bm; $precomp_bm[0] = ($bm * $bm) % $n; $precomp_bm[$_] = ($precomp_bm[$_-1] * $bm * $bm) % $n for 1..19; $pa = _bi_powmod($pa, $q, $n); my $j = 1; $pc_beg = $q+1; $pc_end = Maddint($pc_beg, 100_000); while (1) { $pc_end = $B2 if $pc_end > $B2; my @bprimes = @{ Mprimes($pc_beg, $pc_end) }; foreach my $i (0 .. $#bprimes) { my $diff = $bprimes[$i] - $q; $q = $bprimes[$i]; my $qdiff = ($diff >> 1) - 1; $precomp_bm[$qdiff] = _bi_powmod($bm, $diff, $n) unless defined $precomp_bm[$qdiff]; $pa = ($pa * $precomp_bm[$qdiff]) % $n; if ($pa == 0) { push @factors, $n; return @factors; } $b *= ($pa-1); if (($j++ % 128) == 0) { $b %= $n; $f = Mgcd($b, $n); last if $f != 1; } } last if $f != 1 || $pc_end >= $B2; ($pc_beg, $pc_end) = (Madd1int($pc_end), Maddint($pc_end,500_000)); } $f = Mgcd($b, $n); } return _found_factor($f, $n, "pminus1-bigint $B1/$B2", @factors); } sub cheb_factor { my($n, $B1, $initx, $skipbasic) = @_; validate_integer_nonneg($n); validate_integer_nonneg($B1) if defined $B1; validate_integer_nonneg($initx) if defined $initx; my @factors; if (!$skipbasic) { @factors = _basic_factor($n); return @factors if $n < 4; } my $x = (defined $initx && $initx > 0) ? $initx : 72; # Arbitrary my $B = (defined $B1 && $B1 > 0) ? $B1 : Mmulint(Mpowint(Mlogint($n,2),2),8); $B = Msqrtint($n) if $B > Msqrtint($n); my $sqrtB = Msqrtint($B); my $inv = Minvmod(2,$n); my $f = 1; my @bprimes = @{ Mprimes(2, $B) }; foreach my $p (@bprimes) { my $xx = Maddmod($x,$x,$n); if ($p <= $sqrtB) { my $plgp = Mpowint($p, Mlogint($B, $p)); $x = Mmulmod(Math::Prime::Util::lucasvmod($xx, 1, $plgp, $n), $inv, $n); } else { $x = Mmulmod(Math::Prime::Util::lucasvmod($xx, 1, $p, $n), $inv, $n); } $f = Mgcd($x-1, $n); last if $f != 1; } return _found_factor($f, $n, "cheb", @factors); } sub holf_factor { my($n, $rounds, $startrounds) = @_; validate_integer_nonneg($n); if (defined $rounds) { validate_integer_nonneg($rounds); } else { $rounds = 64*1024*1024; } $startrounds = 1 if (!defined $startrounds) || ($startrounds < 1); my @factors = _basic_factor($n); return @factors if $n < 4; if (ref($n)) { for my $i ($startrounds .. $rounds) { my $ni = Mmulint($n,$i); my $s = Msqrtint($ni); if (Mmulint($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 = Mgcd($ni, $n); return _found_factor($f, $n, "HOLF", @factors); } $s = Madd1int($s); my $m = Msubint(Mmulint($s,$s),$ni); if (Mis_power($m, 2, \my $f)) { $f = Mgcd($n, $s > $f ? $s-$f : $f-$s); 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) = @_; validate_integer_nonneg($n); if (defined $rounds) { validate_integer_nonneg($rounds); } else { $rounds = 64*1024*1024; } my @factors = _basic_factor($n); return @factors if $n < 4; if (ref($n)) { my $pa = Msqrtint($n); return _found_factor($pa, $n, "Fermat", @factors) if Mmulint($pa,$pa) == $n; $pa = Madd1int($pa); my $b2 = Msubint(Mmulint($pa,$pa),$n); my $lasta = Maddint($pa,$rounds); while ($pa <= $lasta) { if (Mis_power($b2, 2, \my $s)) { my $i = Msubint($pa,($lasta-$rounds))+1; return _found_factor(Msubint($pa,$s), $n, "Fermat ($i rounds)", @factors); } $pa = Madd1int($pa); $b2 = Msubint(Mmulint($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_integer_nonneg($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 = reftyped($n, $ef[-1]); return _found_factor($ecmfac, $n, "ECM (GMP) B1=$B1 curves $ncurves", @factors); } push @factors, $n; return @factors; } $n = tobigint($n) if OLD_PERL_VERSION && !ref($n) && $n > INTMAX; $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 = @{ Mprimes(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) ? @{Mprimes($B1+1, $B2)} : (); foreach my $curve (1 .. $ncurves) { my $sigma = tobigint(Murandomm($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 = Mgcd( $cb, $n ); $f = Mgcd( $z, $n ) if $f == 1; next if $f == $n; return _found_factor($f,$n, "ECM B1=$B1 curve $curve", @factors) if $f != 1; $u = Minvmod($cb,$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 = Mgcd($fm, $n); last if $f != 1; } } $f = Mgcd($fm, $n); next if $f == $n; if ($f == 1 && $B2 > $B1) { # BEGIN STAGE 2 my $D = Msqrtint($B2 >> 1); $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 = Mgcd( $z2, $n ); last if $f != 1; $u = Minvmod($z2,$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 = Mgcd( $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 = Mgcd($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,$k) = @_; validate_integer_nonneg($n); if (defined $k) { validate_integer_nonneg($k); $k = $n if $k > $n; } else { $k = $n; } if (!wantarray) { # In scalar context, returns sigma_0(n). Very fast. return Mdivisor_sum($n,0) if $k >= $n; my @div = divisors($n,$k); return scalar(@div); } return () if $n == 0 || $k == 0; return (1) if $n == 1 || $k == 1; my @d; if ($Math::Prime::Util::_GMPfunc{"divisors"}) { # This trips an erroneous compile time error without the eval. if ($k < $n && $Math::Prime::Util::GMP::VERSION >= 0.53) { eval "\@d = Math::Prime::Util::GMP::divisors(\"$n\",\"$k\"); "; ## no critic qw(ProhibitStringyEval) } else { eval "\@d = Math::Prime::Util::GMP::divisors(\"$n\"); "; ## no critic qw(ProhibitStringyEval) @d = grep { $_ <= $k } @d if $k < $n; } return maybetobigintall(@d); } my @pe = Mfactor_exp($n); return (1,$n) if @pe == 1 && $pe[0]->[1] == 1 && $n <= $k; @d = (1); for my $pe (@pe) { my($p,$e) = @$pe; last if $p > $k; my @t; push @d, @t = map { Mmulint($_,$p) } @d; # multiply through push @d, @t = map { Mmulint($_,$p) } @t for 2 .. $e; # repeat } @d = grep { $_ <= $k } @d if $k < $n; Mvecsort(@d); } ################################################################################ sub _chebyshev_theta { my($n,$low) = @_; my($sum,$high) = (0.0, 0); while ($low <= $n) { $high = $low + 1e6; $high = $n if $high > $n; $sum += log($_) for @{Mprimes($low,$high)}; $low = $high+1; } $sum; } sub chebyshev_theta { my($n) = @_; validate_integer_nonneg($n); _chebyshev_theta($n,2); } sub chebyshev_psi { my($n) = @_; validate_integer_nonneg($n); return 0 if $n <= 1; my ($sum, $logn, $sqrtn) = (0.0, log($n), Msqrtint($n)); # Sum the log of prime powers first for my $p (@{Mprimes($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) = @_; validate_integer($n); 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 = Msqrtint($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 = Msqrtint($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; } # Ramanujan Tau using Cohen's method with Hurwitz class numbers. # Also see Lygeros (2010). # The two hclassno calls could be collapsed with some work sub _tauprime { my($p) = @_; return -24 if $p == 2; my $sum = 0; my($p9,$pp7) = (Mmulint(9,$p), Mvecprod(7,$p,$p)); for my $t (1 .. Msqrtint($p)) { my $t2 = Mpowint($t,2); my $v = Msubint($p,$t2); my $T1 = Mpowint($t2,3); my $T2 = Maddint( Msubint(Mvecprod(4,$t2,$t2), Mmulint($p9,$t2)), $pp7); my $T3; my $v4 = $v % 4; if ($v4 == 0) { $T3 = Maddint(Mmulint(2,Mhclassno($v)), Mhclassno(Mmulint(4,$v)) ); } elsif ($v4 == 3) { $T3 = Mmulint( $v%8 == 3 ? 6 : 4, Mhclassno($v) ); } else { $T3 = Mhclassno(Mmulint(4,$v)); } $sum = Maddint($sum, Mvecprod($T1, $T2, $T3)); } Mvecsum( Mmulint( 28, Mpowint($p,6)), Mmulint(-28, Mpowint($p,5)), Mmulint(-90, Mpowint($p,4)), Mmulint(-35, Mpowint($p,3)), -1, Mmulint(-32,Mdivint($sum,3)) ); } # Recursive method for handling prime powers sub _taupower { my($p, $e, $tp) = @_; return 1 if $e <= 0; $tp = _tauprime($p) unless defined $tp; return $tp if $e == 1; my $p11 = Mpowint($p,11); return Msubint(Mpowint($tp,2), $p11) if $e == 2; return Msubint(Mpowint($tp,3), Mvecprod(2,$tp,$p11)) if $e == 3; return Mvecsum(Mpowint($tp,4), Mvecprod(-3,Mpowint($tp,2),$p11), Mpowint($p11,2)) if $e == 4; # Recurse -3 my $F3 = Msubint(Mpowint($tp,3),Mvecprod(2,$tp,$p11)); my $F4 = Msubint(Mmulint($p11,$p11),Mvecprod($tp,$tp,$p11)); Maddint( Mmulint($F3,_taupower($p,$e-3,$tp)), Mmulint($F4,_taupower($p,$e-4,$tp)) ); } sub ramanujan_tau { my($n) = @_; validate_integer_nonneg($n); return 0 if $n <= 0; # Use GMP if we have no XS or if size is small if ($n < 100000 || !getconfig()->{'xs'}) { if ($Math::Prime::Util::_GMPfunc{"ramanujan_tau"}) { return reftyped($_[0], Math::Prime::Util::GMP::ramanujan_tau($n)); } } Mvecprod(map { _taupower($_->[0],$_->[1]) } Mfactor_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; # We are going to ignore bignum, as it's: # 1) unclear what we should do different # 2) hard to tell if it's active in scope # We do have to care in regards to giving correct results. But we're not # going to actively promote things based on it. if ($Math::Prime::Util::_GMPfunc{"ei"}) { my $r = _try_real_gmp_func(\&Math::Prime::Util::GMP::ei, $x<100?0.49:0.53, $x); return $r if defined $r; } $x=_bigint_to_int($x) if ref($x)eq'Math::BigInt' && $x<=INTMAX && $x>=INTMIN; $x=_upgrade_to_float($x) if ref($x) && 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) = @_; 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; if ($Math::Prime::Util::_GMPfunc{"li"}) { my $r = _try_real_gmp_func(\&Math::Prime::Util::GMP::li, 0.49, $x); return $r if defined $r; } if ($x == 2) { my $li2const = (ref($x) eq 'Math::BigFloat') ? Math::BigFloat->new(_Li2(_find_big_acc($x))) : 0.0+_Li2(30); return $li2const; } $x=_bigint_to_int($x) if ref($x)eq'Math::BigInt' && $x<=INTMAX && $x>=INTMIN; $x=_upgrade_to_float($x) if ref($x) && 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 = mulint($factorial, $n); $q = mulint($factorial, $power2); $power2 = mulint(2, $power2); while ($k <= ($n-1)>>1) { $inner_sum += Math::BigFloat->bone / (2*$k+1); $k++; } $p->bmul($neglogx); my $term = $p->copy->bdiv("$q", $xdigits)->bmul($inner_sum); $term->bround($xdigits) if $xdigits; $sum->badd($term); last if $term->copy->babs < $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) = @_; # 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 (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 RiemannR: x must be > 0" if $x <= 0; if ($Math::Prime::Util::_GMPfunc{"riemannr"}) { my $r = _try_real_gmp_func(\&Math::Prime::Util::GMP::riemannr, 0.41, $x); return $r if defined $r; } $x=_bigint_to_int($x) if ref($x)eq'Math::BigInt' && $x<=INTMAX && $x>=INTMIN; $x=_upgrade_to_float($x) if ref($x) && ref($x) ne 'Math::BigFloat'; # 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 (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 = Mmoebius(0,300); for my $k (1 .. 300) { next if $mob[$k] == 0; my $term = $mob[$k] / $k * MLi($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) = @_; croak "Invalid input to LambertW: x must be >= -1/e" if $x < -0.36787944118; if ($Math::Prime::Util::_GMPfunc{"lambertw"}) { my $r = _try_real_gmp_func(\&Math::Prime::Util::GMP::lambertw, 0.42, $x); return $r if defined $r; } $x=_bigint_to_int($x) if ref($x)eq'Math::BigInt' && $x<=INTMAX && $x>=INTMIN; $x=_upgrade_to_float($x) if ref($x) && ref($x) ne 'Math::BigFloat'; my $xacc = ref($x) ? _find_big_acc($x) : 0; my $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)); # # Also see https://arxiv.org/pdf/2008.06122 # https://people.eecs.berkeley.edu/~wkahan/Math273/LmbrtsW.pdf # Fritsch converges quadratically, so tolerance could be 4x smaller. Use 2x. my $tol = 1.054e-8; # sqrt(double eps) if ($xacc) { $tol = 10**(-int(1+$xacc/2)); $w->accuracy($xacc+15); } 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; return $w; } my $_Pi = "3.141592653589793238462643383279503"; sub Pi { my($digits) = @_; 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) over a minute, C pidigits 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 = getconfig()->{'xs'}; my $_verbose = getconfig()->{'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 forprimes { my($sub, $beg, $end) = @_; if (defined $end) { validate_integer_nonneg($beg); } else { ($beg,$end) = (2, $beg); } validate_integer_nonneg($end); $beg = 2 if $beg < 2; my $oldforexit = Math::Prime::Util::_start_for_loop(); { my $pp; local *_ = \$pp; for (my $p = Mnext_prime($beg-1); $p <= $end; $p = Mnext_prime($p)) { $pp = $p; $sub->(); last if Math::Prime::Util::_get_forexit(); } } Math::Prime::Util::_end_for_loop($oldforexit); } sub _forcomp_sub { my($what, $sub, $beg, $end) = @_; if (defined $end) { validate_integer_nonneg($beg); } else { ($beg,$end) = (0, $beg); } validate_integer_nonneg($end); my $cinc = 1; if ($what eq 'oddcomposites') { $beg = 9 if $beg < 9; $beg++ unless $beg % 2 == 1; $cinc = 2; } else { $beg = 4 if $beg < 4; } $end = tobigint(~0) if $end == ~0 && !ref($end); my $oldforexit = Math::Prime::Util::_start_for_loop(); { my $pp; local *_ = \$pp; for (my $p = Mnext_prime($beg-1); $beg <= $end; $p = Mnext_prime($p)) { for ( ; $beg < $p && $beg <= $end ; $beg += $cinc ) { $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 forcomposites { _forcomp_sub('composites', @_); } sub foroddcomposites { _forcomp_sub('oddcomposites', @_); } sub forsemiprimes { foralmostprimes($_[0], 2, $_[1], $_[2]); } sub _forfac_sub { my($sf, $sub, $beg, $end) = @_; if (defined $end) { validate_integer_nonneg($beg); } else { ($beg,$end) = (1, $beg); } validate_integer_nonneg($end); $beg = 1 if $beg < 1; my $oldforexit = Math::Prime::Util::_start_for_loop(); { my $pp; local *_ = \$pp; while ($beg <= $end) { if (!$sf || Mis_square_free($beg)) { $pp = $beg; if ($sf == 2) { $sub->(); } else { my @f = Mfactor($beg); $sub->(@f); } last if Math::Prime::Util::_get_forexit(); } $beg++; } } Math::Prime::Util::_end_for_loop($oldforexit); } sub forfactored { _forfac_sub(0, @_); } sub forsquarefree { _forfac_sub(1, @_); } sub forsquarefreeint { _forfac_sub(2, @_); } sub fordivisors { my($sub, $n) = @_; validate_integer_nonneg($n); my @divisors = Mdivisors($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 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_integer_nonneg($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_integer_nonneg($mina); } if (defined $rhash->{amax}) { $maxa = $rhash->{amax}; validate_integer_nonneg($maxa); } $minn = $maxn = $rhash->{n} if defined $rhash->{n}; $minn = $rhash->{nmin} if defined $rhash->{nmin}; $maxn = $rhash->{nmax} if defined $rhash->{nmax}; validate_integer_nonneg($minn); validate_integer_nonneg($maxn); if (defined $rhash->{prime}) { $primeq = $rhash->{prime}; validate_integer_nonneg($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 Mvecany(sub{ $_ < $mina || $_ > $maxa }, @a[0..$k]); } } next if $primeq == 0 && Mvecany(sub{ Mis_prime($_) }, @a[0..$k]); next if $primeq == 2 && Mvecany(sub{ !Mis_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_integer_nonneg($n); my($begk, $endk); if (defined $k) { validate_integer_nonneg($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) = @_; if ($n <= 1) { my $oldforexit = Math::Prime::Util::_start_for_loop(); if ($n == 0) { $sub->(); } else { $sub->(0); } Math::Prime::Util::_end_for_loop($oldforexit); return; } 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_integer_nonneg($n); croak "Too many arguments for forperm" if defined $k; _forperm($sub, $n, 1); } sub forderange { my($sub, $n, $k) = @_; validate_integer_nonneg($n); croak "Too many arguments for forderange" if defined $k; 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_integer_nonneg($n); validate_integer($k); return () if $n == 0; return (0) if $n == 1; my $f = Mfactorial($n-1); $k %= Mmulint($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) = @_; 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 = Maddint($rank, Mmulint($k,$f)); $f /= $n-$i-1; } $rank; } sub randperm { my($n,$k) = @_; validate_integer_nonneg($n); if (defined $k) { validate_integer_nonneg($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 = Murandomm($n); } while $seen{$v}++; push @S,$v; } } else { @S = (0..$n-1); for my $i (0 .. $n-2) { last if $i >= $k; my $j = Murandomm($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 = Murandomm($i+1); @S[$i,$j] = @S[$j,$i]; } @S; } sub vecsample { my $k = shift; return () if $k == 0 || @_ == 0; my $R = $_[0]; my $isarr = (@_ > 1 || !ref($R) || ref($R) ne 'ARRAY'); my $len = $isarr ? scalar(@_) : scalar(@$R); $k = $len if $k > $len; my @I = ($len-1, 0 .. $len-2); my $j; my @O = map { $j = Murandomm(scalar(@I)); # random index from remaining @I[0,$j] = @I[$j,0]; # move to front shift @I; # take it off } 1 .. $k; return $isarr ? @_[@O] : @$R[@O]; } ############################################################################### sub vecsort { my(@s) = @_; # If we have a single array reference, unpack it. @s = @{$s[0]} if scalar(@s) == 1 && (ref($s[0]) || '') eq 'ARRAY'; # Validate and convert everything into a native int or bigint validate_integer($_) for @s; # See https://github.com/perl/perl5/issues/12803 for various discussion. # Optimize to skip the sorting. return scalar(@s) unless wantarray; # Before Perl 5.26, numerical sort used doubles (sigh). if ($] < 5.026) { @s = sort { 0+($a<=>$b) } @s; # Prevent sort from using built-in compare } else { @s = sort { $a<=>$b } @s; } return @s; } # In-place sort. sub vecsorti { my($r) = @_; croak 'Not an array reference' unless (ref($r) || '') eq 'ARRAY'; validate_integer($_) for @$r; if ($] < 5.026) { @$r = sort { 0+($a<=>$b) } @$r; } else { @$r = sort { $a<=>$b } @$r; } return $r; } sub setbinop (&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) my($sub, $ra, $rb) = @_; croak 'Not a subroutine reference' unless (ref($sub) || '') eq 'CODE'; croak 'Not an array reference' unless (ref($ra) || '') eq 'ARRAY'; if (defined $rb) { croak 'Not an array reference' unless (ref($rb) || '') eq 'ARRAY'; } else { $rb = $ra; } my $caller = caller(); no strict 'refs'; ## no critic(strict) local(*{$caller.'::a'}) = \my $a; local(*{$caller.'::b'}) = \my $b; # Typically faster and less memory to push them all instead of hashing here. my @set; for my $ia (@$ra) { for my $ib (@$rb) { # Set both here in case they modified $a in their function. $a = $ia; $b = $ib; push @set, $sub->(); } } Mtoset(@set); } sub sumset { my($ra,$rb) = @_; croak 'Not an array reference' unless (ref($ra) || '') eq 'ARRAY'; if (defined $rb) { croak 'Not an array reference' unless (ref($rb) || '') eq 'ARRAY'; } else { $rb = $ra; } return [] if scalar(@$ra) == 0 || scalar(@$rb) == 0; validate_integer($_) for @$ra; if ($ra != $rb) { validate_integer($_) for @$rb; } my @set; for my $x (@$ra) { for my $y (@$rb) { push @set, Maddint($x,$y); } } Mtoset(@set); } sub vecuniq { my %seen = (); my $k; # Validation means about 1.4x slower. #my @T = @_; return grep { validate_integer($_) && not $seen{$k = $_}++; } @T; # We have decided to skip validation and not support undefined values. return grep { not $seen{$k = $_}++; } @_; } sub vecfreq { my %count = (); my $countundef = 0; my $k; for (@_) { if (defined $_) { $count{$k = $_}++; } else { $countundef++; } } return wantarray ? %count : scalar(keys %count) if !$countundef; return 1 + scalar(keys %count) if !wantarray; undef $k; return (%count, (\$k => $countundef)); } sub vecsingleton { my %count = (); my ($countundef,$k) = (0); # Filter later duplicates during the count stage for a ~10% speedup. # Idea from List::MoreUtil. return grep { (defined $_ ? $count{$k=$_} : $countundef) == 1 } grep { ! (defined $_ ? $count{$k = $_}++ : $countundef++) } @_; } # SET/VEC generic. # Assume two (sorted,uniqed,validated) sets as input, merge $T into $S. sub _merge_sets_inplace { my($S,$T) = @_; # 1 Push set over to make room at the front. unshift @$S, (0) x scalar(@$T); # 2 walk the two arrays merging values my($it,$nt) = (0, scalar(@$T)); my($is,$ns) = ($nt, scalar(@$S)); my $i = 0; while ($it < $nt && $is < $ns) { my($SV,$TV) = ($S->[$is], $T->[$it]); if ($SV == $TV) { $S->[$i++] = $SV; $is++; $it++; } elsif ($SV < $TV) { $S->[$i++] = $SV; $is++; } else { $S->[$i++] = $TV; $it++; } } # 3 splice the remainder onto the end of the set if ($is < $ns) { # slide the last part over splice(@$S, $i, $is-$i); } elsif ($it < $nt) { # replace everything at the end with the new values splice(@$S, $i, @$S-$i, @{$T}[$it..$nt-1]); } else { $#$S = $i-1; } $S; } sub setunion { my($ra,$rb) = @_; croak 'Not an array reference' unless (ref($ra) || '') eq 'ARRAY' && (ref($rb) || '') eq 'ARRAY'; # return toset(@$ra,@$rb); my(%seen,$k); Mtoset(grep { not $seen{$k = $_}++ } @$ra,@$rb); } sub setintersect { my($ra,$rb) = @_; croak 'Not an array reference' unless (ref($ra) || '') eq 'ARRAY' && (ref($rb) || '') eq 'ARRAY'; ($ra,$rb) = ($rb,$ra) if scalar(@$ra) > scalar(@$rb); # Performance return [] if scalar(@$ra) == 0; my %ina; undef @ina{@$ra}; Mtoset(grep { exists $ina{$_} } @$rb); } sub setminus { my($ra,$rb) = @_; croak 'Not an array reference' unless (ref($ra) || '') eq 'ARRAY' && (ref($rb) || '') eq 'ARRAY'; return $ra if scalar(@$rb) == 0; my %inb; undef @inb{@$rb}; Mtoset(grep { !exists $inb{$_} } @$ra); } sub setdelta { my($ra,$rb) = @_; croak 'Not an array reference' unless (ref($ra) || '') eq 'ARRAY' && (ref($rb) || '') eq 'ARRAY'; return $ra if scalar(@$rb) == 0; return $rb if scalar(@$ra) == 0; my(%ina, %inb); undef @ina{@$ra}; undef @inb{@$rb}; my @s = grep { !exists $inb{$_} } @$ra; push @s, grep { !exists $ina{$_} } @$rb; Mtoset(@s); } # Can do setminus([$min..$max],\@L) albeit 2x slower sub _setcomplement { my($ra, $min, $max) = @_; croak 'Not an array reference' unless (ref($ra) || '') eq 'ARRAY'; validate_integer($min); validate_integer($max); my %ina; $ina{$_} = undef for @$ra; my @s; if ((ref($min) && !ref($max)) || (!ref($min) && ref($max))) { while ($min <= $max) { push @s, $min unless exists $ina{$min}; $min = Madd1int($min); } } else { while ($min <= $max) { push @s, $min unless exists $ina{$min}; $min++; } } @s; } sub toset { my(@list) = @_; validate_integer($_) for @list; return \@list if scalar(@list) <= 1; my($k,%seen); @list = grep { not $seen{$k = $_}++; } @list; Mvecsorti(\@list); } # Is the second set a subset of the first set? sub setcontains { my $set = shift @_; my $iset; if (@_ == 1 && ref($_[0]) eq 'ARRAY') { $iset = $_[0]; } else { $iset = Mtoset(@_); } return 1 if @$iset == 0; return 0 if @$set == 0 || @$iset > @$set || $iset->[-1] > $set->[-1] || $iset->[0] < $set->[0]; if (@$set <= 150 || (@$set <= 250 && @$iset > 2)) { # Linear search my $i = 0; for my $sv (@$set) { if ($sv >= $iset->[$i]) { return 0 if $sv > $iset->[$i]; return 1 if $i == $#$iset; $i++; } } return 0; } my $newlo = 0; # The next value is probably in this range. Can save a lot of steps. my $range = Mcdivint(scalar(@$set),(scalar(@$iset)+1) >> 1); for my $v (@$iset) { my($lo,$hi) = ($newlo,$#$set); $hi = $lo + $range if $hi-$lo > $range && $set->[$lo+$range] >= $v; while ($lo < $hi) { my $mid = $lo + (($hi-$lo) >> 1); if ($set->[$mid] < $v) { $lo = $mid+1; } else { $hi = $mid; } } return 0 if $set->[$hi] != $v; $newlo = $hi+1; } 1; } sub setcontainsany { my($set,@in) = @_; my $iset; if (@in == 1 && ref($in[0]) eq 'ARRAY') { $iset = $in[0]; } else { $iset = \@in; } # For better performance, make iset the larger ($set,$iset) = ($iset,$set) if scalar(@$set) > scalar(@$iset); return 0 if @$set == 0; my %ina; undef @ina{@$set}; for (@$iset) { return 1 if exists $ina{$_} } return 0; } sub _setinsert1 { # UNUSED my($rset, $v) = @_; validate_integer($v); if (scalar(@$rset) == 0 || $v > $rset->[-1]) { push @$rset, $v; } elsif ($v < $rset->[0]) { unshift @$rset, $v; } elsif (scalar(@$rset) > 1) { my($lo,$hi) = (0,$#$rset); while ($lo < $hi) { my $mid = $lo + (($hi-$lo) >> 1); if ($rset->[$mid] < $v) { $lo = $mid+1; } else { $hi = $mid; } } return 0 if $rset->[$hi] == $v; croak "internal too high" if $hi > 0 && $rset->[$hi-1] >= $v; croak "internal too low" if $rset->[$hi] <= $v; splice @$rset, $hi, 0, $v; } else { return 0; # Single element already in list. } 1; } sub setinsert { my($set, @in) = @_; my $iset; if (@in == 1 && ref($in[0]) eq 'ARRAY') { $iset = $in[0]; } else { $iset = Mtoset(@in); } return 0 if @$iset == 0; my $setsize = scalar(@$set); if ($setsize == 0 || $iset->[0] > $set->[-1]) { push @$set, @$iset; } elsif ($iset->[-1] < $set->[0]) { unshift @$set, @$iset; } elsif (@$iset > 400) { # $set is required to be in proper form as input. # @newset was run through toset() earlier, so it is in proper form. # Times from the 20x50k insert operation in xt/test-sets. # 17.09 In theory efficient, but too much redundant work #@$set = @{Msetunion($set,$iset)}; # 12.48 Better but still ignores all input structure #@$set = @{Mtoset([@$set,@$iset])}; # 6.04 toset inlined and with all unnecessary work removed #my($k,%seen); #@$set = grep { not $seen{$k=$_}++ } @$set,@$iset; #if ($] < 5.026) { @$set = sort { 0+($a<=>$b) } @$set; } #else { @$set = sort { $a<=>$b } @$set; } # 5.64 as above but assume $set has no duplicates #my($k,%seen); #undef @seen{@$set}; #push @$set, grep { !exists $seen{$k=$_} } @$iset; #if ($] < 5.026) { @$set = sort { 0+($a<=>$b) } @$set; } #else { @$set = sort { $a<=>$b } @$set; } # 4.12 Merge two proper-form sets _merge_sets_inplace($set, $iset); } else { # 1. values in front and back. my($nbeg,$nend) = (0,0); my(@sbeg,@send); $nend++ while $nend < scalar(@$iset) && $iset->[-1 - $nend] > $set->[-1]; @send = splice(@$iset,-$nend) if $nend > 0; $nbeg++ while $nbeg < scalar(@$iset) && $iset->[$nbeg] < $set->[0]; @sbeg = splice(@$iset,0,$nbeg) if $nbeg > 0; # 2. values in the middle. my $start = 0; my $range = Mcdivint(scalar(@$set),(scalar(@$iset)+2) >> 1); for my $v (@$iset) { my($lo,$hi) = ($start,$#$set); $hi = $lo + $range if $hi-$lo > $range && $set->[$lo+$range] >= $v; while ($lo < $hi) { my $mid = $lo + (($hi-$lo) >> 1); if ($set->[$mid] < $v) { $lo = $mid+1; } else { $hi = $mid; } } splice @$set, $hi, 0, $v if $set->[$hi] != $v; $start = $hi+1; } # 3. bulk insert the front and back values we saved earlier unshift @$set, @sbeg if @sbeg; push @$set, @send if @send; } return scalar(@$set) - $setsize; } sub _setremove1 { my($rset, $v) = @_; #validate_integer($v); return 0 if scalar(@$rset) == 0 || $v > $rset->[-1] || $v < $rset->[0]; my($lo,$hi) = (0,$#$rset); while ($lo < $hi) { my $mid = $lo + (($hi-$lo) >> 1); if ($rset->[$mid] < $v) { $lo = $mid+1; } else { $hi = $mid; } } return 0 if $rset->[$hi] != $v; splice @$rset, $hi, 1; 1; } sub setremove { my $set = shift; my $iset; if (@_ == 1 && ref($_[0]) eq 'ARRAY') { $iset = $_[0]; } else { $iset = Mtoset(@_); } my $setsize = scalar(@$set); return 0 if $setsize == 0 || @$iset == 0; my($SMIN,$SMAX) = ($set->[0],$set->[-1]); pop @$iset while @$iset && $iset->[-1] > $SMAX; shift @$iset while @$iset && $iset->[0] < $SMIN; # Try to decide the most performant of the two methods. my $fitmin = $setsize < 170 ? 1 + ($setsize>=35) + int($setsize/30) : $setsize < 75000 ? int(2.7*sqrt($setsize)-28) : 700; if (@$iset <= $fitmin) { _setremove1($set,$_) for @$iset; } else { my(%remove, $k); $remove{$k=$_}=undef for @$iset; my $remsize = scalar(keys(%remove)); return 0 if $remsize == 0; @$set = grep { !exists $remove{$k=$_} } @$set; } return $setsize - scalar(@$set); } sub _setinvert1 { my($rset, $v) = @_; # No validate here. if (scalar(@$rset) == 0 || $v > $rset->[-1]) { push @$rset, $v; } elsif ($v < $rset->[0]) { unshift @$rset, $v; } else { my($lo,$hi) = (0,$#$rset); while ($lo < $hi) { my $mid = $lo + (($hi-$lo) >> 1); if ($rset->[$mid] < $v) { $lo = $mid+1; } else { $hi = $mid; } } if ($rset->[$hi] == $v) { splice @$rset, $hi, 1; return -1; } splice @$rset, $hi, 0, $v; } 1; } sub setinvert { my($set, @in) = @_; return 0 if @in == 0; my $iset; if (@in == 1 && ref($in[0]) eq 'ARRAY') { $iset = $in[0]; } else { $iset = Mtoset(@in); } my $setsize = scalar(@$set); if ($setsize == 0) { @$set = @$iset; return scalar(@$set); } # Like setinsert and setremove, we assume the input set is in set form. if (@$iset <= 100) { _setinvert1($set,$_) for @$iset; } else { my @S; for my $sv (@$set) { push @S, shift @$iset while @$iset && $iset->[0] < $sv; if (@$iset && $iset->[0] == $sv) { shift @$iset; } else { push @S, $sv; } } push @S, @$iset; @$set = @S; } return scalar(@$set) - $setsize; } # For these set_is_ functions, the inputs can be unordered but no duplicates. sub set_is_disjoint { my($s,$t) = @_; croak 'Not an array reference' unless (ref($s) || '') eq 'ARRAY' && (ref($t) || '') eq 'ARRAY'; ($s,$t) = ($t,$s) if scalar(@$s) > scalar(@$t); return 1 if @$s == 0 || @$t == 0; my($k,%ins); $ins{$k=$_}=undef for @$s; for my $v (@$t) { return 0 if exists $ins{$k=$v} } 1; } sub set_is_equal { my($s,$t) = @_; croak 'Not an array reference' unless (ref($s) || '') eq 'ARRAY' && (ref($t) || '') eq 'ARRAY'; return 0 unless @$s == @$t; my %ins; $ins{$_} = 0 for @$s; for my $v (@$t) { return 0 unless exists $ins{$v}; $ins{$v}++; } for (values %ins) { return 0 unless $_ } 1; } sub set_is_subset { my($s,$t) = @_; croak 'Not an array reference' unless (ref($s) || '') eq 'ARRAY' && (ref($t) || '') eq 'ARRAY'; return 1 if @$t == 0; return 0 if @$s < @$t; my %ins; undef @ins{@$s}; for my $v (@$t) { return 0 unless exists $ins{$v} } 1; } sub set_is_proper_subset { my($s,$t) = @_; croak 'Not an array reference' unless (ref($s) || '') eq 'ARRAY' && (ref($t) || '') eq 'ARRAY'; return 0 if @$s <= @$t; set_is_subset($s,$t); } sub set_is_superset { set_is_subset($_[1],$_[0]); } sub set_is_proper_superset { set_is_proper_subset($_[1],$_[0]); } sub set_is_proper_intersection { my($s,$t) = @_; croak 'Not an array reference' unless (ref($s) || '') eq 'ARRAY' && (ref($t) || '') eq 'ARRAY'; my $minsize = (scalar(@$s) < scalar(@$t)) ? scalar(@$s) : scalar(@$t); my $intersize = scalar(@{Msetintersect($s,$t)}); return ($intersize > 0 && $intersize < $minsize) ? 1 : 0; } sub is_sidon_set { my($ra) = @_; croak 'Not an array reference' unless (ref($ra) || '') eq 'ARRAY'; my %sums; my @S = @{Mtoset(@$ra)}; # Validated, sorted, deduped. while (@S) { my $x = pop @S; return 0 if $x < 0; for my $y ($x, @S) { my $s = Maddint($x, $y); return 0 if exists $sums{$s}; $sums{$s} = undef; } } 1; } sub is_sumfree_set { my($ra) = @_; croak 'Not an array reference' unless (ref($ra) || '') eq 'ARRAY'; my %ina; my @S = @{Mtoset(@$ra)}; # Validated, sorted, deduped. $ina{$_}=undef for @S; while (@S) { my $x = pop @S; for my $y ($x, @S) { return 0 if exists $ina{Maddint($x,$y)}; } } 1; } ############################################################################### sub foralmostprimes { my($sub, $k, $lo, $hi) = @_; validate_integer_nonneg($k); return if $k == 0; if (defined $hi) { validate_integer_nonneg($lo); } else { ($lo,$hi) = (1, $lo); } validate_integer_nonneg($hi); $lo = Mvecmax($lo, Mpowint(2, $k)); return if $lo > $hi; #return Math::Prime::Util::forprimes($sub,$lo,$hi) if $k == 1; my $estcount = almost_prime_count_approx($k,$hi) - almost_prime_count_approx($k,$lo); my $nsegs = "$estcount" / 1e6; my $len = Madd1int(Msubint($hi,$lo)); my $segsize = ($nsegs <= 1.1) ? $len : int("$len"/$nsegs); if ($segsize < 5*1e6) { $segsize = 5e6; } # warn " estcount $estcount nsegs $nsegs segsize $segsize\n"; my $oldforexit = Math::Prime::Util::_start_for_loop(); while ($lo <= $hi) { my $seghi = Mvecmin($hi, Maddint($lo,$segsize)-1); my $ap = Math::Prime::Util::almost_primes($k, $lo, $seghi); #my $ap = []; _genkap($lo, $seghi, $k, 1, 2, sub { push @$ap,$_[0]; }); # warn " from $lo to $seghi found ",scalar(@$ap), " $k-almost-primes\n"; { my $pp; local *_ = \$pp; for my $kap (@$ap) { $pp = $kap; $sub->(); last if Math::Prime::Util::_get_forexit(); } } $lo = Madd1int($seghi); last if Math::Prime::Util::_get_forexit(); } Math::Prime::Util::_end_for_loop($oldforexit); } ############################################################################### # 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); return _frombinary( substr(unpack("B*",$bytes),0,$n) ); } sub urandomm { my($n) = @_; # validate_integer_nonneg($n); return 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 $rmin = (4294967295 - ($n-1)) % $n; do { $r = Math::Prime::Util::irand(); } while $r < $rmin; } elsif (!ref($n)) { my $rmin = (~0 - ($n-1)) % $n; do { $r = Math::Prime::Util::irand64(); } while $r < $rmin; } else { # TODO: verify and try to optimize this my $bytes = 1 + length(todigitstring($n,16)); my $rmax = Msub1int(Mpowint(2,$bytes*8)); my $overflow = $rmax - ($rmax % $n); do { $r = Murandomb($bytes*8); } while $r >= $overflow; } return $r % $n; } sub random_prime { my($low, $high) = @_; if (scalar(@_) == 1) { ($low,$high) = (2,$low); } else { validate_integer_nonneg($low); } validate_integer_nonneg($high); return 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_integer_nonneg($digits); croak "random_ndigit_prime digits must be >= 1" unless $digits >= 1; return reftyped($_[0], Math::Prime::Util::GMP::random_ndigit_prime($digits)) if $Math::Prime::Util::_GMPfunc{"random_ndigit_prime"} && !getconfig()->{'nobigint'}; require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_ndigit_prime($digits); } sub random_nbit_prime { my($bits) = @_; validate_integer_nonneg($bits); croak "random_nbit_prime bits must be >= 2" unless $bits >= 2; return 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_safe_prime { my($bits) = @_; validate_integer_nonneg($bits); croak "random_safe_prime bits must be >= 3" unless $bits >= 3; return reftyped($_[0], eval "Math::Prime::Util::GMP::random_safe_prime($bits)") ## no critic qw(ProhibitStringyEval) if $Math::Prime::Util::_GMPfunc{"random_safe_prime"}; require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_safe_prime($bits); } sub random_strong_prime { my($bits) = @_; validate_integer_nonneg($bits); croak "random_strong_prime bits must be >= 128" unless $bits >= 128; return reftyped($_[0], eval "Math::Prime::Util::GMP::random_strong_prime($bits)") ## no critic qw(ProhibitStringyEval) if $Math::Prime::Util::_GMPfunc{"random_strong_prime"}; require Math::Prime::Util::RandomPrimes; return Math::Prime::Util::RandomPrimes::random_strong_prime($bits); } sub random_proven_prime { random_maurer_prime(@_); } sub random_maurer_prime { my($bits) = @_; validate_integer_nonneg($bits); croak "random_maurer_prime bits must be >= 2" unless $bits >= 2; return 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_integer_nonneg($bits); croak "random_shawe_taylor_prime bits must be >= 2" unless $bits >= 2; return 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_integer($n); if (scalar(@_) == 1 ) { $k = 1; } else { validate_integer_nonneg($k); } return 0 if $n < 2; 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); } # getconfig()->{'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, Murandomm($brange)+2 ); $k--; while ($k > 0) { my $nbases = ($k >= 20) ? 20 : $k; return 0 unless is_strong_pseudoprime($n, map { Murandomm($brange)+2 } 1 .. $nbases); $k -= $nbases; } 1; } sub random_semiprime { my($b) = @_; validate_integer_nonneg($b); croak "random_semiprime bits must be >= 4" unless $b >= 4; my $n; my $min = Mpowint(2,$b-1); my $max = $min + ($min - 1); my $L = $b >> 1; my $N = $b - $L; do { $n = Mmulint(random_nbit_prime($L), random_nbit_prime($N)); } while $n < $min || $n > $max; $n; } sub random_unrestricted_semiprime { my($b) = @_; validate_integer_nonneg($b); croak "random_unrestricted_semiprime bits must be >= 3" unless $b >= 3; my $n; my $min = Mpowint(2,$b-1); my $max = Maddint($min, $min - 1); if ($b <= MPU_MAXBITS) { do { $n = $min + Murandomb($b-1); } while !Mis_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..113,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; my $a; if ($r <= 3.54) { # result under 10^15, can do directly $a = int( exp(exp($r)) + 0.5 ); } elsif ($Math::Prime::Util::_GMPfunc{"expreal"}) { # Use our fast arbitrary precision expreal. my $digits = $r < 4.45 ? 40 : int(exp($r)/2.2 + 2); # overestimate my $re = Math::Prime::Util::GMP::expreal($r,$digits); $a = Math::Prime::Util::GMP::expreal($re,$digits); $a = Mtoint($a); #_upgrade_to_float($a)->as_int; } else { # exp(x)=exp(x/n)^n # We could use Math::BigFloat but it's sooooooooooo slow. my $re = exp($r); my $redd = 1+int($re/34.5); $a = Mpowint(int(exp($re/$redd)+0.5), $redd); } $p = $a < 2 ? 2 : Mprev_prime($a+1); } my $ranmin = Mcdivint($min, $p); my $ranmax = Mdivint($max, $p); my $q = random_prime($ranmin, $ranmax); $n = Mmulint($p,$q); } $n; } sub random_factored_integer { my($n) = @_; validate_integer_positive($n); while (1) { my @S = ($n); # make s_i chain push @S, 1 + Murandomm($S[-1]) while $S[-1] > 1; # first is n, last is 1 @S = grep { Mis_prime($_) } @S[1 .. $#S-1]; my $r = Mvecprod(@S); return ($r, [@S]) if $r <= $n && (1+Murandomm($n)) <= $r; } } ################################################################################ sub prime_precalc { my($n) = @_; croak "Parameter '$n' must be a non-negative integer" unless _is_nonneg_int($n); _expand_prime_cache($n); } my @_free_subs; sub _register_free_sub { push @_free_subs, shift; } sub prime_memfree { # Make the internal callbacks that reset cached data. $_->() for @_free_subs; # Call GMP's free if we have it 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; } 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.74 =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. All routines should work with native integers or multi-precision numbers. To enable big numbers, use bigint: use bigint; say prime_count_approx(1000000000000000000000000); # says 18435599767347541878147 Or string inputs: say prime_count_approx("1000000000000000000000000"); # identical output. Some functions will be very slow. L has much faster versions of many of these functions. Alternately, L has a lot of these types of functions. =head1 LIMITATIONS The SQUFOF and P+1 factoring algorithms are not implemented yet. =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 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 other pure Perl sieves, but it 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-2026 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.74/lib/Math/Prime/Util/PrimalityProving.pm000644 000765 000024 00000076257 15152504242 023716 0ustar00danastaff000000 000000 package 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 lucasvmod kronecker is_power factor prime_get_config /; BEGIN { $Math::Prime::Util::PrimalityProving::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::PrimalityProving::VERSION = '0.74'; } BEGIN { do { require Math::BigInt; Math::BigInt->import(try=>"GMP,GMPz,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{$_}") } @_; } # is_power(n,2) 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) # kronecker(n,m) 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 lucasvmod($lp, $lq, $m/2, $n) != 0; return _pfail "BLS15: $n failed V_{(N+1)/2} mod N == 0" unless lucasvmod($lp, $lq, ($n+1)/2, $n) == 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.74 =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.74/lib/Math/Prime/Util/ZetaBigFloat.pm000644 000765 000024 00000065577 15152504277 022725 0ustar00danastaff000000 000000 package Math::Prime::Util::ZetaBigFloat; use strict; use warnings; BEGIN { $Math::Prime::Util::ZetaBigFloat::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::ZetaBigFloat::VERSION = '0.74'; } BEGIN { do { require Math::BigInt; Math::BigInt->import(try=>"GMP,GMPz,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.74 =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.74/lib/Math/Prime/Util/MemFree.pm000644 000765 000024 00000004115 15151073457 021707 0ustar00danastaff000000 000000 package Math::Prime::Util::MemFree; use strict; use warnings; BEGIN { $Math::Prime::Util::MemFree::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::MemFree::VERSION = '0.74'; } 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.74 =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.74/lib/Math/Prime/Util/PrimeArray.pm000644 000765 000024 00000030703 15151073547 022444 0ustar00danastaff000000 000000 package Math::Prime::Util::PrimeArray; use strict; use warnings; BEGIN { $Math::Prime::Util::PrimeArray::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::PrimeArray::VERSION = '0.74'; } # 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 Math::Prime::Util::MemFree; use Tie::Array; use Carp qw/carp croak confess/; use constant SEGMENT_SIZE => 80_000; use constant HALFSEG => SEGMENT_SIZE >> 1; 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 $prlen = scalar @{$self->{PRIMES}}; # Keep up to HALFSEG elements from the previous array if ($prlen > HALFSEG) { @{$self->{PRIMES}} = @{$self->{PRIMES}}[-(HALFSEG) .. -1]; $begidx += $prlen - HALFSEG; } # Add HALFSEG elements to the end my $end_prime = nth_prime_upper($index + HALFSEG); push @{$self->{PRIMES}}, @{primes($self->{PRIMES}->[-1]+1, $end_prime)}; } 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 $prlen = scalar @{$self->{PRIMES}}; my $beg_prime = $index <= HALFSEG ? 2 : nth_prime_lower($index - HALFSEG); unshift @{$self->{PRIMES}}, @{primes($beg_prime, $self->{PRIMES}->[0]-1)}; my $prnewlen = scalar @{$self->{PRIMES}}; $begidx -= $prnewlen - $prlen; $#{$self->{PRIMES}} = SEGMENT_SIZE-1 if $prnewlen > SEGMENT_SIZE; } else { $begidx--; unshift @{$self->{PRIMES}}, prev_prime($self->{PRIMES}->[0]); } } else { # Random access $self->{ACCESS_TYPE} = int($self->{ACCESS_TYPE} / 2); # TODO: we are destroying the primes array, just to get $begidx set. # We should instead have an additional single last-index-result. # return nth_prime($index+1); $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.74 =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 Performance of tied arrays increased substantially (40% faster) between Perl v5.18 and 5.24. It is recommended to use a new-ish Perl. 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. M1 Macbook, Perl 5.42.0, Math::NumSeq v75, Math::Prime::TiedArray v0.04 with C, List::Gen 0.979. Summing the first 0.1M primes via walking the array (milliseconds): .05 56k Math::Prime::Util sumprimes 1.7 56k Math::Prime::Util forprimes 1.6 4 MB Math::Prime::Util sum big array 12 0 Math::Prime::Util prime_iterator 31 3 MB MPU::PrimeArray using FETCH 41 3 MB MPU::PrimeArray array 63 6 MB List::Gen sequence 51 950k Math::NumSeq::Primes sequence iterator 2367ms 78 MB Math::Prime::TiedArray (extend 1k) Summing the first 1M primes via walking the array (seconds): .0003 268k Math::Prime::Util sumprimes .018 268k Math::Prime::Util forprimes .015 41 MB Math::Prime::Util sum big array 0.11 0 Math::Prime::Util prime_iterator 0.3 644k MPU::PrimeArray using FETCH 0.4 644k MPU::PrimeArray array 0.8 57 MB List::Gen sequence 4.3 3179k Math::NumSeq::Primes sequence iterator 35.9s 722 MB Math::Prime::TiedArray (extend 1k) Summing the first 10M primes via walking the array (seconds): 0.0015 432k Math::Prime::Util sumprimes 0.19 432k Math::Prime::Util forprimes 0.16 394 MB Math::Prime::Util sum big array 1.2 0 Math::Prime::Util prime_iterator 3.0 772k MPU::PrimeArray using FETCH 4.0 772k MPU::PrimeArray array 8.3s 652 MB List::Gen sequence 577 22.8MB Math::NumSeq::Primes sequence iterator >5000 MB Math::Prime::TiedArray (extend 1k) L offers four obvious solutions: the C function, summing a big generated 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. The C construct is both fast and low memory, but it isn't quite as flexible as the iterator. 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. Version 0.975 will use this module for primes if it can, which is shown in the above numbers. It is the odd module out in this comparison, as primes aren't a core feature. Without this module, it is very slow. 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-2026 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.74/lib/Math/Prime/Util/RandomPrimes.pm000644 000765 000024 00000122064 15152504265 022770 0ustar00danastaff000000 000000 package 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_pseudoprime is_strong_pseudoprime is_extra_strong_lucas_pseudoprime next_prime prev_prime urandomb urandomm random_bytes addint subint add1int sub1int logint modint cmpint mulint divint powint modint lshiftint rshiftint sqrtint cdivint powmod invmod vecsum vecprod gcd is_odd fromdigits /; BEGIN { $Math::Prime::Util::RandomPrimes::AUTHORITY = 'cpan:DANAJ'; $Math::Prime::Util::RandomPrimes::VERSION = '0.74'; } BEGIN { # TODO: remove this when everything uses tobigint do { require Math::BigInt; Math::BigInt->import(try=>"GMP,GMPz,LTM,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; *tobigint = \&Math::Prime::Util::_to_bigint; *maybetobigint = \&Math::Prime::Util::_to_bigint_if_needed; } ################################################################################ # 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; } my $biclass = prime_get_config()->{'bigintclass'}; if (defined $biclass && $biclass =~ /^Math::GMP/) { $_big_gcd_use = 1; } elsif (Math::BigInt->config()->{lib} !~ /^Math::BigInt::(GMP|Pari)/) { $_big_gcd_use = 0; return; } $_big_gcd_use = 1; my($p0,$p1,$p2,$p3) = map { primorial($_) } (520,2052,6028,$_big_gcd_top); $_big_gcd[0] = divint($p0,223092870); $_big_gcd[1] = divint($p1,$p0); $_big_gcd[2] = divint($p2,$p1); $_big_gcd[3] = divint($p3,$p2); } ################################################################################ ################################################################################ # 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. $low = tobigint($low) if ref($high); 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)) { my $nbins = cdivint($oddrange, $rand_part_size); $binsize = cdivint($oddrange, $nbins); $nparts = divint($oddrange, $binsize); $low = tobigint($low) unless ref($low); } 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 = addint($low,vecprod(2,$binsize,$rpart)); my $partsize = ($rpart < $nparts) ? $binsize : $oddrange - ($nparts * $binsize); $partsize = _bigint_to_int($partsize) if ref($partsize); #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)) { 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 = modint($primelow, 30); # 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 gcd($prime,7436429) == 1; if ($_big_gcd_use && $prime > $_big_gcd_top) { next unless gcd($prime, $_big_gcd[0]) == 1; next unless gcd($prime, $_big_gcd[1]) == 1; next unless gcd($prime, $_big_gcd[2]) == 1; next unless gcd($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 bit. Not used in current code path. my @_random_nbit_ranges = (undef, undef, [2,3],[5,7] ); # For fixed small ranges with XS, e.g. 6-digit, 18-bit # mpu 'say join ",",map {($b,$e)=(next_prime(powint(10,$_-1)),prev_prime(powint(10,$_))); $s=prime_count($b); $c=prime_count($b,$e); "[$s,$c]";} 1..8' my $_d_digits = [undef,[1,4],[5,21],[26,143],[169,1061],[1230,8363],[9593,68906],[78499,586081],[664580,5096876]]; # mpu 'say join ",",map {($b,$e)=(next_prime(powint(2,$_-1)),prev_prime(powint(2,$_))); $s=prime_count($b); $c=prime_count($b,$e); "[$s,$c]";} 2..24' my $_d_bits = [undef,undef,[2,1],[3,2],[5,2],[7,5],[12,7],[19,13],[32,23],[55,43],[98,75],[173,137],[310,255],[565,464],[1029,872],[1901,1612],[3513,3030],[6543,5709],[12252,10749],[23001,20390],[43391,38635],[82026,73586],[155612,140336],[295948,268216],[564164,513708]]; sub _random_xscount_prime { my($n, $data) = @_; my $dv = $data->[$n]; croak "bad xscount data: $n" unless defined $dv; return nth_prime($dv->[0] + urandomm($dv->[1])); } my @_digit_loprime = qw/0 2 11 101 1009 10007 100003 1000003 10000019 100000007 1000000007 10000000019 100000000003 1000000000039 10000000000037 100000000000031 1000000000000037 10000000000000061 100000000000000003 1000000000000000003 10000000000000000051/; my @_digit_hiprime = qw/0 7 97 997 9973 99991 999983 9999991 99999989 999999937 9999999967 99999999977 999999999989 9999999999971 99999999999973 999999999999989 9999999999999937 99999999999999997 999999999999999989 9999999999999999961 99999999999999999989/; my $_max_native_prime = MPU_32BIT ? 4294967291 : 18446744073709551557; sub random_prime { my($low,$high) = @_; return undef 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 undef if $low >= $high; # At this point low and high are both primes, and low < high. } # At this point low and high are both odds, and low < high. return $_random_prime->($low, $high); } sub random_ndigit_prime { my($D) = @_; croak "random_ndigit_prime, digits must be >= 1" unless $D >= 1; return _random_xscount_prime($D,$_d_digits) if $D <= 6 && MPU_USE_XS; $_digit_loprime[$D] = powint(10,$D-1)+1 unless defined $_digit_loprime[$D]; $_digit_hiprime[$D] = powint(10,$D)-1 unless defined $_digit_hiprime[$D]; my($lo,$hi) = map { $_ >= ~0 && !ref($_) ? addint($_,0) : $_ } ($_digit_loprime[$D], $_digit_hiprime[$D]); if ($D >= MPU_MAXDIGITS && prime_get_config->{'nobigint'}) { croak "random_ndigit_prime with -nobigint, digits out of range" if $D > MPU_MAXDIGITS; $hi = $_max_native_prime; } return $_random_prime->($lo, $hi); } sub _set_premod { my($arr, $b, $bits, @plist) = @_; my $mod = vecprod(@plist); croak "Bad mod $mod [@plist]" unless $mod <= ~0 && $mod*$plist[-1] < ~0; my($bpremod,$twopremod) = (modint($b,$mod), powmod(2,$bits,$mod)); for my $p (@plist) { # Find the value X where $twopremod * X + $bpremod % $p == 0 $arr->[$p] = (invmod($twopremod,$p) * ($p-$bpremod)) % $p; } } sub _get_premod { my($b, $bits, @plist) = @_; my @premod; my($fn,$fp,$bn) = MPU_32BIT ? (8,23,3) : (14,47,5); # Do one initial mod with first $fn primes, then batches of $bn primes. _set_premod(\@premod, $b, $bits, splice(@plist,0,$fn)) if @plist >= $fn && $plist[$fn-1] <= $fp; _set_premod(\@premod, $b, $bits, splice(@plist,0,$bn)) while @plist; @premod; } 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 <= 19 && 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($bits,$_d_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 > MPU_MAXBITS) { 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 $lbits = $bits - $l - 1; my $brand = urandomb($bits-$l-2); my $b = add1int(lshiftint($brand)); # Precalculate some modulii so we can do trial division on native int my @PM = _get_premod($b, $lbits, 3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89); _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 = addint((1 << $l),urandomb($l)); # $a % s == $PM[s] => $p % s == 0 => p will be composite next if $a % 3 == $PM[ 3] || $a % 5 == $PM[ 5] || $a % 7 == $PM[ 7] || $a % 11 == $PM[11] || $a % 13 == $PM[13] || $a % 17 == $PM[17] || $a % 19 == $PM[19] || $a % 23 == $PM[23] || $a % 29 == $PM[29] || $a % 31 == $PM[31] || $a % 37 == $PM[37] || $a % 41 == $PM[41] || $a % 43 == $PM[43] || $a % 47 == $PM[47] || $a % 53 == $PM[53] || $a % 59 == $PM[59] || $a % 61 == $PM[61] || $a % 67 == $PM[67] || $a % 71 == $PM[71] || $a % 73 == $PM[73] || $a % 79 == $PM[79] || $a % 83 == $PM[83] || $a % 89 == $PM[89]; my $p = addint(lshiftint($a,$lbits), $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 { if ($_big_gcd_use && $p > $_big_gcd_top) { next unless gcd($p, $_big_gcd[0]) == 1; next unless gcd($p, $_big_gcd[1]) == 1; next unless gcd($p, $_big_gcd[2]) == 1; next unless gcd($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 = add1int(lshiftint(1,$bits-1)); while ($loop_limit-- > 0) { my $n = addint(lshiftint(urandomb($bits-2)), $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 = powint(2,$bits-1); my $high = powint(2,$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); my $I = divint(powint(2,$k-2),$q); print "r = $r k = $k q = $q I = $I\n" if $verbose && $verbose != 3; $qcert = cmpint($q,"18446744073709551615") <= 0 ? "" : _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 $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 = addint($I, add1int(urandomm($I))); #my $n = 2 * $R * $q + 1; my $nm1 = vecprod(2,$R,$q); my $n = add1int($nm1); # 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 gcd($n, 111546435) == 1; if ($_big_gcd_use && $n > $_big_gcd_top) { next unless gcd($n, $_big_gcd[0]) == 1; next unless gcd($n, $_big_gcd[1]) == 1; next unless gcd($n, $_big_gcd[2]) == 1; next unless gcd($n, $_big_gcd[3]) == 1; } 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 = mulint(2,$R); if (! (is_odd($q) && $q > 2 && $m > 0 && mulint($m,$q) + 1 == $n && mulint(2,$q)+1 > sqrtint($n)) ) { carp "Maurer prime failed BLS75 theorem 3 conditions. Retry."; next; } # Find a suitable a. Move on if one isn't found quickly. foreach my $a (2, 3, 5, 7, 11, 13) { # m/2 = R (n-1)/2 = (2*R*q)/2 = R*q next unless powmod($a, $R, $n) != $nm1; next unless powmod($a, mulint($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 = tobigint(powint(2,$k-1)); # $k2 is a bigint 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 = cmpint($c0,"18446744073709551615") <= 0 ? "" : _strip_proof_header($cert); my $iterations = int(($k + 255) / 256) - 1; # SHA256 generates 256 bits my $old_counter = $prime_gen_counter; my $c02 = lshiftint($c0); # $c02 = 2*$c0 my $xstr = ''; for my $i (0 .. $iterations) { $xstr = Digest::SHA::sha256_hex($seed) . $xstr; $seed = _seed_plus_one($seed); } my $x = fromdigits($xstr,16); $x = $k2 + ($x % $k2); my $t = cdivint($x, $c02); _make_big_gcds() if $_big_gcd_use < 0; while (1) { my $c = add1int(mulint($t,$c02)); if ($c > 2*$k2) { $t = cdivint($k2, $c02); $c = add1int(mulint($t,$c02)); } $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 = gcd($c, 111546435) == 1; if ($looks_prime && $_big_gcd_use && $c > $_big_gcd_top) { $looks_prime = gcd($c, $_big_gcd[0]) == 1 && gcd($c, $_big_gcd[1]) == 1 && gcd($c, $_big_gcd[2]) == 1 && gcd($c, $_big_gcd[3]) == 1; } $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 = fromdigits($astr,16); $a = addint(modint($a,$c-3),2); my $z = powmod($a, lshiftint($t), $c); if (gcd($z-1,$c) == 1 && powmod($z, $c0, $c) == 1) { 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++; } } sub random_safe_prime { my $bits = int("$_[0]"); croak "random_safe_prime, bits must be >= 3" unless $bits >= 3; return (5,7)[urandomb(1)] if $bits == 3; return 11 if $bits == 4; return 23 if $bits == 5; return (47,59)[urandomb(1)] if $bits == 6; return (83,107)[urandomb(1)] if $bits == 7; # Without GMP (e.g. Calc), this can be significantly faster. # With GMP, they are about the same. return _random_safe_prime_large($bits) if $bits > 35; my($p,$q); while (1) { $q = Math::Prime::Util::random_nbit_prime($bits-1); my $qm = modint($q, 1155); # a nice native int next if ($qm % 3) != 2 || ($qm % 5) == 2 || ($qm % 7) == 3 || ($qm % 11) == 5; $p = mulint(2, $q) + 1; # This is sufficient, but we'll do the full test including pre-tests. #last if is_pseudoprime($p,2); # p is prime if q is prime last if is_prob_prime($p); } return $p; } sub _random_safe_prime_large { my $bits = shift; croak "Not enough bits for large random_safe_prime" if $bits <= 35; # Set first and last two bits my $base = addint(lshiftint(1, $bits-1),3); # Fill in lower portion with random bits, leaving 32 upper $base = addint($base, lshiftint(urandomb($bits - 35), 2)); while (1) { my($p,$q,$qmod,$pmod); # 1. generate random nbit p $p = lshiftint(urandomb(32), $bits-33); $p = addint($base, $p); # 2. p = 2q+1 => q = p>>1 $q = rshiftint($p); # 3. Force q mod 6 = 5 $qmod = modint(add1int($q),6); if ($qmod > 0) { $q = subint($q,$qmod); $q = addint($q,12) if 1+logint($q,2) != $bits-1; $p = add1int(lshiftint($q)); } # 4. Fast compositeness pre-tests for q and p $pmod = modint($p, 5*7*11*13*17*19*23*37); next if (($pmod % 5) >> 1) == 0 || (($pmod % 7) >> 1) == 0 || (($pmod % 11) >> 1) == 0 || (($pmod % 13) >> 1) == 0 || (($pmod % 17) >> 1) == 0 || (($pmod % 19) >> 1) == 0 || (($pmod % 23) >> 1) == 0 || (($pmod % 37) >> 1) == 0; $pmod = modint($p, 29*31*41*43*47*53); next if (($pmod % 29) >> 1) == 0 || (($pmod % 31) >> 1) == 0 || (($pmod % 41) >> 1) == 0 || (($pmod % 43) >> 1) == 0 || (($pmod % 47) >> 1) == 0 || (($pmod % 53) >> 1) == 0; $pmod = modint($p, 59*61*67*71*73); next if (($pmod % 59) >> 1) == 0 || (($pmod % 61) >> 1) == 0 || (($pmod % 67) >> 1) == 0 || (($pmod % 71) >> 1) == 0 || (($pmod % 73) >> 1) == 0; # 6. Primality testing on p and q # Use Pocklington's theorem for p, BPSW for q. # If we find an 'a' such that # 1. a^(p-1) = 1 mod p (This is a Fermat test base 'a') # 2. gcd(a^(p-1)/q - 1, p) = 1 => gcd(a^2-1, p) = 1 # then p is prime if q is prime. # Choose a=2. # Then p is prime if: # - q is prime # - p passes a base 2 Fermat test # - p is not divisible by 3 next unless is_pseudoprime($p, 2); # Now strong testing on q. Split in two. next unless is_strong_pseudoprime($q, 2); next unless is_extra_strong_lucas_pseudoprime($q); croak "random safe prime internal failure" unless $p == 2*$q+1; # q passes BPSW, p passes Fermat base 2. p is prime if q is prime. return $p; } } # 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 = ($t >> 1) - 20; my $lpp = $l - 20; while (1) { my $qp = random_nbit_prime($lp); my $qpp = random_nbit_prime($lpp); my $qp2 = mulint(2,$qp); my $qpp2 = mulint(2,$qpp); my $il = cdivint(sub1int(lshiftint(1,$l-1)),$qpp2); my $iu = divint(subint(lshiftint(2,$l),2),$qpp2); my $istart = addint($il, urandomm($iu - $il + 1)); for (my $i = $istart; $i <= $iu; $i=add1int($i)) { # Search for q my $q = add1int(mulint($i,$qpp2)); next unless is_prob_prime($q); my $qqp2 = mulint($q,$qp2); my $pp = sub1int(mulint($qp2, powmod($qp, $q-2, $q))); my $jl = cdivint(subint(lshiftint(1,$t-1),$pp), $qqp2); my $ju = divint(subint(lshiftint(1,$t),$pp+1), $qqp2); my $jstart = addint($jl, urandomm($ju - $jl + 1)); for (my $j = $jstart; $j <= $ju; $j=add1int($j)) { # Search for p my $p = addint($pp, mulint($j,$qqp2)); 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.74 =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_safe_prime Construct a random safe prime of C bits. C must be at least 3. =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-2026 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.74/lib/Math/Prime/Util/ECProjectivePoint.pm000644 000765 000024 00000014637 15152504201 023720 0ustar00danastaff000000 000000 package 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.74'; } BEGIN { do { require Math::BigInt; Math::BigInt->import(try=>"GMP,GMPz,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.74 =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.74/lib/Math/Prime/Util/PPFE.pm000644 000765 000024 00000100652 15152306553 021121 0ustar00danastaff000000 000000 package 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_integer = \&Math::Prime::Util::PP::_validate_integer; *_validate_integer_nonneg = \&Math::Prime::Util::PP::_validate_integer_nonneg; *_validate_integer_positive = \&Math::Prime::Util::PP::_validate_integer_positive; *_validate_integer_abs = \&Math::Prime::Util::PP::_validate_integer_abs; *_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 : $Config{nvsize} == 32 ? 236 : $Config{nvsize} == 16 ? 112 : $Config{nvsize} == 8 ? 52 : $Config{nvsize} == 4 ? 23 : 52; my $nvdigits = int(($nvbits+1) / 3.322); 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; { my $ivsize = $Config{ivsize}; *_ivsize = sub { return $ivsize; }; } { my $uvsize = $Config{uvsize}; *_uvsize = sub { return $uvsize; }; } { my $uvbits = $Config{uvsize}*8; *_uvbits = sub { return $uvbits; }; } { my $nvsize = $Config{nvsize}; *_nvsize = sub { return $nvsize; }; } *_nvmantbits = sub { return $nvbits; }; *_nvmantdigits = sub { return $nvdigits; }; } # These functions all do input validation within the PP code. # Therefore we can send user input straight to them. # The advantage is simplicity and speed for a single user call. # # The disadvantage is that we're doing very expensive PP validation # for each function call within the PP code itself. # Rules of thumb: # if a function is expensive, no harm in validation # if a function is cheap and often called, consider validation here. # TODO: revisit decision for all of these *urandomb = \&Math::Prime::Util::PP::urandomb; *urandomm = \&Math::Prime::Util::PP::urandomm; *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; *inverse_li_nv = \&Math::Prime::Util::PP::inverse_li_nv; *sieve_prime_cluster = \&Math::Prime::Util::PP::sieve_prime_cluster; *sieve_range = \&Math::Prime::Util::PP::sieve_range; *lucky_numbers = \&Math::Prime::Util::PP::lucky_numbers; *powerful_numbers = \&Math::Prime::Util::PP::powerful_numbers; *prime_count = \&Math::Prime::Util::PP::prime_count; *prime_power_count = \&Math::Prime::Util::PP::prime_power_count; *twin_prime_count = \&Math::Prime::Util::PP::twin_prime_count; *semiprime_count = \&Math::Prime::Util::PP::semiprime_count; *almost_prime_count = \&Math::Prime::Util::PP::almost_prime_count; *omega_prime_count = \&Math::Prime::Util::PP::omega_prime_count; *ramanujan_prime_count = \&Math::Prime::Util::PP::ramanujan_prime_count; *lucky_count = \&Math::Prime::Util::PP::lucky_count; *smooth_count = \&Math::Prime::Util::PP::smooth_count; *rough_count = \&Math::Prime::Util::PP::rough_count; *sum_primes = \&Math::Prime::Util::PP::sum_primes; *print_primes = \&Math::Prime::Util::PP::print_primes; *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; *is_pseudoprime = \&Math::Prime::Util::PP::is_pseudoprime; *is_euler_pseudoprime = \&Math::Prime::Util::PP::is_euler_pseudoprime; *is_strong_pseudoprime = \&Math::Prime::Util::PP::is_strong_pseudoprime; *is_euler_plumb_pseudoprime = \&Math::Prime::Util::PP::is_euler_plumb_pseudoprime; *is_perrin_pseudoprime = \&Math::Prime::Util::PP::is_perrin_pseudoprime; *is_cyclic = \&Math::Prime::Util::PP::is_cyclic; *is_carmichael = \&Math::Prime::Util::PP::is_carmichael; *is_quasi_carmichael = \&Math::Prime::Util::PP::is_quasi_carmichael; *is_practical = \&Math::Prime::Util::PP::is_practical; *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_almost_prime = \&Math::Prime::Util::PP::is_almost_prime; *is_chen_prime = \&Math::Prime::Util::PP::is_chen_prime; *is_omega_prime = \&Math::Prime::Util::PP::is_omega_prime; *is_totient = \&Math::Prime::Util::PP::is_totient; *is_square = \&Math::Prime::Util::PP::is_square; *is_prime_power = \&Math::Prime::Util::PP::is_prime_power; *is_lucky = \&Math::Prime::Util::PP::is_lucky; *is_gaussian_prime = \&Math::Prime::Util::PP::is_gaussian_prime; *is_polygonal = \&Math::Prime::Util::PP::is_polygonal; *is_smooth = \&Math::Prime::Util::PP::is_smooth; *is_rough = \&Math::Prime::Util::PP::is_rough; *is_perfect_power = \&Math::Prime::Util::PP::is_perfect_power; *is_powerful = \&Math::Prime::Util::PP::is_powerful; *is_odd = \&Math::Prime::Util::PP::is_odd; *is_even = \&Math::Prime::Util::PP::is_even; *is_divisible = \&Math::Prime::Util::PP::is_divisible; *is_congruent = \&Math::Prime::Util::PP::is_congruent; *is_congruent_number = \&Math::Prime::Util::PP::is_congruent_number; *is_perfect_number = \&Math::Prime::Util::PP::is_perfect_number; *is_delicate_prime = \&Math::Prime::Util::PP::is_delicate_prime; *is_happy = \&Math::Prime::Util::PP::is_happy; *powerful_count = \&Math::Prime::Util::PP::powerful_count; *nth_powerful = \&Math::Prime::Util::PP::nth_powerful; *sumpowerful = \&Math::Prime::Util::PP::sumpowerful; *perfect_power_count = \&Math::Prime::Util::PP::perfect_power_count; *is_power = \&Math::Prime::Util::PP::is_power; *is_square_free = \&Math::Prime::Util::PP::is_square_free; *is_sum_of_squares = \&Math::Prime::Util::PP::is_sum_of_squares; *is_powerfree = \&Math::Prime::Util::PP::is_powerfree; *powerfree_count = \&Math::Prime::Util::PP::powerfree_count; *nth_powerfree = \&Math::Prime::Util::PP::nth_powerfree; *powerfree_sum = \&Math::Prime::Util::PP::powerfree_sum; *powerfree_part = \&Math::Prime::Util::PP::powerfree_part; *powerfree_part_sum = \&Math::Prime::Util::PP::powerfree_part_sum; *squarefree_kernel = \&Math::Prime::Util::PP::squarefree_kernel; # TODO: Should this do validation here? *powersum = \&Math::Prime::Util::PP::powersum; *next_chen_prime = \&Math::Prime::Util::PP::next_chen_prime; *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_safe_prime = \&Math::Prime::Util::PP::random_safe_prime; *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; *next_prime = \&Math::Prime::Util::PP::next_prime; *prev_prime = \&Math::Prime::Util::PP::prev_prime; *next_prime_power = \&Math::Prime::Util::PP::next_prime_power; *prev_prime_power = \&Math::Prime::Util::PP::prev_prime_power; *next_perfect_power = \&Math::Prime::Util::PP::next_perfect_power; *prev_perfect_power = \&Math::Prime::Util::PP::prev_perfect_power; *numtoperm = \&Math::Prime::Util::PP::numtoperm; *permtonum = \&Math::Prime::Util::PP::permtonum; *randperm = \&Math::Prime::Util::PP::randperm; *shuffle = \&Math::Prime::Util::PP::shuffle; *lcm = \&Math::Prime::Util::PP::lcm; *gcdext = \&Math::Prime::Util::PP::gcdext; *prime_bigomega = \&Math::Prime::Util::PP::prime_bigomega; *prime_omega = \&Math::Prime::Util::PP::prime_omega; *moebius = \&Math::Prime::Util::PP::moebius; *euler_phi = \&Math::Prime::Util::PP::euler_phi; *inverse_totient = \&Math::Prime::Util::PP::inverse_totient; *divisor_sum = \&Math::Prime::Util::PP::divisor_sum; *sumtotient = \&Math::Prime::Util::PP::sumtotient; *jordan_totient = \&Math::Prime::Util::PP::jordan_totient; *ramanujan_sum = \&Math::Prime::Util::PP::ramanujan_sum; *mertens = \&Math::Prime::Util::PP::mertens; *valuation = \&Math::Prime::Util::PP::valuation; *hammingweight = \&Math::Prime::Util::PP::hammingweight; *chinese = \&Math::Prime::Util::PP::chinese; *chinese2 = \&Math::Prime::Util::PP::chinese2; *cornacchia = \&Math::Prime::Util::PP::cornacchia; *primorial = \&Math::Prime::Util::PP::primorial; *pn_primorial = \&Math::Prime::Util::PP::pn_primorial; *divisors = \&Math::Prime::Util::PP::divisors; *partitions = \&Math::Prime::Util::PP::partitions; *consecutive_integer_lcm = \&Math::Prime::Util::PP::consecutive_integer_lcm; *carmichael_lambda = \&Math::Prime::Util::PP::carmichael_lambda; *exp_mangoldt = \&Math::Prime::Util::PP::exp_mangoldt; *liouville = \&Math::Prime::Util::PP::liouville; *sumliouville = \&Math::Prime::Util::PP::sumliouville; *frobenius_number = \&Math::Prime::Util::PP::frobenius_number; *binomial = \&Math::Prime::Util::PP::binomial; *subfactorial = \&Math::Prime::Util::PP::subfactorial; *fubini = \&Math::Prime::Util::PP::fubini; *falling_factorial = \&Math::Prime::Util::PP::falling_factorial; *rising_factorial = \&Math::Prime::Util::PP::rising_factorial; *chebyshev_theta = \&Math::Prime::Util::PP::chebyshev_theta; *chebyshev_psi = \&Math::Prime::Util::PP::chebyshev_psi; *hclassno = \&Math::Prime::Util::PP::hclassno; *ramanujan_tau = \&Math::Prime::Util::PP::ramanujan_tau; *legendre_phi = \&Math::Prime::Util::PP::legendre_phi; *bernfrac = \&Math::Prime::Util::PP::bernfrac; *harmfrac = \&Math::Prime::Util::PP::harmfrac; *contfrac = \&Math::Prime::Util::PP::contfrac; *from_contfrac = \&Math::Prime::Util::PP::from_contfrac; *next_calkin_wilf = \&Math::Prime::Util::PP::next_calkin_wilf; *next_stern_brocot = \&Math::Prime::Util::PP::next_stern_brocot; *calkin_wilf_n = \&Math::Prime::Util::PP::calkin_wilf_n; *stern_brocot_n = \&Math::Prime::Util::PP::stern_brocot_n; *nth_calkin_wilf = \&Math::Prime::Util::PP::nth_calkin_wilf; *nth_stern_brocot = \&Math::Prime::Util::PP::nth_stern_brocot; *nth_stern_diatomic = \&Math::Prime::Util::PP::nth_stern_diatomic; *farey = \&Math::Prime::Util::PP::farey; *next_farey = \&Math::Prime::Util::PP::next_farey; *farey_rank = \&Math::Prime::Util::PP::farey_rank; *addint = \&Math::Prime::Util::PP::addint; *subint = \&Math::Prime::Util::PP::subint; *add1int = \&Math::Prime::Util::PP::add1int; *sub1int = \&Math::Prime::Util::PP::sub1int; *lshiftint = \&Math::Prime::Util::PP::lshiftint; *rshiftint = \&Math::Prime::Util::PP::rshiftint; *rashiftint = \&Math::Prime::Util::PP::rashiftint; *mulint = \&Math::Prime::Util::PP::mulint; *powint = \&Math::Prime::Util::PP::powint; *divint = \&Math::Prime::Util::PP::divint; *modint = \&Math::Prime::Util::PP::modint; *cdivint = \&Math::Prime::Util::PP::cdivint; *divrem = \&Math::Prime::Util::PP::divrem; *tdivrem = \&Math::Prime::Util::PP::tdivrem; *fdivrem = \&Math::Prime::Util::PP::fdivrem; *cdivrem = \&Math::Prime::Util::PP::cdivrem; *absint = \&Math::Prime::Util::PP::absint; *negint = \&Math::Prime::Util::PP::negint; *signint = \&Math::Prime::Util::PP::signint; *cmpint = \&Math::Prime::Util::PP::cmpint; *sqrtint = \&Math::Prime::Util::PP::sqrtint; *rootint = \&Math::Prime::Util::PP::rootint; *logint = \&Math::Prime::Util::PP::logint; *negmod = \&Math::Prime::Util::PP::negmod; *sqrtmod = \&Math::Prime::Util::PP::sqrtmod; *allsqrtmod = \&Math::Prime::Util::PP::allsqrtmod; *rootmod = \&Math::Prime::Util::PP::rootmod; *allrootmod = \&Math::Prime::Util::PP::allrootmod; *factorialmod = \&Math::Prime::Util::PP::factorialmod; *binomialmod = \&Math::Prime::Util::PP::binomialmod; *lucasumod = \&Math::Prime::Util::PP::lucasumod; *lucasvmod = \&Math::Prime::Util::PP::lucasvmod; *lucasuvmod = \&Math::Prime::Util::PP::lucasuvmod; *pisano_period = \&Math::Prime::Util::PP::pisano_period; *znlog = \&Math::Prime::Util::PP::znlog; *znorder = \&Math::Prime::Util::PP::znorder; *znprimroot = \&Math::Prime::Util::PP::znprimroot; *is_primitive_root = \&Math::Prime::Util::PP::is_primitive_root; *qnr = \&Math::Prime::Util::PP::qnr; *is_qr = \&Math::Prime::Util::PP::is_qr; *vecequal = \&Math::Prime::Util::PP::vecequal; *vecuniq = \&Math::Prime::Util::PP::vecuniq; *vecfreq = \&Math::Prime::Util::PP::vecfreq; *vecsingleton = \&Math::Prime::Util::PP::vecsingleton; *vecsort = \&Math::Prime::Util::PP::vecsort; *vecsorti = \&Math::Prime::Util::PP::vecsorti; *setbinop = \&Math::Prime::Util::PP::setbinop; *sumset = \&Math::Prime::Util::PP::sumset; *setunion = \&Math::Prime::Util::PP::setunion; *setintersect = \&Math::Prime::Util::PP::setintersect; *setminus = \&Math::Prime::Util::PP::setminus; *setdelta = \&Math::Prime::Util::PP::setdelta; *setinsert = \&Math::Prime::Util::PP::setinsert; *setremove = \&Math::Prime::Util::PP::setremove; *setinvert = \&Math::Prime::Util::PP::setinvert; *setcontains = \&Math::Prime::Util::PP::setcontains; *setcontainsany = \&Math::Prime::Util::PP::setcontainsany; *toset = \&Math::Prime::Util::PP::toset; *is_sidon_set = \&Math::Prime::Util::PP::is_sidon_set; *is_sumfree_set = \&Math::Prime::Util::PP::is_sumfree_set; *set_is_disjoint = \&Math::Prime::Util::PP::set_is_disjoint; *set_is_equal = \&Math::Prime::Util::PP::set_is_equal; *set_is_subset = \&Math::Prime::Util::PP::set_is_subset; *set_is_proper_subset = \&Math::Prime::Util::PP::set_is_proper_subset; *set_is_superset = \&Math::Prime::Util::PP::set_is_superset; *set_is_proper_superset = \&Math::Prime::Util::PP::set_is_proper_superset; *set_is_proper_intersection = \&Math::Prime::Util::PP::set_is_proper_intersection; *tozeckendorf = \&Math::Prime::Util::PP::tozeckendorf; *fromzeckendorf = \&Math::Prime::Util::PP::fromzeckendorf; *goldbach_pairs = \&Math::Prime::Util::PP::goldbach_pairs; *goldbach_pair_count = \&Math::Prime::Util::PP::goldbach_pair_count; *minimal_goldbach_pair = \&Math::Prime::Util::PP::minimal_goldbach_pair; *prime_count_approx = \&Math::Prime::Util::PP::prime_count_approx; *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; *nth_prime_approx = \&Math::Prime::Util::PP::nth_prime_approx; *nth_prime_lower = \&Math::Prime::Util::PP::nth_prime_lower; *nth_prime_upper = \&Math::Prime::Util::PP::nth_prime_upper; *prime_power_count_approx = \&Math::Prime::Util::PP::prime_power_count_approx; *prime_power_count_lower = \&Math::Prime::Util::PP::prime_power_count_lower; *prime_power_count_upper = \&Math::Prime::Util::PP::prime_power_count_upper; *perfect_power_count_approx = \&Math::Prime::Util::PP::perfect_power_count_approx; *perfect_power_count_lower = \&Math::Prime::Util::PP::perfect_power_count_lower; *perfect_power_count_upper = \&Math::Prime::Util::PP::perfect_power_count_upper; *lucky_count_approx = \&Math::Prime::Util::PP::lucky_count_approx; *lucky_count_lower = \&Math::Prime::Util::PP::lucky_count_lower; *lucky_count_upper = \&Math::Prime::Util::PP::lucky_count_upper; *nth_prime_power = \&Math::Prime::Util::PP::nth_prime_power; *nth_prime_power_approx = \&Math::Prime::Util::PP::nth_prime_power_approx; *nth_prime_power_lower = \&Math::Prime::Util::PP::nth_prime_power_lower; *nth_prime_power_upper = \&Math::Prime::Util::PP::nth_prime_power_upper; *nth_perfect_power = \&Math::Prime::Util::PP::nth_perfect_power; *nth_perfect_power_approx = \&Math::Prime::Util::PP::nth_perfect_power_approx; *nth_perfect_power_lower = \&Math::Prime::Util::PP::nth_perfect_power_lower; *nth_perfect_power_upper = \&Math::Prime::Util::PP::nth_perfect_power_upper; *nth_lucky = \&Math::Prime::Util::PP::nth_lucky; *nth_lucky_approx = \&Math::Prime::Util::PP::nth_lucky_approx; *nth_lucky_lower = \&Math::Prime::Util::PP::nth_lucky_lower; *nth_lucky_upper = \&Math::Prime::Util::PP::nth_lucky_upper; *semiprime_count_approx = \&Math::Prime::Util::PP::semiprime_count_approx; *nth_semiprime_approx = \&Math::Prime::Util::PP::nth_semiprime_approx; *twin_prime_count_approx = \&Math::Prime::Util::PP::twin_prime_count_approx; *nth_twin_prime_approx = \&Math::Prime::Util::PP::nth_twin_prime_approx; *nth_semiprime = \&Math::Prime::Util::PP::nth_semiprime; *almost_prime_count_approx = \&Math::Prime::Util::PP::almost_prime_count_approx; *almost_prime_count_lower = \&Math::Prime::Util::PP::almost_prime_count_lower; *almost_prime_count_upper = \&Math::Prime::Util::PP::almost_prime_count_upper; *ramanujan_prime_count_approx= \&Math::Prime::Util::PP::ramanujan_prime_count_approx; *ramanujan_prime_count_lower = \&Math::Prime::Util::PP::ramanujan_prime_count_lower; *ramanujan_prime_count_upper = \&Math::Prime::Util::PP::ramanujan_prime_count_upper; *nth_ramanujan_prime =\&Math::Prime::Util::PP::nth_ramanujan_prime; *nth_ramanujan_prime_lower =\&Math::Prime::Util::PP::nth_ramanujan_prime_lower; *nth_ramanujan_prime_upper =\&Math::Prime::Util::PP::nth_ramanujan_prime_upper; *nth_ramanujan_prime_approx=\&Math::Prime::Util::PP::nth_ramanujan_prime_approx; *factor = \&Math::Prime::Util::PP::factor; *factor_exp = \&Math::Prime::Util::PP::factor_exp; *trial_factor = \&Math::Prime::Util::PP::trial_factor; *prho_factor = \&Math::Prime::Util::PP::prho_factor; *pbrent_factor = \&Math::Prime::Util::PP::pbrent_factor; *ecm_factor = \&Math::Prime::Util::PP::ecm_factor; *fermat_factor = \&Math::Prime::Util::PP::fermat_factor; *holf_factor = \&Math::Prime::Util::PP::holf_factor; *squfof_factor = \&Math::Prime::Util::PP::squfof_factor; *lehman_factor = \&Math::Prime::Util::PP::lehman_factor; *pminus1_factor = \&Math::Prime::Util::PP::pminus1_factor; *pplus1_factor = \&Math::Prime::Util::PP::pplus1_factor; *cheb_factor = \&Math::Prime::Util::PP::cheb_factor; *primes = \&Math::Prime::Util::PP::primes; *prime_powers = \&Math::Prime::Util::PP::prime_powers; *twin_primes = \&Math::Prime::Util::PP::twin_primes; *semi_primes = \&Math::Prime::Util::PP::semi_primes; *ramanujan_primes = \&Math::Prime::Util::PP::ramanujan_primes; *almost_primes = \&Math::Prime::Util::PP::almost_primes; *omega_primes = \&Math::Prime::Util::PP::omega_primes; # We are doing the validation here so the PP code doesn't have to do it. sub nth_twin_prime { my($n) = @_; _validate_integer_nonneg($n); return Math::Prime::Util::PP::nth_twin_prime($n); } sub nth_almost_prime { my($k,$n) = @_; _validate_integer_nonneg($k); _validate_integer_nonneg($n); return Math::Prime::Util::PP::nth_almost_prime($k,$n); } sub nth_almost_prime_approx { my($k,$n) = @_; _validate_integer_nonneg($k); _validate_integer_nonneg($n); return Math::Prime::Util::PP::nth_almost_prime_approx($k,$n); } sub nth_almost_prime_lower { my($k,$n) = @_; _validate_integer_nonneg($k); _validate_integer_nonneg($n); return Math::Prime::Util::PP::nth_almost_prime_lower($k,$n); } sub nth_almost_prime_upper { my($k,$n) = @_; _validate_integer_nonneg($k); _validate_integer_nonneg($n); return Math::Prime::Util::PP::nth_almost_prime_upper($k,$n); } sub nth_omega_prime { my($k,$n) = @_; _validate_integer_nonneg($k); _validate_integer_nonneg($n); return Math::Prime::Util::PP::nth_omega_prime($k,$n); } sub is_lucas_pseudoprime { my($n) = @_; _validate_integer($n); return 0 if $n < 0; return Math::Prime::Util::PP::is_lucas_pseudoprime($n); } sub is_strong_lucas_pseudoprime { my($n) = @_; _validate_integer($n); return 0 if $n < 0; return Math::Prime::Util::PP::is_strong_lucas_pseudoprime($n); } sub is_extra_strong_lucas_pseudoprime { my($n) = @_; _validate_integer($n); return 0 if $n < 0; return Math::Prime::Util::PP::is_extra_strong_lucas_pseudoprime($n); } sub is_almost_extra_strong_lucas_pseudoprime { my($n, $increment) = @_; _validate_integer($n); return 0 if $n < 0; if (defined $increment) { _validate_integer_nonneg($increment); } else { $increment = 1; } croak "aes lucas pseudoprime parameter must be 1-256" if $increment < 1 || $increment > 256; return Math::Prime::Util::PP::is_almost_extra_strong_lucas_pseudoprime($n, $increment); } sub is_catalan_pseudoprime { my($n) = @_; _validate_integer($n); return 0 if $n < 0; return Math::Prime::Util::PP::is_catalan_pseudoprime($n); } sub is_frobenius_pseudoprime { my($n, $P, $Q) = @_; _validate_integer($n); return 0 if $n < 0; # TODO: validate P & Q return Math::Prime::Util::PP::is_frobenius_pseudoprime($n, $P, $Q); } sub is_frobenius_underwood_pseudoprime { my($n) = @_; _validate_integer($n); return 0 if $n < 0; return Math::Prime::Util::PP::is_frobenius_underwood_pseudoprime($n); } sub is_frobenius_khashin_pseudoprime { my($n) = @_; _validate_integer($n); return 0 if $n < 0; return Math::Prime::Util::PP::is_frobenius_khashin_pseudoprime($n); } sub is_aks_prime { my($n) = @_; _validate_integer($n); return 0 if $n < 0; return Math::Prime::Util::PP::is_aks_prime($n); } sub is_ramanujan_prime { my($n) = @_; _validate_integer($n); return 0 if $n < 0; return Math::Prime::Util::PP::is_ramanujan_prime($n); } sub is_mersenne_prime { my($p) = @_; _validate_integer_nonneg($p); return Math::Prime::Util::PP::is_mersenne_prime($p); } sub lucas_sequence { my($n, $P, $Q, $k) = @_; my ($vp, $vq) = ($P, $Q); _validate_integer_positive($n); _validate_integer($vp); _validate_integer($vq); _validate_integer_nonneg($k); return Math::Prime::Util::PP::lucas_sequence(@_); } sub lucasu { my($P, $Q, $k) = @_; my ($vp, $vq) = ($P, $Q); _validate_integer($vp); _validate_integer($vq); _validate_integer_nonneg($k); return Math::Prime::Util::PP::lucasu($P,$Q,$k); } sub lucasv { my($P, $Q, $k) = @_; my ($vp, $vq) = ($P, $Q); _validate_integer($vp); _validate_integer($vq); _validate_integer_nonneg($k); return Math::Prime::Util::PP::lucasv($P,$Q,$k); } sub lucasuv { my($P, $Q, $k) = @_; _validate_integer($P); _validate_integer($Q); _validate_integer_nonneg($k); return Math::Prime::Util::PP::lucasuv($P,$Q,$k); } sub kronecker { my($a, $b) = @_; my ($va, $vb) = ($a, $b); _validate_integer($va); _validate_integer($vb); return Math::Prime::Util::PP::kronecker(@_); } sub factorial { my($n) = @_; _validate_integer_nonneg($n); return Math::Prime::Util::PP::factorial($n); } sub stirling { my($n, $k, $type) = @_; _validate_integer_nonneg($n); _validate_integer_nonneg($k); _validate_integer_nonneg($type) if defined $type; return Math::Prime::Util::PP::stirling($n, $k, $type); } sub gcd { my(@v) = @_; _validate_integer($_) for @v; return Math::Prime::Util::PP::gcd(@v); } 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 vecmex { my(@v) = @_; _validate_integer_nonneg($_) for @v; return Math::Prime::Util::PP::vecmex(@v); } sub vecpmex { my(@v) = @_; for (@v) { _validate_integer_nonneg($_); croak "parameter must be a positive integer (x > 0)" if $_ <= 0; } return Math::Prime::Util::PP::vecpmex(@v); } sub invmod { my ($a, $n) = @_; _validate_integer($a); _validate_integer($n); return Math::Prime::Util::PP::invmod($a,$n); } sub addmod { my ($a, $b, $n) = @_; _validate_integer($a); _validate_integer($b); _validate_integer($n); return Math::Prime::Util::PP::addmod($a,$b, $n); } sub submod { my ($a, $b, $n) = @_; _validate_integer($a); _validate_integer($b); _validate_integer($n); return Math::Prime::Util::PP::submod($a,$b, $n); } sub mulmod { my ($a, $b, $n) = @_; _validate_integer($a); _validate_integer($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); _validate_integer($n); return Math::Prime::Util::PP::divmod($a,$b, $n); } sub powmod { my ($a, $b, $n) = @_; _validate_integer($a); _validate_integer($b); _validate_integer($n); return Math::Prime::Util::PP::powmod($a,$b, $n); } sub muladdmod { my ($a, $b, $c, $n) = @_; _validate_integer($a); _validate_integer($b); _validate_integer($c); _validate_integer($n); return Math::Prime::Util::PP::muladdmod($a,$b,$c, $n); } sub mulsubmod { my ($a, $b, $c, $n) = @_; _validate_integer($a); _validate_integer($b); _validate_integer($c); _validate_integer($n); return Math::Prime::Util::PP::mulsubmod($a,$b,$c, $n); } sub Pi { my($digits) = @_; _validate_integer_nonneg($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; } no warnings 'prototype'; sub forprimes (&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::PP::forprimes(@_); } sub forcomposites(&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::PP::forcomposites(@_); } sub foroddcomposites(&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::PP::foroddcomposites(@_); } sub forsemiprimes(&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::PP::forsemiprimes(@_); } sub foralmostprimes(&$$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::PP::foralmostprimes(@_); } sub forfactored(&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::PP::forfactored(@_); } sub forsquarefree(&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::PP::forsquarefree(@_); } sub forsquarefreeint(&$;$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::PP::forsquarefreeint(@_); } sub fordivisors (&$) { ## no critic qw(ProhibitSubroutinePrototypes) Math::Prime::Util::PP::fordivisors(@_); } 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 vecslide (&@) { ## no critic qw(ProhibitSubroutinePrototypes) my($sub, @v) = @_; my $caller = caller(); no strict 'refs'; ## no critic(strict) local(*{$caller.'::a'}) = \my $a; local(*{$caller.'::b'}) = \my $b; return map { $a = $v[$_-1]; $b = $v[$_]; $sub->(); } 1..$#v; } 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(@_); } sub vecsample ($@) { ## no critic qw(ProhibitSubroutinePrototypes) _validate_integer_nonneg($_[0]); Math::Prime::Util::PP::vecsample(@_); } 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-2024 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.74/lib/Math/Prime/Util/Entropy.pm000644 000765 000024 00000012253 15151073442 022023 0ustar00danastaff000000 000000 package 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.74'; } 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.74 =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.74/examples/project_euler_211.pl000644 000765 000024 00000000565 13025437630 022001 0ustar00danastaff000000 000000 #!/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.74/examples/findomegaseq.c000644 000765 000024 00000005035 15145577415 021035 0ustar00danastaff000000 000000 #include #include #include #include #include "ptypes.h" #include "factor.h" #define FUNC_isqrt 1 #include "util.h" #include "cache.h" /* Compile with: * gcc -O3 -fomit-frame-pointer -march=native -Wall -DSTANDALONE -I. examples/findomegaseq.c factor.c util.c primality.c cache.c sieve.c chacha.c csprng.c prime_nth_count.c lmo.c -lm */ /* A simple example to use the ranged factoring API to find sequential * integers whose omega (count of distinct prime factors) sums to . * Testing is from 1 to with results with indices less than * ignored. */ int main(int argc, char *argv[]) { UV VSEQ, VSUM, VLEN, VPRINT; if (argc != 5) { printf("Usage: findseq SEQLEN SEQSUM N PRINTN\n"); printf("E.g. findseq 11 23 10000000 10000\n"); exit(-1); } VSEQ = strtoul(argv[1], 0, 10); VSUM = strtoul(argv[2], 0, 10); VLEN = strtoul(argv[3], 0, 10); VPRINT = strtoul(argv[4], 0, 10); /* ... add input error / range checking here ... */ #if 0 { factor_range_context_t fctx; UV V[VSEQ], k, n, nf, T=0, N = VSEQ+VLEN; for (k=0; k VPRINT) printf("%"UVuf"\n", n-VSEQ+1); } factor_range_destroy(&fctx); } #else { UV V[VSEQ], k, n, nf, T=0, N = VSEQ+VLEN; for (k=0; k VPRINT) printf("%"UVuf"\n", n-VSEQ+1); } Safefree(nfs); #endif prime_precalc(isqrt(N)); n = 1; while (n <= N) { UV seg_beg = n; UV seg_end = N; if ((seg_end - seg_beg + 1) > 200000) seg_end = seg_beg + 200000 - 1; unsigned char* nfs = range_nfactor_sieve(seg_beg, seg_end, 0); while (n <= seg_end) { nf = nfs[n-seg_beg]; T += nf - V[n%VSEQ]; V[n%VSEQ] = nf; if (T == VSUM && n > VPRINT) printf("%"UVuf"\n", n-VSEQ+1); n++; } Safefree(nfs); //n = seg_end+1; } } #endif return(0); } Math-Prime-Util-0.74/examples/project_euler_072.pl000644 000765 000024 00000000226 13025437630 022000 0ustar00danastaff000000 000000 #!/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.74/examples/project_euler_095.pl000644 000765 000024 00000002251 13025437630 022005 0ustar00danastaff000000 000000 #!/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.74/examples/project_euler_037.pl000644 000765 000024 00000000666 13025437630 022011 0ustar00danastaff000000 000000 #!/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.74/examples/verify-cert.pl000755 000765 000024 00000044236 13025437630 021021 0ustar00danastaff000000 000000 #!/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.74/examples/twin_primes.pl000755 000765 000024 00000005724 13667653334 021136 0ustar00danastaff000000 000000 #!/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.74/examples/project_euler_142.pl000644 000765 000024 00000002454 13025437630 022003 0ustar00danastaff000000 000000 #!/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.74/examples/project_euler_214.pl000644 000765 000024 00000000562 13025437630 022001 0ustar00danastaff000000 000000 #!/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.74/examples/csrand-gmp.pl000644 000765 000024 00000007125 13025437630 020606 0ustar00danastaff000000 000000 #!/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.74/examples/fibprime-mce.pl000755 000765 000024 00000005207 13667653334 021131 0ustar00danastaff000000 000000 #!/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.74/examples/verify-primegaps.pl000755 000765 000024 00000010662 14651120131 022036 0ustar00danastaff000000 000000 #!/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: # https://faculty.lynchburg.edu/~nicely/#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.74/examples/project_euler_047.pl000644 000765 000024 00000000527 13025437630 022006 0ustar00danastaff000000 000000 #!/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.74/examples/ktuplet.pl000644 000765 000024 00000006042 13025437630 020240 0ustar00danastaff000000 000000 #!/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.74/examples/inverse_totient.pl000644 000765 000024 00000006233 13667653334 022010 0ustar00danastaff000000 000000 use 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.74/examples/fibprime-threads.pl000755 000765 000024 00000006361 13025437630 022004 0ustar00danastaff000000 000000 #!/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.74/examples/sophie_germain.pl000755 000765 000024 00000005364 13025437630 021552 0ustar00danastaff000000 000000 #!/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.74/examples/find_mr_bases.pl000755 000765 000024 00000003674 13025437630 021356 0ustar00danastaff000000 000000 #!/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.74/examples/project_euler_049.pl000644 000765 000024 00000001027 13025437630 022004 0ustar00danastaff000000 000000 #!/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.74/examples/project_euler_069.pl000644 000765 000024 00000000616 13025437630 022011 0ustar00danastaff000000 000000 #!/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.74/examples/ktuplet-threads.pl000755 000765 000024 00000004354 14124333162 021673 0ustar00danastaff000000 000000 #!/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.74/examples/README000644 000765 000024 00000004147 13025437630 017077 0ustar00danastaff000000 000000 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.74/examples/fibprime-serial.pl000755 000765 000024 00000002311 13025437630 021620 0ustar00danastaff000000 000000 #!/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.74/examples/csrand.pl000644 000765 000024 00000007215 13025437630 020025 0ustar00danastaff000000 000000 #!/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.74/examples/numseqs.pl000755 000765 000024 00000041267 14056645657 020275 0ustar00danastaff000000 000000 #!/usr/bin/env perl use warnings; use strict; use Math::Prime::Util qw/:all/; use Math::BigInt try=>"GMP"; # The Math::NumSeq module on CPAN is pretty neat, offering a uniform set of operations # such as next, predicate, iterators, approximations, and more. Numerous sequences # are implemented. # # https://metacpan.org/release/Math-NumSeq # # This example program shows how we could implement some of these, though this purely # looks at generating the first 'N' values from the sequence. # # 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, what is implemented here works 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. # 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. # The argument method here is really simple -- this is just to show code. 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 'CullenNumbers') { print join " ", map { addint(1,mulint($_,powint(2,$_))) } 0..$count-1; } 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') { print join " ",n_with_pred(0, $count, \&is_deletable_prime); } elsif ($type eq 'DigitSum') { print join " ", map { sumdigits($_) } 0..$count-1; } elsif ($type eq 'DigitProduct') { # remember todigits(0) returns empty array print join " ", map { vecprod($_ && todigits($_)) } 0..$count-1; } elsif ($type eq 'DivisorCount') { print join " ", map { scalar divisors($_) } 1..$count; } elsif ($type eq 'DuffinianNumbers') { print join " ",n_with_pred(0, $count, \&is_duffinian); } 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 'HappyNumbers') { print join " ",n_with_pred(1, $count, \&is_happy); } 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 'LuckyNumbers') { print join " ", @{lucky_numbers(nth_lucky($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') { print join " ",n_with_pred(1, $count, \&is_moran); } 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 'Polygonal') { # Use predicate: # my $i=0; while (@n<$count) { $i++ while !is_polygonal($i,5); push @n,$i++; } # Or do the trivial way (using the constants (3,1) for k=5): @n = map { ($_ * (3*$_-1)) >> 1 } 0 .. $count-1; 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; if ($which eq 'some' && $power == 2) { print join " ",n_with_pred(1, $count, sub { moebius($_[0]) == 0 }); } else { my(@pe,$nmore); my $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(nth_prime($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. print join " ",n_with_pred(0, $count, \&is_proth); } elsif ($type eq 'PythagoreanHypots') { if ($arg eq 'primitive') { print join " ",n_with_pred(2, $count, sub { vecall { ($_ & 3) == 1 } factor($_[0]) }); } else { print join " ",n_with_pred(2, $count, sub { vecany { ($_ & 3) == 1 } factor($_[0]) }); } } 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') { print join " ",n_with_pred(0, $count, sub { is_power($_[0],2) }); } elsif ($type eq 'SternDiatomic') { # Slow direct way for ith value: # vecsum( map { binomial($i-$_-1,$_) % 2 } 0..(($i-1)>>1) ); # Bitwise method (used in MNS for nth): # print join " ", map { stern_diatomic($_) } 0..$count-1; # Using recurrence: my(@n)=(0,1); push @n, $n[-2] + $n[-1] - (($n[-2] % $n[-1]) << 1) for 3..$count; $#n = $count-1 if $count < 2; print join " ",@n; } 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]; } elsif ($type eq 'WoodallNumbers') { print join " ", map { mulint($_,powint(2,$_)) - 1 } 1..$count; } 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 # DigitCount # DigitCountHigh # DigitCountLow # DigitLength # DigitLengthCumulative # DigitProductSteps # DigitSumModulo # Even # Expression # Fibbinary # FibbinaryBitCount # FibonacciRepresentations # FibonacciWord # File # FractionDigits # GolayRudinShapiro # GolayRudinShapiroCumulative # GolombSequence # HafermanCarpet # HappyNumbers # HappySteps # HarshadNumbers # HofstadterFigure # JugglerSteps # KlarnerRado # Kolakoski # MaxDigitCount # Modulo # Multiples # NumAronson # OEIS # OEIS::Catalogue # OEIS::Catalogue::Plugin # Odd # Palindromes # Perrin # PisanoPeriodSteps # 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 # Xenodromes die "sequence '$type' is not implemented here\n"; } print "\n"; exit(0); sub n_with_pred { my($i,$count, $sub) = @_; my @n; while (@n < $count) { $i++ while !$sub->($i); push @n, $i++; } @n; } # 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_happy { my $n = shift; while ($n > 6) { $n = vecsum(map { $_*$_ } todigits($n)); } $n == 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 = shift; vecprod( map { powint($_->[1], $_->[0]) } factor_exp($n) ); } 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.74/examples/project_euler_357.pl000644 000765 000024 00000002133 13025437630 022005 0ustar00danastaff000000 000000 #!/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.74/examples/abundant.pl000755 000765 000024 00000002116 13025437630 020345 0ustar00danastaff000000 000000 #!/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.74/examples/porter.pl000755 000765 000024 00000006325 13025437630 020072 0ustar00danastaff000000 000000 #!/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.74/examples/verify-sage-ecpp-cert.pl000755 000765 000024 00000003237 13025437630 022657 0ustar00danastaff000000 000000 #!/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.74/examples/project_euler_070.pl000644 000765 000024 00000000734 13025437630 022002 0ustar00danastaff000000 000000 #!/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.74/examples/project_euler_021.pl000644 000765 000024 00000000341 13025437630 021770 0ustar00danastaff000000 000000 #!/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.74/examples/verify-gmp-ecpp-cert.pl000755 000765 000024 00000003533 13025437630 022522 0ustar00danastaff000000 000000 #!/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.74/examples/project_euler_193.pl000644 000765 000024 00000003346 13025437630 022012 0ustar00danastaff000000 000000 #!/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.74/examples/project_euler_342.pl000644 000765 000024 00000005320 13025437630 022000 0ustar00danastaff000000 000000 #!/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.74/examples/project_euler_131.pl000644 000765 000024 00000000616 13025437630 021777 0ustar00danastaff000000 000000 #!/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.74/examples/project_euler_010.pl000644 000765 000024 00000000220 13025437630 021762 0ustar00danastaff000000 000000 #!/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.74/xt/primality-aks.pl000755 000765 000024 00000001445 13667653334 020175 0ustar00danastaff000000 000000 #!/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.74/xt/division.pl000644 000765 000024 00000003140 14113024367 017203 0ustar00danastaff000000 000000 #!/usr/bin/env perl use warnings; use strict; use ntheory ":all"; use Math::Prime::Util::PP; show(7,3); #show(13,4); #show(13,13); sub show { my($D,$d) = @_; printf "Name %2d/%2d %2d/%2d %2d/%2d %2d/%2d\n", $D,$d, $D,-$d, -$D,$d, -$D,-$d; printf "--------- ----- ----- ----- -----\n"; showd($D,$d,"Perl naive", \&ndivrem); showd($D,$d,"Perl floor", \&nfdivrem); print "\n"; showd($D,$d,"Perl ui", \&uidivrem); showd($D,$d,"tdivrem", \&tdivrem); showd($D,$d,"PP tdivrem", \&Math::Prime::Util::PP::tdivrem); print "\n"; showd($D,$d,"fdivrem", \&fdivrem); showd($D,$d,"div/mod", \&div_and_mod); showd($D,$d,"PP fdivrem", \&Math::Prime::Util::PP::fdivrem); print "\n"; showd($D,$d,"divrem", \&divrem); showd($D,$d,"PP divrem", \&Math::Prime::Util::PP::divrem); } sub showd { my($D,$d,$name,$func) = @_; #printf "%-8s %2d/%2d = %2d %2d %2d/%2d = %2d %2d\n", "$name:", -$D,$d, $func->(-$D,$d), $D,-$d, $func->($D,-$d); printf "%-11s %2d %2d %2d %2d %2d %2d %2d %2d\n", $name, $func->($D,$d), $func->($D,-$d), $func->(-$D,$d), $func->(-$D,-$d); } sub ndivrem { my($D,$d) = @_; ( int($D/$d), $D % $d ); } sub uidivrem { my($D,$d) = @_; use integer; ( int($D/$d), $D % $d ); } sub nfdivrem { my($D,$d) = @_; use POSIX; ( POSIX::floor($D/$d), $D % $d ); } sub div_and_mod { my($D,$d) = @_; ( divint($D,$d), modint($D,$d) ); } sub ivmod { my($a,$n) = @_; die "wrong usage: n must be positive" unless $n >= 0; return $a % $n if $a >= 0; my $amodn = -$a % $n; return ($amodn == 0) ? 0 : $n-$amodn; } Math-Prime-Util-0.74/xt/rwh_primecount.py000755 000765 000024 00000001365 13025437630 020455 0ustar00danastaff000000 000000 #!/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.74/xt/pari-totient-moebius.pl000755 000765 000024 00000002120 13667653334 021456 0ustar00danastaff000000 000000 use 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.74/xt/primes-edgecases.pl000755 000765 000024 00000011513 15137676763 020631 0ustar00danastaff000000 000000 #!/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 { my($lo, $hi) = @_; return primes($lo,$hi); } 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.74/xt/test-primecount.pl000755 000765 000024 00000002145 13667653334 020547 0ustar00danastaff000000 000000 #!/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.74/xt/test-pcbounds.pl000755 000765 000024 00000006113 13667653334 020176 0ustar00danastaff000000 000000 #!/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.74/xt/nth_twin_prime.t000644 000765 000024 00000003377 13025437630 020253 0ustar00danastaff000000 000000 #!/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.74/xt/factor-holf.pl000755 000765 000024 00000001212 13025437630 017566 0ustar00danastaff000000 000000 #!/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.74/xt/check-bigint.pl000644 000765 000024 00000044076 15153234150 017721 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/:all/; use Time::HiRes qw(gettimeofday tv_interval); use feature 'say'; use Math::GMPz; use Math::GMP; use Math::BigInt; $| = 1; # fast pipes my $class = 'Math::GMPz'; prime_set_config(bigint=>$class); my($rnat, $rbig); my @S; my $r; # There is no particular reason for these numbers, they are just convenient # bigints that are comfortably larger than 2^64 but not too much larger. my $x = $class->new("1180591620717411303424"); # powint(2,70); my $y = $class->new("2503155504993241601315571986085849"); # powint(3,70); my $z = $class->new("1104427674243920646305299201"); # powint(7,32); print "Operations should produce native ints (UV/IV) if possible.\n"; print "They should produce bigint results of the requested class if large.\n"; print "The intention is to check return types, not the functions themselves.\n"; ################################################################################ print "\nbasic "; $rnat = sqrtint(77777777); $rbig = sqrtint($x * $x + 31); die "sqrtint" unless !ref($rnat) && ref($rbig) eq $class && $rnat == 8819 && $rbig == $x; die "sqrtint native" unless checkv($rnat,8819); die "sqrtint bigint" unless checkv($rbig,$x); print "."; $rnat = addint(15, 31); $rbig = addint($x, 31); die "addint" unless !ref($rnat) && ref($rbig) eq $class && $rnat == 46 && $rbig == $x+31; die "addint native" unless checkv($rnat,46); die "addint bigint" unless checkv($rbig,$x+31); print "."; $rnat = subint(15, 31); $rbig = subint($x, 31); die "subint native" unless checkv($rnat,-16); die "subint bigint" unless checkv($rbig,$x-31); print "."; $rnat = add1int(15); $rbig = add1int($x); die "add1int native" unless checkv($rnat,16); die "add1int bigint" unless checkv($rbig,$x+1); print "."; $rnat = sub1int(15); $rbig = sub1int($x); die "sub1int" unless !ref($rnat) && ref($rbig) eq $class && $rnat == 14 && $rbig == $x-1; die "sub1int native" unless checkv($rnat,14); die "sub1int bigint" unless checkv($rbig,$x-1); print "."; $rnat = mulint(15, 31); $rbig = mulint($x, 31); die "mulint native" unless checkv($rnat,465); die "mulint bigint" unless checkv($rbig,$x*31); print "."; $rnat = divint(310, 15); $rbig = divint($x, 31); die "divint native" unless checkv($rnat,20); die "divint bigint" unless checkv($rbig,"38083600668303590433"); print "."; $rnat = cdivint(310, 15); $rbig = cdivint($x, 31); die "cdivint native" unless checkv($rnat,21); die "cdivint bigint" unless checkv($rbig,"38083600668303590434"); print "."; $rnat = modint(310, 15); die "modint native" unless checkv($rnat,10); $rnat = modint($x, 31); die "modint native" unless checkv($rnat,1); $rbig = modint($y,$x); die "modint bigint" unless checkv($rbig,"297440975187654227929"); print "."; $rnat = powint(310, 3); $rbig = powint(317, 31); die "powint native" unless checkv($rnat,29791000); die "powint bigint" unless checkv($rbig,"341064979770708619981328007297127930890658843588985670937159050598503087466133"); print "."; $rnat = absint(-10001); $rbig = absint(-$x); die "absint native" unless checkv($rnat,10001); die "absint bigint" unless checkv($rbig,$x); print "."; $rnat = negint(10001); $rbig = negint($x); die "negint" unless !ref($rnat) && ref($rbig) eq $class && $rnat == -10001 && $rbig == -$x; die "negint native" unless checkv($rnat,-10001); die "negint bigint" unless checkv($rbig,-$x); print "."; $rnat = lshiftint(10001); $rbig = lshiftint($x); die "lshiftint native" unless checkv($rnat,20002); die "lshiftint bigint" unless checkv($rbig,2*$x); print "."; $rnat = rshiftint($x,66); $rbig = rshiftint($x,3); die "rshiftint native" unless checkv($rnat,16); die "rshiftint bigint" unless checkv($rbig,"147573952589676412928"); print "."; $rnat = rashiftint(-$y,82); $rbig = rashiftint(-$y,20); die "rashiftint native" unless checkv($rnat,-517640426); die "rashiftint bigint" unless checkv($rbig,"-2387195115082971192660877215"); print "."; $rnat = logint($y, 4); die "logint" unless checkv($rnat,55); $rnat = rootint($y,4); $rbig = rootint($y*$y*$y-1,3); die "rootint native" unless checkv($rnat,223677323); die "rootint bigint" unless checkv($rbig,$y-1); print "."; ################################################################################ print "\nmodint "; $rnat = addmod(15, 31, 17); $rbig = addmod($x, $y, $z); die "addmod native" unless checkv($rnat,12); die "addmod bigint" unless checkv($rbig,"867780633942779001401200"); print "."; $rnat = submod(15, 31, 17); $rbig = submod($x, $y, $z); die "submod native" unless checkv($rnat,1); die "submod bigint" unless checkv($rbig,"1103562254793219302126504849"); print "."; $rnat = mulmod(15, 31, 17); $rbig = mulmod($x, $y, $z); die "mulmod native" unless checkv($rnat,6); die "mulmod bigint" unless checkv($rbig,"749232057443429182743012873"); print "."; $rnat = powmod(15, 31, 17); $rbig = powmod($x, $y, $z); die "powmod native" unless checkv($rnat,8); die "powmod bigint" unless checkv($rbig,"573707816919163066477349622"); print "."; $rnat = divmod(15, 31, 17); $rbig = divmod($x, $y, $z); die "divmod native" unless checkv($rnat,12); die "divmod bigint" unless checkv($rbig,"814177443435415951196839160"); print "."; $rnat = muladdmod(15, 31, 2, 17); $rbig = muladdmod($x, $y, 2, $z); die "muladdmod native" unless checkv($rnat,8); die "muladdmod bigint" unless checkv($rbig,"749232057443429182743012875"); print "."; $rnat = mulsubmod(15, 31, 2, 17); $rbig = mulsubmod($x, $y, 2, $z); die "mulsubmod native" unless checkv($rnat,4); die "mulsubmod bigint" unless checkv($rbig,"749232057443429182743012871"); print "."; $rnat = factorialmod(15, 17); $rbig = factorialmod(1000, $z+1); die "factorialmod native" unless checkv($rnat,1); die "factorialmod bigint" unless checkv($rbig,"13829182657193587281465406"); print "."; $rnat = sqrtmod(310, 17); $rbig = sqrtmod($y, $z); die "sqrtmod native" unless checkv($rnat,2); die "sqrtmod bigint" unless checkv($rbig,"50031545098999707"); print "."; # divrem (Euclidean): remainder always >= 0 { my($q,$r); ($q,$r) = divrem(310, 17); die "divrem native" unless checkv($q,18) && checkv($r,4); ($q,$r) = divrem(-310, 17); die "divrem native neg" unless checkv($q,-19) && checkv($r,13); ($q,$r) = divrem($y, $x); die "divrem bigint" unless checkv($q,2120255184830) && checkv($r,"297440975187654227929"); ($q,$r) = divrem(-$y, $x); die "divrem bigint neg" unless checkv($q,-2120255184831) && checkv($r,"883150645529757075495"); print "."; } # tdivrem (truncated toward zero) { my($q,$r); ($q,$r) = tdivrem(310, 17); die "tdivrem native" unless checkv($q,18) && checkv($r,4); ($q,$r) = tdivrem(-310, 17); die "tdivrem native neg" unless checkv($q,-18) && checkv($r,-4); ($q,$r) = tdivrem($y, $x); die "tdivrem bigint" unless checkv($q,2120255184830) && checkv($r,"297440975187654227929"); ($q,$r) = tdivrem(-$y, $x); die "tdivrem bigint neg" unless checkv($q,-2120255184830) && checkv($r,"-297440975187654227929"); print "."; } # fdivrem (floored) { my($q,$r); ($q,$r) = fdivrem(310, 17); die "fdivrem native" unless checkv($q,18) && checkv($r,4); ($q,$r) = fdivrem(-310, 17); die "fdivrem native neg" unless checkv($q,-19) && checkv($r,13); ($q,$r) = fdivrem($y, $x); die "fdivrem bigint" unless checkv($q,2120255184830) && checkv($r,"297440975187654227929"); ($q,$r) = fdivrem(-$y, $x); die "fdivrem bigint neg" unless checkv($q,-2120255184831) && checkv($r,"883150645529757075495"); print "."; } # cdivrem (ceiling) { my($q,$r); ($q,$r) = cdivrem(310, 17); die "cdivrem native" unless checkv($q,19) && checkv($r,-13); ($q,$r) = cdivrem(-310, 17); die "cdivrem native neg" unless checkv($q,-18) && checkv($r,-4); ($q,$r) = cdivrem($y, $x); die "cdivrem bigint" unless checkv($q,2120255184831) && checkv($r,"-883150645529757075495"); ($q,$r) = cdivrem(-$y, $x); die "cdivrem bigint neg" unless checkv($q,-2120255184830) && checkv($r,"-297440975187654227929"); print "."; } $rnat = lucasumod(4,-3,2379,377); $rbig = lucasumod(4,-3,2379,$x); die "lucasumod native" unless checkv($rnat,68); die "lucasumod bigint" unless checkv($rbig,"705649089465838257763"); print "."; $rnat = lucasvmod(4,-3,2379,377); $rbig = lucasvmod(4,-3,2379,$x); die "lucasvmod native" unless checkv($rnat,105); die "lucasvmod bigint" unless checkv($rbig,"751898682006794398852"); print "."; { my($r1,$r2); ($r1,$r2) = lucasuvmod(31,-17,88891112, 570); die "lucasuvmod" unless checkv($r1,535) && checkv($r2,257); ($r1,$r2) = lucasuvmod(31,-17,88891112, $x); die "lucasuvmod" unless checkv($r1,"585481810409681695659") && checkv($r2,"1102837250424259606255"); print "."; } # binomialmod # negmod # invmod # rootmod # allsqrtmod # allrootmod ################################################################################ print "\nnthry "; # gcd: small result from small inputs, big result from big inputs $rnat = gcd(15, 35); $rbig = gcd(mulint($z,6), mulint($z,10)); die "gcd native" unless checkv($rnat, 5); die "gcd bigint" unless checkv($rbig, "2208855348487841292610598402"); print "."; # lcm $rnat = lcm(15, 35); $rbig = lcm(mulint($z,6), mulint($z,10)); die "lcm native" unless checkv($rnat, 105); die "lcm bigint" unless checkv($rbig, "33132830227317619389158976030"); print "."; # gcdext { my @ge = gcdext(15, 35); die "gcdext native" unless checkv($ge[0],-2) && checkv($ge[1],1) && checkv($ge[2],5); @ge = gcdext(mulint($z,6), mulint($z,10)); die "gcdext bigint" unless checkv($ge[0],2) && checkv($ge[1],-1) && checkv($ge[2],"2208855348487841292610598402"); print "."; } # euler_phi: phi(100) = 40, phi(7^32) = 7^31 * 6 $rnat = euler_phi(100); $rbig = euler_phi($z); die "euler_phi native" unless checkv($rnat, 40); die "euler_phi bigint" unless checkv($rbig, "946652292209074839690256458"); print "."; # carmichael_lambda: lambda(100) = 20, lambda(7^32) = 7^31 * 6 $rnat = carmichael_lambda(100); $rbig = carmichael_lambda($z); die "carmichael_lambda native" unless checkv($rnat, 20); die "carmichael_lambda bigint" unless checkv($rbig, "946652292209074839690256458"); print "."; # jordan_totient: J_2(100) = 7200, J_2(7^32) = 7^62 * 48 $rnat = jordan_totient(2, 100); $rbig = jordan_totient(2, $z); die "jordan_totient native" unless checkv($rnat, 7200); die "jordan_totient bigint" unless checkv($rbig, "1194867416459594155237786640878013212168766002414274352"); print "."; # kronecker: always returns native -1, 0, or 1 $rnat = kronecker(15, 35); die "kronecker" unless checkv($rnat, 0); $rnat = kronecker($x, $z); die "kronecker bigint args" unless checkv($rnat, 1); print "."; # znorder: znorder(2,101) = 100 $rnat = znorder(2, 101); die "znorder native" unless checkv($rnat, 100); # znorder with bigint prime modulus: znorder(2, next_prime(2^70)) $rbig = znorder(2, $class->new("1180591620717411303449")); die "znorder bigint" unless checkv($rbig, "295147905179352825862"); print "."; # znprimroot: znprimroot(101) = 2 $rnat = znprimroot(101); die "znprimroot native" unless checkv($rnat, 2); $rnat = znprimroot($class->new("1180591620717411303449")); die "znprimroot bigint" unless checkv($rnat, 3); print "."; # exp_mangoldt: prime power -> prime, otherwise -> 1 $rnat = exp_mangoldt(128); # 2^7 -> 2 die "exp_mangoldt native" unless checkv($rnat, 2); $rnat = exp_mangoldt($z); # 7^32 -> 7 die "exp_mangoldt bigint" unless checkv($rnat, 7); $rnat = exp_mangoldt(30); # not a prime power -> 1 die "exp_mangoldt 30" unless checkv($rnat, 1); print "."; # consecutive_integer_lcm: result can exceed UV $rnat = consecutive_integer_lcm(20); $rbig = consecutive_integer_lcm(100); die "consecutive_integer_lcm native" unless checkv($rnat, 232792560); die "consecutive_integer_lcm bigint" unless checkv($rbig, "69720375229712477164533808935312303556800"); print "."; # ramanujan_tau $rnat = ramanujan_tau(20); $rbig = ramanujan_tau(1000); die "ramanujan_tau native" unless checkv($rnat, -7109760); die "ramanujan_tau bigint" unless checkv($rbig, "-30328412970240000"); print "."; # partitions $rnat = partitions(30); $rbig = partitions(1000); die "partitions native" unless checkv($rnat, 5604); die "partitions bigint" unless checkv($rbig, "24061467864032622473692149727991"); print "."; # chinese (CRT) $rnat = chinese([3,7],[5,11]); $rbig = chinese([3,$x],[5,$z]); die "chinese native" unless checkv($rnat, 38); die "chinese bigint" unless checkv($rbig, "274780012208942403819037834081377580846524923907"); print "."; # binomial $rnat = binomial(20, 10); $rbig = binomial(100, 50); die "binomial native" unless checkv($rnat, 184756); die "binomial bigint" unless checkv($rbig, "100891344545564193334812497256"); $rbig = binomial($x, 3); die "binomial bigint n" unless checkv($rbig, "274250759553534340358464632138771002190616713273449955064807424"); print "."; # stirling (type 1 and type 2) $rnat = stirling(10, 3, 1); $rbig = stirling(30, 3, 1); die "stirling s1 native" unless checkv($rnat, -1172700); die "stirling s1 bigint" unless checkv($rbig, "-62262192842035613491057459200000"); $rnat = stirling(10, 3, 2); $rbig = stirling(50, 3, 2); die "stirling s2 native" unless checkv($rnat, 9330); die "stirling s2 bigint" unless checkv($rbig, "119649664052358811373730"); print "."; # permtonum $rnat = permtonum([2,1,0]); $rbig = permtonum([24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0]); die "permtonum native" unless checkv($rnat, 5); die "permtonum bigint" unless checkv($rbig, "15511210043330985983999999"); print "."; # subfactorial $rnat = subfactorial(10); $rbig = subfactorial(50); die "subfactorial native" unless checkv($rnat, 1334961); die "subfactorial bigint" unless checkv($rbig, "11188719610782480504630258070757734324011354208865721592720336801"); print "."; # falling_factorial $rnat = falling_factorial(10, 3); $rbig = falling_factorial($x, 3); die "falling_factorial native" unless checkv($rnat, 720); die "falling_factorial bigint" unless checkv($rbig, "1645504557321206042150787792832626013143700279640699730388844544"); print "."; # rising_factorial $rnat = rising_factorial(10, 3); $rbig = rising_factorial($x, 3); die "rising_factorial native" unless checkv($rnat, 1320); die "rising_factorial bigint" unless checkv($rbig, "1645504557321206042159150572282074996821776173992942865953587200"); print "."; # pisano_period $rnat = pisano_period(100); $rbig = pisano_period($x); die "pisano_period native" unless checkv($rnat, 300); die "pisano_period bigint" unless checkv($rbig, "1770887431076116955136"); print "."; # powersum $rnat = powersum(10, 2); $rbig = powersum(100, 10); die "powersum native" unless checkv($rnat, 385); die "powersum bigint" unless checkv($rbig, "959924142434241924250"); print "."; # lucasu: U(1,-1,k) = Fibonacci(k) $rnat = lucasu(1, -1, 20); $rbig = lucasu(1, -1, 100); die "lucasu native" unless checkv($rnat, 6765); die "lucasu bigint" unless checkv($rbig, "354224848179261915075"); print "."; # lucasv: V(1,-1,k) = Lucas(k) $rnat = lucasv(1, -1, 20); $rbig = lucasv(1, -1, 100); die "lucasv native" unless checkv($rnat, 15127); die "lucasv bigint" unless checkv($rbig, "792070839848372253127"); print "."; # lucasuv { my($u,$v); ($u,$v) = lucasuv(1, -1, 20); die "lucasuv native" unless checkv($u, 6765) && checkv($v, 15127); ($u,$v) = lucasuv(1, -1, 100); die "lucasuv bigint" unless checkv($u, "354224848179261915075") && checkv($v, "792070839848372253127"); print "."; } # TODO # next_prime prev_prime # urandomb urandomm random_nbig_prime random_ndigit_prime # random_strong_prime random_safe_prime random_prime # random_maurer_prime random_shawe_taylor_prime # primorial pn_primorial # fromdigits # powerful_count powerfree_count prime_power_count perfect_power_count # nth_powerfree nth_perfect_power nth_perfect_power_approx # next_perfect_power prev_perfect_power # bernfrac harmfrac # ... more ... # many _approx, _lower, _upper ################################################################################ print "\nsemipr "; $r = is_semiprime(165); die "is_semiprime $r" unless $r == 0 && !ref($r); print "."; $r = is_semiprime(166); die "is_semiprime $r" unless $r == 1 && !ref($r); print "."; $r = is_semiprime($class->new("27273137616939507011")); die "is_semiprime $r" unless $r == 1 && !ref($r); print "."; $r = random_semiprime(32); die "random_semiprime 32" unless is_semiprime($r) && !ref($r); print "."; $r = random_semiprime(65); die "random_semiprime 65" unless is_semiprime($r) && ref($r) eq $class; print "."; $r = random_unrestricted_semiprime(32); die "random_unrestricted_semiprime 32" unless is_semiprime($r) && !ref($r); print "."; $r = random_unrestricted_semiprime(65); die "random_unrestricted_semiprime 65" unless is_semiprime($r) && ref($r) eq $class; print "."; $r = semi_primes(1000000000,1000000010); die "semiprimes small" unless $r->[0] == 1000000006 && !ref($r->[0]); print "."; $r = semi_primes($x,$x+10); die "semiprimes large" unless $r->[0] == $x+9 && ref($r->[0]) eq $class; print "."; $r = semiprime_count(1000000000); die "semiprime_count" unless $r == 160788536 && !ref($r); print "."; $r = semiprime_count_approx($x); die "semiprime_count_approx" unless ref($r) eq $class; print "."; $r = nth_semiprime(1000000); die "nth_semiprime" unless $r == 5109839 && !ref($r); print "."; $r = nth_semiprime_approx($x); die "nth_semiprime_approx" unless ref($r) eq $class; print "."; forsemiprimes { push @S, $_; } 3000000000,3000000005; die "forsemiprimes small" unless vecequal(\@S,[3000000001,3000000002,3000000005]) && vecall { !ref($_) } @S; print "."; @S=(); forsemiprimes { push @S, $_; } $x,$x+10; die "forsemiprimes large" unless vecequal(\@S,["1180591620717411303433"]) && vecall { ref($_) eq $class } @S; print "."; ################################################################################ print "\nPASS\n"; sub checkv { my($n,$v)=@_; # This is great except it assumes addint always works correctly. # That should be true, but this test is trying to verify it. #$v = addint($v,0); # assuming addint works, v is the right type #return 0 unless (!ref($n) && !ref($v)) || (ref($v) && ref($n) eq $class); #return $n == $v; # This assumes cmpint will work correctly. It doesn't depend on return types. if (cmpint($v,~0) <= 0 && cmpint($v,negint(1+(~0 >> 1))) >= 0) { return 0 unless !ref($n) && $n == $v; } else { $v = $class->new($v) unless ref($v); return 0 unless ref($n) eq $class && $n == $v; } 1; } Math-Prime-Util-0.74/xt/small-is-next-prev.pl000755 000765 000024 00000013363 13025437630 021043 0ustar00danastaff000000 000000 #!/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.74/xt/primecount-approx.t000644 000765 000024 00000014433 13025437630 020714 0ustar00danastaff000000 000000 #!/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.74/xt/allrootmod.pl000644 000765 000024 00000003222 15146553566 017553 0ustar00danastaff000000 000000 #!/usr/bin/env perl use warnings; use strict; use v5.16; use ntheory ":all"; use Math::Prime::Util::PP; #csrand(2); #for (1..100) { # my $k = 10+urandomm(10000); # test($k); #} # Performance: # my @r = allrootmod(33,3432,10428581733134514527); my $iter = shift || 10000; test($_,$iter,10** 4) for 2,3,5,7,4,6,8,9,27,625; test($_,$iter,10** 8) for 2,3,5,7,4,6,8,9,27,625; test($_,$iter,10**12) for 2,3,5,7,4,6,8,9,27,625; test($_,$iter,10**16) for 2,3,5,7,4,6,8,9,27,625; test($_,$iter,~0) for 2,3,5,7,4,6,8,9,27,625; sub test { my($k,$iter,$size) = @_; for (1..$iter) { my(@rxs,@rpp, @sxs,@spp, $a,$n); $n = urandomm(100_000_000_000); $a = urandomm($n); @rxs = allrootmod($a,$k,$n); @rpp = Math::Prime::Util::PP::allrootmod($a,$k,$n); die "allrootmod fail for $a,$k,$n\n" unless vecequal(\@rxs,\@rpp); if ($k == 2) { @sxs = allsqrtmod($a,$n); @spp = Math::Prime::Util::PP::allsqrtmod($a,$n); die "allsqrtmod fail for $a,$n\n" unless vecequal(\@sxs,\@spp); die "allsqrtmod fail for $a,$n\n" unless vecequal(\@rxs,\@sxs); } if (@rxs) { my %roots = map { $_ => 1 } @rxs; my $rxs = rootmod($a,$k,$n); my $rpp = Math::Prime::Util::PP::rootmod($a,$k,$n); die "xs rootmod fail for $a,$k,$n" unless $roots{$rxs}; die "pp rootmod fail for $a,$k,$n" unless $roots{$rpp}; if ($k == 2) { my $sxs = sqrtmod($a,$n); my $spp = Math::Prime::Util::PP::sqrtmod($a,$n); die "xs sqrtmod fail for $a,$n" unless $roots{$sxs}; die "pp sqrtmod fail for $a,$n" unless $roots{$spp}; } } } say "pass $iter iterations with max n $size for k $k"; } Math-Prime-Util-0.74/xt/primality-small.pl000755 000765 000024 00000002265 13025437630 020513 0ustar00danastaff000000 000000 #!/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.74/xt/measure_zeta_accuracy.pl000755 000765 000024 00000006511 13667653334 021744 0ustar00danastaff000000 000000 #!/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.74/xt/lucasuv.pl000644 000765 000024 00000000562 13025437630 017050 0ustar00danastaff000000 000000 #!/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.74/xt/test-primes-script.pl000755 000765 000024 00000010122 14056645657 021157 0ustar00danastaff000000 000000 #!/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+perl -Iblib/lib -Iblib/arch $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.74/xt/test-znlog.pl000755 000765 000024 00000001710 13040020347 017461 0ustar00danastaff000000 000000 #!/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.74/xt/pari-compare.pl000755 000765 000024 00000027064 14613365430 017760 0ustar00danastaff000000 000000 #!/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 = 1+int(rand($n-2)); 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; # znlog(1,Mod(1,2)) MPU and Pari 2.12.1 => 0. Math::Pari 2.030518 => 1 if ($a == 1 && $g == 1 && $n == 2) { die "znlog(1, 1, 2)" unless $log == 0; next; } 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.74/xt/test-factor-yafu.pl000755 000765 000024 00000005631 13667653334 020605 0ustar00danastaff000000 000000 #!/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.74/xt/primality-proofs.pl000755 000765 000024 00000007527 14446007131 020716 0ustar00danastaff000000 000000 #!/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.74/xt/totient-range.pl000755 000765 000024 00000001320 13667653334 020157 0ustar00danastaff000000 000000 #!/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.74/xt/setop.pl000644 000765 000024 00000003342 15146553566 016534 0ustar00danastaff000000 000000 #!/usr/bin/perl $|=1; use warnings; use strict; use Math::Prime::Util qw/:all/; use Math::Prime::Util::PP; csrand(4); #for my $bits (3..65,70) { for my $bits (3..63) { print "$bits "; for my $n (1..800) { my(@x,@y); my @a = map { urandomb($bits); } 1..$n; my @b = map { urandomb($bits); } 1..$n; checksetops(\@a,\@b,$bits,$n); my $mp = powint(2,$bits-1); @a = map { subint($_,$mp) } @a; @b = map { subint($_,$mp) } @a; checksetops(\@a,\@b,$bits,$n); } } print "\n"; sub checksetops { my($a,$b,$bits,$n) = @_; my($X,$Y); $X = setunion($a,$b); $Y = Math::Prime::Util::PP::setunion($a,$b); die "wrong for setunion $bits $n [@$a] [@$b] [@$X] [@$Y]" unless vecequal($X,$Y); $X = setintersect($a,$b); $Y = Math::Prime::Util::PP::setintersect($a,$b); die "wrong for setintersect $bits $n" unless vecequal($X,$Y); $X = setminus($a,$b); $Y = Math::Prime::Util::PP::setminus($a,$b); die "wrong for setminus $bits $n [@$a] [@$b] [@$X] [@$Y]" unless vecequal($X,$Y); $X = setdelta($a,$b); $Y = Math::Prime::Util::PP::setdelta($a,$b); die "wrong for setdelta $bits $n [@$a] [@$b] [@$X] [@$Y]" unless vecequal($X,$Y); # First set must be in set form for insert, contains, remove, invert $a = toset(@$a); # Second list must not have duplicates for set_is_subset $b = [vecuniq(@$b)]; my $s1 = Math::Prime::Util::set_is_subset($a,$b); my $s2 = Math::Prime::Util::setcontains($a,@$b); my $s3 = Math::Prime::Util::PP::set_is_subset($a,$b); my $s4 = Math::Prime::Util::PP::setcontains($a,@$b); die "wrong for contains $bits $n [@$a] [@$b]" unless $s2 == $s1; die "wrong for PP subset $bits $n [@$a] [@$b]" unless $s3 == $s1; die "wrong for PP contains $bits $n" unless $s4 == $s1; } Math-Prime-Util-0.74/xt/primecount-many.t000644 000765 000024 00000016406 13667653334 020366 0ustar00danastaff000000 000000 #!/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.74/xt/test-bpsw.pl000755 000765 000024 00000011435 13667653334 017337 0ustar00danastaff000000 000000 #!/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.74/xt/test-factor-mpxs.pl000755 000765 000024 00000002125 13667653334 020623 0ustar00danastaff000000 000000 #!/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.74/xt/twin_prime_count.t000644 000765 000024 00000005773 13025437630 020614 0ustar00danastaff000000 000000 #!/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.74/xt/sort-return.pl000644 000765 000024 00000002636 15000125314 017662 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/vecsort/; use Math::Prime::Util::PP; testit("sort direct", \&sort_direct); testit("sort indirect", \&sort_indirect); testit("sort workaround", \&sort_workaround); print "\n"; testit("vecsort direct", \&vecsort_direct); testit("vecsort indirect", \&vecsort_indirect); testit("vecsort workaround", \&vecsort_workaround); print "\n"; testit("PP vecsort direct", \&ppvecsort_direct); testit("PP vecsort indirect", \&ppvecsort_indirect); testit("PP vecsort workaround", \&ppvecsort_workaround); sub testit { my($name, $func) = @_; my @v = (12,13,14,11); my @X = $func->(@v); my $x = $func->(@v); $x = "" unless defined $x; printf "%21s %7s %7s\n", $name, scalar(@X), $x; } sub sort_direct { return sort { $a<=> $b } @_; } sub sort_indirect { my @p = sort { $a<=> $b } @_; return @p; } sub sort_workaround { return scalar @_ unless wantarray; return sort { $a<=> $b } @_; } sub vecsort_direct { return vecsort(@_); } sub vecsort_indirect { my @p = vecsort(@_); return @p; } sub vecsort_workaround { return scalar @_ unless wantarray; return vecsort(@_); } sub ppvecsort_direct { return Math::Prime::Util::PP::vecsort(@_); } sub ppvecsort_indirect { my @p = Math::Prime::Util::PP::vecsort(@_); return @p; } sub ppvecsort_workaround { return scalar @_ unless wantarray; return Math::Prime::Util::PP::vecsort(@_); } Math-Prime-Util-0.74/xt/test-sets.pl000644 000765 000024 00000022640 15152301327 017316 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util qw/vecequal toset set_is_subset setcontains setintersect setunion setminus setdelta/; use Math::Prime::Util::PP; # Have it available for comparison use Benchmark qw/:all/; my $N = 100000; my @set1 = map { 2*$_+1 } 0..$N-1; # Odds my @set2 = map { 2*$_ } 0..$N-1; # Evens my @set3 = reverse @set1; # Odds descending # Set::IntSpan::Fast only works on SIGNED 32-bit inputs (!!!). So shift down. my @set4 = map {_hash32($_)>>1} 0..$N-1; # random1 my @set5 = map {_hash32(10*$N+$_)>>1} 0..$N-1; # random2 sub _hash32 { use integer; my $x = shift; $x = (($x >> 16) ^ $x) * 0x45d9f3b; $x = (($x >> 16) ^ $x) * 0x45d9f3b; $x = ($x >> 16) ^ $x; return $x & 0xFFFFFFFF; } # Verify toset { my $s = toset(@set3); die "toset on descending odds didn't work right" unless vecequal(\@set1,$s); } my @iset4 = @{toset(@set4)}; print "iset4 entries: ",$#iset4+1,"\n"; my @iset5 = @{toset(@set5)}; print "iset5 entries: ",$#iset5+1,"\n"; # Verify functions if (1) { my $s1 = setintersect(\@set1,\@set2); die "intersect of odds and evens should be null" unless @$s1 == 0; my $s2 = setintersect(\@set1,\@set3); die "intersect of odds and odds should be odds" unless vecequal($s2,\@set1); my $s3 = setintersect(\@set2,\@set3); die "intersect of evens and odds should be null" unless @$s3 == 0; } if (1) { my $s1 = setunion(\@set1,\@set2); die "union of odds and evens should be all" unless vecequal($s1,[0..2*$N-1]); my $s2 = setunion(\@set1,\@set3); die "union of odds and odds should be odds" unless vecequal($s2,\@set1); my $s3 = setunion(\@set2,\@set3); die "union of evens and odds should be all" unless vecequal($s3,[0..2*$N-1]); } if (1) { my $s1 = setminus(\@set1,\@set2); die "diff of odds and evens should be odds" unless vecequal($s1,\@set1); my $s2 = setminus(\@set1,\@set3); die "diff of odds and odds should be null" unless @$s2 == 0; my $s3 = setminus(\@set2,\@set3); die "diff of evens and odds should be evens" unless vecequal($s3,\@set2); } if (1) { my $s1 = setdelta(\@set1,\@set2); die "delta of odds and evens should be all" unless vecequal($s1,[0..2*$N-1]); my $s2 = setdelta(\@set1,\@set3); die "delta of odds and odds should be null" unless @$s2 == 0; my $s3 = setdelta(\@set2,\@set3); die "delta of evens and odds should be all" unless vecequal($s3,[0..2*$N-1]); } my @R; use Array::Set qw/set_intersect set_union set_diff set_symdiff/; use Set::SortedArray; my $saset4 = Set::SortedArray->new(@iset4); my $saset5 = Set::SortedArray->new(@iset5); my $R; use Set::IntSpan::Fast; my $sisf4 = Set::IntSpan::Fast->new(@iset4); my $sisf5 = Set::IntSpan::Fast->new(@iset5); use Set::Functional; my @sf4 = Set::Functional::setify(@iset4); my @sf5 = Set::Functional::setify(@iset5); use Set::Tiny; my $st4 = Set::Tiny->new(@iset4); my $st5 = Set::Tiny->new(@iset5); my $ts=0; cmpthese(-1, { "is_subset" => sub { $ts += set_is_subset(\@iset4, \@iset5); }, "contains" => sub { $ts += setcontains(\@iset4, \@iset5); }, }); cmpthese(-1, { "intersect odds/odds" => sub { $R=setintersect(\@set1,\@set1); }, "intersect odds/evens" => sub { $R=setintersect(\@set1,\@set2); }, "intersect rodds/evens" => sub { $R=setintersect(\@set2,\@set3); }, "intersect hashes" => sub { $R=setintersect(\@set4,\@set5); }, "intersect iset hashes" => sub { $R=setintersect(\@iset4,\@iset5); }, "Set::SortedArray iset" => sub { $R=$saset4->intersection($saset5); }, "Array::Set iset" => sub { $R=set_intersect(\@iset4,\@iset5); }, "Set::IntSpan::Fast iset"=>sub { $R=$sisf4->intersection($sisf5); }, "Set::Functional" => sub {@R=Set::Functional::intersection(\@sf4,\@sf5);}, "Set::Tiny" => sub { $R=$st4->intersection($st5);}, "MPUPP iset"=>sub { $R=Math::Prime::Util::PP::setintersect(\@iset4,\@iset5); }, #"inter1 iset hashes" => sub { $R=inter1(\@iset4,\@iset5); }, #"inter2 iset hashes" => sub { $R=inter2(\@iset4,\@iset5); }, #"inter3 iset hashes" => sub { $R=inter3(\@iset4,\@iset5); }, }); cmpthese(-1, { "union odds/odds" => sub { $R=setunion(\@set1,\@set1); }, "union odds/evens" => sub { $R=setunion(\@set1,\@set2); }, "union rodds/evens" => sub { $R=setunion(\@set2,\@set3); }, "union hashes" => sub { $R=setunion(\@set4,\@set5); }, "union iset hashes" => sub { $R=setunion(\@iset4,\@iset5); }, "union Set::Tiny" => sub { $R=$st4->union($st5);}, #"Set::SortedArray iset" => sub { $R=$saset4->union($saset5); }, #"Array::Set iset" => sub { $R=set_union(\@iset4,\@iset5); }, #"Set::IntSpan::Fast iset"=>sub { $R=$sisf4->union($sisf5); }, }); cmpthese(-1, { "minus odds/odds" => sub { $R=setminus(\@set1,\@set1); }, "minus odds/evens" => sub { $R=setminus(\@set1,\@set2); }, "minus rodds/evens" => sub { $R=setminus(\@set2,\@set3); }, "minus hashes" => sub { $R=setminus(\@set4,\@set5); }, "minus iset hashes" => sub { $R=setminus(\@iset4,\@iset5); }, "minus Set::Tiny" => sub { $R=$st4->difference($st5);}, #"Set::SortedArray iset" => sub { $R=$saset4->difference($saset5); }, #"Array::Set iset" => sub { $R=set_diff(\@iset4,\@iset5); }, #"Set::IntSpan::Fast iset"=>sub { $R=$sisf4->diff($sisf5); }, }); cmpthese(-1, { "delta odds/odds" => sub { $R=setdelta(\@set1,\@set1); }, "delta odds/evens" => sub { $R=setdelta(\@set1,\@set2); }, "delta rodds/evens" => sub { $R=setdelta(\@set2,\@set3); }, "delta hashes" => sub { $R=setdelta(\@set4,\@set5); }, "delta iset hashes" => sub { $R=setdelta(\@iset4,\@iset5); }, "Set::Tiny iset" => sub { $R=$st4->symmetric_difference($st5);}, "Set::SortedArray iset" => sub { $R=$saset4->symmetric_difference($saset5);}, "Array::Set iset" => sub { $R=set_symdiff(\@iset4,\@iset5); }, "Set::IntSpan::Fast iset"=>sub { $R=$sisf4->diff($sisf5); }, "MPUPP iset"=>sub { $R=Math::Prime::Util::PP::setdelta(\@iset4,\@iset5); }, }); sub inter1 { my($a1,$a2) = @_; my %counts; ++$counts{$_} for @$a1; my @c = grep { --$counts{$_} >= 0 } @$a2; return \@c; } sub inter2 { my($a1,$a2) = @_; my %count= (); foreach my $element (@$a1, @$a2) { $count{$element}++; } my @c; foreach my $element (keys %count) { push @c, $element if $count{$element} > 1; } return \@c; } sub inter3 { my($ra,$rb) = @_; #croak 'Not an array reference' unless (ref($ra) || '') eq 'ARRAY'; #croak 'Not an array reference' unless (ref($rb) || '') eq 'ARRAY'; ($ra,$rb) = ($rb,$ra) if scalar(@$ra) > scalar(@$rb); # Performance my(%ina,%seen,$k); $ina{$_}=undef for @$ra; my @set = grep { exists $ina{$_} && not $seen{$k=$_}++ } @$rb; #for (@set) { return vecsort(@set) if !ref($_) && ($_ >= INTMAX || $_ <= INTMIN); } @set = sort { $a<=>$b } @set; return \@set; } __END__ # Insert tmmpu 'csrand(5); $s=toset(map{urandomm(2000000)}1..500000); say scalar(@$s)' 442393 0.057s tmmpu 'csrand(5); $s=[]; $t+=setinsert($s,map{urandomm(2000000)}1..500000); say $t;' 442393 0.067s tmmpu 'csrand(5); $s=[]; use Math::Prime::Util::PP; $t+=Math::Prime::Util::PP::setinsert($s,map{urandomm(2000000)}1..500000); say $t;' 442393 0.105s # ^^^ These are inserting a single chunk of 500k numbers # \/ These are inserting one at a time tmmpu 'csrand(5); %h=(); for (1..500000) { $h{urandomm(2000000)}=1;} @s=vecsort(keys %h); say scalar(@s);' 442393 0.232s tmmpu 'use Set::Tiny; csrand(5); $s=Set::Tiny->new(); for (1..500000) { $s->insert(urandomm(2000000)) } say $s->size()' 442393 0.258s tmmpu 'use Set::Scalar; my $s=Set::Scalar->new(); csrand(5); for (1..500000) { $s->insert(urandomm(2000000)) } say $s->size();' 442393 1.344s tmmpu 'csrand(5); $s=[]; for (1..500000) { $t+=setinsert($s,urandomm(2000000)); } say $t;' 442393 3.967s tmmpu 'use Math::Prime::Util::PP; csrand(5); $s=[]; for (1..500000) { $t+=Math::Prime::Util::PP::setinsert($s,urandomm(2000000)); } say $t;' 442393 14.170s tmmpu 'use List::BinarySearch::XS qw/:all/; @s=(); csrand(5); for (1..500000) { $v=urandomm(2000000); $index=binsearch_pos {$a<=>$b} $v,@s; splice @s,$index,0,$v if $s[$index] != $v; } say scalar(@s)' 442393 17.504s tmmpu 'use Set::Intspan::Fast::XS; csrand(5); $s=Set::IntSpan::Fast::XS->new(); for (1..500000) { $s->add(urandomm(2000000)) } say $s->cardinality()' 442393 22.776s tmmpu 'use Tie::Array::Sorted; tie @s,"Tie::Array::Sorted",sub{ $_[0]<=>$_[1] }; csrand(5); for (1..500000) { push @s,urandomm(2000000); } $s=toset(@s); say scalar(@$s)' 442393 23.721s tmmpu 'use Set::SortedArray; my $s=Set::SortedArray->new(); csrand(5); for (1..50000) { $s=$s+[urandomm(2000000)]; } say $s->size();' 49407 164.110s (for 10x fewer insertions than above) # Another insert test, 20 inserts, final count is 786538 tmmpu 'csrand(5); $s=[1999990]; for (1..20) { setinsert($s,map {urandomm(2000000)}1..50000); say scalar(@$s); }' 0.195s tmmpu 'use Set::Tiny; csrand(5); $s=Set::Tiny->new(1999990); for (1..20) { $s->insert(map {urandomm(2000000)}1..50000); say $s->size(); }' 0.482s tmmpu 'use Set::Scalar; csrand(5); $s=Set::Scalar->new(1999990); for (1..20) { $s->insert(map {urandomm(2000000)}1..50000); say $s->size(); }' 1.405s tmmpu 'use Set::Intspan::Fast::XS; csrand(5); $s=Set::IntSpan::Fast::XS->new(1999990); for (1..20) { $s->add(map {urandomm(2000000)}1..50000); say $s->cardinality; }' 1.964s MPU_NO_XS=1 MPU_NO_GMP=1 tmmpu 'csrand(5); $s=[1999990]; for (1..20) { setinsert($s,map {urandomm(2000000)}1..50000); say scalar(@$s); }' 4.146s Math-Prime-Util-0.74/xt/divtest.pl000644 000765 000024 00000006551 15146553566 017071 0ustar00danastaff000000 000000 #!/usr/bin/env perl use warnings; use strict; use ntheory ":all"; use Math::Prime::Util::PP; use Math::BigInt; my @N = (1..255); push @N, map { (1 << $_)+0 } 8 .. 63; push @N, map { (1 << $_)-1 } 8 .. 63; push @N, map { (1 << $_)+1 } 8 .. 63; push @N, ~0; push @N, ~0 - 1; push @N, 479,709,1979,2293,5527,9491,18803,55697,67547,234977,472189,794831,1795987,3420581,6659201,8616679,32359207,36287963,110125493,186431731,329522393,579566597,1081042813,3930325367,8232694003,9965227067,18953892493,48398125001,74180605321,172260332171,531942628597,952424752493,1683828392317,4152728744257,7544680499843,11684892744529,29481476832221,44483282520737,80989922766787,165916886096329,372528286807679,625954070066009,2024742834179983,3492450230167973,8886306409922317,9866050790952803,35085838827392533,37974793647167711,79879452462015781,206179373730094717,508869317949427363,875096421074592361,2064451162885400581,4422949619687292341,4629427415289143573,9405019501832426699; push @N, 2232881419280027; # Crash and burn... my @negN = map { negint($_) } @N; print "running simple division tests\n"; for my $num (@N, @negN) { for my $den (@N, @negN) { #next unless $num >= 0 && $den >= 0; #print "$num $den\n"; # This can't be represented as an IV or UV, so skip it next if $den < 0 && ($num >> 63) > 0; my $mx = (tdivrem($num,$den))[0]; # These two always match my $bi = Math::BigInt->new($num)->btdiv($den); die "$num $den" if $bi ne $mx; my $mp = (Math::Prime::Util::PP::tdivrem($num,$den))[0]; die "$num $den" if "$mp" ne "$mx"; # This does not #my $nd = (ndivrem($num,$den))[0]; #die "$num $den" if $nd ne $mx; # my $nd = div9316n($num,$den); # die "$num $den" if $nd ne $mx; # print "$num $den = $nd\n" if $den == 2 && $num == 2232881419280027; # my $dm = (divmod9316n($num,$den))[0]; # print "$num $den = $dm\n" if $den == 2 && $num == 2232881419280027; # warn "$num $den" if $dm ne $mx; } } print "pass simple tests\n"; sub ndivrem { my($D,$d) = @_; ( int($D/$d), $D % $d ); } sub uidivrem { my($D,$d) = @_; use integer; ( int($D/$d), $D % $d ); } sub nfdivrem { my($D,$d) = @_; use POSIX; ( POSIX::floor($D/$d), $D % $d ); } sub div_and_mod { my($D,$d) = @_; ( divint($D,$d), modint($D,$d) ); } sub divmod9316 { my($D,$d) = @_; my $mod = $D % $d; (($D - $mod) / $d, $mod); } # This is SO close to working. But ... not always. sub divmod9316n { # Truncated div and mod my($D,$d) = @_; my $mod = $D % $d; $mod -= $d if $mod != 0 && (($D < 0 && $d >= 0) || ($D >= 0 && $d < 0)); (($D - $mod) / $d, $mod); } sub div9316 { my($D,$d) = @_; ($D - ($D % $d)) / $d; } sub div9316n { my($D,$d) = @_; #return -div9316(-$D, $d) if $D < 0 && $d >= 0; #return -div9316( $D,-$d) if $D >= 0 && $d < 0; #return div9316(-$D,-$d) if $D < 0 && $d < 0; #return div9316( $D, $d); # Truncated div and mod my $mod = $D % $d; $mod -= $d if $mod != 0 && (($D < 0 && $d >= 0) || ($D >= 0 && $d < 0)); return ($D - $mod) / $d; } sub ivmod { my($a,$n) = @_; die "wrong usage: n must be positive" unless $n >= 0; return $a % $n if $a >= 0; my $amodn = -$a % $n; return ($amodn == 0) ? 0 : $n-$amodn; } # div9316n wrong for things like: # # 1125899906842624 1 # 2232881419280027 2 # 4503599627370496 3 # 4503599627370496 4 # 9007199254740992 6 # 9007199254740993 9 # 3492450230167973 3 Math-Prime-Util-0.74/xt/check-nth-bounds.pl000644 000765 000024 00000002206 13667653334 020534 0ustar00danastaff000000 000000 #!/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.74/xt/rwh_primecount_numpy.py000755 000765 000024 00000001150 13025437630 021675 0ustar00danastaff000000 000000 #!/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.74/xt/test-nthapprox.pl000755 000765 000024 00000003064 13025437630 020371 0ustar00danastaff000000 000000 #!/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.74/xt/lucky.c000644 000765 000024 00000073773 15145577415 016355 0ustar00danastaff000000 000000 /* * Lucky number sieves and utilities. Standalone version 0.10, March 2023. * by Dana Jacobsen * * Includes small implementations of David Wilson's and Hugo van der Sanden's * algorithms from OEIS for comparison purposes. The bitmask implementation * here is faster and uses less memory. * * Originally part of Math::Prime::Util available here: * https://github.com/danaj/Math-Prime-Util * * The full pagelist implementation is not included here, as the bitmask is * superior in both memory and CPU time. The small monolithic version is * included and is quite fast for very small inputs if counting microseconds, * but is inappropriate for large sieves. * * Timings for different sizes and algorithms on 2020 M1 Macbook. * Generate lucky numbers to 100k 1M 10M 100M 1000M * ---- ----- ------ -------- -------- * bitmask126 0.003 0.018 0.100 0.781 9.708 * pagelist (monolithic) 0.002 0.137 6.824 1395.2 * cgen (using count array) 0.005 0.133 5.741 344.04 * wilson (iterated nth lucky) 0.024 0.879 54.069 3457.5 */ #include #include #include #include #include #include typedef unsigned long UV; #define UVCONST(x) ((unsigned long)x##UL) #define BMTYPE UV #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 MPU_MAX_LUCKY UVCONST(18446744073709551517) /* Maybe */ static int _verbose = 0; /******************************************************************************/ /* BITMASK126 DATA STRUCTURE */ /******************************************************************************/ /* * This is a bitmask for lucky numbers, using a 32-bit word for 126 integers. * Crucially, we use a tree of counts so we can skip to a given index in a * reasonable amount of time. * * The amount of memory used is about n/25. This is about 20x smaller than * the 64-bit pagelist or cgen method, and 10x smaller than Wilson's list, * in addition to being much faster than cgen or Wilson. */ #define SSHIFT 4 #define TSHIFT 3 #define ADDSIZE(bm, wi, n) \ { int _i; \ bm->size[wi] += n; \ bm->bsize[(wi) >> 3] += n; \ bm->sbsize[(wi) >> (3+SSHIFT)] += n; \ for (_i = 0; _i < bm->nilevels; _i++) \ bm->tbsize[_i][(wi) >> (3+SSHIFT+(_i+1)*TSHIFT)] += n; \ } static unsigned char _bm_offset[32] = {1,3,7,9,13,15,21,25,31,33,37,43,45,49,51,55,63,67,69,73,75,79,85,87,93,97,99,105,109,111,115,117}; static unsigned char _bm_bit[63] = {0,1,1,2,3,3,4,5,5,5,6,6,7,7,7,8,9,9,10,10,10,11,12,12,13,14,14,15,15,15,15,16,16,17,18,18,19,20,20,21,21,21,22,23,23,23,24,24,25,26,26,26,27,27,28,29,29,30,31,31,31,31,31}; #define BM_WORD(n) (((n)>>1) / 63) #define BM_BITN(n) _bm_bit[(((n)>>1) % 63)] #define BM_BITM(n) (1U << _bm_bit[(((n)>>1) % 63)]) /* From Stanford Bit Twiddling Hacks, via "Nominal Animal" */ static uint32_t _nth_bit_set(uint32_t n, uint32_t word) { const uint32_t pop2 = (word & 0x55555555u) + ((word >> 1) & 0x55555555u); const uint32_t pop4 = (pop2 & 0x33333333u) + ((pop2 >> 2) & 0x33333333u); const uint32_t pop8 = (pop4 & 0x0f0f0f0fu) + ((pop4 >> 4) & 0x0f0f0f0fu); const uint32_t pop16 = (pop8 & 0x00ff00ffu) + ((pop8 >> 8) & 0x00ff00ffu); const uint32_t pop32 = (pop16 & 0x000000ffu) + ((pop16 >>16) & 0x000000ffu); uint32_t temp, rank = 0; if (n++ >= pop32) return 32; temp = pop16 & 0xffu; if (n > temp) { n -= temp; rank += 16; } temp = (pop8 >> rank) & 0xffu; if (n > temp) { n -= temp; rank += 8; } temp = (pop4 >> rank) & 0x0fu; if (n > temp) { n -= temp; rank += 4; } temp = (pop2 >> rank) & 0x03u; if (n > temp) { n -= temp; rank += 2; } temp = (word >> rank) & 0x01u; if (n > temp) rank += 1; return rank; } typedef struct bitmask126_t { BMTYPE n; BMTYPE nelems; BMTYPE nwords; int nilevels; uint32_t* data; uint8_t* size; uint8_t* bsize; uint16_t* sbsize; BMTYPE* tbsize[12]; /* Further index levels */ } bitmask126_t; static bitmask126_t* bitmask126_create(BMTYPE n) { BMTYPE nblocks, nlevels; bitmask126_t *bm; New(0, bm, 1, bitmask126_t); bm->n = n; bm->nelems = 0; bm->nwords = (n+125)/126; nblocks = (bm->nwords + 7) / 8; Newz(0, bm->data, bm->nwords, uint32_t); Newz(0, bm->size, bm->nwords, uint8_t); Newz(0, bm->bsize, nblocks, uint8_t); nblocks = (nblocks + (1U << SSHIFT) - 1) >> SSHIFT; Newz(0, bm->sbsize, nblocks, uint16_t); for (nlevels=0; nlevels < 12 && nblocks > 2*(1U<> TSHIFT; Newz(0, bm->tbsize[nlevels], nblocks, BMTYPE); } bm->nilevels = nlevels; return bm; } static void bitmask126_destroy(bitmask126_t *bm) { int i; Safefree(bm->data); Safefree(bm->size); Safefree(bm->bsize); Safefree(bm->sbsize); for (i = 0; i < bm->nilevels; i++) Safefree(bm->tbsize[i]); bm->nelems = 0; bm->n = 0; Safefree(bm); } static void bitmask126_append(bitmask126_t *bm, BMTYPE n) { BMTYPE w = BM_WORD(n); bm->data[w] |= BM_BITM(n); ADDSIZE(bm, w, 1); bm->nelems++; } static BMTYPE* bitmask126_to_array(UV *size, bitmask126_t *bm) { BMTYPE nelem, wi, nwords, *arr; New(0, arr, bm->nelems, BMTYPE); nwords = bm->nwords; nelem = 0; for (wi = 0; wi < nwords; wi++) { uint32_t bit, w = bm->data[wi]; for (bit = 0; bit < 32; bit++, w >>= 1) if (w & 1) arr[nelem++] = wi*126 + _bm_offset[bit]; } if (nelem != bm->nelems) croak("bitmask126: bad number of elements in array"); *size = nelem; return arr; } static uint32_t* bitmask126_to_array32(UV *size, bitmask126_t *bm) { uint32_t nelem, wi, nwords, *arr; New(0, arr, bm->nelems, uint32_t); nwords = bm->nwords; nelem = 0; for (wi = 0; wi < nwords; wi++) { uint32_t bit, w = bm->data[wi]; for (bit = 0; bit < 32; bit++, w >>= 1) if (w & 1) arr[nelem++] = wi*126 + _bm_offset[bit]; } if (nelem != bm->nelems) croak("bitmask126: bad number of elements in array"); *size = nelem; return arr; } /* We want to find the e.g. 101'st set value, returns the array index wn. */ static BMTYPE _bitmask126_find_index(bitmask126_t *bm, BMTYPE *idx) { int lev; BMTYPE i = *idx, tbi, sbi, bi, wi; if (i > bm->nelems) croak("index higher than number of elements"); /* Skip though superblock tree (128,2048,32768,524288,... words) */ for (lev = bm->nilevels-1, tbi = 0; lev >= 0; lev--) { BMTYPE *tbsizei = bm->tbsize[lev]; for (tbi = tbi << TSHIFT; i >= tbsizei[tbi]; tbi++) i -= tbsizei[tbi]; } for (sbi = tbi << TSHIFT; i >= bm->sbsize[sbi]; sbi++)/* Skip superblocks */ i -= bm->sbsize[sbi]; for (bi = sbi << SSHIFT; i >= bm->bsize[bi]; bi++) /* Skip 8w blocks */ i -= bm->bsize[bi]; for (wi = bi << 3; i >= bm->size[wi]; wi++) /* Skip words */ i -= bm->size[wi]; *idx = i; return wi; } #if 0 static BMTYPE bitmask126_val(bitmask126_t *bm, BMTYPE idx) { BMTYPE wi; uint32_t bit; wi = _bitmask126_find_index(bm, &idx); bit = _nth_bit_set(idx, bm->data[wi]); return wi * 126 + _bm_offset[bit]; } #endif static void bitmask126_delete(bitmask126_t *bm, BMTYPE idx) { /* idx 0,1,... */ BMTYPE wi = _bitmask126_find_index(bm, &idx); if (bm->size[wi] == 1) { /* Only 1 value, zero the word. */ bm->data[wi] = 0; } else { /* Find the index bit and zero it */ uint32_t bit = _nth_bit_set(idx, bm->data[wi]); bm->data[wi] &= ~(1U << bit); } ADDSIZE(bm, wi, -1); bm->nelems--; } typedef struct bitmask126_iter_t { bitmask126_t *bm; uint32_t *data; BMTYPE wi; uint32_t bit; } bitmask126_iter_t; static bitmask126_iter_t bitmask126_iterator_create(bitmask126_t *bm, BMTYPE idx) { bitmask126_iter_t iter; if (idx >= bm->nelems) croak("bitmask126: invalid iterator initial position\n"); iter.bm = bm; iter.data = bm->data; iter.wi = _bitmask126_find_index(bm, &idx); iter.bit = _nth_bit_set(idx, bm->data[iter.wi]); return iter; } static BMTYPE bitmask126_iterator_next(bitmask126_iter_t *iter) { BMTYPE v, wi = iter->wi; uint32_t bit = iter->bit; uint32_t w = iter->data[wi] >> bit; while (w == 0) { /* skip any empty words */ w = iter->data[++wi]; bit = 0; } #if defined(__GNUC__) && (__GNUC__ >= 4 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) bit += __builtin_ctzl(w); #else for ( ; bit < 32; bit++, w >>= 1) /* Find next set bit */ if (w & 1) break; #endif v = wi * 126 + _bm_offset[bit]; if (++bit > 31) { /* Skip to next set bit */ bit = 0; wi++; } iter->bit = bit; iter->wi = wi; return v; } static BMTYPE bitmask126_iterator_prev(bitmask126_iter_t *iter) { BMTYPE v, wi = iter->wi; int bit = iter->bit; uint32_t w = iter->data[wi]; do { if (bit < 0) { if (wi == 0) croak("bitmask126: iterator underflow"); w = iter->data[--wi]; bit = 31; } for ( ; bit >= 0; bit--) { /* Find prev set bit */ if (w & (1U << bit)) break; } } while (bit < 0); v = wi * 126 + _bm_offset[bit]; if (bit > 0) { iter->bit = bit-1; iter->wi = wi; } else { iter->bit = 31; iter->wi = wi-1; } return v; } #undef BMTYPE #undef SSHIFT #undef TSHIFT #undef ADDSIZE #undef BM_WORD #undef BM_BITN #undef BM_BITM /******************************************************************************/ /******************************************************************************/ /******************************************************************************/ /******************************************************************************/ /* LUCKY NUMBERS */ /******************************************************************************/ static const unsigned char _small_lucky[48] = {1,3,7,9,13,15,21,25,31,33,37,43,49,51,63,67,69,73,75,79,87,93,99,105,111,115,127,129,133,135,141,151,159,163,169,171,189,193,195,201,205,211,219,223,231,235,237,241}; static const unsigned char _small_lucky_count[48] = {0,1,1,2,2,2,2,3,3,4,4,4,4,5,5,6,6,6,6,6,6,7,7,7,7,8,8,8,8,8,8,9,9,10,10,10,10,11,11,11,11,11,11,12,12,12,12,12}; /* True for any position where (n % 7*9) could be a lucky number */ static const char _lmask63[63+2] = {1,1,0,1,1,0,1,1,0,1,1,0,1,1,0,1,1,0,0,0,0,1,1,0,1,1,0,0,0,0,1,1,0,1,1,0,1,1,0,0,0,0,1,1,0,1,1,0,1,1,0,1,1,0,1,1,0,0,0,0,0,0,0,1,1}; /* mpufile '$n++; chomp; $v=$_; next unless $v > 10000; $m[ ($v>>1) % 4095 ]++; END { for (0..4094) { next unless $m[$_]; $b[$_ >> 5] |= (1 << ($_%32)); } say join ",",@b; }' ~/misc/ntheory/lucky_1e8.txt */ /* A large bitmask for ((n>>1) % 3*7*3*13) (819). Covers 2,3,7,9,13. */ static const uint32_t _lmask5[26] = {2334495963,2261929142,1169344621,2204739155,2727961910,1639207725,3513561243,2430232978,1754683725,3630970059,3025873062,1278646881,3658323539,3055177010,1830209833,3406669457,3054200212,1837519692,1531293898,650340770,757258597,2606838995,2530306226,1169218145,3408442969,11572}; /* Lucky Number sieves. * * Mask presieving for the first 5 levels, followed by pre-sieving with a small * number of initial values. * * For fairly small sieves, less than 250k or so, we use a simplied pagelist. * Unlike the full pagelist method, this does not use an index tree. * * For sieving of non-small sizes, a bitmask (32 bits per 126 integers) is * used, with an index tree allowing log(n) time index lookups. This is much * faster and uses substantially less memory than the other methods. Memory * use grows linearly with the sieve size n. * * Generate first 10M lucky numbers (from 1 to 196502733) on 2020 M1 Mac: * 1.8s bitmask126 memory: n/25 ( 8MB) * 3.1s pagelist_sieve32 memory: 4 * count * ~2.5 (100MB) * 4.2s pagelist_sieve64 memory: 8 * count * ~2.3 (190MB) * 1356s lucky_cgen memory: 8 * count * 2 (160MB) * 8950s Wilson memory: 8 * count * 1 ( 80MB) * * pagelist: * nth_lucky(1<<31): 55291335127 47 sec using lucky_sieve32 930MB * nth_lucky(1<<32): 113924214621 140 sec using lucky_sieve64 3.2GB * nth_lucky(1<<33): 234516370291 312 sec using lucky_sieve64 6.3GB * nth_lucky(1<<34): 482339741617 733 sec using lucky_sieve64 12.1GB * * bitmask: * nth_lucky(1<<31): 55291335127 23 sec using lucky_sieve32 89MB * nth_lucky(1<<32): 113924214621 50 sec using lucky_sieve64 173MB * nth_lucky(1<<33): 234516370291 107 sec using lucky_sieve64 341MB * nth_lucky(1<<34): 482339741617 224 sec using lucky_sieve64 675MB * nth_lucky(1<<35): 991238156013 469 sec using lucky_sieve64 1.3GB * nth_lucky(1<<36): 2035487409679 987 sec using lucky_sieve64 2.6GB * nth_lucky(1<<37): 4176793875529 2063 sec using lucky_sieve64 5.3GB * * A Graviton3 r7g takes about 1.6x more CPU time. * nth_lucky(1<<39) 17551419620869 in 258min on Graviton3 r7g, 21GB. * nth_lucky(1<<40) 35944896074391 in 523min on Graviton3 r7g, 42GB. * nth_lucky(1<<41) 73571139180453 in 1112min on Graviton3 r7g, 84GB. * nth_lucky(1<<42) 150499648533909 in 2303min on Graviton3 r7g, 168GB. * nth_lucky(1<<43) 307703784778627 in 3691min on Graviton3 r7g, 334GB. */ /* Simple 32-bit pagelist: fast for small (less than 10M or so) inputs. * Simple filtering, then sieve a big block using memmove. * This is memory intensive and has poor performance with large n. */ static uint32_t* _small_lucky_sieve32(UV *size, uint32_t n) { uint32_t i, m, c13, level, init_level, fsize, lsize, *lucky; if (n < 259) { if (n == 0) { *size = 0; return 0; } New(0, lucky, 5+n/5, uint32_t); for (lsize = 0; lsize < 48 && _small_lucky[lsize] <= n; lsize++) lucky[lsize] = _small_lucky[lsize]; *size = lsize; return lucky; } /* @l=(2,3,7,9,13); $n=vecprod(@l); $n -= divint($n,$_) for @l; say $n */ fsize = (uint64_t)1152*(n+4913)/4914; if (_verbose) { printf(" fsize %u\n", fsize); fflush(stdout); } New(0, lucky, 1 + fsize, uint32_t); lsize = c13 = 0; /* Create initial list, filtering out 3,7,9,13 */ for (i = 1, m = 1; i <= n; i += 6) { if (_lmask63[m ]) { if (++c13 == 13) c13 = 0; else lucky[lsize++] = i; } if (_lmask63[m+2] && (i+2) <= n) { if (++c13 == 13) c13 = 0; else lucky[lsize++] = i+2; } if ((m += 6) >= 63) m -= 63; } init_level = 5; if (_verbose) { printf(" finished initial list, lsize %u\n", lsize); fflush(stdout); } /* After the fill-in, we'll start deleting at 15 */ for (level = init_level; level < lsize && lucky[level]-1 < lsize; level++) { uint32_t skip = lucky[level]-1, nlsize = skip; if (2*(skip+1) > lsize) break; /* Only single skips left */ for (i = skip+1; i < lsize; i += skip+1) { uint32_t ncopy = (skip <= (lsize-i)) ? skip : (lsize-i); memmove( lucky + nlsize, lucky + i, ncopy * sizeof(uint32_t) ); nlsize += ncopy; } lsize = nlsize; } if (_verbose) { printf(" finished multi-skip deletes, level %u, lsize %u\n", level, lsize); fflush(stdout); } /* Now we just have single skips. Process them all in one pass. */ if (level < lsize && lucky[level]-1 < lsize) { uint32_t skip = lucky[level], nlsize = skip-1; while (skip < lsize) { uint32_t ncopy = lucky[level+1] - lucky[level]; if (ncopy > lsize-skip) ncopy = lsize - skip; memmove(lucky + nlsize, lucky + skip, ncopy * sizeof(uint32_t)); nlsize += ncopy; skip += ncopy + 1; level++; } lsize = nlsize; } if (_verbose) { printf(" finished all deletes, lsize %u\n", lsize); fflush(stdout); } *size = lsize; return lucky; } static bitmask126_t* _bitmask126_sieve(UV* size, UV n) { UV i, lsize, level, init_level; bitmask126_t *pl; pl = bitmask126_create(n); { uint8_t count[48] = {0}; uint32_t m, sln, ln, lbeg, lend; /* Decide how much additional filtering we'll do. */ sln = (n <= 200000000) ? 21 : (n <= 0xFFFFFFFF) ? 25 : 87; for (lbeg = lend = 5; lend < 48; lend++) if (_small_lucky[lend] >= sln) break; if (_verbose) { printf("bitmask lucky pre-sieve using %u lucky numbers up to %u\n", lend, _small_lucky[lend]); fflush(stdout); } /* Construct the initial list */ for (i = 1, m = 0; i <= n; i += 2, m += 1) { if (m >= 819) m -= 819; /* m = (i>>1) % 819 */ if (_lmask5[m >> 5] & (1U << (m & 0x1F))) { for (ln = lbeg; ln <= lend; ln++) { if (++count[ln] == _small_lucky[ln]) { count[ln] = 0; break; } } if (ln > lend) bitmask126_append(pl,i); } } init_level = lend+1; } lsize = pl->nelems; if (_verbose) { printf("bitmask lucky done inserting. values: %lu\n",lsize); fflush(stdout); } if (init_level < lsize) { bitmask126_iter_t iter = bitmask126_iterator_create(pl, init_level); for (level = init_level; level < lsize; level++) { UV skip = bitmask126_iterator_next(&iter) - 1; if (skip >= lsize) break; for (i = skip; i < lsize; i += skip) { bitmask126_delete(pl, i); lsize--; } } if (_verbose) { printf("bitmask lucky done sieving. values: %lu\n",lsize); fflush(stdout); } } *size = lsize; return pl; } uint32_t* lucky_sieve32(UV *size, uint32_t n) { uint32_t *lucky; bitmask126_t *pl; if (n == 0) { *size = 0; return 0; } if (n > 4294967275U) n = 4294967275U; /* Max 32-bit lucky number */ if (n <= 240000U) return _small_lucky_sieve32(size, n); pl = _bitmask126_sieve(size, n); lucky = bitmask126_to_array32(size, pl); if (_verbose) { printf("lucky_sieve32 done copying.\n"); fflush(stdout); } bitmask126_destroy(pl); return lucky; } UV* lucky_sieve64(UV *size, UV n) { UV *lucky; bitmask126_t *pl; if (n == 0) { *size = 0; return 0; } pl = _bitmask126_sieve(size, n); lucky = bitmask126_to_array(size, pl); if (_verbose) { printf("lucky_sieve64 done copying.\n"); fflush(stdout); } bitmask126_destroy(pl); return lucky; } UV* lucky_sieve_range(UV *size, UV beg, UV end) { UV i, nlucky, startcount, *lucky; bitmask126_t *pl; bitmask126_iter_t iter; if (end == 0 || beg > end) { *size = 0; return 0; } if (beg <= 1) return lucky_sieve64(size, end); startcount = 0; /* lucky_count_lower(beg) - 1; */ pl = _bitmask126_sieve(size, end); New(0, lucky, *size - startcount, UV); iter = bitmask126_iterator_create(pl, startcount); for (i = startcount, nlucky = 0; i < *size; i++) { UV l = bitmask126_iterator_next(&iter); if (l >= beg) lucky[nlucky++] = l; } bitmask126_destroy(pl); *size = nlucky; return lucky; } /* Lucky Number sieve for 64-bit inputs. * Uses running counters to skip entries while we add them. * Based substantially on Hugo van der Sanden's cgen_lucky.c. */ UV* lucky_sieve_cgen(UV *size, UV n) { UV i, j, c3, lsize, lmax, lindex, *lucky, *count; if (n == 0) { *size = 0; return 0; } /* Init */ lmax = (n < 1000) ? 153 : 100 + n/log(n); New(0, lucky, lmax, UV); New(0, count, lmax, UV); lucky[0] = 1; lucky[1] = 3; lucky[2] = 7; lindex = 2; lsize = 1; c3 = 2; for (i = 3; i <= n; i += 2) { if (!--c3) { c3 = 3; continue; } /* Shortcut count[1] */ for (j = 2; j < lindex; j++) { if (--count[j] == 0) { count[j] = lucky[j]; break; } } if (j < lindex) continue; if (lsize >= lmax) { /* Given the estimate, we probably never do this. */ lmax = 1 + lsize * 1.2; Renew(lucky, lmax, UV); Renew(count, lmax, UV); } lucky[lsize] = count[lsize] = i; lsize++; if (lucky[lindex] == lsize) { lindex++; lsize--; /* Discard immediately */ } } Safefree(count); *size = lsize; return lucky; } /* Lucky Number sieve based on David W. Wilson's generator */ UV* lucky_sieve_wilson(UV *size, UV n) { UV lmax, nlucky, g, k, i, *lucky; if (n == 0) { *size = 0; return 0; } lmax = (n <= 6) ? 1+(n>2) : 5 + 1.039 * n/log(n); New(0, lucky, lmax, UV); nlucky = 0; if (n >= 1) lucky[nlucky++] = 1; if (n >= 3) lucky[nlucky++] = 3; for (g = 0; nlucky < lmax; nlucky++) { if (lucky[g+1] <= nlucky+1) g++; for (k = nlucky, i = g; i >= 1; i--) k = k * lucky[i] / (lucky[i]-1); k = 2*k; if (k+1 > n) break; lucky[nlucky] = k+1; } *size = nlucky; return lucky; } /******************************************************************************/ /******************************************************************************/ /******************************************************************************/ static UV _simple_lucky_count_upper(UV n) { double a, logn = log(n); if (n <= 6) return (n > 0) + (n > 2); if (n <= 7000) return 5 + 1.039 * n/logn; /* Don't make discontinities */ a = (n < 10017000) ? 0.58003 - 3.00e-9 * (n-7000) : 0.55; return n/(1.065*logn - a - 3.1/logn - 2.85/(logn*logn)); } UV lucky_count_upper(UV n) { /* Holds under 1e9 */ if (n < 48) return _small_lucky_count[n]; return _simple_lucky_count_upper(n); } UV lucky_count_range(UV lo, UV hi) { UV nlucky, lsize; if (hi < lo) return 0; if (hi < 48) return _small_lucky_count[hi] - (lo == 0 ? 0 : _small_lucky_count[lo-1]); /* * Analogous to how nth_lucky works, we sieve enough lucky numbers to * ensure we cover everything up to 'hi'. We can then get an exact * count by determining exactly how many values will be removed. */ if ((lo & 1)) lo--; /* Both lo and hi will be even */ if ((hi & 1)) hi++; lsize = 1+lucky_count_upper(hi); if (hi <= UVCONST(2000000000)) { uint32_t i, hicount = hi/2, locount = lo/2; uint32_t *lucky32 = lucky_sieve32(&nlucky, lsize); for (i = 1; i < nlucky && lucky32[i] <= lo; i++) { locount -= locount/lucky32[i]; hicount -= hicount/lucky32[i]; } for ( ; i < nlucky && lucky32[i] <= hicount; i++) hicount -= hicount/lucky32[i]; Safefree(lucky32); return hicount - locount; } else { /* We use the iterator here to cut down on memory use. */ UV i, hicount = hi/2, locount = lo/2; bitmask126_t* pl = _bitmask126_sieve(&nlucky, lsize); bitmask126_iter_t iter = bitmask126_iterator_create(pl, 1); for (i = 1; i < nlucky; i++) { UV l = bitmask126_iterator_next(&iter); if (l <= lo) locount -= locount/l; if (l > hicount) break; hicount -= hicount/l; } bitmask126_destroy(pl); return hicount - locount; } } UV lucky_count(UV n) { return lucky_count_range(0,n); } UV nth_lucky(UV n) { UV i, k, nlucky; if (n <= 48) return (n == 0) ? 0 : _small_lucky[n-1]; /* Apply the backward sieve, ala Wilson, for entry n */ if (n <= UVCONST(100000000)) { uint32_t *lucky32 = lucky_sieve32(&nlucky, n); for (i = nlucky-1, k = n-1; i >= 1; i--) k += k/(lucky32[i]-1); Safefree(lucky32); } else { /* Iterate backwards through the sieve directly to save memory. */ bitmask126_t* pl = _bitmask126_sieve(&nlucky, n); bitmask126_iter_t iter = bitmask126_iterator_create(pl, nlucky-1); for (i = nlucky-1, k = n-1; i >= 1; i--) k += k / (bitmask126_iterator_prev(&iter) - 1); bitmask126_destroy(pl); } return (2 * k + 1); } static int _test_lucky_to(UV lsize, UV *beg, UV *end) { UV i = *beg, pos = *end, l, quo, nlucky; int ret = -1; if (lsize <= 700000000U) { uint32_t *lucky32 = lucky_sieve32(&nlucky, lsize); while (i < nlucky) { l = lucky32[i++]; if (pos < l) { ret = 1; break; } quo = pos / l; if (pos == quo*l) { ret = 0; break; } pos -= quo; } Safefree(lucky32); } else { /* For 64-bit, iterate directly through the bit-mask to save memory. */ bitmask126_t* pl = _bitmask126_sieve(&nlucky, lsize); if (i < nlucky) { bitmask126_iter_t iter = bitmask126_iterator_create(pl, i); while (i < nlucky) { l = bitmask126_iterator_next(&iter); i++; if (pos < l) { ret = 1; break; } quo = pos / l; if (pos == quo*l) { ret = 0; break; } pos -= quo; } } bitmask126_destroy(pl); } /* printf("tested lsize = %lu from %lu to %lu\n", lsize, *beg, i-1); */ *beg = i; *end = pos; return ret; } int is_lucky(UV n) { UV i, l, quo, pos, lsize; int res; /* Simple pre-tests */ if ( !(n & 1) || (n%6) == 5 || !_lmask63[n % 63]) return 0; if (n < 45) return 1; if (n > MPU_MAX_LUCKY) return 0; /* Check valid position using the static list */ pos = (n+1) >> 1; /* Initial position in odds */ for (i = 1; i < 48; i++) { l = _small_lucky[i]; if (pos < l) return 1; quo = pos / l; if (pos == quo*l) return 0; pos -= quo; } lsize = 1+lucky_count_upper(n); { /* Check more small values */ UV psize = 600, gfac = 6; while (psize < lsize/3) { res = _test_lucky_to(psize, &i, &pos); if (res != -1) return res; psize *= gfac; gfac += 1; } } res = _test_lucky_to(lsize, &i, &pos); return (res == 0) ? 0 : 1; } /******************************************************************************/ /******************************************************************************/ /******************************************************************************/ static void _dieusage(const char* pname) { printf("lucky number sieve version 0.10. Dana Jacobsen, 2023.\n\n"); printf("Usage: %s [options] \n\n", pname); printf("With no options, print lucky numbers up to (inclusive)\n\n"); printf("Options:\n"); printf(" -v set verbose (a few extra lines of information)\n"); printf(" -q set quiet (do work but don't print anything)\n"); printf(" -help this message\n"); printf("\n"); printf(" -t test if is a lucky number\n"); printf(" -c count of lucky numbers up to (inclusive)\n"); printf(" -n the -th lucky number\n"); printf("\n"); printf(" -s sieve with counts (Hugo van der Sanden's method)\n"); printf(" -w compute using nth-lucky method (David Wilson's method)\n"); printf(" -p sieve with monolithic pagelist\n"); printf(" -b sieve with bitmask (the default)\n"); exit(0); } #include int main(int argc, char *argv[]) { UV i, n, nlucky; int a, optdone = 0; int flag_verbose = 0, flag_quiet = 0; int flag_test = 0, flag_count = 0, flag_nth = 0; int flag_cgen = 0, flag_wilson = 0, flag_pagelist = 0, flag_bitmask = 1; if (argc < 2) _dieusage(argv[0]); for (a = 1; a < argc; a++) { if (!optdone && argv[a][0] == '-') { if (strcmp(argv[a], "--") == 0) { optdone = 1; } else if (strcmp(argv[a], "-v") == 0) { flag_verbose = 1; } else if (strcmp(argv[a], "-q") == 0) { flag_quiet = 1; } else if (strcmp(argv[a], "-help") == 0 || strcmp(argv[a], "--help") == 0) { _dieusage(argv[0]); } else if (strcmp(argv[a], "-t") == 0) { flag_test = 1; flag_count = 0; flag_nth = 0; } else if (strcmp(argv[a], "-c") == 0) { flag_test = 0; flag_count = 1; flag_nth = 0; } else if (strcmp(argv[a], "-n") == 0) { flag_test = 0; flag_count = 0; flag_nth = 1; } else if (strcmp(argv[a], "-s") == 0) { flag_cgen = 1; flag_wilson = 0; flag_pagelist = 0; flag_bitmask = 0; } else if (strcmp(argv[a], "-w") == 0) { flag_cgen = 0; flag_wilson = 1; flag_pagelist = 0; flag_bitmask = 0; } else if (strcmp(argv[a], "-p") == 0) { flag_cgen = 0; flag_wilson = 0; flag_pagelist = 1; flag_bitmask = 0; } else if (strcmp(argv[a], "-b") == 0) { flag_cgen = 0; flag_wilson = 0; flag_pagelist = 0; flag_bitmask = 1; } else { printf("Unknown option: %s\n\n", argv[a]); _dieusage(argv[0]); } continue; } break; } n = strtoul(argv[a], 0, 10); if (n == ULONG_MAX && errno == ERANGE) { printf("Argument larger than ULONG_MAX\n"); return(-1); } if (flag_verbose) _verbose = 1; /************/ if (flag_test) { int is = is_lucky(n); if (!flag_quiet) printf("%lu %s a lucky number\n", n, is ? "is" : "is not"); return is; } if (flag_nth) { UV nth = nth_lucky(n); if (!flag_quiet) printf("%lu\n", nth); return 0; } if (flag_count) { UV count = lucky_count(n); if (!flag_quiet) printf("%lu\n", count); return 0; } /************/ if (flag_wilson) { UV* lucky64 = lucky_sieve_wilson(&nlucky, n); if (!flag_quiet) for (i = 0; i < nlucky; i++) printf("%lu\n", lucky64[i]); Safefree(lucky64); return 0; } if (flag_cgen) { UV* lucky64 = lucky_sieve_cgen(&nlucky, n); if (!flag_quiet) for (i = 0; i < nlucky; i++) printf("%lu\n", lucky64[i]); Safefree(lucky64); return 0; } if (flag_pagelist) { uint32_t *lucky32; if (n > 0xFFFFFFFF) { printf("Small monolithic pagelist only supports 32-bit inputs\n"); exit(0); } lucky32 = _small_lucky_sieve32(&nlucky, n); if (!flag_quiet) for (i = 0; i < nlucky; i++) printf("%u\n", lucky32[i]); Safefree(lucky32); return 0; } #if 0 /* Sieve to array. Convenient. */ if (n <= 0xFFFFFFFF) { uint32_t* lucky32 = lucky_sieve32(&nlucky, n); if (!flag_quiet) for (i = 0; i < nlucky; i++) printf("%u\n", lucky32[i]); Safefree(lucky32); } else { UV* lucky64 = lucky_sieve_range(&nlucky, 0, n); if (!flag_quiet) for (i = 0; i < nlucky; i++) printf("%lu\n", lucky64[i]); Safefree(lucky64); } #else /* Use the iterator */ if (n > 0) { bitmask126_t* pl = _bitmask126_sieve(&nlucky, n); if (!flag_quiet) { bitmask126_iter_t iter = bitmask126_iterator_create(pl, 0); for (i = 0; i < nlucky; i++) printf("%lu\n", bitmask126_iterator_next(&iter)); } bitmask126_destroy(pl); } #endif return(0); } Math-Prime-Util-0.74/xt/test-ispower.pl000755 000765 000024 00000001566 15037171065 020045 0ustar00danastaff000000 000000 #!/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 "\nfail $n\n" unless is_power($n); foreach my $o (-10..10) { my $m = $n+$o; next if $m==$n; die "\nfail $m ($n + $o)\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.74/xt/foralmostprimes.pl000644 000765 000024 00000002502 14764024027 020613 0ustar00danastaff000000 000000 #!/usr/bin/env perl use warnings; use strict; use ntheory ":all"; use v5.16; $|=1; my @cmap = (0..9, 'a'..'z', 'A'..'Z','!','@','#','$','%'); while (1) { my $a = urandomm(1e13); my $l = 1 + urandomm(50000); my $k = 1 + urandomm(64); my $b = $a + $l - 1; #$b=~0; $a=$b-$l; my(@a1, @a2); print "$cmap[$k]"; #@a1 = @{Math::Prime::Util::almost_prime_sieve($k, $a, $b)}; foralmostprimes { push @a1,$_; } $k, $a, $b; for ($a .. $b) { push @a2, $_ if prime_bigomega($_)==$k; } #die "k $k beg $a end $b" unless areq(\@a1,\@a2); #die "\nforalmostprimes { say } $k, $a, $b;\n" unless areq(\@a1,\@a2); die "\nforalmostprimes { say } $k, $a, $b;\n" unless vecequal(\@a1,\@a2); } # We have vecequal now sub areq { my($a,$b) = @_; return 1 if !defined $a && !defined $b; return 0 unless defined $a && defined $b; return 0 unless scalar(@$a) == scalar(@$b); for my $i (0 .. $#$a) { next if !defined $a->[$i] && !defined $b->[$i]; return 0 if !defined $a->[$i] || !defined $b->[$i]; return 0 if $a->[$i] != $b->[$i]; } 1; } # mmpu 'for my $k (1..12) { for my $l (0 .. 100) { for my $s (0 .. 1000) { say "---- $k $s $l"; foralmostprimes { say } $k,$s,$s+$l; } } }' | shasum # mmpu 'for my $k (1..61) { say "$k:"; foralmostprimes { say } $k,nth_almost_prime($k,10),nth_almost_prime($k,11); }' | shasum Math-Prime-Util-0.74/xt/test-nextprime-yafu.pl000755 000765 000024 00000004574 13667653334 021347 0ustar00danastaff000000 000000 #!/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.74/xt/divisors.pl000644 000765 000024 00000003230 14613363164 017227 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util qw/divisors vecequal/; use Math::Prime::Util::PP; use Math::Prime::Util::GMP; my($lim,$klim) = (200000,800); print "scalar divisors from 0 to $lim ... "; for my $n (0..$lim) { my $t1 = 0+Math::Prime::Util::divisors($n); my $t2 = 0+Math::Prime::Util::GMP::divisors($n); my $t3 = 0+Math::Prime::Util::PP::divisors($n); die "FAIL scalar divisors $n: $t1 $t2 $t3\n" unless $t1 == $t2 && $t2 == $t3; } print "PASS\n"; print "list divisors from 0 to $lim ... "; for my $n (0..$lim) { my @t1 = Math::Prime::Util::divisors($n); my @t2 = Math::Prime::Util::GMP::divisors($n); my @t3 = Math::Prime::Util::PP::divisors($n); die "FAIL list divisors $n: [@t1] [@t2] [@t3]\n" unless vecequal(\@t1,\@t2) && vecequal(\@t1,\@t3); } print "PASS\n"; print "scalar restricted divisors from 0 to $klim ... "; for my $n (0..$klim) { for my $k (0 .. $n+6) { my $t1 = 0+Math::Prime::Util::divisors($n,$k); my $t2 = 0+Math::Prime::Util::GMP::divisors($n,$k); my $t3 = 0+Math::Prime::Util::PP::divisors($n,$k); die "FAIL scalar divisors $n,$k: $t1 $t2 $t3\n" unless $t1 == $t2 && $t2 == $t3; } } print "PASS\n"; print "list restricted divisors from 0 to $klim .. "; for my $n (0..$klim) { for my $k (0 .. $n+6) { my @t1 = Math::Prime::Util::divisors($n,$k); my @t2 = Math::Prime::Util::GMP::divisors($n,$k); my @t3 = Math::Prime::Util::PP::divisors($n,$k); die "FAIL list divisors $n,$k: [@t1] [@t2] [@t3]\n" unless vecequal(\@t1,\@t2) && vecequal(\@t1,\@t3); } } print "PASS\n"; print "PASS all comparisons for divisors() code\n"; Math-Prime-Util-0.74/xt/A003459.pl000644 000765 000024 00000002623 14056645657 016252 0ustar00danastaff000000 000000 #!/usr/bin/env perl use warnings; use strict; use ntheory ":all"; use v5.16; # formultiperm is done by doing a require of the Perl code. Since this is # inside the forprimes, it does the require inside a call_sv. This can lead # to a stack overflow if the required module does too many static variables. # This is probably a bug in Perl, but regardless this is something we should # work around. sub t1 { my $n = shift; forprimes { my $ok = 1; formultiperm { if (!is_prime(fromdigits([@_]))) { $ok = 0; lastfor; } } [todigits($_)]; say if $ok; } $n; } sub t2 { my $n = shift; forprimes { if (!/[^1379]/) { my $ok = 1; formultiperm { if (!is_prime(fromdigits([@_]))) { $ok = 0; lastfor; } } [todigits($_)]; say if $ok; } } $n; } # M. F. Hasler method. # This runs about 2x faster than Pari/GP sub t3 { my $digits = shift; for my $n (1 .. $digits) { my @S; my $r = divint(powint(10,$n),9); for my $a (1 .. (($n<=1) ? 1 : 9)) { for my $b ( (($n>2) ? 1-$a : 0) .. 9-$a ) { my $v = mulint($a,$r); if ($b == 0) { push @S, $v if is_prime($v); } else { next unless vecall { is_prime(addint($v,mulint($b,powint(10,$_)))) } 0 .. $n-1; push @S, map { addint($v,mulint($b,powint(10,$_))) } 0 .. $n-1; } } } say for sort { $a<=>$b } @S; } } t2(10000); #t3(1031); Math-Prime-Util-0.74/xt/nthprime.t000644 000765 000024 00000007721 13025437630 017050 0ustar00danastaff000000 000000 #!/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.74/xt/legendre_phi.t000644 000765 000024 00000001145 14007774536 017653 0ustar00danastaff000000 000000 #!/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.74/xt/totientsum.pl000644 000765 000024 00000007542 14773127256 017621 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use 5.020; use experimental qw(signatures); use Math::Prime::Util qw/euler_phi moebius divint sqrtint rootint vecsum sumtotient/; my $n = shift || 1_000_000; my $s; # 1 sieve them all and sum #print "sum totient $n: ", vecsum(euler_phi(0,$n)), "\n"; # 2 sieve them all and sum if (0) { $s = 0; $s += $_ for euler_phi(0,$n); print "sum2 $n: $s\n"; } # 3 sieve mobius and sum if (0) { my @m = moebius(0,$n); $s = 1; for (1..$n) { if ($m[$_] != 0) { my $d = divint($n,$_); $s += $m[$_] * $d * $d; } } $s >>= 1; print "sum3 $n: $s\n"; } # 4 from sidef my @tsum_cache = (0); sub R { my $n = shift; my $s = sqrtint($n); if ($#tsum_cache < $s) { $tsum_cache[$_] = $tsum_cache[$_-1] + euler_phi($_) for 1 .. $s; } return $tsum_cache[$n] if $n <= $#tsum_cache; my $L = ($n*($n-1)) >> 1; for my $k (2 .. divint($n, $s+1)) { $L -= R(divint($n, $k)); } for my $k (1..$s) { $L -= $tsum_cache[$k] * (divint($n,$k) - divint($n,$k+1)); } return $L; } #print "sum4 $n: ", R($n),"\n"; # 5 from Andy on stackoverflow my @x2; sub R2 { my $n = shift; return 0 if $n <= 1; return $x2[$n] if defined $x2[$n]; my $sum = ($n*($n-1)) >> 1; my $m = 2; while (1) { my $x = divint($n,$m); my $nxt = divint($n,$x); if ($nxt >= $n) { $x2[$n] = $sum - ($n-$m+1) * R2($x); return $x2[$n]; } $sum -= ($nxt-$m+1) * R2($x); $m = $nxt + 1; } } #print "sum5 $n: ", 1+R2($n),"\n"; # 6 Basic sub R3 { my $n = shift; return $n if $n <= 2; my $sum = ($n*($n-1)) >> 1; for my $m (2 .. $n) { $sum -= R3(divint($n,$m)); } $sum; } #print "sum6 $n: ", R3($n),"\n"; # 7 from other definition my @r4c; sub R4 { my $n = shift; return $n if $n <= 2; return $r4c[$n] if defined $r4c[$n]; my $sum = ($n*($n-1)) >> 1; my $sqrtn = sqrtint($n); for my $i (2 .. $sqrtn) { $sum -= R4(divint($n,$i)); } for my $j (1 .. $sqrtn) { $sum -= R4($j) * (divint($n,$j) - divint($n,$j+1)); } $r4c[$n] = $sum; $sum; } #print "sum7 $n: ", R3($n),"\n"; # 8 from oeis 002088 my @acache; my $_l = 0; sub a002088 { my $n = shift; return $n if $n <= 2; return $acache[$n] if defined $acache[$n]; my $c = 0; my $j = 2; my $k1 = divint($n, $j); while ($k1 > 1) { my $j2 = divint($n, $k1) + 1; $c += ($j2 - $j) * (2*a002088($k1)-1); $j = $j2; $k1 = divint($n, $j2); } my $sum = (($n * ($n-1) - $c + $j) >> 1); $acache[$n] = $sum; return $sum; } #print "sum8 $n: ", a002088($n),"\n"; # https://raw.githubusercontent.com/trizen/perl-scripts/master/Math/partial_sums_of_euler_totient_function_fast.pl sub partial_sums_of_euler_totient($n) { my $s = sqrtint($n); my @euler_sum_lookup = (0); my $lookup_size = 2 * rootint($n, 3)**2; my @euler_phi = euler_phi(0, $lookup_size); foreach my $i (1 .. $lookup_size) { $euler_sum_lookup[$i] = $euler_sum_lookup[$i - 1] + $euler_phi[$i]; } my %seen; sub ($n) { if ($n <= $lookup_size) { return $euler_sum_lookup[$n]; } if (exists $seen{$n}) { return $seen{$n}; } my $s = sqrtint($n); my $T = ($n * ($n + 1)) >> 1; foreach my $k (2 .. int($n / ($s + 1))) { $T -= __SUB__->(int($n / $k)); } foreach my $k (1 .. $s) { $T -= (int($n / $k) - int($n / ($k + 1))) * __SUB__->($k); } $seen{$n} = $T; }->($n); } print "sum9 $n: ", partial_sums_of_euler_totient($n),"\n"; # 5,8 are fast. 9 is 10x faster than those. # MPU uses Trizen's algorithm from 9. # # MPU PP is a little faster than 9 and doesn't overflow with n > 32-bit. # MPU XS is about 100x faster, and has 128-bit support. print "MPU: $n: ", sumtotient($n),"\n"; Math-Prime-Util-0.74/xt/test-pcapprox.pl000755 000765 000024 00000005340 13025437630 020201 0ustar00danastaff000000 000000 #!/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.74/xt/make-perrin-data.pl000644 000765 000024 00000003161 13025437630 020505 0ustar00danastaff000000 000000 #!/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.74/xt/test-rootint.pl000644 000765 000024 00000003141 15146553566 020052 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Carp qw/carp croak confess/; $| = 1; # fast pipes use Math::Prime::Util qw/rootint powint is_perfect_power is_power addint subint/; use Math::Prime::Util::PP; # Have it available for comparison my @rootmax = (0,0,4294967295,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,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2); for my $k (reverse 3 .. 63) { my($j,$nextroot,$r) = (0,1); # 1. Check all small inputs for my $n (0..200000) { my $flag = 0 + ($n == $nextroot); if ($flag) { $j++; $nextroot = powint($j+1,$k); } else { $flag |= ($n == 0); } #croak "is_perfect_power($n) != $flag" if is_perfect_power($n) != $flag; croak "is_power($n,$k) != $flag" unless ($flag && is_power($n,$k,\$r) && $r == $j) || (!$flag && !is_power($n,$k)); croak "bad rootint($n,$k)" unless rootint($n,$k) == $j; } # 2. Check all j^k and a small window around them while (++$j <= $rootmax[$k]) { my $n = powint($j,$k); croak "is_power($n,$k) != 1" unless is_power($n,$k,\$r); croak "is_power($n,$k) root $r != $j" if $r != $j; for my $i (-10 .. 10) { my $rexpect = $j - ($i < 0); $r = rootint($n+$i,$k); croak "rootint($n + $i,$k) = $r != $rexpect" unless $r == $rexpect; } } # 3. Check values near 2^64 my $rexpect = $j-1; for my $i (0 .. 10000) { my $n = subint(~0,$i); $r = rootint($n+$i,$k); croak "rootint($n,$k) = $r != $rexpect" unless $r == $rexpect; } print "$k "; } print "\n"; Math-Prime-Util-0.74/xt/binomialmod.pl000644 000765 000024 00000002371 15153231011 017645 0ustar00danastaff000000 000000 #!/usr/bin/env perl use warnings; use strict; use ntheory qw/binomialmod next_prime/; #Math::Prime::Util::prime_set_config(bigint=>"Math::GMPz"); { my $s = 0; my $p = 2; for my $n (1..4000) { for my $k (1..$n) { $b=binomialmod($n,$k,$p); $s+=$b; } } die "small binomial mod 2" if $s != 465296; print " ok binomialmod(1..4000, 1..n, 2)\n"; } { my $s = 0; for my $p (1..120) { for my $n (1..100) { for my $k (1..$n) { $b=binomialmod($n,$k,$p); $s += $b; } } } die "small binomial mod 1..120" if $s != 13535875; print " ok binomialmod(1..100, 1..n, 1..120)\n"; } { my @expect = (qw/51200 90431 214840 396378 855185 1038432 1316041 1565620 2185172 2879324 3794082 4866224 5227689 5568658 6050631 6944996 7792862 7766337 8805047 9303431 9470898 10240897 11059095 11588935 12579194 13417658 13460749 13817518 14358681 14906734/); my $p = 2; for (0..$#expect) { my $s=0; for my $n (1..1000) { for my $k (1..$n) { $s += binomialmod($n,$k,$p); #$s += Math::Prime::Util::binomial($n,$k) % $p; }; } die "wrong binomialmod(1..1000,1..n,$p)\n" unless $s == $expect[$_]; print " ok binomialmod(1..1000, 1..n, $p)\n"; $p=next_prime($p); } } Math-Prime-Util-0.74/xt/test-primes-script2.pl000755 000765 000024 00000007203 14056645657 021247 0ustar00danastaff000000 000000 #!/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, "CMD 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, "CMD --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, "CMD --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', "CMD --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', # "CMD --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', "CMD --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', "CMD --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', "CMD --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/; $command_scr =~ s|CMD|perl -Iblib/lib -Iblib/arch $FindBin::Bin/../bin/primes.pl|; 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.74/xt/almost-primes-big.pl000644 000765 000024 00000043622 15146553566 020742 0ustar00danastaff000000 000000 #!perl use warnings; use strict; use v5.16; use ntheory ":all"; use feature 'say'; while () { chomp; next if /^#/ || /^\s*$/; # skip comments and blank lines my($k,$n,$c)=split(" "); my $clo = almost_prime_count_lower($k,$n); my $chi = almost_prime_count_upper($k,$n); die "bad lower count for $k $n: $clo not le $c\n" if $clo > $c; die "bad upper count for $k $n: $chi not ge $c\n" if $chi < $c; next if $c == 0; my $nlo = nth_almost_prime_lower($k,$c); my $nhi = nth_almost_prime_upper($k,$c); die "bad lower nth for $k $c: $nlo not le $n\n" if $nlo > $n; if ($nhi < $n) { my $actual = nth_almost_prime($k,$c); die "bad upper nth for $k $c: $nhi not ge $n and $actual\n" if $nhi < $actual; } } print "PASS\n"; __DATA__ # # k n count for k 50 down to 32, n powers of 2^65 to 2^75 # 50 36893488147419103232 185387 50 73786976294838206464 389954 50 147573952589676412928 817053 50 295147905179352825856 1709640 50 590295810358705651712 3567978 50 1180591620717411303424 7433670 50 2361183241434822606848 15460810 50 4722366482869645213696 32103728 50 9444732965739290427392 66567488 50 18889465931478580854784 137840687 50 37778931862957161709568 285076323 49 36893488147419103232 389954 49 73786976294838206464 817053 49 147573952589676412928 1709640 49 295147905179352825856 3567978 49 590295810358705651712 7433670 49 1180591620717411303424 15460810 49 2361183241434822606848 32103728 49 4722366482869645213696 66567488 49 9444732965739290427392 137840687 49 18889465931478580854784 285076323 49 37778931862957161709568 588891185 48 36893488147419103232 817053 48 73786976294838206464 1709640 48 147573952589676412928 3567978 48 295147905179352825856 7433670 48 590295810358705651712 15460810 48 1180591620717411303424 32103728 48 2361183241434822606848 66567488 48 4722366482869645213696 137840687 48 9444732965739290427392 285076323 48 18889465931478580854784 588891185 48 37778931862957161709568 1215204568 47 36893488147419103232 1709640 47 73786976294838206464 3567978 47 147573952589676412928 7433670 47 295147905179352825856 15460810 47 590295810358705651712 32103728 47 1180591620717411303424 66567488 47 2361183241434822606848 137840687 47 4722366482869645213696 285076323 47 9444732965739290427392 588891185 47 18889465931478580854784 1215204568 47 37778931862957161709568 2505088087 46 36893488147419103232 3567978 46 73786976294838206464 7433670 46 147573952589676412928 15460810 46 295147905179352825856 32103728 46 590295810358705651712 66567488 46 1180591620717411303424 137840687 46 2361183241434822606848 285076323 46 4722366482869645213696 588891185 46 9444732965739290427392 1215204568 46 18889465931478580854784 2505088086 46 37778931862957161709568 5159284080 45 36893488147419103232 7433670 45 73786976294838206464 15460810 45 147573952589676412928 32103728 45 295147905179352825856 66567488 45 590295810358705651712 137840687 45 1180591620717411303424 285076323 45 2361183241434822606848 588891185 45 4722366482869645213696 1215204567 45 9444732965739290427392 2505088084 45 18889465931478580854784 5159284074 45 37778931862957161709568 10616337999 44 36893488147419103232 15460810 44 73786976294838206464 32103728 44 147573952589676412928 66567488 44 295147905179352825856 137840687 44 590295810358705651712 285076323 44 1180591620717411303424 588891185 44 2361183241434822606848 1215204566 44 4722366482869645213696 2505088080 44 9444732965739290427392 5159284062 44 18889465931478580854784 10616337970 44 37778931862957161709568 21827166225 43 36893488147419103232 32103728 43 73786976294838206464 66567488 43 147573952589676412928 137840687 43 295147905179352825856 285076323 43 590295810358705651712 588891184 43 1180591620717411303424 1215204563 43 2361183241434822606848 2505088072 43 4722366482869645213696 5159284043 43 9444732965739290427392 10616337921 43 18889465931478580854784 21827166101 43 37778931862957161709568 44841770229 42 36893488147419103232 66567488 42 73786976294838206464 137840687 42 147573952589676412928 285076323 42 295147905179352825856 588891182 42 590295810358705651712 1215204559 42 1180591620717411303424 2505088059 42 2361183241434822606848 5159284008 42 4722366482869645213696 10616337837 42 9444732965739290427392 21827165897 42 18889465931478580854784 44841769755 42 37778931862957161709568 92054904764 41 36893488147419103232 137840687 41 73786976294838206464 285076322 41 147573952589676412928 588891179 41 295147905179352825856 1215204551 41 590295810358705651712 2505088035 41 1180591620717411303424 5159283950 41 2361183241434822606848 10616337698 41 4722366482869645213696 21827165564 41 9444732965739290427392 44841768976 41 18889465931478580854784 92054902967 41 37778931862957161709568 188846598627 40 36893488147419103232 285076320 40 73786976294838206464 588891173 40 147573952589676412928 1215204535 40 295147905179352825856 2505087994 40 590295810358705651712 5159283853 40 1180591620717411303424 10616337462 40 2361183241434822606848 21827165014 40 4722366482869645213696 44841767695 40 9444732965739290427392 92054900055 40 18889465931478580854784 188846592042 40 37778931862957161709568 387154790784 39 36893488147419103232 588891163 39 73786976294838206464 1215204509 39 147573952589676412928 2505087925 39 295147905179352825856 5159283691 39 590295810358705651712 10616337074 39 1180591620717411303424 21827164114 39 2361183241434822606848 44841765619 39 4722366482869645213696 92054895366 39 9444732965739290427392 188846581484 39 18889465931478580854784 387154767211 39 37778931862957161709568 793210574490 38 36893488147419103232 1215204461 38 73786976294838206464 2505087810 38 147573952589676412928 5159283424 38 295147905179352825856 10616336439 38 590295810358705651712 21827162647 38 1180591620717411303424 44841762273 38 2361183241434822606848 92054887825 38 4722366482869645213696 188846564566 38 9444732965739290427392 387154729605 38 18889465931478580854784 793210491471 38 37778931862957161709568 1624180962108 37 36893488147419103232 2505087624 37 73786976294838206464 5159282975 37 147573952589676412928 10616335393 37 295147905179352825856 21827160268 37 590295810358705651712 44841756876 37 1180591620717411303424 92054875728 37 2361183241434822606848 188846537545 37 4722366482869645213696 387154669824 37 9444732965739290427392 793210359893 37 18889465931478580854784 1624180673981 37 37778931862957161709568 3323800242183 36 36893488147419103232 5159282240 36 73786976294838206464 10616333704 36 147573952589676412928 21827156428 36 295147905179352825856 44841748205 36 590295810358705651712 92054856360 36 1180591620717411303424 188846494478 36 2361183241434822606848 387154574923 36 4722366482869645213696 793210151628 36 9444732965739290427392 1624180219296 36 18889465931478580854784 3323799253575 36 37778931862957161709568 6798324253396 35 36893488147419103232 10616330965 35 73786976294838206464 21827150242 35 147573952589676412928 44841734321 35 295147905179352825856 92054825431 35 590295810358705651712 188846426068 35 1180591620717411303424 387154424592 35 2361183241434822606848 793209822609 35 4722366482869645213696 1624179502721 35 9444732965739290427392 3323797699000 35 18889465931478580854784 6798320894293 35 37778931862957161709568 13897797889642 34 36893488147419103232 21827140299 34 73786976294838206464 44841712120 34 147573952589676412928 92054776170 34 295147905179352825856 188846317569 34 590295810358705651712 387154186733 34 1180591620717411303424 793209303473 34 2361183241434822606848 1624178375068 34 4722366482869645213696 3323795258362 34 9444732965739290427392 6798315630913 34 18889465931478580854784 13897786571872 34 37778931862957161709568 28397331476238 33 36893488147419103232 44841676716 33 73786976294838206464 92054697931 33 147573952589676412928 188846145779 33 295147905179352825856 387153811074 33 590295810358705651712 793208485858 33 1180591620717411303424 1624176602998 33 2361183241434822606848 3323791430535 33 4722366482869645213696 6798307390826 33 9444732965739290427392 13897768885128 33 18889465931478580854784 28397293622195 33 37778931862957161709568 57997025059232 32 36893488147419103232 92054573895 32 73786976294838206464 188845874114 32 147573952589676412928 387153218646 32 295147905179352825856 793207199668 32 590295810358705651712 1624173821202 32 1180591620717411303424 3323785433921 32 2361183241434822606848 6798294505172 32 4722366482869645213696 13897741273215 32 9444732965739290427392 28397234611879 32 18889465931478580854784 57996899244903 32 37778931862957161709568 118396626650197 # # k n count for various large k and n. # # n 2^61 50 2305843009213693952 9184 49 2305843009213693952 19611 48 2305843009213693952 41604 47 2305843009213693952 87993 46 2305843009213693952 185387 45 2305843009213693952 389954 44 2305843009213693952 817053 43 2305843009213693952 1709640 42 2305843009213693952 3567978 41 2305843009213693952 7433670 40 2305843009213693952 15460810 39 2305843009213693952 32103728 38 2305843009213693952 66567487 37 2305843009213693952 137840679 36 2305843009213693952 285076274 35 2305843009213693952 588890969 34 2305843009213693952 1215203665 33 2305843009213693952 2505084574 32 2305843009213693952 5159270863 31 2305843009213693952 10616289827 30 2305843009213693952 21826993919 29 2305843009213693952 44841164956 28 2305843009213693952 92052806400 27 2305843009213693952 188839407735 26 2305843009213693952 387130383261 25 2305843009213693952 793128408178 24 2305843009213693952 1623906336546 23 2305843009213693952 3322888083693 22 2305843009213693952 6795311371282 21 2305843009213693952 13887895368206 20 2305843009213693952 28364929292854 19 2305843009213693952 57891427457709 18 2305843009213693952 118053750614948 17 2305843009213693952 240484564287559 16 2305843009213693952 489202084580191 15 2305843009213693952 993219838185333 14 2305843009213693952 2010852272976848 13 2305843009213693952 4054082956829350 12 2305843009213693952 8121421789026587 # # n 2^62 50 4611686018427387904 19611 49 4611686018427387904 41604 48 4611686018427387904 87993 47 4611686018427387904 185387 46 4611686018427387904 389954 45 4611686018427387904 817053 44 4611686018427387904 1709640 43 4611686018427387904 3567978 42 4611686018427387904 7433670 41 4611686018427387904 15460810 40 4611686018427387904 32103728 39 4611686018427387904 66567488 38 4611686018427387904 137840683 37 4611686018427387904 285076296 36 4611686018427387904 588891060 35 4611686018427387904 1215204027 34 4611686018427387904 2505085950 33 4611686018427387904 5159275951 32 4611686018427387904 10616308060 31 4611686018427387904 21827058367 30 4611686018427387904 44841389241 29 4611686018427387904 92053577623 28 4611686018427387904 188842033229 27 4611686018427387904 387139242594 26 4611686018427387904 793158083381 25 4611686018427387904 1624005082298 24 4611686018427387904 3323214786505 23 4611686018427387904 6796386710871 22 4611686018427387904 13891418655723 21 4611686018427387904 28376425147307 20 4611686018427387904 57928794866619 19 4611686018427387904 118174791722978 18 4611686018427387904 240875370160260 17 4611686018427387904 490459957003389 16 4611686018427387904 997255906585879 # # n 2^63 50 9223372036854775808 41604 49 9223372036854775808 87993 48 9223372036854775808 185387 47 9223372036854775808 389954 46 9223372036854775808 817053 45 9223372036854775808 1709640 44 9223372036854775808 3567978 43 9223372036854775808 7433670 42 9223372036854775808 15460810 41 9223372036854775808 32103728 40 9223372036854775808 66567488 39 9223372036854775808 137840685 38 9223372036854775808 285076309 37 9223372036854775808 588891113 36 9223372036854775808 1215204250 35 9223372036854775808 2505086797 34 9223372036854775808 5159279091 33 9223372036854775808 10616319464 32 9223372036854775808 21827098899 31 9223372036854775808 44841530987 30 9223372036854775808 92054067228 29 9223372036854775808 188843705453 28 9223372036854775808 387144903124 27 9223372036854775808 793177093966 26 9223372036854775808 1624068487060 25 9223372036854775808 3323424993038 24 9223372036854775808 6797079873722 23 9223372036854775808 13893693496440 22 9223372036854775808 28383858637957 21 9223372036854775808 57952990683107 20 9223372036854775808 118253267723513 19 9223372036854775808 241129059619567 18 9223372036854775808 491277525438318 17 9223372036854775808 999882846764610 16 9223372036854775808 2032174655403956 # # n 2^64-1 64 18446744073709551615 0 63 18446744073709551615 2 62 18446744073709551615 7 61 18446744073709551615 15 60 18446744073709551615 37 59 18446744073709551615 84 58 18446744073709551615 187 57 18446744073709551615 421 56 18446744073709551615 914 55 18446744073709551615 2001 54 18446744073709551615 4283 53 18446744073709551615 9184 52 18446744073709551615 19611 51 18446744073709551615 41604 50 18446744073709551615 87993 49 18446744073709551615 185387 48 18446744073709551615 389954 47 18446744073709551615 817053 46 18446744073709551615 1709640 45 18446744073709551615 3567978 44 18446744073709551615 7433670 43 18446744073709551615 15460810 42 18446744073709551615 32103728 41 18446744073709551615 66567488 40 18446744073709551615 137840686 39 18446744073709551615 285076316 38 18446744073709551615 588891145 37 18446744073709551615 1215204383 36 18446744073709551615 2505087309 35 18446744073709551615 5159281045 34 18446744073709551615 10616326552 33 18446744073709551615 21827124353 32 18446744073709551615 44841620426 31 18446744073709551615 92054377509 30 18446744073709551615 188844769357 29 18446744073709551615 387148515886 28 18446744073709551615 793189260998 27 18446744073709551615 1624109166018 26 18446744073709551615 3323560145881 25 18446744073709551615 6797526392535 24 18446744073709551615 13895161400556 23 18446744073709551615 28388662714236 22 18446744073709551615 57968649799947 21 18446744073709551615 118304122014405 20 18446744073709551615 241293656953012 19 18446744073709551615 491808604962296 18 18446744073709551615 1001591348315641 17 18446744073709551615 2037655246635364 16 18446744073709551615 4139595949113890 15 18446744073709551615 8393048221327186 14 18446744073709551615 16967424859951587 13 18446744073709551615 34151861008771016 12 18446744073709551615 68283616225825256 11 18446744073709551615 135128109904869290 10 18446744073709551615 263157990621533964 9 18446744073709551615 499840874923678341 8 18446744073709551615 913164427599983727 7 18446744073709551615 1571012171387856192 6 18446744073709551615 2466706950238087748 5 18446744073709551615 3378907169603895030 4 18446744073709551615 3787884015050788482 3 18446744073709551615 3167597434038354478 2 18446744073709551615 1701748900850019777 1 18446744073709551615 425656284035217743 # # n 2^65 42 36893488147419103232 66567488 41 36893488147419103232 137840687 40 36893488147419103232 285076320 39 36893488147419103232 588891163 38 36893488147419103232 1215204461 37 36893488147419103232 2505087624 36 36893488147419103232 5159282240 35 36893488147419103232 10616330965 34 36893488147419103232 21827140299 # # n 2^66 42 73786976294838206464 137840687 41 73786976294838206464 285076322 40 73786976294838206464 588891173 39 73786976294838206464 1215204509 # # n 2^67 42 147573952589676412928 285076323 41 147573952589676412928 588891179 40 147573952589676412928 1215204535 39 147573952589676412928 2505087925 38 147573952589676412928 5159283424 37 147573952589676412928 10616335393 36 147573952589676412928 21827156428 35 147573952589676412928 44841734321 34 147573952589676412928 92054776170 33 147573952589676412928 188846145779 32 147573952589676412928 387153218646 31 147573952589676412928 793205179283 30 147573952589676412928 1624162629558 29 147573952589676412928 3323738467309 28 147573952589676412928 6798117607159 27 147573952589676412928 13897111023968 26 147573952589676412928 28395061243805 # # n 2^70 50 1180591620717411303424 7433670 49 1180591620717411303424 15460810 48 1180591620717411303424 32103728 47 1180591620717411303424 66567488 46 1180591620717411303424 137840687 45 1180591620717411303424 285076323 44 1180591620717411303424 588891185 43 1180591620717411303424 1215204563 42 1180591620717411303424 2505088059 41 1180591620717411303424 5159283950 40 1180591620717411303424 10616337462 39 1180591620717411303424 21827164114 38 1180591620717411303424 44841762273 37 1180591620717411303424 92054875728 36 1180591620717411303424 188846494478 35 1180591620717411303424 387154424592 34 1180591620717411303424 793209303473 33 1180591620717411303424 1624176602998 32 1180591620717411303424 3323785433921 31 1180591620717411303424 6798274373931 30 1180591620717411303424 13897631080548 29 1180591620717411303424 28396777171142 28 1180591620717411303424 57995193392113 27 1180591620717411303424 118390604234288 26 1180591620717411303424 241574405535782 25 1180591620717411303424 492716978857699 24 1180591620717411303424 1004521422339203 23 1180591620717411303424 2047079488688087 22 1180591620717411303424 4169825122934310 # # n 2^80 70 1208925819614629174706176 4283 69 1208925819614629174706176 9184 68 1208925819614629174706176 19611 67 1208925819614629174706176 41604 66 1208925819614629174706176 87993 65 1208925819614629174706176 185387 64 1208925819614629174706176 389954 63 1208925819614629174706176 817053 62 1208925819614629174706176 1709640 61 1208925819614629174706176 3567978 60 1208925819614629174706176 7433670 59 1208925819614629174706176 15460810 58 1208925819614629174706176 32103728 57 1208925819614629174706176 66567488 56 1208925819614629174706176 137840687 55 1208925819614629174706176 285076323 54 1208925819614629174706176 588891185 53 1208925819614629174706176 1215204568 52 1208925819614629174706176 2505088087 51 1208925819614629174706176 5159284087 50 1208925819614629174706176 10616338035 49 1208925819614629174706176 21827166388 48 1208925819614629174706176 44841770893 47 1208925819614629174706176 92054907365 46 1208925819614629174706176 188846608343 45 1208925819614629174706176 387154826263 44 1208925819614629174706176 793210701031 43 1208925819614629174706176 1624181406484 42 1208925819614629174706176 3323801781048 41 1208925819614629174706176 6798329523559 40 1208925819614629174706176 13897815765484 39 1208925819614629174706176 28397391623028 38 1208925819614629174706176 57997225987154 37 1208925819614629174706176 118397293732399 36 1208925819614629174706176 241596320912299 35 1208925819614629174706176 492788479670113 Math-Prime-Util-0.74/xt/lucasseq.pl000644 000765 000024 00000010372 15137176252 017214 0ustar00danastaff000000 000000 #!/usr/bin/env perl use warnings; use strict; use ntheory ":all"; use v5.030; use Math::Prime::Util::PP; use Math::Prime::Util::GMP; # These two functions based on pseudocode from Trizen. # We will compare the library code vs. this. # Combine V_k(P,Q) mod n sub _lucasvmod { my($P,$Q, $k, $n) = @_; my($V1,$V2) = (2,modint($P,$n)); my($Q1,$Q2) = (1,1); my(@bits) = todigits($k,2); for my $bit (@bits) { # 5 even, 6 odd $Q1 = mulmod($Q1,$Q2,$n); if ($bit) { $Q2 = mulmod($Q1,$Q,$n); $V1 = submod(mulmod($V2,$V1,$n),mulmod($P,$Q1,$n),$n); $V2 = submod(mulmod($V2,$V2,$n),mulmod(2,$Q2,$n),$n); } else { $Q2 = $Q1; $V2 = submod(mulmod($V2,$V1,$n),mulmod($P,$Q1,$n),$n); $V1 = submod(mulmod($V1,$V1,$n),mulmod(2,$Q2,$n),$n); } } # Outputs V_k, <...>, Q_k ($V1, $V2, mulmod($Q1,$Q2,$n)); } sub _lucasuvmod { my($P,$Q, $k, $n) = @_; return (0,0) if $n == 1; return (0,2 % $n) if $k == 0; die "Invalid modulus $n" if $n <= 0; my $U1 = 1; my($V1,$V2) = (2 % $n,modint($P,$n)); my($Q1,$Q2) = (1,1); my $D = submod( mulmod($P,$P,$n), mulmod(4,$Q,$n), $n); if (gcd($D,$n) == 1) { ($V1,$V2,$Q1) = _lucasvmod($P, $Q, $k, $n); $U1 = divmod( submod(mulmod(2,$V2,$n),mulmod($P,$V1,$n),$n), $D,$n); #return ($U1, $V1, $Q1); return ($U1, $V1); } my $s = valuation($k,2); $k = rshiftint($k,$s+1); #print "s $s k $k\n"; my(@bits) = todigits($k,2); for my $bit (@bits) { # 3 even, 7 odd (primality.c) # 6 even, 7 odd $Q1 = mulmod($Q1,$Q2,$n); #print "bit $bit Q1 = $Q1\n"; if ($bit) { $Q2 = mulmod($Q1,$Q,$n); $U1 = mulmod($U1,$V2,$n); $V1 = submod(mulmod($V2,$V1,$n),mulmod($P,$Q1,$n),$n); $V2 = submod(mulmod($V2,$V2,$n),mulmod(2,$Q2,$n),$n); } else { $Q2 = $Q1; $U1 = submod(mulmod($U1,$V1,$n),$Q1,$n); $V2 = submod(mulmod($V2,$V1,$n),mulmod($P,$Q1,$n),$n); $V1 = submod(mulmod($V1,$V1,$n),mulmod(2,$Q2,$n),$n); } } $Q1 = mulmod($Q1,$Q2,$n); $Q2 = mulmod($Q1, $Q, $n); $U1 = submod(mulmod($U1,$V1,$n),$Q1,$n); $V1 = submod(mulmod($V2,$V1,$n),mulmod($P,$Q1,$n),$n); $Q1 = mulmod($Q1,$Q2,$n); for (1 .. $s) { $U1 = mulmod($U1,$V1,$n); $V1 = submod(mulmod($V1,$V1,$n),mulmod(2,$Q1,$n),$n); $Q1 = mulmod($Q1,$Q1,$n); } #($U1,$V1,$Q1); ($U1,$V1); } #say join ", ",lucasuvmod(-4,4,50,1001); #say join ", ",lucasuvmod(-4,7,50,1001); #say join ", ",lucasuvmod(1,-1,50,1001); #say join ", ",lucasuvmod(1,-1,4,5); for my $n (1 .. 20) { # n 1 print "n $n\n"; for my $k (0 .. 101) { # k 0 for my $P (-30 .. 30) { for my $Q (-30 .. 30) { #print "($n,$P,$Q,$k)\n"; #my $s1 = join " ", _lucasuvmod($P, $Q, $k, $n); #my $s1 = join " ", (Math::Prime::Util::GMP::lucas_sequence($n,$P,$Q,$k))[0,1]; #my $s1 = join " ", Math::Prime::Util::GMP::lucasuvmod($P,$Q,$k,$n); #my $s3 = join " ", lucasuvmod($P,$Q,$k,$n); #my $s3 = join " ", (lucas_sequence($n,$P,$Q,$k))[0,1]; #my $s3 = join " ", Math::Prime::Util::PP::lucasuvmod($P,$Q,$k,$n); #say "($P,$Q,$k,$n) : '$s1' : '$s3'" if $s1 ne $s3; lucasuvmod($P, $Q, $k, $n); #lucas_sequence($n,$P,$Q,$k); #Math::Prime::Util::GMP::lucasuvmod($P, $Q, $k, $n); #Math::Prime::Util::GMP::lucas_sequence($n,$P,$Q,$k); #Math::Prime::Util::PP::lucasuvmod($P, $Q, $k, $n); #_lucasuvmod($P, $Q, $k, $n); #modint(lucasu($P,$Q,$k),$n); modint(lucasv($P,$Q,$k),$n); powmod($Q, $k, $n); } } } } # 2.8s XS # 10.1s GMP # 34.1s funcs here (w/ XS) # 270.4s PP (w/ XS) # 299.0s PP (no XS) # 803.3s funcs here (no XS) # May 2023 lucasuvmod added # 2.6s XS lucasuvmod # 2.9s XS lucas_sequence # 8.8s GMP::lucasuvmod # 22.2s PP (w/ XS and GMP) # 33.7s funcs here (w/ XS) # 37.0s PP (w/ XS) # 542.8s PP (no XS no GMP) # 728.1s funcs here (no XS) [705s using mulsubmods. Not much help.] #1722.1s funcs here (no XS no GMP) # May 2024 retest # 1.5s XS lucasuvmod # 1.7s XS lucas_sequence # 7.5s GMP::lucasuvmod # 8.0s GMP::lucas_sequence # 12.4s PP::lucasuvmod # 27.3s PP::lucasuvmod (no GMP) # 32.1s _lucasuvmod # 32.2s _lucasuvmod (no GMP) # 506.6s PP::lucasuvmod (no XS, no GMP) # 688.9s _lucasuvmod (no XS) Math-Prime-Util-0.74/xt/rootmod.pl000644 000765 000024 00000003777 15137220524 017062 0ustar00danastaff000000 000000 #!/usr/bin/env perl use warnings; use strict; use v5.16; use ntheory ":all"; use Math::Prime::Util::PP; #*rootmod = \&Math::Prime::Util::rootmod; my $lpr = primes(1e10,1e10+1000); test("primes", 2, $lpr); test("primes", 3, $lpr); test("primes", 5, $lpr); test("primes", 4, $lpr); test("primes", 6, $lpr); test("primes", 9, $lpr); test("primes",27, $lpr); test("primes",81, $lpr); say ""; my $lp2 = [map { $_*$_ } 2,3,5,101,103,107,109]; test("prime squares", 2, $lp2); test("prime squares", 3, $lp2); test("prime squares", 5, $lp2); my $lp3 = [map { powint($_,3) } 2,3,5,101,103,107,109]; test("prime cubes", 2, $lp3); test("prime cubes", 3, $lp3); test("prime cubes", 5, $lp3); my $lpp = [8,16,32,243,625,14641,130321,371293,24137569]; test("prime powers", 2, $lpp); test("prime powers", 3, $lpp); test("prime powers", 5, $lpp); say ""; my $lsf = [grep { is_square_free($_) } 1e10..1e10+100]; test("square free", 2, $lsf); test("square free", 3, $lsf); test("square free", 5, $lsf); test("square free", 4, $lsf); test("square free", 6, $lsf); test("square free", 9, $lsf); test("square free",27, $lsf); test("square free",81, $lsf); say ""; my $lcp = [grep { !is_prime($_) && !is_square_free($_) } 1e10 .. 1e10+200]; test("composites", 2, $lcp); test("composites", 3, $lcp); test("composites", 5, $lcp); test("composites", 4, $lcp); test("composites", 6, $lcp); test("composites", 9, $lcp); test("composites",27, $lcp); test("composites",81, $lcp); say ""; sub test { my($name, $k, $list) = @_; my($t,$bad,$und) = (0,0,0); for my $p (@$list) { my %h; my $lim = $p > 1000 ? 1000 : $p-1; $h{ powmod($p-$_, $k, $p) }++ for 1..$lim; for my $a (keys %h) { #my $r = Math::Prime::Util::PP::rootmod($a, $k, $p); my $r = rootmod($a, $k, $p); if (!defined $r) { $und++; } elsif (powmod($r,$k,$p) != $a) { $bad++; } $t++; } } printf "Total: %8u undef: %7u bad: %5u for x^%2u = a mod $name\n",$t,$und,$bad,$k; #say "Total: $t undef: $und bad: $bad for x^$k = a mod $name"; } Math-Prime-Util-0.74/xt/make-chacha20-inner.pl000644 000765 000024 00000002524 13667653032 020773 0ustar00danastaff000000 000000 #!/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.74/xt/make-script-test-data.pl000755 000765 000024 00000012274 13667653334 021514 0ustar00danastaff000000 000000 #!/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.74/xt/chinese.pl000755 000765 000024 00000003205 15146553566 017021 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util qw/chinese lcm chinese2 powint urandomb urandomm/; use Math::ModInt qw(mod); use Math::ModInt::ChineseRemainder qw(cr_combine); my $limit = shift || 10_000; my $printmod = int(($limit+77) / 78); cmp_chinese($limit, powint(2,16), 2); cmp_chinese($limit, powint(2,32), 2); cmp_chinese($limit, powint(2,16), 4); cmp_chinese($limit, powint(2,40), 3); cmp_chinese($limit, powint(2,31), 13); print "\nDone\n"; sub rpairs { my($lim, $num) = @_; my @p; for (1..$num) { my $mod = 1+urandomm($lim); # random modulo between 1 and $lim inclusive push @p, [ urandomm($mod), $mod ] } @p; } sub printpairs { my(@rm) = @_; print "\ninput: "; print join(" ", map { "[$_->[0] $_->[1]]" } @rm), "\n"; 1; } sub cmp_chinese { my($ntests, $lim, $num) = @_; my $size = $lim > 2**30 ? "large" : "small"; print "Running $limit random tests with $num $size inputs...\n"; for my $n (1 .. $ntests) { print '.' unless $n % $printmod; my @rm = rpairs($lim, $num); #printpairs(@rm); my $mic = cr_combine( map { mod($_->[0],$_->[1]) } @rm ); if ($mic->is_undefined) { my $mpu_res = chinese(@rm); printpairs(@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,$mpu_mod) = chinese2(@rm); printpairs(@rm) && die "MIC: $mic_res $mic_mod MPU: undef\n" if !defined $mpu_res; printpairs(@rm) && die "MIC: $mic_res $mic_mod MPU: $mpu_res $mpu_mod" if $mpu_res != $mic_res || $mpu_mod != $mic_mod; } print "\n"; } Math-Prime-Util-0.74/xt/create-pc-tables.pl000755 000765 000024 00000004453 13025437630 020507 0ustar00danastaff000000 000000 #!/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.74/xt/moebius-mertens.pl000755 000765 000024 00000001546 13025437630 020512 0ustar00danastaff000000 000000 #!/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.74/xt/kronecker.pl000644 000765 000024 00000001414 14613375122 017347 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util qw/kronecker urandomb negint/; use Math::Prime::Util::PP; use Math::Prime::Util::GMP; my($lim,$klim) = (200000,800); for (1 .. 74) { for (0 .. 20000) { my $au = urandomb(64); my $bu = urandomb(64); my $as = negint(urandomb(63)); my $bs = negint(urandomb(63)); next if $bu == 0 || $bs == 0; tkron($au,$bu); tkron($as,$bu); tkron($au,$bs); tkron($as,$bs); } print "."; } print " PASS\n"; sub tkron { my($a,$b) = @_; my $k1 = kronecker($a,$b); my $k2 = Math::Prime::Util::GMP::kronecker($a,$b); my $k3 = Math::Prime::Util::PP::kronecker($a,$b); die "FAIL kronecker($a,$b) MPU $k1 GMP $k2 PP $k3\n" unless $k1 == $k2 && $k1 == $k3; } Math-Prime-Util-0.74/t/19-chinese.t000644 000765 000024 00000006611 15150457172 016700 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/chinese chinese2/; #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, 0 ], [ [[4,5]], 4, 5 ], [ [[77,11]], 0, 11 ], [ [[0,5],[0,6]], 0, 30 ], [ [[14,5],[0,6]], 24, 30 ], [ [[10,11],[4,22],[9,19]], undef, undef ], [ [[77,13],[79,17]], 181, 221 ], [ [[2,3],[3,5],[2,7]], 23, 105 ], [ [[10,11],[4,12],[12,13]], 1000, 1716 ], [ [[42,127],[24,128]], 2328, 16256 ], # Some tests from Mod::Int [ [[32,126],[23,129]], 410, 5418 ], [ [[2328,16256],[410,5418]], 28450328, 44037504 ], [ [[1,10],[11,100]], 11, 100 ], [ [[11,100],[22,100]], undef, undef ], [ [[3,5],[2,0]], undef, undef ], # three tests that we handle zeros. [ [[3,0],[2,3]], undef, undef ], [ [[3,5],[3,0],[2,3]], undef, undef ], [ [[5,0],[15,1]], undef, undef ], # two more test for zeros [ [[15,1],[5,0]], undef, undef ], # Tests to make IV_MAX < lcm < UV_MAX [ [[2,181], [3,193], [5,227], [30,383]], 2205672518, 3037109953], # Negative modulos [ [[14,-5], [ 17, -6]], 29, 30], [ [[14, 5], [ 17, -6]], 29, 30], [ [[-4,17], [-17, 19]], 268, 323], [ [[-4,17], [-17, 19]], 268, 323], [ [[-4,17], [ 17,-19]], 302, 323], ); my @crt_big = ( [ [[14,44381], [87,48473], [19,59467], [74,118751]], "6441035217555187414", "15191836855823857721"], [ [[1753051086,3243410059],[2609156951,2439462460]], "6553408220202087311", "7912177081316885140"], [ [ ["6325451203932218304","2750166238021308"], ["5611464489438299732","94116455416164094"] ], "1433171050835863115088946517796","129417949063886082109332998257476" ], [ [ ["1762568892212871168","8554171181844660224"], ["2462425671659520000","2016911328009584640"] ], "188079320578009823963731127992320","263259960302667721456496781557760" ], [ [ ["856686401696104448","11943471150311931904"], ["6316031051955372032","13290002569363587072"] ], "943247297188055114646647659888640","1211004350851176848301478947323904" ], [ [[-3105579549,3743000622],[-1097075646,1219365911]], "2754322117681955433", "4564087363318596642"], [ [ ["-925543788386357567","243569243147991"], ["-1256802905822510829","28763455974459440"] ], "837055903505897549759994093811", "7005893202019645748120146985040" ], [ [ ["-2155972909982577461","8509855219791386062"], ["-5396280069505638574","6935743629860450393"] ], "12941173114744545542549046204020289525","59022174131702808856838498513062622366" ], ); plan tests => 2 + 2; ###### chinese is_deeply( [ map { chinese(@{$_->[0]}) } @crts ], [ map { $_->[1] } @crts ], "chinese()" ); ###### chinese2 is_deeply( [ map { [chinese2(@{$_->[0]})] } @crts ], [ map { [$_->[1],$_->[2]] } @crts ], "chinese2()" ); # big results. # Some combinations of Test::More and Math::GMPz don't get along # Also Math::GMP is missing some overloads. is_deeply( [ map { "" . chinese(@{$_->[0]}) } @crt_big ], [ map { $_->[1] } @crt_big ], "chinese() big result" ); ###### chinese2 is_deeply( [ map { [map { "$_" } chinese2(@{$_->[0]})] } @crt_big ], [ map { [$_->[1],$_->[2]] } @crt_big ], "chinese2() big result" ); Math-Prime-Util-0.74/t/28-pi.t000644 000765 000024 00000004154 15146553566 015703 0ustar00danastaff000000 000000 #!/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 $usegmp = Math::Prime::Util::prime_get_config->{'gmp'}; my $Pi = '3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701938521105559644622948954930381964428810975665933446128475648233786783165271201909145648566923460348610454326648213393607260249141273724587006606315588174881520920962829254091715364367892590360011330530548820466521384146951941511609433057270365759591953092186117381932611793105118548074462379962749567351885752724891227938183011949129833673362440656643086021394946395224737190702179860943702770539217176293176752384674818467669405132000568127145263560827785771342757789609173637178721468440901224953430146549585371050792279689258923542019956112129021960864034418159813629774771309960518707211349999998372978049951059731732816096318595024459455346908302642522308253344685035261931188171010003137838752886587533208381420617177669147303598253490428755468731159562863882353787593751957781857780532171226806613001927876611195909216420199'; my $roundt = $usegmp; my $ninitial = 50; if ($extra) { $roundt = 0; $ninitial = $usexs || $usegmp ? 1000 : 400; } 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.74/t/26-perfectpowers.t000644 000765 000024 00000016133 15150474625 020152 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_perfect_power next_perfect_power prev_perfect_power perfect_power_count perfect_power_count_approx perfect_power_count_lower perfect_power_count_upper nth_perfect_power nth_perfect_power_approx nth_perfect_power_lower nth_perfect_power_upper/; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; 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 @A069623 = (1, 1, 1, 2, 2, 2, 2, 3, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 7, 7, 7, 7, 7, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 12, 12, 12, 12, 12); my @A070428 = (1, 4, 13, 41, 125, 367, 1111, 3395, 10491, 32670, 102231, 320990, 1010196, 3184138, 10046921, 31723592, 100216745, 316694005, 1001003332, 3164437425, 10004650118, 31632790244, 100021566157, 316274216762, 1000100055684); my @A001597 = (1, 4, 8, 9, 16, 25, 27, 32, 36, 49, 64, 81, 100, 121, 125, 128, 144, 169, 196, 216, 225, 243, 256, 289, 324, 343, 361, 400, 441, 484, 512, 529, 576, 625, 676, 729, 784, 841, 900, 961, 1000, 1024, 1089, 1156, 1225, 1296, 1331, 1369, 1444, 1521, 1600, 1681, 1728, 1764); $#A069623 = 40; $#A070428 = 10; my @pp100 = (qw/-64 -32 -27 -8 -1 0 1 4 8 9 16 25 27 32 36 49 64 81 100/); my @uviv = ( [qw/-18446745128696702936 -18446724184312856125/], [qw/-9223372036854775808 -9223358842721533951/], [qw/-4298942376 -4291015625/], [qw/-2147483648 -2146689000/], [qw/2147395600 2147483648/], [qw/4294836225 4294967296/], [qw/9223372030926249001 9223372036854775808/], [qw/18446744065119617025 18446744073709551616/], ); plan tests => 0 + 4 # is_perfect_power + 8 # next / prev + 4 # count basic tests + 1 # count large value + 2 # count ranges + 3 # nth + 1 # small bounds + 6 # upper, lower, approx + 0; ###### is_perfect_power is_deeply( [map { is_perfect_power($_) } 0..10], [1,1,0,0,1,0,0,0,1,1,0], "is_perfect_power(0 .. 10)" ); is_deeply( [grep { is_perfect_power($_) } -100..100], \@pp100, "is_perfect_power(-100 .. 100)" ); is( is_perfect_power("18446744065119617025"), 1, "is_perfect_power(18446744065119617025)" ); is( is_perfect_power("18446744073709551616"), 1, "is_perfect_power(18446744073709551616)" ); ###### next / prev is_deeply( [map { next_perfect_power($_) } 0..20], [1,4,4,4,8,8,8,8,9,16,16,16,16,16,16,16,25,25,25,25,25], "next perfect power with small inputs" ); is_deeply( [map { prev_perfect_power($_) } 0..20], [-1,0,1,1,1,4,4,4,4,8,9,9,9,9,9,9,9,16,16,16,16], "prev perfect power with small inputs" ); is_deeply( [map { next_perfect_power($_) } -9 .. 9], [-8,-1,-1,-1,-1,-1,-1,-1,0,1,4,4,4,8,8,8,8,9,16], "next perfect power with small inputs around zero" ); is_deeply( [map { prev_perfect_power($_) } -9 .. 9], [-27,-27,-8,-8,-8,-8,-8,-8,-8,-1,0,1,1,1,4,4,4,4,8], "prev perfect power with small inputs around zero" ); is_deeply( [map { next_perfect_power($_) } @pp100], [@pp100[1..$#pp100], 121], "next_perfect_power on perfect powers -100 to 100" ); is_deeply( [map { prev_perfect_power($_) } @pp100], [-125, @pp100[0..$#pp100-1]], "prev_perfect_power on perfect powers -100 to 100" ); { my(@gotprev, @expprev, @gotnext, @expnext); for my $pair (@uviv) { push @expprev, $pair->[0]; push @gotprev, "".prev_perfect_power($pair->[1]); push @expnext, $pair->[1]; push @gotnext, "".next_perfect_power($pair->[0]); #is($gotprev[-1],$expprev[-1],"prev_perfect_power($pair->[1]) = $pair->[0]"); #is($gotnext[-1],$expnext[-1],"next_perfect_power($pair->[0]) = $pair->[1]"); } is_deeply( \@gotprev, \@expprev, "prev_perfect_power on numbers crossing 32-bit/64-bit boundaries" ); is_deeply( \@gotnext, \@expnext, "next_perfect_power on numbers crossing 32-bit/64-bit boundaries" ); } ###### perfect_power_count is(perfect_power_count(0), 0, "perfect_power_count(0) = 0"); is(perfect_power_count(1), 1, "perfect_power_count(1) = 1"); is_deeply( [map { perfect_power_count(1+$_) } 0..$#A069623], \@A069623, "perfect_power_count(n) for 1..".scalar(@A069623) ); is_deeply( [map { perfect_power_count(10**$_) } 0..$#A070428], \@A070428, "perfect_power_count(10^n) for 0..$#A070428" ); # mpu 'say 1+vecsum(map{!!is_power($_)}1..12345678)' is(perfect_power_count(12345678), 3762, "perfect_power_count(12345678) = 3762"); is( perfect_power_count(123456, 133332), 17, "perfect_power_count(123456,133332) = 17" ); is_deeply( [map { perfect_power_count($_,16) } 8,9,10], [3,2,1], "perfect_power_count(8..10,16) = 3,2,1" ); ###### nth_perfect_power is_deeply( [map { nth_perfect_power($_) } 1 .. scalar(@A001597)], \@A001597, "nth perfect_powers creates A001597" ); is_deeply( [map { "".nth_perfect_power($_) } 67224..67229], [qw/4294574089 4294705156 4294836225 4294967296 4295098369 4295229444/], "nth perfect powers with results around 2^32" ); SKIP: { skip "ranges around 2^64 only on 64-bit",1 unless $use64; is_deeply( [map { "".nth_perfect_power($_) } 4297615579,4297615580,4297615581,4297615582], [qw/18446744047939747849 18446744056529682436 18446744065119617025 18446744073709551616/], "nth perfect powers with results around 2^64" ); } ###### approx and bounds for count and nth is_deeply( [map{cmp_rn($_+1,$A001597[$_])} 0..$#A001597], \@A001597, "small perfect power limits" ); is( cmp_rn(1571,2048383), 2048383, "perfect power limits for 1571" ); is( cmp_rn(59643,3373286400), 3373286400, "perfect power limits for 59643" ); is( cmp_rn(15964377,"252826822479841"), "252826822479841", "perfect power limits for 15964377" ); is( approx_in_range(1571,2048383), 2048383, "perfect power approx for 1571" ); is( approx_in_range(59643,3373286400), 3373286400, "perfect power approx for 59643" ); is( approx_in_range(15964377,"252826822479841"), "252826822479841", "perfect power approx for 15964377" ); sub cmp_rn { my($n,$rn) = @_; return 'nth lower' unless nth_perfect_power_lower($n) <= $rn; return 'nth upper' unless nth_perfect_power_upper($n) >= $rn; return 'pc lower' unless perfect_power_count_lower($rn) <= $n; return 'pc upper' unless perfect_power_count_upper($rn) >= $n; $rn; } sub approx_in_range { my($n,$rn) = @_; my $arn = nth_perfect_power_approx($n); my $an = perfect_power_count_approx($rn); return 'nth approx too low' if "$arn" < ($rn-$rn/100); return 'nth approx too high' if "$arn" > ($rn+$rn/100); return 'count approx too low' if "$an" < ($n-$n/100); return 'count approx too high' if "$an" > ($n+$n/100); $rn; } Math-Prime-Util-0.74/t/92-release-pod-coverage.t000644 000765 000024 00000021111 15146553566 021255 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } #--------------------------------------------------------------------- use Test::More; eval "use Test::Pod::Coverage 1.08"; plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" if $@; my @modules = grep { $_ ne 'Math::Prime::Util::PPFE' } Test::Pod::Coverage::all_modules(); plan tests => scalar @modules; #my $ppsubclass = { trustme => [mpu_public_regex()] }; foreach my $m (@modules) { my $param = { also_private => [ qr/^(erat|segment|trial|sieve)_primes$/, ], }; $param->{trustme} = [mpu_public_regex(), mpu_factor_regex(), mpu_PPM_regex()] if $m eq 'Math::Prime::Util::PP'; $param->{trustme} = [qw/maybetobigint tobigint/] if $m eq 'Math::Prime::Util::RandomPrimes'; $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_delicate_prime is_chen_prime is_odd is_even is_divisible is_congruent is_power is_prime_power is_perfect_power is_square is_square_free is_powerfree is_pillai is_polygonal is_congruent_number is_perfect_number is_semiprime is_almost_prime is_omega_prime is_primitive_root is_carmichael is_quasi_carmichael is_cyclic is_fundamental is_totient is_gaussian_prime is_sum_of_squares is_smooth is_rough is_powerful is_practical is_lucky is_happy sqrtint rootint logint lshiftint rshiftint rashiftint absint negint signint cmpint addint subint add1int sub1int mulint powint divint modint cdivint divrem fdivrem cdivrem tdivrem miller_rabin_random lucas_sequence lucasu lucasv lucasuv lucasumod lucasvmod lucasuvmod pisano_period primes twin_primes semi_primes almost_primes omega_primes ramanujan_primes sieve_prime_cluster sieve_range prime_powers lucky_numbers forprimes forcomposites foroddcomposites forsemiprimes foralmostprimes forpart forcomp forcomb forperm forderange formultiperm forsetproduct fordivisors forfactored forsquarefree forsquarefreeint lastfor numtoperm permtonum randperm shuffle vecsample prime_iterator prime_iterator_object next_prime prev_prime next_prime_power prev_prime_power next_perfect_power prev_perfect_power next_chen_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 inverse_li_nv twin_prime_count twin_prime_count_approx nth_twin_prime nth_twin_prime_approx semiprime_count semiprime_count_approx nth_semiprime nth_semiprime_approx almost_prime_count almost_prime_count_approx almost_prime_count_lower almost_prime_count_upper nth_almost_prime nth_almost_prime_approx nth_almost_prime_lower nth_almost_prime_upper omega_prime_count nth_omega_prime 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 powerful_count nth_powerful sumpowerful powerful_numbers prime_power_count prime_power_count_approx prime_power_count_lower prime_power_count_upper nth_prime_power nth_prime_power_approx nth_prime_power_lower nth_prime_power_upper perfect_power_count perfect_power_count_approx perfect_power_count_lower perfect_power_count_upper nth_perfect_power nth_perfect_power_approx nth_perfect_power_lower nth_perfect_power_upper nth_powerfree powerfree_count powerfree_sum squarefree_kernel powerfree_part powerfree_part_sum smooth_count rough_count powersum lucky_count lucky_count_approx lucky_count_lower lucky_count_upper nth_lucky nth_lucky_approx nth_lucky_lower nth_lucky_upper minimal_goldbach_pair goldbach_pairs goldbach_pair_count sum_primes print_primes random_prime random_ndigit_prime random_nbit_prime random_safe_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 chinese2 gcd lcm factor factor_exp divisors valuation hammingweight frobenius_number todigits fromdigits todigitstring sumdigits tozeckendorf fromzeckendorf sqrtmod allsqrtmod rootmod allrootmod cornacchia negmod invmod addmod submod mulmod divmod powmod muladdmod mulsubmod vecsum vecmin vecmax vecprod vecreduce vecextract vecequal vecuniq vecany vecall vecnotall vecnone vecfirst vecfirstidx vecmex vecpmex vecsort vecsorti vecfreq vecsingleton vecslide setbinop sumset setunion setintersect setminus setdelta toset setcontains setcontainsany setinsert setremove setinvert is_sidon_set is_sumfree_set set_is_disjoint set_is_equal set_is_proper_intersection set_is_subset set_is_proper_subset set_is_superset set_is_proper_superset moebius mertens liouville sumliouville prime_omega prime_bigomega euler_phi jordan_totient exp_mangoldt sumtotient partitions bernfrac bernreal harmfrac harmreal chebyshev_theta chebyshev_psi divisor_sum carmichael_lambda hclassno inverse_totient kronecker is_qr qnr ramanujan_tau ramanujan_sum stirling fubini znorder znprimroot znlog legendre_phi factorial factorialmod subfactorial binomial binomialmod falling_factorial rising_factorial contfrac from_contfrac next_calkin_wilf next_stern_brocot calkin_wilf_n stern_brocot_n nth_calkin_wilf nth_stern_brocot nth_stern_diatomic farey next_farey farey_rank 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 cheb_factor ecm_factor/); my $pattern = '^(' . join('|', @funcs) . ')$'; return qr/$pattern/; } sub mpu_PPM_regex { my @funcs = qw( Maddint Msubint Mmulint Mdivint Mcdivint Mpowint Mabsint Mnegint Madd1int Msub1int Mdivrem Mtdivrem Mmodint Mlogint Mrootint Msqrtint Mcmpint Mlshiftint Mrshiftint Maddmod Msubmod Mmulmod Mrootmod Mdivmod Mpowmod Minvmod Mmuladdmod Mmulsubmod Mbinomial Mchinese Mfactor Mfactor_exp Mtrial_factor Mdivisors Mfactorial Mfordivisors Mforprimes Mgcd Mlcm Mgcdext Mznorder Mfalling_factorial Mkronecker Mmoebius Mtotient Mstirling Mnext_prime Mprev_prime Mprime_count Mnth_prime_upper Mprimorial Mpn_primorial Mprime_omega MLi Mpowersum Murandomb Murandomm Mvaluation Mprimes Mis_power Mis_prime Mis_prime_power Mis_odd Mis_even Mdivisor_sum Mis_congruent Mis_divisible Mis_semiprime Mis_square_free Mhclassno Mvecall Mvecany Mvecmin Mvecmax Mvecnone Mvecprod Mvecsum Mvecslide Msetinsert Msetintersect Msetunion Mtoset Msetcontains Mtodigits Mtodigitstring Mfromdigits Mlucasumod Mvecfirst Mvecsort Mvecsorti Saddint Ssubint Smulint Sdivint Spowint Mtoint reftyped validate_integer validate_integer_nonneg validate_integer_abs validate_integer_positive tobigint maybetobigint maybetobigintall getconfig ); my $pattern = '^(' . join('|', @funcs) . ')$'; return qr/$pattern/; } Math-Prime-Util-0.74/t/19-primroots.t000644 000765 000024 00000010271 15146553566 017326 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/ znprimroot is_primitive_root qnr is_qr/; 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, 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 $primroots{36002292036481} = 13; $primroots{72004584072962} = 13; $primroots{2067900233973681742} = 17; $primroots{8000468009126059319} = 13; } if ($usegmp || $extra) { # in each case, p-1 is very easy to factor # p^2 $primroots{"474264225821700214950222988868518911801235024731324721"} = 7; # 2p^2 $primroots{"1580603145023079446166874838636458851122"} = 7; # p^3 $primroots{"11154774760949852441478897023837868805975434161260919037124141673071282481903446814549"} = 2; # 2p^3 $primroots{"44434394326141300867665315903406029736550298166159399085858"} = 23; } plan tests => 0 + scalar(keys %primroots) + 1 # znprimroot + scalar(keys %primroots) + 6 # is_primitive_root + 7 # qnr + 9 # is_qr ; ###### znprimroot while (my($n, $root) = each (%primroots)) { is( znprimroot($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,$n), 1, "$root is a primitive root mod $n" ); } else { is( is_primitive_root(2,$n), 0, "2 is not a primitive root mod $n" ); } } is(is_primitive_root(2,0), undef, "is_primitive_root(2,0) => undef"); 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"); is(is_primitive_root(74513,2), 1, "74513 is a primitive root mod 2"); is(is_primitive_root(74513,3), 1, "74513 is a primitive root mod 3"); ###### qnr is(qnr(0), undef, "qnr(0) returns undef"); is_deeply([map{qnr($_)}1..15], [1,2,2,2,2,2,3,2,2,2,2,2,2,3,2], "qnr(1..15)"); is_deeply([map{qnr(2**$_)}1..16], [map{2}1..16], "qnr(2^k) = 2 for k>=1"); is(qnr(5711), 19, "The least quadratice non-residue of 5711 is 19"); is(qnr(366791), 43, "The least quadratice non-residue of 366791 is 43"); is(qnr(2737), 3, "qnr(7*17*23) = 2"); is(qnr(9257330), 2, "qnr(2*5*925733) = 2"); ###### is_qr is(is_qr(0,0), undef, "is_qr(x,0) returns undef"); is_deeply([map{is_qr($_,1)}0..5], [1,1,1,1,1,1], "is_qr(a,1) = 1"); is_deeply([map{is_qr($_,2)}0..5], [1,1,1,1,1,1], "is_qr(a,2) = 1"); is_deeply([map{is_qr($_,3)}0..10], [1,1,0,1,1,0,1,1,0,1,1], "is_qr(0..10,3)"); is_deeply([map{is_qr($_,4)}0..10], [1,1,0,0,1,1,0,0,1,1,0], "is_qr(0..10,4)"); is_deeply([map{is_qr($_,6)}0..10], [1,1,0,1,1,0,1,1,0,1,1], "is_qr(0..10,6)"); is_deeply([map{is_qr($_,9)}0..20], [1,1,0,0,1,0,0,1,0,1,1,0,0,1,0,0,1,0,1,1,0], "is_qr(0..20,9)"); is_deeply([map{is_qr($_,15)}0..32], [1,1,0,0,1,0,1,0,0,1,1,0,0,0,0,1,1,0,0,1,0,1,0,0,1,1,0,0,0,0,1,1,0], "is_qr(0..32,15)"); is(is_qr("2636542937688", "3409243234243"), 1, "2636542937688 is a qr mod 3409243234243"); Math-Prime-Util-0.74/t/01-load.t000644 000765 000024 00000000154 13025437630 016160 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More tests => 1; require_ok 'Math::Prime::Util'; Math-Prime-Util-0.74/t/18-90-int_rtype.t000644 000765 000024 00000010007 15150470541 017511 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; # TODO: Verify more functions than just addint use Test::More; use Math::Prime::Util qw/addint subint add1int sub1int mulint/; use Math::BigInt; # Integer forms: # 1) native (IV or UV). Good for all 32-bit and all 64-bit post 5.6. # 2) bigint. Good but horribly slow in most cases. # 3) string. We don't have strong typing so it's dodgy how these get # converted if using standard Perl operations. This is one thing # out module is trying to do correctly. # # Regardless of input form, we want a correct result. Efficiently if possible. # # The output form expected is: # 1) native if it fits, regardless of input form. # 2) bigint otherwise, regardless of input form. # # We will attempt to preserve the input type, typically based on the first # argument. That is, if the input was a "Math::GMPz" object then we will # try to output either native or Math::GMPz. # Expect all the 5.6 workarounds to be deprecated in 2026. my $isoldperl = $] < 5.008; my $is32bit = ~0 == 4294967295; my $is64bit = ~0 > 4294967295; my $isbroken64 = 18446744073709550592 == ~0; my $intmax = (!$isoldperl || $is32bit) ? ~0 : 562949953421312; my $intmin = $is32bit ? -2147483648 : !$isoldperl ? -9223372036854775808 : -562949953421312; diag "Perl safe min: $intmin"; diag "Perl safe max: $intmax"; my($mm1, $m, $mp1, $mp2); # ~0-1, ~0, ~0+1, ~0+2 if ($is32bit) { ($mm1,$m,$mp1,$mp2) = (4294967294, 4294967295, 4294967296, 4294967297); } elsif ($isbroken64) { ($mm1,$m,$mp1,$mp2) = (562949953421311,562949953421312,"562949953421313","562949953421314"); } else { ($mm1,$m,$mp1,$mp2) = (18446744073709551614,18446744073709551615,"18446744073709551616","18446744073709551617"); } my @tests = ( [$mm1, 1, $m], # native => native [1, $mm1, $m], [$m, 1, $mp1], # native => bigint [1, $m, $mp1], [$mp1, 1, $mp2], # bigint => bigint [1, $mp1, $mp2], [$mp1, -1, $m], # bigint => native [-1, $mp1, $m], ); if ($isbroken64) { plan skip_all => "Broken 64-bit Perl, skipping all tests"; } else { plan tests => 4 + scalar(@tests) + 1 + 1; } is(should_be_ref($mm1), 0, "$mm1 should be a UV"); is(should_be_ref($m), 0, "$m should be a UV"); is(should_be_ref($mp1), 1, "$mp1 should be a bigint"); is(should_be_ref($mp2), 1, "$mp2 should be a bigint"); for my $t (@tests) { my($a,$b,$r) = @$t; my $expr = ($r eq $mp1 || $r eq $mp2) ? "BIGINT" : "NATIVE"; #my $expr = should_be_ref($r); my $sum = addint($a,$b); my $gotr = ref($sum) ? "BIGINT" : "NATIVE"; ok("$sum" eq $r && $gotr eq $expr, "$sum [$gotr] expect $r [$expr]"); } sub addsub1 { my($a,$b) = @_; my $sum = 0; if ($b == -1) { $sum = sub1int($a); } elsif ($b == 1) { $sum = add1int($a); } elsif ($a == 1) { $sum = add1int($b); } elsif ($a == -1) { $sum = sub1int($b); } my $sum_is_ref = ref($sum) ? 1 : 0; ["$sum", $sum_is_ref]; } is_deeply( [map { addsub1($_->[0],$_->[1]) } @tests], [map { [$_->[2], should_be_ref($_->[2])] } @tests], "add1int and sub1int return correct types" ); my $m2 = "".addint($m,$m); my @mulres = ( [mulint($m,1),$m,0], # native => native [mulint($m,2),$m2,1], # native => bigint [mulint($mp1,1),$mp1,1], # bigint => bigint [mulint($mp1,0),0,0], # bigint => native ); is_deeply( [map { "".$_->[0], ref($_->[0]) ? 1 : 0 } @mulres], [map { $_->[1], $_->[2] } @mulres], "mulint returns correct types" ); sub should_be_ref { my($n,$min,$max) = @_; $min = $intmin unless defined $min; $max = $intmax unless defined $max; # If n meets these conditions, we're good regardless of integer form. return 0 if $n > $min && $n < $max; # If a number is in string form (not a bigint), then Perl will say: # ~0+2048 == ~0 # # In decreasing performance order: # 1) Use a module like Math::Prime::Util. That's us. # 2) Compare as strings. Requires a bit of code. # 3) Turn it into a Math::BigInt so things work right. $n = Math::BigInt->new("$n"); return ($n > $max || $n < $min) ? 1 : 0; } Math-Prime-Util-0.74/t/31-threading.t000644 000765 000024 00000012111 14056645657 017224 0ustar00danastaff000000 000000 #!/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[0..50]; 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.74/t/53-realfunctions.t000644 000765 000024 00000012221 15152557511 020126 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; # TODO: These tolerances are too tight for NV = float. use Test::More; use Math::Prime::Util qw/ExponentialIntegral LogarithmicIntegral RiemannR RiemannZeta LambertW/; my $infinity = 20**20**20; # We can check using Pari/GP: -real(eint1(-x)) 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.61362206325045575150640392249037e+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)) + 1 ; 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"); } # Put at end to not hit bug in pre-0.53 MPU::GMP { my($n,$ein) = (170, 4.00120321792254728767739056606721e+71); cmp_closeto( ExponentialIntegral($n), $ein, 0.00000001 * abs($ein), "Ei($n) ~= $ein"); } 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.74/t/94-weaken.t000644 000765 000024 00000003576 15153316734 016547 0ustar00danastaff000000 000000 #!/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 forprimes divisors divrem/; 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"); $leaks = Test::Weaken::leaks( sub { my @p; forprimes { push @p, $_ } 1000; return \@p; }); ok(!$leaks, "forprimes block doesn't leak"); $leaks = Test::Weaken::leaks( sub { return [divrem(1000000007, 12345)]; }); ok(!$leaks, "divrem doesn't leak"); $leaks = Test::Weaken::leaks( sub { return [divisors(720720)]; }); ok(!$leaks, "divisors doesn't leak"); done_testing(); Math-Prime-Util-0.74/t/26-lucky.t000644 000765 000024 00000015055 15015767160 016412 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/lucky_numbers is_lucky lucky_count lucky_count_approx lucky_count_lower lucky_count_upper nth_lucky nth_lucky_approx nth_lucky_lower nth_lucky_upper/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my @lucky = (qw/1 3 7 9 13 15 21 25 31 33 37 43 49 51 63 67 69 73 75 79 87 93 99 105 111 115 127 129 133 135 141 151 159 163 169 171 189 193 195/); # 10 randomly selected samples up to 1e6 my %samples = (1144=>10239, 3378=>34639, 4996=>53595, 24406=>308119, 26427=>336201, 43449=>578395, 67655=>935911, 69526=>964101, 69985=>971011, 70970=>985983); my $nsamples = scalar(keys %samples); plan tests => 5 + 1*$extra # lucky_numbers + 2 # lucky_numbers ranges + 7 + (1+$nsamples)*$extra # is_lucky + 3 + (0+$nsamples)*$extra # nth_lucky + 1 # lucky_count + 1 # lucky_count ranges + 5 # lucky_count bounds + 11; # nth_lucky bounds ###### lucky_numbers sieve # Simple test for correct set is_deeply( lucky_numbers(200), \@lucky, "lucky_numbers(200)" ); my $ln1k = lucky_numbers(1000); # We will use this later { # Verify we get the right set back for each n from 0 to 200 my(@expect,@triangle); for my $n (0 .. 200) { push @triangle, @{lucky_numbers($n)}, ":"; push @expect, (grep { $_ <= $n } @lucky), ":"; } is_deeply( \@triangle, \@expect, "lucky numbers for each n from 0 to 200"); } is( scalar(@{lucky_numbers(12345)}), 1349, "correct count for lucky_numbers(12345)" ); if ($extra) { is( scalar(@{lucky_numbers(145845)}), 12345, "correct count for lucky_numbers(145845)" ); #is( scalar(@{lucky_numbers(1795453)}), 123456, "correct count for lucky_numbers(1795453)" ); } SKIP: { skip "skip mid-size lucky sieve for PP without EXTENDED_TESTING",2 unless $usexs || $extra; my $l = lucky_numbers(350000); is( scalar(@$l), 27420, "Lucky numbers under 350k: 27420" ); my $sum = 0; $sum += $_ for @$l; is( $sum, 4574808744, "Lucky numbers under 350k: correct sum" ); } # ranges { my(@expect,@got); for my $lo (0 .. 40) { for my $hi (0 .. 40) { #push @expect, [$lo,$hi,grep { $_ >= $lo && $_ <= $hi } @lucky]; #push @got, [$lo,$hi,@{lucky_numbers($lo,$hi)}]; } } is_deeply( \@got, \@expect, "all lucky numbers ranges 0 .. 40" ); is_deeply( lucky_numbers(51221,51289), [51229,51253,51255,51271,51283,51289], "range sieve: lucky_numbers(51221,51289)" ); } ###### is_lucky is_deeply( [grep { is_lucky($_) } 0..200], \@lucky, "is_lucky for 0 to 200" ); ok( is_lucky(42975), "42975 is a lucky number" ); ok( !is_lucky(513), "513 is not a lucky number" ); ok( !is_lucky(49023), "49023 is not a lucky number" ); ok( is_lucky(120001), "120001 is a lucky number" ); ok( !is_lucky(1000047), "1000047 is not a lucky number" ); ok( is_lucky(1000071), "1000047 is a lucky number" ); if ($extra) { ok( is_lucky(9999997), "9999997 is a lucky number" ); while (my($n, $ln) = each (%samples)) { ok( is_lucky($ln), "is_lucky($ln) returns true" ); } } ###### lucky_count { my @exact = (0); for my $l (@$ln1k) { push @exact, $exact[-1] while scalar(@exact) < $l; push @exact, $exact[-1] + 1; } is_deeply( [map { lucky_count($_) } 0 .. $#exact], \@exact, "lucky_count(0..$#exact)" ); } { my(@expect,@got); for my $lo (0 .. 40) { for my $hi (0 .. 40) { push @expect, [$lo,$hi,scalar(grep { $_ >= $lo && $_ <= $hi } @lucky)]; push @got, [$lo,$hi,lucky_count($lo,$hi)]; } } is_deeply( \@got, \@expect, "lucky_count ranges 0 .. 40" ); } ###### lucky_count_{upper,lower,approx} is(check_count_bounds(513, 86), 1, "lucky count bounds for 513"); is(check_count_bounds(5964377, 376288), 1, "lucky count bounds for 5964377"); is_deeply( [map { check_count_bounds($_, lucky_count($_)) } 0..100], [map { 1 } 0..100], "lucky count bounds for small numbers" ); is_deeply( [map { check_count_bounds($samples{$_},$_) } keys %samples], [map { 1 } keys %samples], "lucky count bounds for small samples" ); is(check_count_bounds(307703784778627, 8796093022208), 1, "lucky count bounds for 2^43-rd lucky number"); ###### nth_lucky is( nth_lucky(0), undef, "nth_lucky(0) returns undef" ); is_deeply( [map { nth_lucky($_) } 1 .. 153], $ln1k, "lucky numbers under 1000 with nth_lucky" ); is( nth_lucky(1 << 12), 42975, "42975 is the 2^12th lucky number" ); if ($extra) { while (my($n, $ln) = each (%samples)) { is( nth_lucky($n), $ln, "nth_lucky($n) = $ln" ); } } ###### nth_lucky{upper,lower,approx} is( nth_lucky_lower(0), undef, "nth_lucky_lower(0) returns undef" ); is( nth_lucky_upper(0), undef, "nth_lucky_upper(0) returns undef" ); is( nth_lucky_approx(0), undef, "nth_lucky_approx(0) returns undef" ); is(check_nth_bounds(86, 511), 1, "nth_lucky(86) bounds"); is(check_nth_bounds(123456, 1795453), 1, "nth_lucky(123456) bounds"); is(check_nth_bounds(5286238, 99999979), 1, "nth_lucky(5286238) bounds"); is(check_nth_bounds(46697909, 999999991), 1, "nth_lucky(46697909) bounds"); is(check_nth_bounds(1<<31, 55291335127), 1, "nth_lucky(2^31) bounds"); is(check_nth_bounds("8796093022208", "307703784778627"), 1, "nth_lucky(2^43) bounds"); is_deeply( [map { check_nth_bounds($_, $ln1k->[$_-1]) } 1..100], [map { 1 } 1..100], "nth_lucky(1..100) bounds" ); is_deeply( [map { check_nth_bounds($_, $samples{$_}) } keys %samples], [map { 1 } keys %samples], "nth_lucky bounds for small samples" ); sub check_count_bounds { my($n, $count) = @_; return "bad lower count for $n" if lucky_count_lower($n) > $count; return "bad upper count for $n" if lucky_count_upper($n) < $count; my $approx = lucky_count_approx($n); # Should convert the tolerances using toint return "approx count too low for $n" if "$approx" < 0.9 * "$count"; return "approx count too high for $n" if "$approx" > 1.1 * "$count"; 1; } sub check_nth_bounds { my($n, $nth) = @_; return "bad nth lower for $n" if nth_lucky_lower($n) > $nth; return "bad nth upper for $n" if nth_lucky_upper($n) < $nth; my $approx = nth_lucky_approx($n); return "approx nth too low for $n" if "$approx" < 0.9 * "$nth"; return "approx nth too high for $n" if "$approx" > 1.1 * "$nth"; 1; } Math-Prime-Util-0.74/t/19-totients.t000644 000765 000024 00000013004 15146553566 017136 0ustar00danastaff000000 000000 #!/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 sumtotient/; 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) + 2 # euler_phi around 2^32 and 2^64 + 1 # Small Carmichael Lambda + 14 # inverse_totient + 3 # sumtotient ; ###### 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" ); is_deeply([[euler_phi(4294967293,4294967295)], [euler_phi(4294967293,4294967296)], [euler_phi(4294967295,4294967297)], [euler_phi(4294967296,4294967298)]], [[4294493280,2147483646,2147483648],[4294493280,2147483646,2147483648,2147483648],[2147483648,2147483648,4288266240],[2147483648,4288266240,1431655764]], "euler_phi ranges around 2^32"); SKIP: { skip "ranges around 2^64 only on 64-bit",1 unless $use64; is_deeply([euler_phi("18446744073709551613","18446744073709551615"), euler_phi("18446744073709551613","18446744073709551616"), euler_phi("18446744073709551615","18446744073709551617")], [qw/17023385317621506048 7713001620195508224 9208981628670443520 17023385317621506048 7713001620195508224 9208981628670443520 9223372036854775808 9208981628670443520 9223372036854775808 18446676793287966720/], "euler_phi ranges around 2^64"); } ###### 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"); SKIP: { skip "Larger inverse totient with EXTENDED_TESTING",1 unless $extra; is(0+inverse_totient(3978374400), 63600, "inverse_totient(3978374400) = 63600"); } is_deeply( [inverse_totient(0)], [], "inverse_totient(0)" ); is_deeply( [inverse_totient(1)], [1,2], "inverse_totient(1)" ); is_deeply( [inverse_totient(2)], [3,4,6], "inverse_totient(2)" ); is_deeply( [inverse_totient(3)], [], "inverse_totient(3)" ); is_deeply( [inverse_totient(4)], [5,8,10,12], "inverse_totient(4)" ); is_deeply( [inverse_totient(2*12135413)], [], "inverse_totient(2*12135413)" ); is_deeply( [inverse_totient(2*10754819)], [21509639,43019278], "inverse_totient(2*10754819)" ); is_deeply( [inverse_totient(10000008)], [10555583,15000039,21111166,30000078], "inverse_totient(10000008)" ); is_deeply( [inverse_totient(10000)], [10291,12625,13805,18825,20582,20625,22088,25000,25100,25250,27500,27610,33132,37500,37650,41250], "inverse_totient(10000)" ); ok( scalar(grep { $_ == 123456789} inverse_totient(82260072)) == 1, "inverse_totient(82260072) includes 123456789" ); } ###### sumtotient is_deeply([map { sumtotient($_) } 0..10], [0,1,2,4,6,10,12,18,22,28,32], "sumtotient(0..10)"); is(sumtotient(12345),46326398,"sumtotient(12345)"); is("".sumtotient(654321),130137945644,"sumtotient(654321)"); Math-Prime-Util-0.74/t/011-load-ntheory.t000644 000765 000024 00000000142 13025437630 017724 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More tests => 1; require_ok 'ntheory'; Math-Prime-Util-0.74/t/18-60-logint.t000644 000765 000024 00000002043 15146553566 017004 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/logint/; plan tests => 2 + 4 + 4; ok( !defined eval { logint(0,10) } && !defined eval { logint(-5,10) }, "logint(n,base): n must be at least 1" ); ok( !defined eval { logint(10,1) } && !defined eval { logint(10,0) }, "logint(n,base): base must be at least 2" ); 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" ); is_deeply( [map { logint($_,10) } 1..200], [map { length($_)-1 } 1..200], "logint base 10: 0 .. 200" ); { my $be; is( logint(19284098234,16,\$be), 8, "logint(19284098234,16) = 8" ); is( $be, 16**8, "power is 16^8" ); } is(logint(58,~0), 0, "logint(58,~0) = 0"); is(logint("1329227995784915872903807060280344576",2), 120, "logint(2^120,2) = 120"); Math-Prime-Util-0.74/t/23-primality-proofs.t000644 000765 000024 00000037170 15152525733 020602 0ustar00danastaff000000 000000 #!/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,GMPz,Pari"; my $doexpensive = 0 + ($extra || ( (!$use64 || !$broken64) && Math::BigInt->config()->{lib} =~ /^Math::BigInt::GMP/ )); my @plist = qw/20907001 809120722675364249 65635624165761929287/; if ($extra || $use64) { push @plist, "1162566711635022452267983"; } # The standard Perl code will only create BLS5 certificates, so there really # is no point to trying more numbers. if ($extra && prime_get_config->{'gmp'}) { push @plist, "3555640317806906120837"; # ECPP push @plist, "677826928624294778921"; # BLS15 push @plist, "1056643454116252998516779"; # BLS3 } ## 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.74/t/11-semiprimes.t000644 000765 000024 00000010051 15146553566 017431 0ustar00danastaff000000 000000 #!/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 %range_counts = ( "1000000 to 1000100" => 25, "1000000000 to 1000000100" => 14, # iterate "1000000000 to 1000010000" => 1567, # sieve "1000000000 to 1001000000" => 155612, # count ); 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 %range_counts) + scalar(keys %big_counts) + scalar(keys %big_semis) + 1; 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($range, $count) = each (%range_counts)) { SKIP: { my($low,$high) = $range =~ /(\d+) to (\d+)/; skip "skip PP semiprime_count($low,$high)", 1 if !$usexs && $low > 1000000 && ($high-$low+1) > 1000; is_deeply( semiprime_count($low, $high), $count, "semiprime_count($low,$high) = $count"); } } while (my($n, $nth) = each (%small_semis)) { SKIP: { skip "skip PP nth_semiprime($n)",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"); } SKIP: { skip "skip large PP nth_semiprime",1 unless $extra && $usexs && Math::Prime::Util::prime_get_config->{'maxbits'} > 32; # More than one interpolation needed is( nth_semiprime(12479400000), 89102597117, "nth_semiprime(12479400000) = 89102597117" ); } sub cmp_closeto { my $got = shift; my $expect = shift; my $tolerance = shift; my $message = shift; my $diff = $got > $expect ? $got-$expect : $expect-$got; # $diff might be a bigint and might not compare correctly (!) ok("$diff" <= $tolerance, "$message (got $got)"); } Math-Prime-Util-0.74/t/26-setbinop.t000644 000765 000024 00000002444 15146553566 017114 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/setbinop/; plan tests => 9; ###### setbinop is_deeply( setbinop(sub{ $a+$b },[],[1,2,3]), [], "setbinop with an empty set" ); is_deeply( setbinop(sub{ $a+$b },[2,4,6]), [4,6,8,10,12], "setbinop A+A" ); is_deeply( setbinop(sub { $a+$b },[2,4,6,8],[3,5,7]), [5,7,9,11,13,15], "setbinop A+B" ); is_deeply( setbinop(sub { $a-$b },[1,2,3],[5,7,9]), [-8,-7,-6,-5,-4,-3,-2], "setbinop A-B" ); is_deeply( setbinop(sub { $b-$a },[1,2,3],[5,7,9]), [2,3,4,5,6,7,8], "setbinop B-A" ); is_deeply( setbinop(sub { $a+2*$b },[1,2,3],[5,7,9]), [11, 12, 13, 15, 16, 17, 19, 20, 21], "setbinop A+2B" ); is_deeply( setbinop(sub { ($a+$b) % 4 },[3,7,14]), [0,1,2], "setbinop A+A mod 4" ); # In practice we'd want to use powint instead of ** is_deeply( setbinop(sub { $a ** $b },[2,3,5,7,11,13],[2,3,5]), [qw/4 8 9 25 27 32 49 121 125 169 243 343 1331 2197 3125 16807 161051 371293/], "setbinop A^B" ); # from Granville and Roesler { my @s = grep { /^[124]{2}$/ } 1..99; my $S = setbinop { $a-$b } \@s; is(scalar(@$S), 7**2, "[124]{2} has 3^2 elements, A-A has 7^2 elements"); } Math-Prime-Util-0.74/t/26-powersum.t000644 000765 000024 00000006370 15150475177 017150 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/powersum/; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my @btests = ( [32, [qw/1624 2 1426381124 1429018500 1431659125/], [qw/67 4 260049713 280200834 301582210/], [qw/44 5 1128489076 1293405300 1477933425/], [qw/19 6 105409929 152455810 216455810/], [qw/17 7 680856256 1091194929 1703414961/], [qw/9 8 24684612 67731333 167731333/], ], [64, [qw/2642245 2 6148904570708739070 6148911552167379095 6148918533631303611/], [qw/5724 4 1228396075811803854 1229469567040762830 1230543808634903455/], [qw/1824 5 6127498198691333376 6147687633902880000 6167932473678270625/], [qw/482 6 857181367123038321 869720925148346545 882417389116663114/], [qw/288 7 5834458368653531904 5998799932115786496 6167177758675187425/], [qw/115 8 375757354506665017 406347583132055642 439131732051867738/], ], ); plan tests => 3 + 3 + 1 + scalar(@btests) + 2; is_deeply([map { powersum(0,$_) } 0..9], [map { 0 } 0..9], "powersum(0,n) = 0"); is_deeply([map { powersum(1,$_) } 0..9], [map { 1 } 0..9], "powersum(1,n) = 1"); is_deeply([map { powersum($_,0) } 1..9], [map { $_ } 1..9], "powersum(n,0) = 1 for n>0"); is_deeply([map { powersum(10,$_) } 0..5], [qw/10 55 385 3025 25333 220825/], "powersum(10,0..5)"); is_deeply([map { "".powersum(16,$_) } 0..15], [qw/16 136 1496 18496 243848 3347776 47260136 680856256 9961449608 147520415296 2206044295976 33254351828416 504635269460168 7701103353860416 118091609375661416 1818399978159990976/], "powersum(16,0..15)"); is_deeply([map { "".powersum(1711,$_) } 0..9], [qw/1711 1464616 1671126856 2145100027456 2937070623367384 4188996380716653376 6145256641557655809016 9202904066587083191010496 14000681533539207660658782424 21565944278446437945896721933376/], "powersum(1711,0..9)"); subtest 'Tests used by Math::AnyNum', sub { is("".powersum(97, 20), '27930470253682554320726764539206479400753', "powersum(97,20)"); is("".powersum(1234, 13), '1363782530586069716227147685797600627310545', "powersum(1234,13)"); is("".powersum(30, 80), '15824906698911682552620450221533100599157410235977820404994404262610329210567189683421455768203096083923986638110352399', "powersum(30,80)"); is("".powersum('36893488147419103232', 6), '13290765244262525999877070971093849105865118528347431876799549931828154109852970889789225381341531108777505296823405714971493113182289920', "powersum(36893488147419103232,6)"); }; for my $btest (@btests) { my($bits,@tarr) = @$btest; subtest "Window around $bits-bit analytic boundaries", sub { for my $test (@tarr) { my($n,$k,@exp) = @$test; my @got = (powersum($n-1,$k), powersum($n,$k), powersum($n+1,$k)); is_deeply(\@got, \@exp, "powersum($n,$k) = $exp[1]"); } }; } is_deeply( ["".powersum(115,4), "".powersum(116,4), "".powersum(117,4)], [qw/4110671642 4291735578 4479124299/], "powersum({115,116,117},4) correct [test 32-bit overflow]" ); is_deeply( ["".powersum(9838,4), "".powersum(9839,4), "".powersum(9840,4)], [qw/18436328665468109431 18445700051808767672 18455075248624127672/], "powersum({9838,9839,9840},4) correct [test 64-bit overflow]" ); Math-Prime-Util-0.74/t/11-almostprimes.t000644 000765 000024 00000012767 15146553566 020013 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/almost_primes almost_prime_count almost_prime_count_approx almost_prime_count_lower almost_prime_count_upper nth_almost_prime nth_almost_prime_approx nth_almost_prime_lower nth_almost_prime_upper /; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $use64 = ~0 > 4294967295; plan tests => 1 # generating + 1 # counting + 1 # nth + 1 # limits + 1; # approx subtest 'generate almost primes', sub { is_deeply([map{almost_primes(0,$_)}0,1,100000],[[],[1],[1]],"almost_primes(0,n)"); my @small_kaps = ( [1], [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], [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], [8,12,18,20,27,28,30,42,44,45,50,52,63,66,68,70,75,76,78,92,98,99,102,105,110,114,116,117,124,125], [16,24,36,40,54,56,60,81,84,88,90,100,104,126,132,135,136,140,150,152,156,184,189,196,198,204,210,220,225,228], [32,48,72,80,108,112,120,162,168,176,180,200,208,243,252,264,270,272,280,300,304,312,368,378,392,396,405,408,420,440], ); for my $k (0..5) { my $kap = $small_kaps[$k]; is_deeply(almost_primes($k,$kap->[-1]), $kap, "small $k-almost-primes"); } my @res = ( [ 8,3,qw/06 14 22 23 31 36 45/], [ 8,4,qw/05 10 11 12 18 24 25 28 29 30 33 38 43 46 47/], [ 8,5,qw/02 21 50/], [13,3,qw/01 09 13 14 21 22 27 31 33 36 39 42 43/], [13,4,qw/03 04 07 11 17 28 29 38 45/], [13,5,qw/02 05 06 10 18 20 23 26 30 34 46 50/], ); for my $rdata (@res) { my($E,$k,@suffix) = @$rdata; next unless $extra || $E == (~0 > 1e13 ? 13 : 8); my $prefix = '1' . '0' x ($E-2); my $got = almost_primes($k, $prefix.'00', $prefix.'50'); my $exp = [map { $prefix.$_ } @suffix]; is_deeply($got, $exp, "almost_primes($k, 10^$E + 0, 10^$E + 50)"); } }; ###### Test almost_prime_count subtest 'counting almost primes', sub { my @counts_at_1e6 = (1,78498,210035,250853,198062,124465,68963,35585,17572,8491,4016,1878,865,400,179,79,35,14,7,2,0); is_deeply([map { almost_prime_count($_, 1e6) } 0..20], \@counts_at_1e6, "k-almost prime counts at 1000000 for k=1..20"); is(almost_prime_count(17,1e9), 38537, "There are 38537 17-almost-primes <= 1,000,000,000"); is_deeply([map{almost_prime_count($_,206)}1..10],[46,67,48,26,12,4,2,0,0,0],"almost_prime_count_approx n=206, k 1..10"); is(almost_prime_count(10,1024),1,"almost_prime_count(10,1024) = 1"); }; ###### Test nth_almost_prime subtest 'nth almost prime', sub { is(nth_almost_prime(1,2), 3, "2nd 1-almost-prime is 3"); is(nth_almost_prime(2,34), 95, "34th 2-almost-prime is 94"); is(nth_almost_prime(3,456), 1802, "456th 3-almost-prime is 1802"); is(nth_almost_prime(2,4), 10, "4th 2-almost-prime is 10"); is(nth_almost_prime(3,4), 20, "4th 3-almost-prime is 20"); is(nth_almost_prime(4,4), 40, "4th 4-almost-prime is 40"); SKIP: { skip "The almost prime pure Perl is *very* slow",3 unless $usexs; is(nth_almost_prime(4,5678), 31382, "5678th 4-almost-prime is 31382"); is(nth_almost_prime(5,67890), 558246, "67890th 5-almost-prime is 558246"); is("".nth_almost_prime(24,5555), "21678243840", "5555th 24-almost-prime is 21678243840"); } is("".nth_almost_prime(100,3), "2852213850513516153367582212096", "nth_almost_prime with k=100 n=3"); }; ###### Test limits subtest 'limits', sub { is( cmp_kap(3,59643,234618), 234618, "3-almost prime limits for 59643" ); is( cmp_kap(32,12,"26843545600"), "26843545600", "32-almost prime limits for 12" ); }; ###### Test approx subtest 'approx', sub { is(approx_in_range(3,59643,234618), 234618, "approx 59643-th 3-almost prime)"); is(approx_in_range(32,12,"26843545600"), "26843545600", "approx 12-th 32-almost prime"); is(approx_in_range(63,2011,"4742290407621132288000"), "4742290407621132288000", "approx 2011-th 63-almost prime"); is(approx_in_range(150,4557,"1546066063123731041156388276406165606486610280448"), "1546066063123731041156388276406165606486610280448", "approx 4557-th 150-almost prime (49 digits)"); my @aptests = ( [1,46,199], [2,67,206], [3,48,195], [4,26,204], ); for my $aap (@aptests) { my($k, $n, $count) = @$aap; is( approx_in_range($k,$n,$count), $count, "small approx $k-almost prime"); } }; sub cmp_closeto { my $got = shift; my $expect = shift; my $tolerance = shift; my $message = shift; cmp_ok( abs($got - $expect), '<=', $tolerance, $message ); } sub cmp_kap { my($k,$n,$rn) = @_; return 'nth lower' unless nth_almost_prime_lower($k,$n) <= $rn; return 'nth upper' unless nth_almost_prime_upper($k,$n) >= $rn; return 'pc lower' unless almost_prime_count_lower($k,$rn) <= $n; return 'pc upper' unless almost_prime_count_upper($k,$rn) >= $n; $rn; } sub approx_in_range { my($k,$n,$rn) = @_; my $arn = nth_almost_prime_approx($k,$n); my $an = almost_prime_count_approx($k,$rn); my $div = $usexs ? 20 : 4; $div *= 0.3 if $k > 2 && $n < 60; $div *= 0.5 if $k > 3; return 'nth approx too low' if "$arn" < ($rn-$rn/$div); return 'nth approx too high' if "$arn" > ($rn+$rn/$div); return 'count approx too low' if "$an" < ($n-$n/$div); return 'count approx too high' if "$an" > ($n+$n/$div); $rn; } Math-Prime-Util-0.74/t/18-91-edge.t000644 000765 000024 00000031556 15152457446 016430 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/ addint subint mulint negint absint cmpint divint modint cdivint divrem fdivrem cdivrem tdivrem powint addmod submod mulmod powmod divmod muladdmod mulsubmod /; my $use64 = (~0 > 4294967295); my $bits = $use64 ? 64 : 32; my $uvmax = $use64 ? "18446744073709551615" : "4294967295"; my $ivmax = $use64 ? "9223372036854775807" : "2147483647"; my $ivmin = $use64 ? "-9223372036854775808" : "-2147483648"; # just past UV boundary my $uvmax1 = $use64 ? "18446744073709551616" : "4294967296"; my $ivmax1 = $use64 ? "9223372036854775808" : "2147483648"; plan tests => + 1 # addint associativity + 1 # subint(IV_MIN, 1) crosses to bigint + 1 # addint(UV_MAX, 1) crosses to bigint + 1 # addint(IV_MIN, -1) crosses to bigint + 1 # subint(0, UV_MAX) = -UV_MAX + 1 # subint(IV_MIN, IV_MAX) extreme spread + 1 # mulint near-boundary products + 1 # mulint distributive + 1 # mulint(-1, IV_MIN) + 1 # powint special cases + 1 # powint bigint overflow + 1 # cmpint systematic + 1 # cmpint equal values + 1 # cmpint transitivity + 1 # cmpint sign dominance + 1 # divint/modint by 1 and -1 + 1 # divint exact division + 1 # divint small / large + 1 # divrem invariant on boundary values + 1 # modops: addmod algebraic identity + 1 # modops: mulmod algebraic identity + 1 # modops: powmod(a,0,m) == 1 mod m + 1 # modops: powmod(a,1,m) == a mod m + 1 # modops: mulmod near UV_MAX + 1 # modops: muladdmod/mulsubmod consistency + 1 # modops: addmod/submod inverse + 0; ##### addint: associativity (a+b)+c == a+(b+c) { my @triples = ( [1, 2, 3], [$ivmax, 1, 1], [-1, $ivmin, -1], [$uvmax, $uvmax, $uvmax], ["$ivmin", "$ivmin", "$ivmin"], [$uvmax, "-$ivmax", 1], ["123456789012345678901234", "-987654321098765432109876", "864197532086419753208642"], ); my $ok = 1; for my $t (@triples) { my($a,$b,$c) = @$t; $ok = 0 if "".addint(addint($a,$b),$c) ne "".addint($a,addint($b,$c)); } ok($ok, "addint is associative"); } ##### addint/subint: boundary crossings is("".subint($ivmin, 1), "".addint($ivmin, -1), "subint(IV_MIN, 1) == addint(IV_MIN, -1)"); is("".addint($uvmax, 1), $uvmax1, "addint(UV_MAX, 1) crosses into bigint"); { my $expect_below_ivmin = subint($ivmin, 1); # IV_MIN - 1 should be one less is("".addint($expect_below_ivmin, 1), $ivmin, "addint(IV_MIN-1, 1) returns to IV_MIN"); } ##### subint: extreme negation and spread is("".subint(0, $uvmax), "-$uvmax", "subint(0, UV_MAX) = -UV_MAX"); { # IV_MIN - IV_MAX should be a very negative number (2*IV_MIN + 1 in magnitude) my $result = subint($ivmin, $ivmax); my $check = addint($result, $ivmax); is("$check", $ivmin, "subint(IV_MIN, IV_MAX) + IV_MAX == IV_MIN"); } ##### mulint: products near UV boundary { # (2^32-1)*(2^32-1) = 2^64 - 2^33 + 1 (overflows UV on 64-bit) # (2^16-1)*(2^16-1) = 2^32 - 2^17 + 1 (overflows UV on 32-bit) my @cases; if ($use64) { push @cases, ["4294967295", "4294967295", "18446744065119617025"], ["4294967296", "4294967295", "18446744069414584320"], [$uvmax, $uvmax, "340282366920938463426481119284349108225"]; } else { push @cases, ["65535", "65535", "4294836225"], [$uvmax, $uvmax, "18446744065119617025"]; } my $ok = 1; for my $c (@cases) { $ok = 0 if "".mulint($c->[0],$c->[1]) ne $c->[2]; } ok($ok, "mulint products near UV boundary"); } ##### mulint: distributive property a*(b+c) == a*b + a*c { my @cases = ( [7, 11, 13], [-5, $ivmax, 1], [3, $uvmax, "-$ivmax"], ["123456789", "-987654321", "864197532"], ); my $ok = 1; for my $c (@cases) { my($a,$b,$cc) = @$c; my $lhs = mulint($a, addint($b,$cc)); my $rhs = addint(mulint($a,$b), mulint($a,$cc)); $ok = 0 if "$lhs" ne "$rhs"; } ok($ok, "mulint distributive: a*(b+c) == a*b + a*c"); } ##### mulint: -1 * IV_MIN (tricky: result is positive and > IV_MAX) { is("".mulint(-1, $ivmin), $ivmax1, "mulint(-1, IV_MIN) = IV_MAX+1"); } ##### powint: special cases { my $ok = 1; $ok = 0 if powint(0, 0) != 1; $ok = 0 if powint(0, 1) != 0; $ok = 0 if powint(0, 100) != 0; $ok = 0 if powint(1, 0) != 1; $ok = 0 if powint(1, 9999999) != 1; $ok = 0 if powint(-1, 0) != 1; $ok = 0 if powint(-1, 1) != -1; $ok = 0 if powint(-1, 2) != 1; $ok = 0 if powint(-1, 99) != -1; $ok = 0 if powint(-1, 100) != 1; $ok = 0 if powint(2, 0) != 1; $ok = 0 if powint(2, 1) != 2; $ok = 0 if powint(2, 10) != 1024; $ok = 0 if "".powint(-2, 3) ne "-8"; $ok = 0 if "".powint(-2, 4) ne "16"; ok($ok, "powint special cases: 0^k, 1^k, (-1)^k, 2^k, (-2)^k"); } ##### powint: overflow to bigint { # 2^BITS should produce UV_MAX+1 as a bigint is("".powint(2, $bits), $uvmax1, "powint(2, BITS) produces bigint UV_MAX+1"); } ##### cmpint: systematic coverage { my @vals = (0, 1, -1, $ivmax, $ivmin, $uvmax, "-$uvmax", $uvmax1, "-$uvmax1"); my $ok = 1; for my $a (@vals) { for my $b (@vals) { my $cmp = cmpint($a, $b); # Verify: cmpint agrees with subint sign my $diff = subint($a, $b); my $expected = ($diff eq "0") ? 0 : (substr("$diff",0,1) eq '-') ? -1 : 1; if ($cmp != $expected) { $ok = 0; } } } ok($ok, "cmpint agrees with sign(subint(a,b)) for boundary values"); } ##### cmpint: equal values { my @vals = (0, 1, -1, $ivmax, $ivmin, $uvmax, $uvmax1, "-$uvmax1", "340282366920938463463374607431768211456"); my $ok = 1; for my $v (@vals) { $ok = 0 if cmpint($v, $v) != 0; } ok($ok, "cmpint(n,n) == 0 for all test values"); } ##### cmpint: transitivity { my @sorted = ("-340282366920938463463374607431768211456", "-$uvmax1", "-$uvmax", $ivmin, -1, 0, 1, $ivmax, $uvmax, $uvmax1, "340282366920938463463374607431768211456"); my $ok = 1; for my $i (0 .. $#sorted-1) { $ok = 0 if cmpint($sorted[$i], $sorted[$i+1]) >= 0; # Also verify reverse $ok = 0 if cmpint($sorted[$i+1], $sorted[$i]) <= 0; } ok($ok, "cmpint: sorted list has correct ordering (transitivity)"); } ##### cmpint: sign dominance - any negative < any non-negative { my @neg = (-1, $ivmin, "-$uvmax", "-$uvmax1"); my @pos = (0, 1, $ivmax, $uvmax, $uvmax1); my $ok = 1; for my $n (@neg) { for my $p (@pos) { $ok = 0 if cmpint($n, $p) >= 0; } } ok($ok, "cmpint: all negative values < all non-negative values"); } ##### divint/modint: divide by 1 and -1 { my @vals = (0, 1, -1, 7, -7, $ivmax, $ivmin, $uvmax, "-$uvmax", "39458349850349850394853049583049"); my $ok = 1; for my $n (@vals) { # divint(n,1) == n, modint(n,1) == 0 $ok = 0 if "".divint($n, 1) ne "$n"; $ok = 0 if modint($n, 1) != 0; # divint(n,-1) == -n, modint(n,-1) == 0 $ok = 0 if "".divint($n, -1) ne "".negint($n); $ok = 0 if modint($n, -1) != 0; } ok($ok, "divint(n,1)==n, modint(n,1)==0, divint(n,-1)==negint(n)"); } ##### divint: exact division (zero remainder) { my @cases = ( [0, 7], [42, 7], [-42, 7], [42, -7], [$uvmax, $uvmax], ["$ivmin", 1], ["39458349850349850394853049583049", "85889"], ); my $ok = 1; for my $c (@cases) { my($prod, $d) = @$c; # Multiply first to guarantee exact division my $n = mulint($prod, $d); # Now divint(n, d) should give prod back (floor division) my($q, $r) = fdivrem($n, $d); $ok = 0 if "$r" ne "0"; $ok = 0 if "$q" ne "".divint($n, $d); } ok($ok, "fdivrem gives zero remainder for exact multiples"); } ##### divint: small numerator / large denominator { my @cases = ( [0, $uvmax, 0], [1, $uvmax, 0], [-1, $uvmax, -1], [1, $uvmax1, 0], [$ivmax, $uvmax, 0], ); my $ok = 1; for my $c (@cases) { $ok = 0 if "".divint($c->[0], $c->[1]) ne "$c->[2]"; } ok($ok, "divint: small / large gives correct quotient"); } ##### divrem invariant on boundary values { my @pairs = ( [$uvmax, 2], [$uvmax, 3], [$uvmax, $ivmax], ["$ivmin", 3], ["$ivmin", -3], ["$ivmin", $ivmax], [$uvmax1, 7], ["-$uvmax1", 7], ["340282366920938463463374607431768211456", $uvmax], ); my $ok = 1; for my $p (@pairs) { my($a, $b) = @$p; for my $fn (\&divrem, \&tdivrem, \&fdivrem, \&cdivrem) { my($q, $r) = $fn->($a, $b); # invariant: a == b*q + r $ok = 0 if "".addint(mulint($b, $q), $r) ne "$a"; } } ok($ok, "a == b*q + r for all division modes on boundary values"); } ##### modops: addmod algebraic identity # addmod(a,b,m) == (a+b) mod m when m > 0 { my @cases = ( [0, 0, 7], [$uvmax, 1, $uvmax], [$uvmax, $uvmax, $uvmax], [$ivmax, $ivmax, $uvmax], ["340282366920938463463374607431768211456", $uvmax, "999999999999999989"], ); my $ok = 1; for my $c (@cases) { my($a,$b,$m) = @$c; my $got = addmod($a, $b, $m); my $exp = modint(addint($a, $b), $m); $ok = 0 if "$got" ne "$exp"; } ok($ok, "addmod(a,b,m) == modint(addint(a,b), m)"); } ##### modops: mulmod algebraic identity # mulmod(a,b,m) == (a*b) mod m when m > 0 { my @cases = ( [0, 0, 7], [0, $uvmax, 13], [$uvmax, 1, $uvmax], [$uvmax, 2, $uvmax], [$ivmax, $ivmax, $uvmax], [$uvmax, $uvmax, "999999999999999989"], ); my $ok = 1; for my $c (@cases) { my($a,$b,$m) = @$c; my $got = mulmod($a, $b, $m); my $exp = modint(mulint($a, $b), $m); $ok = 0 if "$got" ne "$exp"; } ok($ok, "mulmod(a,b,m) == modint(mulint(a,b), m)"); } ##### modops: powmod(a, 0, m) == 1 mod m (for m > 1) { my @bases = (0, 1, 2, -1, $ivmax, $uvmax); my @mods = (2, 3, 7, $uvmax, "999999999999999989"); my $ok = 1; for my $a (@bases) { for my $m (@mods) { my $got = powmod($a, 0, $m); # a^0 mod m should be 1 mod m, which is 1 when m > 1 $ok = 0 if "$got" ne "1"; } } ok($ok, "powmod(a, 0, m) == 1 for m > 1"); } ##### modops: powmod(a, 1, m) == a mod m { my @cases = ( [0, 7], [1, 7], [6, 7], [7, 7], [-1, 7], [$uvmax, "999999999999999989"], [$ivmax, $uvmax], ); my $ok = 1; for my $c (@cases) { my($a, $m) = @$c; my $got = powmod($a, 1, $m); my $exp = modint($a, $m); $ok = 0 if "$got" ne "$exp"; } ok($ok, "powmod(a, 1, m) == a mod m"); } ##### modops: mulmod near UV_MAX (exercises 128-bit intermediate) { my @cases; if ($use64) { @cases = ( # (UV_MAX-1) * (UV_MAX-1) mod UV_MAX should be 1 ["18446744073709551614", "18446744073709551614", $uvmax, 1], # UV_MAX * UV_MAX mod (UV_MAX - 1) should be 1 [$uvmax, $uvmax, "18446744073709551614", 1], # large prime modulus [$uvmax, $uvmax, "999999999999999989", "587155414672247084"], ); } else { @cases = ( ["4294967294", "4294967294", $uvmax, 1], [$uvmax, $uvmax, "4294967294", 1], [$uvmax, $uvmax, "999999937", "264566326"], ); } my $ok = 1; for my $c (@cases) { my($a, $b, $m, $exp) = @$c; my $got = mulmod($a, $b, $m); $ok = 0 if "$got" ne "$exp"; } ok($ok, "mulmod near UV_MAX boundary"); } ##### modops: muladdmod and mulsubmod consistency # muladdmod(a,b,c,m) == addmod(mulmod(a,b,m), c, m) # mulsubmod(a,b,c,m) == submod(mulmod(a,b,m), c, m) { my @cases = ( [0, 0, 0, 7], [3, 5, 7, 11], [$ivmax, 2, $ivmax, $uvmax], [$uvmax, $uvmax, $uvmax, "999999999999999989"], ["123456789012345678901234", "987654321098765432109876", "111111111111111111111111", "314159265358979323846263"], ); my $ok = 1; for my $c (@cases) { my($a,$b,$cc,$m) = @$c; my $mam = muladdmod($a, $b, $cc, $m); my $msm = mulsubmod($a, $b, $cc, $m); my $mam_exp = addmod(mulmod($a, $b, $m), $cc, $m); my $msm_exp = submod(mulmod($a, $b, $m), $cc, $m); $ok = 0 if "$mam" ne "$mam_exp"; $ok = 0 if "$msm" ne "$msm_exp"; } ok($ok, "muladdmod/mulsubmod == addmod/submod(mulmod(...))"); } ##### modops: addmod and submod are inverses # submod(addmod(a, b, m), b, m) == a mod m { my @cases = ( [0, 0, 7], [3, 5, 7], [6, 6, 7], [$ivmax, 1, $uvmax], [$uvmax, $uvmax, "999999999999999989"], [0, $uvmax, $uvmax], ); my $ok = 1; for my $c (@cases) { my($a, $b, $m) = @$c; my $a_mod_m = modint($a, $m); my $roundtrip = submod(addmod($a, $b, $m), $b, $m); $ok = 0 if "$roundtrip" ne "$a_mod_m"; } ok($ok, "submod(addmod(a,b,m), b, m) == a mod m"); } Math-Prime-Util-0.74/t/26-ispower.t000644 000765 000024 00000015542 15152503334 016745 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_power is_prime_power is_square is_sum_of_squares vecsum/; 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], 11 => [362797056], 13 => [1594323], 17 => [129140163], 40 => [qw/1099511627776 12157665459056928801/], ); if ($use64) { push @{$powers{0}}, 9908918038843197151; push @{$powers{2}}, 18446743927680663841; push @{$powers{3}}, 2250923753991375; push @{$powers{4}}, 1150530828529256001; push @{$powers{9}}, 118587876497; push @{$powers{11}}, 12200509765705829; push @{$powers{13}}, 9904578032905937; push @{$powers{17}}, 232630513987207; push @{$powers{31}}, 617673396283947; } 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)) + 5 # is_power + 2*scalar(keys %powers) + scalar(@negpowers) + 13 # tests for 3,5,7 power + 3 # is_square + 7 # is_sum_of_squares + 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,0,r) = $r^$k. Expect ".join("^",@$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, (@fail > 0) ? "is_power(n) should return $e for [@fail]" : "is_power(n) returns $e for [@$vals]" ); my @fail2; my $exp = ($e == 0) ? 0 : 1; foreach my $val (@$vals) { push @fail2, $val unless is_power($val,$e) == $exp; } ok( @fail2 == 0, (@fail2 > 0) ? "is_power(n,$e) should return $exp for [@fail2]" : "is_power(n,$e) returns $exp for [@$vals]" ); } is_deeply( [map { is_power($_,1) } -10..10], [map { 1 } -10..10], "Every integer is a first power"); 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( is_power(56129,3), 0, "56129 is not a 3rd power" ); is( is_power(50653,3), 1, "50653 is a 3rd power" ); is( is_power(76840601,5), 0, "76840601 is not a 5th power" ); is( is_power(69343957,5), 1, "69343957 is a 5th power" ); is( is_power(4782969,7), 1, "4782969 is a 7th power" ); is( is_power(4782971,7), 0, "4782971 is not a 7th power" ); ###### 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"); ###### is_sum_of_squares is_deeply( [map { is_sum_of_squares($_,0) } (-10 .. 10)], [0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0], "is_sum_of_squares (k=0) for -10 .. 10" ); is_deeply( [map { is_sum_of_squares($_,1) } (-10 .. 10)], [0,1,0,0,0,0,1,0,0,1,1,1,0,0,1,0,0,0,0,1,0], "is_sum_of_squares (k=1) for -10 .. 10" ); is_deeply( [map { is_sum_of_squares($_) } (-10 .. 100)], [1,1,1,0,0,1,1,0,1,1,1,1,1,0,1,1,0,0,1,1,1,0,0,1,0,0,1,1,1,0,1,0,0,0,0,1,1,0,0,1,0,0,1,0,1,0,1,1,0,0,1,1,0,0,0,1,0,0,0,1,1,0,1,1,0,0,0,0,1,0,0,1,0,0,1,1,0,0,1,0,0,0,1,1,1,0,0,0,0,0,1,1,1,0,0,1,0,0,0,1,1,0,0,0,0,0,0,1,1,0,1], "is_sum_of_squares (k=2) for -10 .. 100" ); is_deeply( [map { is_sum_of_squares($_,3) } (-10 .. 100)], [1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,0,1,1,1,1,0,1,1,0,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,0,1,1,1,1,0,1,1,0,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,0,1,1,1,1,0,1,1,0,1,1,1,1,1], "is_sum_of_squares (k=3) for -10 .. 100" ); is_deeply( [map { is_sum_of_squares($_,4) } (-10 .. 10)], [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1], "is_sum_of_squares (k=4) for -10 .. 10" ); is_deeply( [map { is_sum_of_squares($_) } (209, 437, 713, 1333, 2021)], [0,0,0,0,0], "is_sum_of_squares (k=2) for selected non-representable integers" ); is_deeply( [map { is_sum_of_squares($_,3) } (qw/0 6 7 8 9 1145141919810 245657627368729 12345678987654321 185724285729475816451975/)], [1,1,0,1,1,1,1,1,0], "is_sum_of_squares (k=3) for selected integers" ); Math-Prime-Util-0.74/t/26-sumset.t000644 000765 000024 00000010155 15150475504 016575 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/sumset setbinop addint/; plan tests => 13+17+1; ###### sumset my $pr200 = [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/]; my $sumset_pr200 = [qw/4 5 6 7 8 9 10 12 13 14 15 16 18 19 20 21 22 24 25 26 28 30 31 32 33 34 36 38 39 40 42 43 44 45 46 48 49 50 52 54 55 56 58 60 61 62 63 64 66 68 69 70 72 73 74 75 76 78 80 81 82 84 85 86 88 90 91 92 94 96 98 99 100 102 103 104 105 106 108 109 110 111 112 114 115 116 118 120 122 124 126 128 129 130 132 133 134 136 138 139 140 141 142 144 146 148 150 151 152 153 154 156 158 159 160 162 164 165 166 168 169 170 172 174 175 176 178 180 181 182 183 184 186 188 190 192 193 194 195 196 198 199 200 201 202 204 206 208 210 212 214 216 218 220 222 224 226 228 230 232 234 236 238 240 242 244 246 248 250 252 254 256 258 260 262 264 266 268 270 272 274 276 278 280 282 284 286 288 290 292 294 296 298 300 302 304 306 308 310 312 314 316 318 320 322 324 326 328 330 332 334 336 338 340 342 344 346 348 350 352 354 356 358 360 362 364 366 370 372 374 376 378 380 382 384 386 388 390 392 394 396 398/]; is_deeply(sumset($pr200),$sumset_pr200,"sumset of primes under 200"); is_deeply(sumset([2,4,6,8],[3,5,7]), [5,7,9,11,13,15], "sumset([2,4,6,8],[3,5,7])"); is_deeply(sumset([1,2,3]), [2,3,4,5,6], "sumset([1,2,3])"); is_deeply(sumset([1,2,3],[2,3,4]), [3,4,5,6,7], "sumset([1,2,3],[2,3,4])"); is_deeply(sumset([1],[2]), [3], "sumset([1],[2])"); is_deeply(sumset([1],[]), [], "sumset([1],[])"); is_deeply(sumset([],[2]), [], "sumset([],[2])"); is_deeply(sumset([map {2*$_} 1..10]), [4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40], "sumset of evens 2-20"); { my $s = sumset([map {2*$_} 1..10]); is(@$s,19,"sumset of evens 2-20 makes only 19 entries"); } is_deeply(sumset([map {3*$_} 1..10]), [6,9,12,15,18,21,24,27,30,33,36,39,42,45,48,51,54,57,60], "sumset of 3x x=1..10"); { my $s = sumset([map {1<<$_} 1..10]); is(@$s,55,"sumset of powers of 2 1..10 has 55 entries"); } is_deeply(sumset([0,3,7,12],[2,4,11,14]), [2,4,5,7,9,11,14,16,17,18,21,23,26], "sumset of two sets"); # from Granville and Roesler { my @s = grep { /^[124]{2}$/ } 1..99; my $S = sumset(\@s); is(scalar(@$S), 36, "[124]{2} has 3^2 elements, A+A has 6^2 elements"); # A-A should have 7^2 elements } # Specific combination tests testsumset([1,2],[3,4], "sumset ANY ANY ok"); testsumset([1,2],[3,4,"18446744073709551615"], "sumset ANY POS overflow"); testsumset([1,2],[3,4,"18446744073709551605"], "sumset ANY POS ok"); testsumset([1,2,"18446744073709551615"],[3,4], "sumset POS ANY overflow"); testsumset([1,2,"18446744073709551605"],[3,4], "sumset POS ANY ok"); testsumset([1,2,"9223372036854775808"],[3,4,"9223372036854775808"], "sumset POS POS overflow"); testsumset([-1,"4611686018427387904"], [3,"9911686018427387905"], "sumset NEG POS overflow"); testsumset([-100,-99], ["9223372036854775808","9223372036854775809"], "sumset NEG POS with sumset ANY"); testsumset([-1,1], [3,"9911686018427387905"], "sumset NEG POS with sumset POS"); testsumset([-1,"4611686018427387904"], [3,"4611686018427387905"], "sumset NEG ANY overflow"); testsumset([-1,"4611686018427387904"], [-3,"4611686018427387905"], "sumset NEG NEG overflow"); testsumset([1,2,"-4611686018427387904"], [3,4,"-4611686018427387904"], "sumset NEG NEG ok"); testsumset([1,2,"-4611686018427387905"], [3,4,"-4611686018427387905"], "sumset NEG NEG undeflow"); testsumset([-1,2], [3,4], "sumset NEG ANY with sumset ANY"); testsumset([-6,2], [3,4], "sumset NEG ANY with sumset NEG"); testsumset([-6,2], [-3,4], "sumset NEG NEG with sumset NEG"); testsumset([-6,-2], [-4,-3], "sumset NEG NEG with sumset NEG"); # bigint is_deeply( [map{"$_"}@{sumset([1,2],[3,4,"73786976294838206464"])}], [qw/4 5 6 73786976294838206465 73786976294838206466/], "sumset with bigint element" ); sub testsumset { my($ra, $rb, $name) = @_; my $sumset1 = [map {"$_"} @{ sumset($ra,$rb) }]; my $sumset2 = [map {"$_"} @{ setbinop(sub{addint($a,$b)}, $ra, $rb) }]; is_deeply($sumset1, $sumset2, $name); } Math-Prime-Util-0.74/t/35-cipher.t000644 000765 000024 00000003427 13667653032 016540 0ustar00danastaff000000 000000 #!/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.74/t/11-omegaprimes.t000644 000765 000024 00000005476 15146553566 017603 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/omega_primes omega_prime_count nth_omega_prime/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my @small_kops = ( [], [2,3,4,5,7,8,9,11,13,16,17,19,23,25,27,29,31,32,37,41,43,47,49,53,59,61,64,67,71,73,79,81,83,89,97,101,103,107,109,113], [6,10,12,14,15,18,20,21,22,24,26,28,33,34,35,36,38,39,40,44,45,46,48,50,51,52,54,55,56,57,58,62,63,65,68,69,72,74,75,76], [30,42,60,66,70,78,84,90,102,105,110,114,120,126,130,132,138,140,150,154,156,165,168,170,174,180,182,186,190,195,198,204,220,222,228,230,231,234,238,240], [210,330,390,420,462,510,546,570,630,660,690,714,770,780,798,840,858,870,910,924,930,966,990,1020,1050,1092,1110,1122,1140,1155,1170,1190,1218,1230,1254,1260,1290,1302,1320,1326], [2310,2730,3570,3990,4290,4620,4830,5460,5610,6006,6090,6270,6510,6630,6930,7140,7410,7590,7770,7854,7980,8190,8580,8610,8778,8970,9030,9240,9282,9570,9660,9690,9870,10010,10230,10374,10626,10710,10920,11130], ); my @counts_at_1e6 = (1,78734,288726,379720,208034,42492,2285,8,0,0,0,0,0,0,0,0,0,0,0,0,0); my @counts_at_1e4 = (1,1280,4097,3695,894,33,0,0,0,0,0); plan tests => 5 # omega_primes sieve + 6 # count + 8 # nth_omega_prime ; ###### omega_primes for my $k (1..5) { my $kop = $small_kops[$k]; is_deeply(omega_primes($k,$kop->[-1]), $kop, "small $k-omega-primes"); } ###### omega_prime_count is_deeply([map{omega_prime_count($_,206)}1..10],[60,113,32,0,0,0,0,0,0,0],"omega_prime_count n=206, k 1..10"); is_deeply([map { omega_prime_count($_, 1e4) } 0..10], \@counts_at_1e4, "k-omega prime counts at 10000 for k=1..10"); is(omega_prime_count(6,9e4), 19, "There are 19 6-omega-primes <= 90,000"); is(omega_prime_count(8,2e7), 10, "There are 10 8-omega-primes <= 20,000,000"); SKIP: { skip "Slow in PP", 2 unless $usexs || $extra; is_deeply([map { omega_prime_count($_, 1e6) } 0..20], \@counts_at_1e6, "k-omega prime counts at 1000000 for k=1..20"); is_deeply([map{omega_prime_count($_,206111)}1..10],[18613,66025,79801,36364,5182,125,0,0,0,0],"omega_prime_count n=206111, k 1..10"); } ###### nth_omega_prime is_deeply([map { nth_omega_prime(0,$_) } 0..4], [undef,1,undef,undef,undef], "nth_omega_prime(0,...)"); is_deeply([map { nth_omega_prime($_,0) } 1..10], [(undef) x 10], "nth_omega_prime(...,0)"); for my $k (1..5) { my $nops = scalar(@{$small_kops[$k]}); $nops = 10 unless $usexs; my @expect = @{$small_kops[$k]}[0..$nops-1]; is_deeply([map { nth_omega_prime($k,$_) } 1..$nops], \@expect, "nth_omega_prime($k, 1 .. $nops)"); } SKIP: { skip "nth_omega_prime is very slow in PP", 1 unless $usexs; is(nth_omega_prime(8,122), 46692030, "The 122nd 8-omega prime is 46692030"); } Math-Prime-Util-0.74/t/18-40-divmodrem.t000644 000765 000024 00000025164 15152433406 017470 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/divint modint cdivint divrem fdivrem cdivrem tdivrem addint mulint divint modint/; use Math::BigInt; my @quotients = ( # trunc, floor, ceiling, euclidian ["S + +", qw/ 9949242744253247 64 155456917878956 155456917878956 155456917878957 155456917878956/], ["S - +", qw/-9949242744253247 64 -155456917878956 -155456917878957 -155456917878956 -155456917878957/], ["L + +", qw/ 39458349850349850394853049583049 85889 459410982202026457344398579 459410982202026457344398579 459410982202026457344398580 459410982202026457344398579/], ["L + -", qw/ 39458349850349850394853049583049 -85889 -459410982202026457344398579 -459410982202026457344398580 -459410982202026457344398579 -459410982202026457344398579/], ["L - +", qw/-39458349850349850394853049583049 85889 -459410982202026457344398579 -459410982202026457344398580 -459410982202026457344398579 -459410982202026457344398580/], ["L - -", qw/-39458349850349850394853049583049 -85889 459410982202026457344398579 459410982202026457344398579 459410982202026457344398580 459410982202026457344398580/], ); plan tests => 0 + 1 # divbyzero + 2 # divint + 2 + 1 # modint + 12 # table 1.3 from Leijen 2001 + 11 # divint with large neg returns + 3 # cdivrem extra + scalar(@quotients) # signed bigint divint+ + scalar(@quotients) # signed bigint divrem+ + 1 # check b*q+r=a + 4 # verify a=b*q+r + 1 # Euclidean remainder in range + 1 # cdivrem remainder sign + 1 # fdivrem = divint/modint + 0; ###### divide by 0 should error { my $ok = 0; $ok++ if !defined eval { divint(0,0); } && $@ =~ /divide by zero/; $ok++ if !defined eval { divint(1,0); } && $@ =~ /divide by zero/; $ok++ if !defined eval { cdivint(0,0); } && $@ =~ /divide by zero/; $ok++ if !defined eval { cdivint(1,0); } && $@ =~ /divide by zero/; $ok++ if !defined eval { modint(0,0); } && $@ =~ /divide by zero/; $ok++ if !defined eval { modint(1,0); } && $@ =~ /divide by zero/; $ok++ if !defined eval { divrem(0,0); } && $@ =~ /divide by zero/; $ok++ if !defined eval { divrem(1,0); } && $@ =~ /divide by zero/; $ok++ if !defined eval { fdivrem(0,0); } && $@ =~ /divide by zero/; $ok++ if !defined eval { fdivrem(1,0); } && $@ =~ /divide by zero/; $ok++ if !defined eval { cdivrem(0,0); } && $@ =~ /divide by zero/; $ok++ if !defined eval { cdivrem(1,0); } && $@ =~ /divide by zero/; $ok++ if !defined eval { tdivrem(0,0); } && $@ =~ /divide by zero/; $ok++ if !defined eval { tdivrem(1,0); } && $@ =~ /divide by zero/; is($ok, 14, "divide by zero correctly trapped"); } # For negative inputs, the div and mod operations might be different than Perl's builtins. # It matches Math::BigInt bdiv / bmod (post 1.997 Sep 2015). my @qpos1024 = map { int(1024/$_) } 1 .. 1025; my @qneg1024 = map { my $d=-1024/$_; my $i = int($d); ($d==$i) ? $i : $i-1; } 1 .. 1025; my @rpos1024 = map { 1024 - $_ * $qpos1024[$_-1] } 1 .. 1025; my @rneg1024 = map { -1024 - $_ * $qneg1024[$_-1] } 1 .. 1025; is_deeply( [map { divint(1024,$_) } 1..1025], \@qpos1024, "divint(1024,x) for 1 .. 1025" ); is_deeply( [map { divint(-1024,$_) } 1..1025], \@qneg1024, "divint(-1024,x) for 1 .. 1025" ); ###### modint is_deeply( [map { modint(1024,$_) } 1..1025], \@rpos1024, "modint(1024,x) for 1 .. 1025" ); is_deeply( [map { modint(-1024,$_) } 1..1025], \@rneg1024, "modint(-1024,x) for 1 .. 1025" ); is(modint("-1117091728166568014",59), 4, "modint(-1117091728166568014,59) = 4"); ###### small values through divint, modint, divrem, fdivrem, cdivrem, tdivrem is( join(" ", tdivrem(8,3), tdivrem(8,-3), tdivrem(-8,3), tdivrem(-8,-3)), "2 2 -2 2 -2 -2 2 -2", "tdivrem with +/- 8,3" ); is( join(" ", divrem(8,3), divrem(8,-3), divrem(-8,3), divrem(-8,-3)), "2 2 -2 2 -3 1 3 1", "divrem with +/- 8,3" ); is( join(" ", fdivrem(8,3), fdivrem(8,-3), fdivrem(-8,3), fdivrem(-8,-3)), "2 2 -3 -1 -3 1 2 -2", "fdivrem with +/- 8,3" ); is( join(" ", cdivrem(8,3), cdivrem(8,-3), cdivrem(-8,3), cdivrem(-8,-3)), "3 -1 -2 2 -2 -2 3 1", "cdivrem with +/- 8,3" ); is( join(" ", divint(8,3), modint(8,3), divint(8,-3), modint(8,-3), divint(-8,3), modint(-8,3), divint(-8,-3), modint(-8,-3)), "2 2 -3 -1 -3 1 2 -2", "divint+modint with +/- 8,3" ); is( join(" ", cdivint(8,3),cdivint(8,-3),cdivint(-8,3),cdivint(-8,-3)), "3 -2 -2 3", "cdivint with +/- 8,3" ); is( join(" ", tdivrem(1,2), tdivrem(1,-2), tdivrem(-1,2), tdivrem(-1,-2)), "0 1 0 1 0 -1 0 -1", "tdivrem with +/- 1,2" ); is( join(" ", divrem(1,2), divrem(1,-2), divrem(-1,2), divrem(-1,-2)), "0 1 0 1 -1 1 1 1", "divrem with +/- 1,2" ); is( join(" ", fdivrem(1,2), fdivrem(1,-2), fdivrem(-1,2), fdivrem(-1,-2)), "0 1 -1 -1 -1 1 0 -1", "fdivrem with +/- 1,2" ); is( join(" ", cdivrem(1,2), cdivrem(1,-2), cdivrem(-1,2), cdivrem(-1,-2)), "1 -1 0 1 0 -1 1 1", "cdivrem with +/- 1,2" ); is( join(" ", divint(1,2), modint(1,2), divint(1,-2), modint(1,-2), divint(-1,2), modint(-1,2), divint(-1,-2), modint(-1,-2)), "0 1 -1 -1 -1 1 0 -1", "divint+modint with +/- 1,2" ); is( join(" ", cdivint(1,2),cdivint(1,-2),cdivint(-1,2),cdivint(-1,-2)), "1 0 0 1", "cdivint with +/- 1,2" ); ###### divint and modint with interesting values is("".divint("1895315831", -1), "-1895315831", "Divide 31-bit input by -1"); is("".divint("3483637757", -1), "-3483637757", "Divide 32-bit input by -1"); is("".cdivint("3483637757", -1), "-3483637757", "Divide 32-bit input by -1 (ceiling)"); is("".divint("6127303089832103323", -1), "-6127303089832103323", "Divide 63-bit input by -1"); is("".divint("13026328650942325963", -1), "-13026328650942325963", "Divide 64-bit input by -1"); is("".divint("14123555781055773270", 2), "7061777890527886635", "Divide 64-bit input by 2"); is("".divint("12844039487317506779", "12844039487317506779"), 1, "Divide 64-bit input by itself"); is(divint(3, "12844039487317506779"), 0, "Divide small int by 64-bit input"); # Note this is floor division: is(divint(-3, "12844039487317506779"), -1, "Divide negative small int by 64-bit input"); # Now ceiling is(cdivint(3, "12844039487317506779"), 1, "Divide (ceil) small int by 64-bit input"); is(cdivint(-3, "12844039487317506779"), 0, "Divide (ceil) negative small int by 64-bit input"); ###### cdivrem special test is( join(" ",cdivrem(3, "12844039487317506779")), "1 -12844039487317506776", "cdivrem with small quotient and 64-bit denominator shouldn't overflow IV" ); { my $x248 = "281474976710656"; is_deeply([cdivint("9223372036854775807",$x248), # 2^63-1 / 2^48 cdivint("9223372036854775808",$x248), # 2^63 / 2^48 cdivint("9223372036854775809",$x248)], # 2^63+1 / 2^48 [32768, 32768, 32769], "cdivint (2^63 +/- 1) / 2^48"); is_deeply([cdivint("18446744073709551615",$x248), # 2^64-1 / 2^48 cdivint("18446744073709551616",$x248), # 2^64 / 2^48 cdivint("18446744073709551617",$x248)], # 2^64+1 / 2^48 [65536, 65536, 65537], "cdivint (2^64 +/- 1) / 2^48"); } ###### large values through divint, cdivint, modint, ###### divrem, tdivrem, fdivrem, cdivrem for my $s (@quotients) { my($signs, $n, $m, $qt, $qf, $qc, $qe) = @$s; my($bn,$bm) = map { Math::BigInt->new($_) } ($n,$m); my($rt, $rf, $rc, $re) = map{"$_"}map { $bn - $bm * $_ } ($qt, $qf, $qc, $qe); #is( "".divint($n, $m), $qf, "large divint $signs" ); #is( "".modint($n, $m), $rf, "large modint $signs" ); #is( "".cdivint($n, $m), $qc, "large cdivint $signs" ); #is_deeply( [map{"$_"}divrem($n, $m)], [$qe, $re], "large divrem $signs" ); #is_deeply( [map{"$_"}tdivrem($n, $m)], [$qt, $rt], "large tdivrem $signs" ); #is_deeply( [map{"$_"}fdivrem($n, $m)], [$qf, $rf], "large fdivrem $signs" ); #is_deeply( [map{"$_"}cdivrem($n, $m)], [$qc, $rc], "large cdivrem $signs" ); is_deeply( ["".divint($n,$m), "".cdivint($n,$m), "".modint($n,$m)], [ $qf, $qc, $rf, ], "$signs divint, cdivint, modint" ); is_deeply( [[map{"$_"} divrem($n,$m)], [map{"$_"}tdivrem($n,$m)], [map{"$_"}fdivrem($n,$m)], [map{"$_"}cdivrem($n,$m)]], [[$qe,$re], [$qt,$rt], [$qf,$rf], [$qc,$rc]], "$signs divrem, tdivrem, fdivrem, cdivrem" ); } # --- divint/modint invariant: b*q + r == a --- { my @pairs = ( [13, 4], [-13, 4], [13, -4], [-13, -4], ["9949242744253247", 64], ["-9949242744253247", 64], ["18446744073709551615", 7], ["-18446744073709551617", 13], ["39458349850349850394853049583049", 85889], ["-39458349850349850394853049583049", 85889], ); my $ok = 1; for my $p (@pairs) { my($a,$b) = @$p; $ok = 0 unless "".addint(mulint($b,divint($a,$b)),modint($a,$b)) eq "$a"; } ok($ok, "b*divint(a,b) + modint(a,b) == a for all test pairs"); } { my @pairs = ([8,3],[-8,3],[8,-3],[-8,-3],[1,2],[-1,2],[7,1],[-7,1]); my @names = qw/divrem tdivrem fdivrem cdivrem/; my @fns = (\&divrem, \&tdivrem, \&fdivrem, \&cdivrem); for my $i (0..$#fns) { my $ok = 1; for my $p (@pairs) { my($a,$b) = @$p; my($q,$r) = $fns[$i]->($a,$b); $ok = 0 unless $b*$q + $r == $a; } ok($ok, "$names[$i]: a == b*q + r for all sign combinations"); } } # --- Euclidean remainder is always >= 0 --- { my @pairs = ([8,3],[-8,3],[8,-3],[-8,-3], ["39458349850349850394853049583049",85889], ["-39458349850349850394853049583049",85889]); my $ok = 1; for my $p (@pairs) { my($q,$r) = divrem($p->[0], $p->[1]); $ok = 0 if $r < 0; } ok($ok, "divrem: remainder is always >= 0"); } # --- cdivrem: remainder has opposite sign from divisor --- { my @cases = ([8,3],[8,-3],[-8,3],[-8,-3]); my $ok = 1; for my $c (@cases) { my($a,$b) = @$c; my($q,$r) = cdivrem($a,$b); # r == 0 or sign(r) != sign(b) $ok = 0 if $r != 0 && (($r > 0) == ($b > 0)); } ok($ok, "cdivrem: remainder has opposite sign from divisor (or is zero)"); } # --- fdivrem results match divint + modint --- { my @pairs = ([13,4],[-13,4],[13,-4],[-13,-4], ["18446744073709551617",7],["-18446744073709551617",13]); my $ok = 1; for my $p (@pairs) { my($a,$b) = @$p; my($q,$r) = fdivrem($a,$b); $ok = 0 unless "$q" eq "".divint($a,$b) && "$r" eq "".modint($a,$b); } ok($ok, "fdivrem results match divint+modint"); } Math-Prime-Util-0.74/t/19-divisorsum.t000644 000765 000024 00000006633 15146553566 017503 0ustar00danastaff000000 000000 #!/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) + 1 + 2 + 1 + 5; ###### Divisor sum is_deeply( [map { divisor_sum(0,$_) } 0..5], [0,0,0,0,0,0], "divisor_sum(0,k) = 0" ); 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" ); } # Check some cases for integer overflow is( "".divisor_sum( 1<<27,2), "24019198012642645", "divisor_sum(2^27,2)" ); is( "".divisor_sum(262144,3), "20587884010836553", "divisor_sum(2^18,3)" ); is( "".divisor_sum( 16384,4), "76861433640456465", "divisor_sum(2^16,4)" ); is( "".divisor_sum( 2048,5), "37191016277640225", "divisor_sum(2^11,5)" ); is( "".divisor_sum( 5003,5), "3134386256752025244", "divisor_sum(5003,5)" ); Math-Prime-Util-0.74/t/33-examples.t000644 000765 000024 00000034773 15152527011 017076 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/:all/; use Math::Prime::Util::PrimeArray; # 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' ); } } my $have_gmp = prime_get_config->{'gmp'}; plan tests => 100; { 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; my $bits = ($have_gmp) ? 512 : 192; $bigprime = random_nbit_prime($bits); is(base2len($bigprime), $bits, "random_nbit_prime($bits) is $bits bits"); $bigprime = random_safe_prime($bits); is(base2len($bigprime), $bits, "random_safe_prime($bits) is $bits bits"); $bigprime = random_strong_prime($bits); is(base2len($bigprime), $bits, "random_strong_prime($bits) is $bits bits"); $bigprime = random_proven_prime($bits); is(base2len($bigprime), $bits, "random_proven_prime($bits) is $bits bits"); } # TODO: More of the random primes and certs sub base2len { length(todigitstring($_[0],2)); } ############################################################################## 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; foroddcomposites { $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 = vecfirst { /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.74/t/26-iscarmichael.t000644 000765 000024 00000003447 15146553566 017721 0ustar00danastaff000000 000000 #!/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 => 5 + 4; ###### is_carmichael is_deeply( [grep { is_carmichael($_) } 1 .. 20000], [561,1105,1729,2465,2821,6601,8911,10585,15841], "Carmichael numbers to 20000" ); # http://www.s369624816.websitehome.co.uk/rgep/cartable.html ok(is_carmichael("1791562810662585767521"),"Large Carmichael"); ok(is_carmichael("32809426840359564991177172754241"),"Large Carmichael"); ok(!is_carmichael("365376903642671522645639268043799"),"Large non-Carmichael"); # Without GMP to factor, these are very slow # ok(is_carmichael("1298392318741906953539071949881"),"Large Carmichael"); # ok(is_carmichael("341627175004511735787409078802107169251"),"Larger Carmichael"); # Cover the "fast check" tests is_deeply( [map { is_carmichael($_) } 5000209,5000145,5000069,5000483,5000169,5000001], [0,0,0,0,0,0], "Medium size non-Carmichael numbers that should be quickly rejected" ); ###### 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.74/t/26-vec.t000644 000765 000024 00000036334 15150477035 016042 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/vecreduce vecextract vecequal vecmin vecmax vecsum vecprod factorial vecuniq vecsingleton vecfreq vecslide vecsort vecsorti vecany vecall vecnotall vecnone vecfirst vecfirstidx/; # vecmex in t/26-mex.t # vecpmex in t/26-mex.t # vecsample in t/26-randperm.t # [related] # setcontains return 0 if we are given something NOT in SETA # setcontainsany return 1 if we are given anything in SETA 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" ], [ "-18446744073709551615", "-9223372036854775807","-9223372036854775807",-1 ], [ "-18446744073709551616", "-9223372036854775807","-9223372036854775807",-2 ], [ "-18446744073709551617", "-9223372036854775807","-9223372036854775807",-3 ], [ "-18446744073709551616", "-9223372036854775808","-9223372036854775808" ], [ "-9223372036854775807", "-9223372036854775807",0 ], [ "-9223372036854775808", "-9223372036854775807",-1 ], [ "-9223372036854775809", "-9223372036854775807",-2 ], [ "-9223372036854775808", 0,"-9223372036854775808",0 ], ); 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 ], ); my @vecsorts = ( [ [], [], "empty input" ], [ [0], [0], "single input" ], [ [5,0], [0,5], "two positive inputs" ], [ [~0,-1], [-1,~0], "-1 and maxuv" ], [ ["-9223372036854775808","-9223372036854775809"], ["-9223372036854775809","-9223372036854775808"], "two large negative inputs" ], [ [qw/9223372036854775807 18446744073709551615 127 32767 2147483647 1 140737488355327/], [qw/1 127 32767 2147483647 140737488355327 9223372036854775807 18446744073709551615/], "various 64-bit positive inputs" ], [ [qw/18446744073709551615 19342813113834066795298815 4722366482869645213695 65535 4294967295/], [qw/65535 4294967295 18446744073709551615 4722366482869645213695 19342813113834066795298815/], "large string inputs" ], [ [qw/9223372036854775812 9223372036854775809 9223372036854775810 9223372036854775811/], [qw/9223372036854775809 9223372036854775810 9223372036854775811 9223372036854775812/], "integers over 2^63 broken before 5.26.0" ], ); plan tests => 1 # vecmin + 1 # vecmax + 1 # vecsum + 1 # vecprod + 1 # vecreduce + 1 # vecextract + 1 # vecequal + 1 # vec{any,all,notall,none} + 1 # vecfirst + 1 # vecfirstidx + 1 # vecuniq + 1 # vecsingleton + 1 # vecfreq + 1 # vecsort + 1 # vecslide + 0; ###### vecmin subtest 'vecmin', sub { 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 subtest 'vecmax', sub { 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 subtest 'vecsum', sub { foreach my $r (@vecsums) { my($exp, @vals) = @$r; is( "".vecsum(@vals), $exp, "vecsum(@vals) = $exp" ); } }; ###### vecprod subtest 'vecprod', sub { 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 subtest 'vecreduce', sub { 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 subtest 'vecextract', sub { 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"); }; ###### vecequal subtest 'vecequal', sub { is(vecequal([],[]), 1, "vecequal([],[]) = 1"); is(vecequal([undef],[undef]), 1, "vecequal([undef],[undef]) = 1"); is(vecequal([0],[0]), 1, "vecequal([0],[0]) = 1"); is(vecequal([undef],[]), 0, "vecequal([undef],[]) = 0"); is(vecequal([undef],[0]), 0, "vecequal([undef],[0]) = 0"); is(vecequal([0],[[]]), 0, "vecequal([0],[[]]) = 0"); is(vecequal([],[[]]), 0, "vecequal([],[[]]) = 0"); is(vecequal([0],["a"]), 0, "vecequal([0],[\"a\"]) = 0"); is(vecequal([1,2,3],[1,2,3]), 1, "vecequal([1,2,3],[1,2,3]) = 1"); is(vecequal([1,2,3],[3,2,1]), 0, "vecequal([1,2,3],[3,2,1]) = 0"); is(vecequal([-1,2,3],[-1,2,3]), 1, "vecequal([-1,2,3],[-1,2,3]) = 1"); is(vecequal([undef,[1,2],"a"],[undef,[1,2],"a"]), 1, "vecequal([undef,[1,2],\"a\"],[undef,[1,2],\"a\"] = 1"); is(vecequal(\@vecsums, \@vecsums), 1, "vecequal = 1 for vecsums"); is(vecequal(\@vecsums, \@vecprods), 0, "vecequal = 0 for vecsums"); }; ###### vec{any,all,notall,none} subtest 'vecany vecall vecnotall vecnone', sub { 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 subtest 'vecfirst', sub { 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"); }; subtest 'vecfirstidx', sub { 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"); }; ###### vecuniq subtest 'vecuniq', sub { my @t = (1..10,1..10); my @u = vecuniq @t; is_deeply(\@u, [1 .. 10], "vecuniq simple 1..10"); my $u = vecuniq @t; is(10,$u,"vecuniq scalar count correct"); my @n = map { reverse -5 .. 5 } 0..2; my @v = vecuniq @n; is_deeply(\@v, [reverse -5 .. 5], "vecuniq simple 5 to -5"); is_deeply([vecuniq()], [], "vecuniq with empty input returns empty"); is_deeply([vecuniq(0)], [0], "vecuniq with one input returns it"); is_deeply([vecuniq(0,"18446744073709551615",0,4294967295,"18446744073709551615",4294967295)], [0,"18446744073709551615",4294967295], "vecuniq with 64-bit inputs"); is_deeply([vecuniq("-9223372036854775808","9223372036854775807",4294967295,"9223372036854775807",4294967295,"-9223372036854775808")], ["-9223372036854775808","9223372036854775807",4294967295], "vecuniq with signed 64-bit inputs"); }; ###### vecsingleton subtest 'vecsingleton', sub { my @t = (15,1..10,4,1..10,-2); my @u = vecsingleton @t; is_deeply(\@u, [15,-2], "vecsingleton simple"); my $u = vecsingleton @t; is(2,$u,"vecsingleton scalar count correct"); is_deeply([vecsingleton()], [], "vecsingleton with empty input returns empty"); is_deeply([vecsingleton(0)], [0], "vecsingleton with one input returns it"); is_deeply([vecsingleton(0,"18446744073709551615",0,4294967295,-1,4294967295)], ["18446744073709551615",-1], "vecsingleton with 64-bit inputs"); is_deeply([vecsingleton("-9223372036854775808","9223372036854775807",4294967295,"9223372036854775807",4294967295,"-9223372036854775807")], ["-9223372036854775808","-9223372036854775807"], "vecsingleton with signed 64-bit inputs"); is_deeply([vecsingleton('a','b','',undef,'b','c','')],['a',undef,'c'],"vecsingleton with strings and one undef"); is_deeply([vecsingleton('a','b','',undef,'b','c',undef)],['a','','c'],"vecsingleton with strings and two undefs"); }; ###### vecfreq subtest 'vecfreq', sub { my @L; my %got; my %exp; is_deeply([vecfreq()], [], "vecfreq on empty list"); is(0+vecfreq(), 0, "vecfreq on empty list (scalar)"); is_deeply([vecfreq(1)], [1=>1], "vecfreq one integer"); is(0+vecfreq(1), 1, "vecfreq one integer (scalar)"); is_deeply([vecfreq(1,1)], [1=>2], "vecfreq two identical integers"); is(0+vecfreq(1,1), 1, "vecfreq two identical integers (scalar)"); @L = (-1,1); %got = vecfreq(@L); %exp = (-1=>1, 1=>1); is_deeply(\%got, \%exp, "vecfreq two integers"); is(0+vecfreq(@L), 2, "vecfreq two integers (scalar)"); @L = (-1,14,4,-4,2,2,3,4,3,4,4,1); %got = vecfreq(@L); %exp = (-1=>1, 14=>1, 4=>4, -4=>1, 2=>2, 3=>2, 1=>1); is_deeply(\%got, \%exp, "vecfreq many integers"); is(0+vecfreq(@L), 7, "vecfreq many integers (scalar)"); @L = ("hello", 14, "world", "tree", "world"); %got = vecfreq(@L); %exp = (hello=>1, 14=>1, world=>2, tree=>1); is_deeply(\%got, \%exp, "vecfreq strings"); is(0+vecfreq(@L), 4, "vecfreq strings (scalar)"); { # from List::MoreUtils::frequency test @L = ('a', 'b', '', undef, 'b', 'c', '', undef); my %e = (a=>1, b=>2, ''=>2, c=>1); my @f = vecfreq(@L); my $seen_undef; # This works because we always put undef at the end ref $f[-2] and ref $f[-2] eq "SCALAR" and not defined ${$f[-2]} and (undef, $seen_undef) = splice @f, -2, 2, (); my %f = @f; is_deeply(\%f, \%e, "vecfreq mixed with undef"); is($seen_undef, 2, "vecfreq counts two undefs"); } is(scalar(vecfreq(-1,~0)),2,"vecfreq doesn't confuse -1 and ~0"); }; ###### vecsort subtest 'vecsort', sub { foreach my $r (@vecsorts) { my($in, $out, $str) = @$r; my @got1 = map{"$_"}vecsort(@$in); my @got2 = map{"$_"}vecsort($in); vecsorti($in); $_ = "$_" for @$in; is_deeply( [ \@got1, \@got2, $in ], [ $out, $out, $out ], "vecsort list, ref, in-place [$str]" ); } my @s = ("5",2,1,3,4); my $in0_beg = length( do { no if $] >= 5.022, "feature", "bitwise"; no warnings "numeric"; $s[0] & "" }) ? "number" : "string"; my @t = vecsort(\@s); my $in0_end = length( do { no if $] >= 5.022, "feature", "bitwise"; no warnings "numeric"; $s[0] & "" }) ? "number" : "string"; is_deeply([[@s],[@t]], [[5,2,1,3,4],[1,2,3,4,5]], "vecsort sorts without modifying input"); my @ivd = (qw/-3937 4322 -3619 -390 2039 2123 -1614 -879 -4372 1793 4404 4229 286 -3613 2707 -4166 4025 2450 -2003 3390 4498 -3094 -4854 3441 3501 -2871 -1206 315 71 -2101 4881 -3141 10 -2545 -2825 -519 3534 -4904 -3523 -1170 -3 3 -2 2 -1 1 0/); my @sivd = (qw/-4904 -4854 -4372 -4166 -3937 -3619 -3613 -3523 -3141 -3094 -2871 -2825 -2545 -2101 -2003 -1614 -1206 -1170 -879 -519 -390 -3 -2 -1 0 1 2 3 10 71 286 315 1793 2039 2123 2450 2707 3390 3441 3501 3534 4025 4229 4322 4404 4498 4881/); is_deeply([vecsort(@ivd)], \@sivd, "vecsort list of negative integers"); # Both of these should be "string". XS doesn't copy for validation. if ($extra) { diag "vecsort input: $in0_beg => $in0_end" if $in0_beg ne $in0_end; } my @actx = return_sort(12,13,14,11); my $sctx = return_sort(12,13,14,11); is($sctx, scalar(@actx), "returning vecsort(\@L) gives the number of items"); }; sub return_sort { return vecsort(@_); } ###### vecslide subtest 'vecslide', sub { is_deeply([vecslide {$a+$b} ()],[],"vecslide with empty array returns empty"); is_deeply([vecslide {$a+$b} 1..1],[],"vecslide with 1 element returns empty"); is_deeply([vecslide {$a+$b} 1..5],[3,5,7,9],"vecslide {\$a+\$b} 1..5"); is_deeply([vecslide { "$a->[0] $b->[1]" } ["hello","world"], ["goodbye","friends"], ["love","hate"]], ["hello friends","goodbye hate"], "vecslide with array refs"); is(join(", ", vecslide { "$a and $b" } 0..3), "0 and 1, 1 and 2, 2 and 3", "vecslide example from LMU"); }; Math-Prime-Util-0.74/t/26-combinatorial.t000644 000765 000024 00000011327 15146553566 020114 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/forcomb forperm forderange formultiperm numtoperm permtonum/; 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'}; plan tests => 0 + 1 # Combinations + 1 # Permutations + 1 # Multiset Permutations + 1 # Derangements + 1 # numtoperm, permtonum ; subtest 'forcomb', sub { my @t1data = ( [ 0, "[]" ], [ 1, "[] [0]" ], [ 2, "[] [0] [1] [0 1]" ], [ 3, "[] [0] [1] [2] [0 1] [0 2] [1 2] [0 1 2]" ], ); my @t2data = ( [ 0,0, "[]" ], [ 5,6, "" ], [ 5,5, "[0 1 2 3 4]" ], [ 5,4, "[0 1 2 3] [0 1 2 4] [0 1 3 4] [0 2 3 4] [1 2 3 4]" ], [ 5,3, "[0 1 2] [0 1 3] [0 1 4] [0 2 3] [0 2 4] [0 3 4] [1 2 3] [1 2 4] [1 3 4] [2 3 4]" ], [ 5,2, "[0 1] [0 2] [0 3] [0 4] [1 2] [1 3] [1 4] [2 3] [2 4] [3 4]" ], [ 5,1, "[0] [1] [2] [3] [4]" ], [ 5,0, "[]" ], [ 4,4, "[0 1 2 3]" ], [ 4,3, "[0 1 2] [0 1 3] [0 2 3] [1 2 3]" ], [ 4,2, "[0 1] [0 2] [0 3] [1 2] [1 3] [2 3]" ], [ 4,1, "[0] [1] [2] [3]" ], [ 4,0, "[]" ], ); for my $test (@t1data) { my($e,$exp) = @$test; my @p; forcomb { push @p, "[@_]" } $e; is("@p", $exp, "forcomb {} $e"); } for my $test (@t2data) { my($s,$e,$exp) = @$test; my @p; forcomb { push @p, "[@_]" } $s,$e; is("@p", $exp, "forcomb {} $s,$e"); } { my @data = (qw/apple bread curry/); my @p; forcomb { push @p, [@data[@_]] } @data,2; is_deeply(\@p, [[qw/apple bread/],[qw/apple curry/],[qw/bread curry/]], "forcomb {} 3,2"); } { my @data = (qw/ant bee cat dog/); my @p; forcomb { push @p, [@data[@_]] } @data,3; is_deeply(\@p, [[qw/ant bee cat/],[qw/ant bee dog/],[qw/ant cat dog/],[qw/bee cat dog/]], "forcomb 4,3"); } { my $s = 0; forcomb { $s++ } 20,15; is($s, 15504, "forcomb { } 20,15 yields binomial(20,15) combinations"); } }; subtest 'forperm', sub { 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]], ); 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, 5040, "forperm 7 yields factorial(7) permutations"); } }; subtest 'formultiperm', sub { { 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"); } }; subtest 'forderange', sub { { 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"); } }; subtest 'numtoperm / permtonum', sub { 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)"); }; Math-Prime-Util-0.74/t/70-rt-bignum.t000644 000765 000024 00000005063 15147754046 017171 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; # 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. We do both. # Limit to AUTHOR_TESTING only. # There is too much danger of effectively failing by hang. # # We try to discourage use of bignum because of the way it changes # behavior of integers to be more like floats. # # This test *should* work, and we'd prefer to find it in testing than prod. # # At least one knowledgeable person has indicated that it's perfectly # natural the 'bignum' module will wreak havoc with us and this test is # going beyond what's needed. BEGIN { unless ($ENV{AUTHOR_TESTING}) { plan( skip_all => 'these tests are for author testing' ); } } use Math::Prime::Util qw/:all/; use Math::Prime::Util::PP; use bignum; plan tests => 3+1; 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); # Don't assume a fixed set of factors beyond 2/3/5 will be found. { my @S = @partial_factor[0..7]; my @L = @partial_factor[8..$#partial_factor]; is_deeply(\@S, [2,2,2,2,2,2,2,3], "PP prho with 'use bignum' small factors are correct"); my $expf = [qw/7 509 3563 277772399 1944406793 141386151091 989703057637/]; ok(setcontainsany(\@L, $expf), "We found one of the expected small factors or products"); is("".vecprod(@L), "260935662785880581087296255696420056487492378994995952270690757169556324683", "product of factors is the input"); } # 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.74/t/19-popcount.t000644 000765 000024 00000002062 14627772650 017136 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/hammingweight prime_set_config/; #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 @inputs = (qw/0 1 2 3 15 -15 452398 -452398 4294967295 506198202011006650616143 777777777777777714523989234823498234098249108234236 65520150907877741108803406077280119039314703968014509493068998974809747144933/); my @popcnt = (0,1,1,2,4,4,12,12,32,45,83,118); plan tests => 2; ###### hammingweight is_deeply( [map { hammingweight($_) } @inputs], \@popcnt, "hammingweight for various inputs" ); ###### Turn off gmp and try SKIP: { skip "No need to test non-GMP when not using GMP", 1 unless $usegmp; prime_set_config(gmp=>0); is_deeply( [map { hammingweight($_) } @inputs], \@popcnt, "non-GMP hammingweight for various inputs" ); } Math-Prime-Util-0.74/t/18-10-unary_int.t000644 000765 000024 00000004131 15150465415 017501 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/absint negint signint/; my @pos = (qw/32767 32768 1073741823 1073741824 1073741825 2147483647 2147483648 2147483649 4294967295 4294967296 8589934591 8589934592 9223372036854775807 9223372036854775808 18446744073709551614 18446744073709551615 18446744073709551616 18446744073709551617 36893488147419103231 36893488147419103232 827639478068904540012 829342632809347434459 1726145541361106236340 2555488174170453670799 4281633715531559907139 1178630961471601951655862 230948092384903284908329048239084023984092384 982349082340982348502392937523840234029384908325098234/); my @neg = map { '-' . $_ } @pos; plan tests => 3 + 2 + 2 + 2 + 2; { my(@absgot,@neggot,@sgngot, @absexp,@negexp,@sgnexp); for my $n (-100 .. 100) { push @absgot, absint($n); push @neggot, negint($n); push @sgngot, signint($n); push @absexp, abs($n); push @negexp, ($n == 0) ? 0 : -$n; push @sgnexp, 0 + ($n > 0) - ($n < 0); } is_deeply( \@absgot, \@absexp, "absint(-100..100)" ); is_deeply( \@neggot, \@negexp, "negint(-100..100)" ); is_deeply( \@sgngot, \@sgnexp, "signint(-100..100)" ); } is_deeply( [absint(0), negint(0), signint(0)], [0,0,0], "absint(0), negint(0), signint(0)" ); is_deeply( [absint(-0), negint(-0), signint(-0)], [0,0,0], "absint(-0), negint(-0), signint(-0)" ); is_deeply([map{"$_"}map { absint($_) } @pos], \@pos, "absint with positive inputs"); is_deeply([map{"$_"}map { absint($_) } @neg], \@pos, "absint with negative inputs"); is_deeply([map{"$_"}map { negint($_) } @pos], \@neg, "negint with positive inputs"); is_deeply([map{"$_"}map { negint($_) } @neg], \@pos, "negint with negative inputs"); is_deeply([map {signint($_)} @pos], [map { 1} @pos], "signint with positive inputs"); is_deeply([map {signint($_)} @neg], [map {-1} @neg], "signint with negative inputs"); Math-Prime-Util-0.74/t/26-factorialmod.t000644 000765 000024 00000002035 15150474454 017722 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/factorialmod factorial/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; plan tests => 4; { 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" ); } SKIP: { skip "medium size factorialmods in PP",2 unless $usexs || $extra; is( factorialmod(1000000000,1000000008), 0, "1000000000! mod 1000000008 is zero" ); is( factorialmod(50000,10000019), 8482159, "50000! mod 10000019" ); } SKIP: { skip "large value without EXTENDED_TESTING on 64-bit",1 unless $extra && $use64; is( "".factorialmod(5000001,"8000036000054000027"), "4179720539133404343", "factorialmod with large n and large composite non-square-free m" ); } Math-Prime-Util-0.74/t/26-isodd.t000644 000765 000024 00000000701 14427047704 016356 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_odd is_even/; plan tests => 4; is_deeply( [map { is_odd($_) } -50..50], [map { $_%2 } -50..50], "is_odd(-50..50)" ); is_deeply( [map { is_even($_) } -50..50], [map { 1-($_%2) } -50..50], "is_even(-50..50)" ); is( is_odd("9832494848388408230982349082309487"), 1, "is_odd bigint" ); is( is_even("98324948483884082309823490823094875"), 0, "is_even bigint" ); Math-Prime-Util-0.74/t/26-iscyclic.t000644 000765 000024 00000001730 14773100372 017054 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/ is_cyclic vecsum /; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; plan tests => 4; is_deeply( [grep { is_cyclic($_) } -20 .. 20], [1,2,3,5,7,11,13,15,17,19], "Cyclic numbers -20 to 20: primes plus 15" ); is_deeply( [grep { is_cyclic($_) } (qw/9 15 21 25 27 33 35 39 45 49 51 55 57 63 65 69 75 77 81 85 87 91 93 95 99 105 111 115 117 119 121 123 125 129 133 135 141 143 145 147 153 155 159 161 165 169 171 175 177 183 185 187 189 195/)], [qw/15 33 35 51 65 69 77 85 87 91 95 115 119 123 133 141 143 145 159 161 177 185 187/], "Cyclic composites under 200" ); is( is_cyclic(32753), 1, "32753 (the 10,000th cyclic number) is cyclic" ); SKIP: { skip "count 10k cyclic numbers only with extended testing", 1 unless $extra; is( vecsum(map { is_cyclic($_) } 1..32753), 10000, "count of cyclic numbers to 32753 = 10000" ); } Math-Prime-Util-0.74/t/26-goldbach.t000644 000765 000024 00000004421 15146553566 017031 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/minimal_goldbach_pair goldbach_pair_count goldbach_pairs/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my @gb = ( [0, []], [1, []], [2, []], [3, []], [4, [2]], [5, [2]], [6, [3]], [7, [2]], [8, [3]], [9, [2]], [10, [3,5]], [11, []], [12, [5]], [13, [2]], [14, [3,7]], [15, [2]], [16, [3,5]], [17, []], [18, [5,7]], [19, [2]], [20, [3,7]], [21, [2]], [22, [3,5,11]], [23, []], [24, [5,7,11]], [25, [2]], [26, [3,7,13]], [27, []], [28, [5,11]], [29, []], [30, [7,11,13]], [31, [2]], [32, [3,13]], [50, [3,7,13,19]], [66, [5,7,13,19,23,29]], [130, [3,17,23,29,41,47,59]], [258, [7,17,19,29,31,47,59,61,67,79,101,107,109,127]], [4022, [3,19,79,103,199,229,283,313,331,349,379,409,439,463,523,631,661,691,709,751,769,853,859,1021,1051,1069,1171,1231,1291,1303,1429,1471,1483,1549,1741,1753,1783,1801,1861,1879,1933,1993,2011]], ); my %bigmin = ( 60119912 => 1093, 15317795894 => 2017, "3325581707333960528" => 9781, "83778272185315920949659591651127238812" => 5441, # Randomly chosen ); plan tests => 1+scalar(keys %bigmin) # minimal + 1 # count + 1; # pairs ###### minimal { my(@exp, @got); for my $g (@gb) { my($n,$L) = @$g; push @exp, (@$L > 0) ? $L->[0] : undef; push @got, minimal_goldbach_pair($n); } is_deeply(\@got, \@exp, "minimal_goldbach_pair for small inputs"); } while (my($n, $p) = each (%bigmin)) { SKIP: { skip "skipping minimal_goldbach_pair($n) without EXTENDED_TESTING",1 unless $n < ~0 || $extra; is(minimal_goldbach_pair($n),$p,"minimal_goldbach_pair($n) = $p"); } } ###### count { my(@exp, @got); for my $g (@gb) { my($n,$L) = @$g; push @exp, scalar @$L; push @got, goldbach_pair_count($n); } is_deeply(\@got, \@exp, "goldbach_pair_count for small inputs"); } ###### pairs { my(@exp, @got); for my $g (@gb) { my($n,$L) = @$g; push @exp, $L; push @got, [goldbach_pairs($n)]; } is_deeply(\@got, \@exp, "goldbach_pairs for small inputs"); } Math-Prime-Util-0.74/t/26-isomegaprime.t000644 000765 000024 00000003723 15146553566 017753 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_omega_prime/; #my $usegmp = Math::Prime::Util::prime_get_config->{'gmp'}; plan tests => 1+6+4; my @fn7 = (10000019, 10000000, 10000005, 10000002, 10000012, 10000080, 10002930, 11741730, 223092870); my @listo = ( [10007,10009,10037,10039,10061,10067,10069,10079,10091,10093,10099], [10000,10001,10003,10006,10012,10015,10016,10018,10019,10021,10022,10025,10027,10029,10031,10033,10041,10042,10043,10046,10048,10049,10051,10053,10055,10057,10063,10071,10072,10073,10077,10078,10081,10082,10083,10084,10085,10096,10097], [10002,10004,10008,10011,10013,10014,10017,10023,10024,10026,10028,10034,10035,10036,10040,10044,10045,10047,10052,10054,10056,10058,10059,10060,10064,10066,10068,10075,10076,10086,10087,10088,10089,10090,10092,10094,10095,10100], [10005,10020,10030,10032,10038,10050,10062,10065,10070,10074,10080,10098], [10010], [], ); { is_deeply( [map { is_omega_prime($_+1,$fn7[$_]) } 0..$#fn7], [(1) x scalar(@fn7)], "some omega primes correctly calculated" ); for my $k (1..6) { is_deeply( [grep { is_omega_prime($k, $_) } 10000..10100], $listo[$k-1], "$k-omega primes 10000 .. 10100" ); } # mpu 'say vecprod(map { random_prime(1000) } 1..18)' # mpu '@x=vecuniq map{random_prime(1000,5000)}1..10 until @x==10; say "@x"; say vecprod(@x)' is(is_omega_prime(10,"24705358214159761813058494125740243"), 1, "is_omega_prime(10,24705358214159761813058494125740243)"); is(is_omega_prime(14,"264161530428233522652629658999365"), 1, "is_omega_prime(14,264161530428233522652629658999365)"); # 18 factors, but one is repeated is(is_omega_prime(18,"32271228927564477576537111610496905348679567"), 0, "is_omega_prime(18,32271228927564477576537111610496905348679567) = 0"); is(is_omega_prime(17,"32271228927564477576537111610496905348679567"), 1, "is_omega_prime(17,32271228927564477576537111610496905348679567)"); # } } Math-Prime-Util-0.74/t/11-primes.t000644 000765 000024 00000017710 13025437630 016547 0ustar00danastaff000000 000000 #!/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.74/t/93-release-spelling.t000644 000765 000024 00000005354 15152710607 020517 0ustar00danastaff000000 000000 #!/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/-th bigint bigints bigfloat bigfloats bignum bignums quadmath pseudoprime pseudoprimes primorial primorials semiprime semiprimes precalculated premultiplier benchmarking hardcoded online unoptimized unusably orderings coprime summatory RiemannR LambertW csrand srand irand irand64 drand urandomb urandomm forprimes forcomposites foroddcomposites fordivisors forpart forcomp forcomb forperm forderange formultiperm forsetproduct forsemiprimes forfactored foralmostprimes forsquarefree forsquarefreeint lastfor numtoperm permtonum randperm totient moebius mertens liouville kronecker znorder znprimroot znlog sumliouville sumtotient gcd lcm gcdext chinese sqrtmod allsqrtmod rootmod allrootmod negmod invmod addmod submod mulmod powmod divmod muladdmod mulsubmod fubini binomialmod factorialmod bernfrac bernreal harmfrac harmreal stirling hclassno vecsum vecprod vecmin vecmax vecreduce vecextract vecequal vecuniq vecall vecany vecnone vecnotall vecfirst vecfirstidx vecmex vecpmex vecsample vecfreq vecsingleton vecslide vecsort vecsorti heapsort quicksort sqrtint logint rootint powint addint subint mulint divint cdivint modint negint absint divrem tdivrem fdivrem cdivrem qnr cornacchia todigits todigitstring fromdigits sumdigits hammingweight tozeckendorf fromzeckendorf lucasu lucasv lucasuv lucasumod lucasvmod lucasuvmod lshiftint rshiftint rashiftint signint cmpint biquadrate powerfree k-powerfree k-free workaround sumpowerful powersum sumset setbinop setunion setintersect setminus setdelta toset setcontains setcontainsany setinsert setremove setinvert contfrac farey _uvsize _ivsize _nvsize _uvbits _nvmantbits _nvmantdigits pp 100ns/); all_pod_files_spelling_ok(); Math-Prime-Util-0.74/t/26-isdivisible.t000644 000765 000024 00000007454 15146553566 017605 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_divisible is_congruent modint irand irand64/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; # From GMP test suite my @divt = ( [0, 0, 1], [17, 0, 0], [0, 1, 1], [123, 1, 1], [-123, 1, 1], [0, 2, 1], [1, 2, 0], [2, 2, 1], [-2, 2, 1], ["340282366920938463463374607431768211456", 2, 1], ["340282366920938463463374607431768211457", 2, 0], ["3689348814741910323",3,1], ["3689348814741910322",3,0], ["68056473384187692692674921486353642291", 3, 1], ["68056473384187692692674921486353642290", 3, 0], ["3689348813882916864", "6442450944", 1], ["68056473384187692688985572671611731968", "27670116110564327424", 1], ["408338840305126156152360180103379943424", "27670116110564327424", 0], # Our additional single divisor tests # Check UV n with negative d larger than IV ["10223372036854775807","-10223372036854775807", 1], ["36472996418050588672","33171997",1], ); my @congt = ( [0,0,0,1], # strict equality mod 0 [11,11,0,1], [3,11,0,0], [0,0,1,1], # anything is congruent mod 1 [1,0,1,1], [0,1,1,1], [123,456,1,1], ["335812727629498640265","2812431594283598168865",1,1], ["3689348814741910323","858993459","6442450944",1], ["68056473384187692692674921486353642291","3689348814741910323","27670116110564327424",1], ["18325193793", "-9162596895", "13743895344", 1], ["78706108047827420225", "-39353054023913710111", "59029581035870565168", 1], ); plan tests => 1 + 9*5 + scalar(@divt) + 2 # is_divisible + 5 + 2 + scalar(@congt); # is_congruent my $ntests = $extra && $use64 ? 10000 : $extra ? 1000 : 100; my @r32 = map { irand() } 0..$ntests; my @r64 = map { irand64() } 0..$ntests; @r64 = map { "$_" } @r64 if 18446744073709550592 == ~0; # broken64 ###### is_divisible is_deeply( [map { is_divisible($_,0) } -20..20], [map { 0+($_ == 0) } -20..20], "is_divisible(x,0) = 0 for x != 0"); for my $d (1 .. 9) { is_deeply( [map { is_divisible($_,$d) } @r32], [map { 0+(modint($_,$d) == 0) } @r32], "is_divisible(x,$d) for 32-bit x" ); is_deeply( [map { is_divisible($_,$d) } @r64], [map { 0+(modint($_,$d) == 0) } @r64], "is_divisible(x,$d) for 64-bit x" ); is_deeply( [map { is_divisible(-$_,$d) } @r32], [map { 0+(modint(-$_,$d) == 0) } @r32], "is_divisible(-x,$d) for 32-bit x" ); is_deeply( [map { is_divisible($_,-$d) } @r32], [map { 0+(modint($_,-$d) == 0) } @r32], "is_divisible(x,-$d) for 32-bit x" ); is_deeply( [map { is_divisible(-$_,-$d) } @r32], [map { 0+(modint(-$_,-$d) == 0) } @r32], "is_divisible(-x,-$d) for 32-bit x" ); } foreach my $r (@divt) { my($n, $d, $exp) = @$r; is(is_divisible($n,$d), $exp, "is_divisible($n,$d) = $exp"); } is(is_divisible("26000117000117",2,3,5,7,11),0,"is_divisible(26000117000117,2,3,5,7,11)"); is(is_divisible("26000117000117",2,3,5,7,11,13),1,"is_divisible(26000117000117,2,3,5,7,11,13)"); ###### is_congruent for my $c (-2 .. 2) { is_deeply( [map { is_congruent($_,$c,0) } -3..3], [map { 0+($_ == $c) } -3..3], "is_congruent(x,$c,0) = 0 for x != $c" ); } is_deeply( [map { is_congruent($_,3,13) } @r32, @r64], [map { 0+(modint($_,13)==3) } @r32, @r64], "is_congruent(x,3,13) for 32-bit and 64-bit x" ); is_deeply( [map { is_congruent($_,-27,17) } @r32, @r64], [map { 0+(modint($_,17)==7) } @r32, @r64], "is_congruent(x,-27,17) for 32-bit and 64-bit x" ); foreach my $r (@congt) { my($n, $c, $d, $exp) = @$r; is(is_congruent($n,$c,$d), $exp, "is_congruent($n,$c,$d) = $exp"); } Math-Prime-Util-0.74/t/27-bernfrac.t000644 000765 000024 00000010216 15146553566 017050 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/bernfrac bernreal harmfrac harmreal/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; 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/); # Harmonic numbers, num and den 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 9304682830147 290774257297357 586061125622639/); 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 2329089562800 72201776446800 144403552893600/); plan tests => 1 + 1 + 1; subtest 'bernfrac (Bernoulli numbers)', sub { is(join(" / ",bernfrac(1)), "1 / 2", "bernfrac(1) = (1,2)"); is(join(" / ",bernfrac(3)), "0 / 1", "bernfrac(3) = (0,1)"); my $last = $extra ? $#A000367 : 20; is_deeply([map { join " / ",bernfrac(2*$_) } 0..$last], [map { join " / ",($A000367[$_],$A002445[$_]) } 0..$last], "bernfrac(2,4,6,...,".2*$last.")"); #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" ); SKIP: { skip "bernfrac(60) only with EXTENDED_TESTING",1 unless $extra; is_deeply([bernfrac(60)],["-1215233140483755572040304994079820246041491",56786730],"bernfrac(60) (numerator has 43 digits)"); } }; subtest 'harmfrac (Harmonic numbers)', sub { is(join(" / ",harmfrac(0)), "0 / 1", "harmfrac(0) = (0,1)"); my $len = scalar @A001008; is_deeply([map { join " / ",harmfrac($_) } 1..$len], [map { join " / ",($A001008[$_-1],$A002805[$_-1]) } 1..$len], "harmfrac(1..$len)"); }; subtest 'bernreal and harmreal', sub { 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 $lbr = $#bern_reals; is_deeply([map {is_closeto(bernreal($_),$bern_reals[$_],1e-8)} 0..$lbr], [map { 1 } 0..$lbr], "bernreal(0..$lbr) within tolerance"); 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); my $lhr = $#harm_reals; is_deeply([map {is_closeto(harmreal($_),$harm_reals[$_],1e-8)} 0..$lhr], [map { 1 } 0..$lhr], "harmreal(0..$lhr) within tolerance"); SKIP: { skip "bernreal(46) and harmreal(46) with EXTENDED_TESTING",2 unless $extra; like( bernreal(46), qr/2115074863808199160560.145/, "bernreal(46)" ); like( harmreal(46), qr/4.416687245986104750714329/, "harmreal(46)" ); } }; sub is_closeto { my($got,$exp,$tol) = @_; return 0 + (abs($got-$exp) <= $tol); } sub cmp_closeto { my($got,$exp,$tol,$mess) = @_; cmp_ok(abs($got - $exp), '<=', $tol, $mess); } Math-Prime-Util-0.74/t/26-issemiprime.t000644 000765 000024 00000002112 15146553566 017607 0ustar00danastaff000000 000000 #!/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("752159046363135949"), 1, "is_semiprime(752159046363135949)"); is(is_semiprime("9881022443630858407"), 1, "is_semiprime(9881022443630858407)"); is(is_semiprime("1814186289136250293214268090047441301"), 0, "is_semiprime(1814186289136250293214268090047441301)"); SKIP: { skip "Skipping difficult is_semiprime", 1 unless $usegmp; is(is_semiprime("42535430147496493121551759"), 0, "is_semiprime(42535430147496493121551759)"); } } Math-Prime-Util-0.74/t/11-ramanujanprimes.t000644 000765 000024 00000007002 15146553566 020452 0ustar00danastaff000000 000000 #!/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.74/t/18-20-addint.t000644 000765 000024 00000007505 15152431566 016747 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/addint subint add1int sub1int/; my @vals = ( [qw/-123456789 -987654321 -1111111110/], [qw/123456789 -987654321 -864197532/], [qw/-12345678983 12345678987 4/], [qw/4294967294 1 4294967295/], [qw/4294967294 2 4294967296/], [qw/4294967296 1 4294967297/], [qw/4294967296 -1 4294967295/], [qw/4294967295 -1 4294967294/], [qw/18446744073709551614 1 18446744073709551615/], # 8 [qw/18446744073709551614 2 18446744073709551616/], # 9 [qw/18446744073709551616 1 18446744073709551617/], # 10 [qw/18446744073709551616 -1 18446744073709551615/], # 11 [qw/18446744073709551615 -1 18446744073709551614/], # 12 [qw/2147483647 -2147483648 -1/], [qw/2147483647 -2147483647 0/], [qw/9223372036854775807 -9223372036854775808 -1/], [qw/9223372036854775807 -9223372036854775807 0/], [qw/9223372036854775808 -9223372036854775808 0/], [qw/9223372036854775809 -9223372036854775809 0/], [qw/1178630961471601951655862 827639478068904540012 1179458600949670856195874/], [qw/-2555488174170453670799 1726145541361106236340 -829342632809347434459/], [qw/9223372036854775808 9223372036854775808 18446744073709551616/], [qw/1177803321993533047115850 827639478068904540012 1178630961471601951655862/], [qw/-4281633715531559907139 1726145541361106236340 -2555488174170453670799/], [qw/18446744073709551616 -9223372036854775808 9223372036854775808/], ); plan tests => + 2 # trivial addint, subint + 1 # addint/subint on test array + 2 # add1int and sub1int + 1 # add/sub 0 ; ###### addint { my(@addgot,@subgot,@addexp,@subexp); for my $a (-3 .. 3) { for my $b (-3 .. 3) { push @addgot, addint($a,$b); push @subgot, subint($a,$b); push @addexp, $a+$b; push @subexp, $a-$b; } } is_deeply( \@addgot, \@addexp, "addint( -3 .. 3, -3 .. 3)" ); is_deeply( \@subgot, \@subexp, "subint( -3 .. 3, -3 .. 3)" ); } subtest 'selected test values', sub { is_deeply( [map { "".addint($_->[0],$_->[1]) } @vals], [map { $_->[2] } @vals], "addint a+b=c" ); is_deeply( [map { "".addint($_->[1],$_->[0]) } @vals], [map { $_->[2] } @vals], "addint b+a=c" ); is_deeply( [map { "".subint($_->[2],$_->[1]) } @vals], [map { $_->[0] } @vals], "subint c-b=a" ); is_deeply( [map { "".subint($_->[2],$_->[0]) } @vals], [map { $_->[1] } @vals], "subint c-a=b" ); is_deeply( [map { "".addint($_->[0],$_->[1])} @vals], [map { "".addint($_->[1],$_->[0])} @vals], "addint is commutative" ); }; ###### add1int / sub1int { my @N = (-17 .. 17, "4294967295", "4294967296", "4294967297", "9223372036854775807", "9223372036854775808", "9223372036854775809", "18446744073709551615", "18446744073709551616", "18446744073709551617", "158456325028528675187087900671"); is_deeply([map {"".add1int($_)} @N], [map {"".addint($_,1)} @N], "add1int"); is_deeply([map {"".sub1int($_)} @N], [map {"".subint($_,1)} @N], "sub1int"); } subtest 'add and subtract 0 on large values', sub { my @big = qw/4294967295 4294967296 9223372036854775807 9223372036854775808 18446744073709551615 18446744073709551616 1178630961471601951655862/; is_deeply([map{"".addint($_,0)} @big], \@big, "addint(n,0) == n for large n"); is_deeply([map{"".addint(0,$_)} @big], \@big, "addint(0,n) == n for large n"); is_deeply([map{"".subint($_,0)} @big], \@big, "subint(n,0) == n for large n"); is_deeply([map{"".subint($_,$_)}@big],[(0)x@big],"subint(n,n) == 0 for large n"); is_deeply([map{"".subint(0,$_)} @big], [map{"-$_"} @big], "subint(0,n) == -n for large n"); }; Math-Prime-Util-0.74/t/19-kronecker.t000644 000765 000024 00000003324 13667653334 017254 0ustar00danastaff000000 000000 #!/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.74/t/18-50-sqrtint.t000644 000765 000024 00000002006 15146553566 017212 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/sqrtint/; my @vals = ( [qw/ 1524155677489 1234567/], [qw/ 1524158146623 1234567/], [qw/ 1524155677488 1234566/], [qw/ 4503599761588224 67108864/], [qw/ 425822367781739534 652550662/], [qw/ 9223372036854775807 3037000499/], [qw/ 9223372036854775808 3037000499/], [qw/18446744065119617024 4294967294/], [qw/18446744065119617025 4294967295/], [qw/18446744073709551615 4294967295/], [qw/18446744073709551616 4294967296/], [qw/18446744082299486208 4294967296/], [qw/18446744082299486209 4294967297/], [qw/84274086103068221283760416414557757 290299993288095377/], ); plan tests => 3; ok(!defined eval { sqrtint(-1) }, "sqrtint(n): n must not be negative"); is_deeply( [map { sqrtint($_) } 0..100], [map { int(sqrt($_)) } 0..100], "sqrtint 0 .. 100" ); is_deeply( [map { sqrtint($_->[0]) } @vals], [map { $_->[1] } @vals], "sqrtint(n) for multiple values" ); Math-Prime-Util-0.74/t/13-primecount.t000644 000765 000024 00000023026 14634020267 017435 0ustar00danastaff000000 000000 #!/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, "1e12 +85536" => 3089, "127976334671 +468" => 2, "127976334672 +467" => 1, "127976334671 +467" => 1, "127976334672 +466" => 0, ); $intervals{"1e13 +85536"} = 2868 if $isxs || $extra; $intervals{"1e14 +2**16"} = 1973 if $isxs || $extra; 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 + 9 + 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", 6 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.74/t/26-frobeniusnum.t000644 000765 000024 00000011610 15146553566 020000 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/frobenius_number/; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my @t1 = ( [ -1, [1]], [ -1, [5,1]], [ 43, [6,9,20]], [ 481, [47, 74, 97, 126, 157, 188]], [ 1666, [83,87,93]], [ 1666, [83,87,93,166,170,174,176,180,186,249,253,257,259]], [ 11, [5,8,9,12]], [ 30, [7,11,13]], [ 899, [53,71,91]], [27971, [322,654,765]], [71459, [123,1234,12345]], [ 3019, [151,157,251,711]], [ 3019, [151,157,251,711,912]], [ 426, [101,109,113,119,121,131,139,149,151,161,163,167,169,187,191,214,219,238,276,324,345,346,349,387,421,427,444,453,463,525,530,555,579,580,625,711,719,737,752,787,814,834,856,878,899,915,937,978,989]], [ 3637, [200,230,528,863,905,976,1355,1725,1796,1808]], [ 67, [10,18,26,33,35]], [ 39, [20/4, 44/4]], [ 3787,[1218,1017,882,11]], [ 175,[43,40,38,37,34]], [ 122,[4,73,63,111]], [ 489,[10,195,218,272,287,324,341,353,499]], [ 2053,[100,101,159]], [ 3415,[133,172,199]], [ 1972,[100,101,139]], [ 2959,[110,151,201]], [ 3059,[110,151,211]], [ 4948,[137,251,256]], [ 1027,[33,89,147]], [ 4049,[100,239,543,609]], [ 899,[100,101,110,111]], [ 204,[30,31,43,55,67,98]], ); my @t2 = ( [ 327473, [2000,3001,4567]], [ 6753481, [4093, 8191, 16381, 32749, 65521]], [149389505, [12223,12224,36671]], [ 106857,[5123,5692,6055,6371,6899,7300]], [ 51648,[5123,5692,6055,6371,6899,7300,8472,8619,9001,9544,9809,10012,11207]], [ 132833,[1854,2712,2266,7857]], ); # from Aardal and Lentra (2005) # https://www.researchgate.net/publication/2559108_Hard_Equality_Constrained_Integer_Knapsacks my @t3 = ( [89643481,[12223,12224,36674,61119,85569]], [89716838,[qw/12228 36679 36682 48908 61139 73365/]], [58925134,[qw/12137 24269 36405 36407 48545 60683/]], [104723595,[qw/13211 13212 39638 52844 66060 79268 92482/]], [45094583,[qw/13429 26850 26855 40280 40281 53711 53714 67141/]], [33367335,[qw/25067 49300 49717 62124 87608 88025 113673 119169/]], [14215206,[qw/11948 23330 30635 44197 92754 123389 136951 140745/]], [58424799,[qw/39559 61679 79625 99658 133404 137071 159757 173977/]], [60575665,[qw/48709 55893 62177 65919 86271 87692 102881 109765/]], [62442884,[qw/28637 48198 80330 91980 102221 135518 165564 176049/]], [22382774,[qw/20601 40429 42207 45415 53725 61919 64470 69340 78539 95043/]], [27267751,[qw/18902 26720 34538 34868 49201 49531 65167 66800 84069 137179/]], [21733990,[qw/17035 45529 48317 48506 86120 100178 112464 115819 125128 129688/]], [13385099,[qw/13719 20289 29067 60517 64354 65633 76969 102024 106036 119930/]], [106925261,[qw/45276 70778 86911 92634 97839 125941 134269 141033 147279 153525/]], [ 577134,[qw/11615 27638 32124 48384 53542 56230 73104 73884 112951 130204/]], [ 944183,[qw/14770 32480 75923 86053 85747 91772 101240 115403 137390 147371/]], [ 765260,[qw/15167 28569 36170 55419 70945 74926 95821 109046 121581 137695/]], [ 680230,[qw/11828 14253 46209 52042 55987 72649 119704 129334 135589 138360/]], [ 663281,[qw/13128 37469 39391 41928 53433 59283 81669 95339 110593 131989/]], [1109710,[qw/35113 36869 46647 53560 81518 85287 102780 115459 146791 147097/]], [ 752109,[qw/14054 22184 29952 64696 92752 97364 118723 119355 122370 140050/]], [ 783879,[qw/20303 26239 33733 47223 55486 93776 119372 136158 136989 148851/]], [ 677347,[qw/20212 30662 31420 49259 49701 62688 74254 77244 139477 142101/]], [1037608,[qw/32663 41286 44549 45674 95772 111887 117611 117763 141840 149740/]], ); # These will kill the RR algorithm my @tx = ( ["1375300010215404" ,[10000000000,10000008870,10000057783,10000072907]], ["38563214973583",[10**10,18543816066,27129592681,43226644830,78522678316]], ); if (!$usexs && !$extra) { @t3 = grep { $_->[1]->[0] < 13000 } @t3; } plan tests => 3 # Simple tests + 3 # More complicated sets + 2; # overflow ##### frobenius_number is( frobenius_number(), undef, "frobenius_number() = undef"); is( frobenius_number(4093), undef, "frobenius_number(4093) = undef"); #is( frobenius_number(20,44), undef, "frobenius_number(20,44) = undef"); eval { frobenius_number(20,44); }; like($@, qr/coprime/, "Non-coprime set gives error"); is_deeply( [map { frobenius_number(@{$_->[1]}) } @t1], [map { $_->[0] } @t1], "frobenius_number simple tests"); is_deeply( [map { frobenius_number(@{$_->[1]}) } @t2], [map { $_->[0] } @t2], "frobenius_number bigger tests"); is_deeply( [map { frobenius_number(@{$_->[1]}) } @t3], [map { $_->[0] } @t3], "frobenius_number hard knapsack problems"); # Check for overflow is( "".frobenius_number(12345,"1494268454735486"), "18445249805254826839", "frobenius_number(12345,1494268454735486) = 18445249805254826839" ); is( "".frobenius_number(12345,"14948739119699798"), "184527235693574294167", "frobenius_number(12345,14948739119699798) = 184527235693574294167" ); Math-Prime-Util-0.74/t/02-can.t000644 000765 000024 00000013613 15146553566 016024 0ustar00danastaff000000 000000 #!/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_delicate_prime is_chen_prime is_odd is_even is_divisible is_congruent is_power is_prime_power is_perfect_power is_square is_square_free is_powerfree is_pillai is_polygonal is_congruent_number is_perfect_number is_semiprime is_almost_prime is_omega_prime is_primitive_root is_carmichael is_quasi_carmichael is_cyclic is_fundamental is_totient is_gaussian_prime is_sum_of_squares is_smooth is_rough is_powerful is_practical is_lucky is_happy sqrtint rootint logint lshiftint rshiftint rashiftint absint negint signint cmpint addint subint add1int sub1int mulint powint divint modint cdivint divrem fdivrem cdivrem tdivrem miller_rabin_random lucas_sequence lucasu lucasv lucasuv lucasumod lucasvmod lucasuvmod pisano_period primes twin_primes semi_primes almost_primes omega_primes ramanujan_primes sieve_prime_cluster sieve_range prime_powers lucky_numbers forprimes forcomposites foroddcomposites forsemiprimes foralmostprimes forpart forcomp forcomb forperm forderange formultiperm forsetproduct fordivisors forfactored forsquarefree forsquarefreeint lastfor numtoperm permtonum randperm shuffle vecsample prime_iterator prime_iterator_object next_prime prev_prime next_prime_power prev_prime_power next_perfect_power prev_perfect_power next_chen_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 inverse_li_nv twin_prime_count twin_prime_count_approx nth_twin_prime nth_twin_prime_approx semiprime_count semiprime_count_approx nth_semiprime nth_semiprime_approx almost_prime_count almost_prime_count_approx almost_prime_count_lower almost_prime_count_upper nth_almost_prime nth_almost_prime_approx nth_almost_prime_lower nth_almost_prime_upper omega_prime_count nth_omega_prime 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 powerful_count nth_powerful sumpowerful powerful_numbers prime_power_count prime_power_count_approx prime_power_count_lower prime_power_count_upper nth_prime_power nth_prime_power_approx nth_prime_power_lower nth_prime_power_upper perfect_power_count perfect_power_count_approx perfect_power_count_lower perfect_power_count_upper nth_perfect_power nth_perfect_power_approx nth_perfect_power_lower nth_perfect_power_upper nth_powerfree powerfree_count powerfree_sum squarefree_kernel powerfree_part powerfree_part_sum smooth_count rough_count powersum lucky_count lucky_count_approx lucky_count_lower lucky_count_upper nth_lucky nth_lucky_approx nth_lucky_lower nth_lucky_upper minimal_goldbach_pair goldbach_pairs goldbach_pair_count sum_primes print_primes random_prime random_ndigit_prime random_nbit_prime random_safe_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 chinese2 gcd lcm factor factor_exp divisors valuation hammingweight frobenius_number todigits fromdigits todigitstring sumdigits tozeckendorf fromzeckendorf sqrtmod allsqrtmod rootmod allrootmod cornacchia negmod invmod addmod submod mulmod divmod powmod muladdmod mulsubmod vecsum vecmin vecmax vecprod vecreduce vecextract vecequal vecuniq vecany vecall vecnotall vecnone vecfirst vecfirstidx vecmex vecpmex vecsort vecsorti vecfreq vecsingleton vecslide setbinop sumset setunion setintersect setminus setdelta toset setcontains setcontainsany setinsert setremove setinvert is_sidon_set is_sumfree_set set_is_disjoint set_is_equal set_is_proper_intersection set_is_subset set_is_proper_subset set_is_superset set_is_proper_superset moebius mertens liouville sumliouville prime_omega prime_bigomega euler_phi jordan_totient exp_mangoldt sumtotient partitions bernfrac bernreal harmfrac harmreal chebyshev_theta chebyshev_psi divisor_sum carmichael_lambda hclassno inverse_totient kronecker is_qr qnr ramanujan_tau ramanujan_sum stirling fubini znorder znprimroot znlog legendre_phi factorial factorialmod subfactorial binomial binomialmod falling_factorial rising_factorial contfrac from_contfrac next_calkin_wilf next_stern_brocot calkin_wilf_n stern_brocot_n nth_calkin_wilf nth_stern_brocot nth_stern_diatomic farey next_farey farey_rank 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.74/t/50-factoring.t000644 000765 000024 00000026505 15151017347 017232 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/factor factor_exp divisors divisor_sum is_prime prime_bigomega prime_omega/; 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'}; 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/7 8 16 57 64 377 9592 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 2339796554687 /; push @testn64, "124838608575421729" if $usegmp || $usexs; push @testn64, "1434569741817480287" if $usegmp || $usexs; push @testn64, "1256490565186616147" if $usegmp || $usexs; push @testn64, "13356777177440210791" if $usegmp || $usexs; 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 @testdivisors = ( [ 0,], [ 1,1], [ 2,1,2], [ 3,1,3], [ 4,1,2,4], [ 5,1,5], [ 6,1,2,3,6], [ 7,1,7], [ 8,1,2,4,8], [ 9,1,3,9], [ 10,1,2,5,10], [ 12,1,2,3,4,6,12], [ 16,1,2,4,8,16], [ 42,1,2,3,6,7,14,21,42], [ 30107,1,7,11,17,23,77,119,161,187,253,391,1309,1771,2737,4301,30107], [ 115553,1,115553], [ 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], [ 456789,1,3,43,129,3541,10623,152263,456789], [ 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], [1032924637,1,6469,159673,1032924637], [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], ); my @testfactors = ( [ 0, [0] ], [ 1, [] ], [ 2, [2] ], [ 3, [3] ], [ 4, [2,2] ], [ 5, [5] ], [ 6, [2,3] ], [ 30107, [7,11,17,23] ], [ 115553, [115553] ], [ 123456, [2,2,2,2,2,2,3,643] ], [ 456789, [3,43,3541] ], [ 174636000, [2,2,2,2,2,3,3,3,3,5,5,5,7,7,11] ], ); plan tests => 4 # factor, factor_exp, including scalar + 2*scalar(@testn) # factor and factor_exp + 2*scalar(@testdivisors) + 3 # extra divisors tests + 10*10 # 10 extra factoring tests * 10 algorithms + 8 # more factoring for code coverage + 4 # omega and bigomega ; #### factor(n) factor_exp(n) scalar of each { my @nvals = map { $_->[0] } @testfactors; is_deeply([map { scalar factor($_) } @nvals], [map { scalar @{$_->[1]} } @testfactors], "scalar factors(n) for @nvals"); is_deeply([map { [factor($_)] } @nvals], [map { $_->[1] } @testfactors], "factors(n) for @nvals"); is_deeply([map { scalar factor_exp($_) } @nvals], [map { scalar linear_to_exp(@{$_->[1]}) } @testfactors], "scalar factor_exp(n) for @nvals"); is_deeply([map { [factor_exp($_)] } @nvals], [map { [linear_to_exp(@{$_->[1]})] } @testfactors], "factor_exp(n) for @nvals"); } #is_deeply([map { scalar factor($_) } 0..6,30107,174636000], # [1,0,1,1,2,1,2,4,15], "scalar_factor(n) for 0..6,30107,174636000"); #### factor(n) factor_exp(n) for many numbers foreach my $n (@testn) { my @f = factor($n); my $facstring = join(' * ',@f); my($ispr,$prod,$inorder) = (1,1,1); for my $f (@f) { $ispr = 0 unless is_prime($f); $prod *= $f; } for (1..$#f) { $inorder = 0 if $f[$_] < $f[$_-1]; } ok($ispr && $inorder && $prod == $n, "factor($n): $n = $facstring, all sorted primes"); # Does factor_exp return the appropriate rearrangement? is_deeply([factor_exp($n)], [linear_to_exp(@f)], "factor_exp($n)" ); } #### divisors and scalar(divisors), simple divisor_sum foreach my $dinfo (@testdivisors) { my($n,@divisors) = @$dinfo; my $nd = scalar @divisors; is_deeply([scalar divisors($n),[divisors($n)]], [scalar @divisors,\@divisors], "divisors($n)"); my $sum = 0; $sum += $_ for @divisors; is_deeply([divisor_sum($n,0),divisor_sum($n)], [$nd,$sum], "divisor_sum($n)"); } #### divisors with a second argument is_deeply( [divisors(5040, 120)], [1,2,3,4,5,6,7,8,9,10,12,14,15,16,18,20,21,24,28,30,35,36,40,42,45,48,56,60,63,70,72,80,84,90,105,112,120], "divisors(5040, 120)" ); #is_deeply( [divisors("340282366920938463463374607431768211455", 5040)], # [1,3,5,15,17,51,85,255,257,641,771,1285,1923,3205,3855,4369], # "divisors(2^128-1, 5040)" ); is_deeply( [divisors("1208925819614629174706175", 128)], [1,3,5,11,15,17,25,31,33,41,51,55,75,85,93,123], "divisors(2^80-1, 128)" ); is_deeply( [ [divisors( 0,0)], [divisors( 0,1)], [divisors( 1,0)], [divisors( 1,1)], [divisors( 1,2)], [divisors(12,0)], [divisors(12,1)], [divisors(12,4)] ], [ [], [], [], [1], [1], [], [1], [1,2,3,4] ], "divisors for n 0,1,12 and k 0,1,x" ); #### test each of the underlying algorithms 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)}); extra_factor_test("cheb_factor", sub {Math::Prime::Util::cheb_factor(shift)}); SKIP: { skip "No lehman_factor in PP", 10 unless $usexs; extra_factor_test("lehman_factor", sub {Math::Prime::Util::lehman_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" ); is_deeply( [Math::Prime::Util::trial_factor(1819015037140)], [2,2,5,7,7,1856137793], "trial_factor(1819015037140) fully factors"); SKIP: { skip "holf_factor for 64-bit input", 1 unless $use64 || !$usexs; is_deeply( [Math::Prime::Util::holf_factor(3747785838079,80000)], [1935281,1936559], "holf factor 1935281 * 1936559" ); } is_deeply( [Math::Prime::Util::pminus1_factor(166213)], [347,479], "p-1 factor 347 * 479" ); SKIP: { skip "p-1 tests for C code", 3 unless $usexs; is_deeply( [Math::Prime::Util::pminus1_factor(899,20)], [29,31], "p-1 factor 29 * 31 with tiny B1" ); is_deeply( [Math::Prime::Util::pminus1_factor(667,1000)], [23,29], "p-1 factor 23 * 29 with small B1" ); is_deeply( [Math::Prime::Util::pminus1_factor(563777293,1000,20000)], [23099,24407], "p-1 factor 23099 * 24407 using stage 2" ); } # GMP still has some issues with this #is_deeply( [Math::Prime::Util::cheb_factor("13581893559735945553",1500)], [3453481411,3932812123], "cheb factor 3453481411 * 3932812123" ); SKIP: { skip "cheb_factor for 64-bit input", 1 unless $use64 || !$usexs; is_deeply( [Math::Prime::Util::cheb_factor("2466600463243213733",1000)], [1552318819,1588978007], "cheb factor 1552318819 * 1588978007" ); } sub extra_factor_test { my $fname = shift; my $fsub = shift; if (0) { 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)" ); } else { is_deeply( [ $fsub->(1) ], [], "$fname(1)" ); is_deeply( [ $fsub->(4) ], [2, 2], "$fname(4)" ); is_deeply( [ $fsub->(9) ], [3, 3], "$fname(9)" ); is_deeply( [ $fsub->(11) ], [11], "$fname(11)" ); is_deeply( [ $fsub->(25) ], [5, 5], "$fname(25)" ); is_deeply( [ $fsub->(30) ], [2, 3, 5], "$fname(30)" ); is_deeply( [ $fsub->(210) ], [2,3,5,7], "$fname(210)" ); is_deeply( [ $fsub->(175) ], [5, 5, 7], "$fname(175)" ); is_deeply( [ $fsub->(403) ], [13, 31], "$fname(403)" ); is_deeply( [ $fsub->(549900) ], [2,2,3,3,5,5,13,47], "$fname(549900)" ); } } sub linear_to_exp { my %exponents; my @factors = grep { !$exponents{$_}++ } @_; return (map { [$_, $exponents{$_}] } @factors); } #### prime_omega and prime_bigomega { my @omegai = (qw/0 1 2 36 102 392 8593952 820681752040947471423/); my @omegao = (qw/1 0 1 2 3 2 3 6/); my @omegab = (qw/1 0 1 4 3 5 7 8/); is_deeply([map { prime_omega($_) } @omegai],\@omegao,"prime_omega(n)"); is_deeply([map { prime_bigomega($_) } @omegai],\@omegab,"prime_bigomega(n)"); is_deeply([map {prime_omega('-'.$_) } @omegai],\@omegao,"prime_omega(-n)"); is_deeply([map {prime_bigomega('-'.$_)}@omegai],\@omegab,"prime_bigomega(-n)"); } Math-Prime-Util-0.74/t/21-conseq-lcm.t000644 000765 000024 00000006702 15146553566 017326 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/consecutive_integer_lcm/; plan tests => 101 + 1; # As per A003418, a(0) = 1 my @lcms = qw/ 1 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.74/t/26-binomial.t000644 000765 000024 00000011523 15146745765 017065 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/binomial/; my @binomials = ( [ 20,15, 15504], [ 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. [ 34,16, "2203961430" ], [ 62,28, "349615716557887465" ], [ 67,30, "9989690752182277136" ], [ 70,25, "6455761770304780752" ], [ 125,61, "2923171367321931373425996933337783875" ], [ 131,64, "183062151498210163887302260440097215750" ], [ 177,78, "3314450882216440395106465322941753788648564665022000" ], [ 61,17, "536830054536825" ], [ -11,22, 64512240 ], [ -12,23, -286097760 ], [ -23,-26, -2300 ], # Kronenburg extension [ -12,-23, -705432 ], # same [ 12,-23, 0 ], [ 12,-12, 0 ], [ -12,0, 1 ], [ "36893488147419103233",1, "36893488147419103233" ], [ "36893488147419103233",2, "680564733841876926945195958937245974528" ], [ "36893488147419103233",3, "8369468980515574351781052564276888554796991677927476166656" ], ); plan tests => 6 + 3+ scalar(@binomials); # # https://pdf.sciencedirectassets.com/271536/1-s2.0-S0012365X08X00172/1-s2.0-S0012365X07007443/main.pdf # Sprugnoli 2008, Table 1, Extended Pascal Array # mpu 'for my $n (-5..5) { say sprintf("%2d",$n),": ",join(" ",map{sprintf("%4d",binomial($n,$_))}-5..5); }' # { my @bin; for my $n (0..10) { for my $k (0..10) { push @bin, [$n,$k]; } } is_deeply( [map { binomial($_->[0],$_->[1]) } @bin], [qw/1 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 1 2 1 0 0 0 0 0 0 0 0 1 3 3 1 0 0 0 0 0 0 0 1 4 6 4 1 0 0 0 0 0 0 1 5 10 10 5 1 0 0 0 0 0 1 6 15 20 15 6 1 0 0 0 0 1 7 21 35 35 21 7 1 0 0 0 1 8 28 56 70 56 28 8 1 0 0 1 9 36 84 126 126 84 36 9 1 0 1 10 45 120 210 252 210 120 45 10 1/], "binomial(0..10,0..10)" ); } { my @bin; for my $n (-10..-1) { for my $k (0..10) { push @bin, [$n,$k]; } } is_deeply( [map { binomial($_->[0],$_->[1]) } @bin], [qw/1 -10 55 -220 715 -2002 5005 -11440 24310 -48620 92378 1 -9 45 -165 495 -1287 3003 -6435 12870 -24310 43758 1 -8 36 -120 330 -792 1716 -3432 6435 -11440 19448 1 -7 28 -84 210 -462 924 -1716 3003 -5005 8008 1 -6 21 -56 126 -252 462 -792 1287 -2002 3003 1 -5 15 -35 70 -126 210 -330 495 -715 1001 1 -4 10 -20 35 -56 84 -120 165 -220 286 1 -3 6 -10 15 -21 28 -36 45 -55 66 1 -2 3 -4 5 -6 7 -8 9 -10 11 1 -1 1 -1 1 -1 1 -1 1 -1 1/], "binomial(-10..-1,0..10)" ); } { my @bin; for my $n (0..10) { for my $k (-10..-1) { push @bin, [$n,$k]; } } is_deeply( [map { binomial($_->[0],$_->[1]) } @bin], [qw/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 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/], "binomial(0..10,-10..-1)" ); } { my @bin; for my $n (-10..-1) { for my $k (-10..-1) { push @bin, [$n,$k]; } } is_deeply( [map { binomial($_->[0],$_->[1]) } @bin], [qw/1 0 0 0 0 0 0 0 0 0 -9 1 0 0 0 0 0 0 0 0 36 -8 1 0 0 0 0 0 0 0 -84 28 -7 1 0 0 0 0 0 0 126 -56 21 -6 1 0 0 0 0 0 -126 70 -35 15 -5 1 0 0 0 0 84 -56 35 -20 10 -4 1 0 0 0 -36 28 -21 15 -10 6 -3 1 0 0 9 -8 7 -6 5 -4 3 -2 1 0 -1 1 -1 1 -1 1 -1 1 -1 1/], "binomial(-10..-1,-10..-1)" ); } is_deeply( [map { binomial(13, $_) } -15 .. 15], [qw/0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 13 78 286 715 1287 1716 1716 1287 715 286 78 13 1 0 0/], "binomial(13,n) for n in -15 .. 15" ); is_deeply( [map { binomial(-13, $_) } -15 .. 15], [qw/91 -13 1 0 0 0 0 0 0 0 0 0 0 0 0 1 -13 91 -455 1820 -6188 18564 -50388 125970 -293930 646646 -1352078 2704156 -5200300 9657700 -17383860/], "binomial(-13,n) for n in -15 .. 15" ); # Binomials from Loeb 1995 { my $n; is_deeply( [map { $n=$_; map { binomial($n,$_) } 0..$n } 0..7], [qw/1 1 1 1 2 1 1 3 3 1 1 4 6 4 1 1 5 10 10 5 1 1 6 15 20 15 6 1 1 7 21 35 35 21 7 1/], "binomial: Loeb 1995 Region 1 (positive n, positive k)" ); is_deeply( [map { $n=$_; map { binomial($n,$_) } 0..6 } -5 .. -1], [qw/1 -5 15 -35 70 -126 210 1 -4 10 -20 35 -56 84 1 -3 6 -10 15 -21 28 1 -2 3 -4 5 -6 7 1 -1 1 -1 1 -1 1/], "binomial: Loeb 1995 Region 2 (negative n, positive k)" ); is_deeply( [map { $n=$_; map { binomial($n,$_) } -6..$n } -6 .. -1], [qw/1 -5 1 10 -4 1 -10 6 -3 1 5 -4 3 -2 1 -1 1 -1 1 -1 1/], "binomial: Loeb 1995 Region 3 (negative n, negative k)" ); # Region 4 is positive n and k > n. We are always 0. # Region 5 is positive n and negative k. We are always 0. # Region 6 is negative n and n < k < 0. We are always 0. } # Selected binomials foreach my $r (@binomials) { my($n, $k, $exp) = @$r; is( "".binomial($n,$k), $exp, "binomial($n,$k)) = $exp" ); } Math-Prime-Util-0.74/t/11-twinprimes.t000644 000765 000024 00000002566 13025437630 017454 0ustar00danastaff000000 000000 #!/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.74/t/81-bigint.t000644 000765 000024 00000065235 15153165540 016542 0ustar00danastaff000000 000000 #!/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; # Performance issues here are in: # primality very little we can do about it, we must test # factoring also must test though maybe can make faster? if ($broken64) { # Perl from before 2002, built for 64-bit. Not supported. plan skip_all => "Broken 64-bit Perl, skipping all tests"; } else { plan tests => 0 + 1 # basic int + 1 # basic mod + 1 # other mod + 1 # gcd and lcm + 1 # gcdext and chinese + 1 # primality + 1 # primes, twin primes, semiprimes, almost primes, etc. + 1 # next/prev prime + 1 # prime_iterator + 1 # primecount and lower/upper/approx + 1 # factoring + 1 # znorder znprimroot znlog + 1 # divisor_sum + 5 # moebius, euler_phi, kronecker, valuation, etc. + 1 # jordan_totient + 1 # liouville + 1 # ispower + 1 # random primes + 1 # vecequal + 1; # $_ didn't get changed } use Math::Prime::Util qw/ prime_set_config negint absint signint cmpint addint subint add1int sub1int mulint powint lshiftint rshiftint rashiftint divint modint cdivint divrem fdivrem cdivrem tdivrem sqrtint rootint logint negmod addmod submod mulmod muladdmod mulsubmod divmod powmod invmod sqrtmod rootmod allsqrtmod allrootmod is_congruent is_qr qnr is_primitive_root factorialmod binomialmod lucasumod lucasvmod 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 next_prime prev_prime prime_iterator random_prime random_ndigit_prime random_nbit_prime random_safe_prime random_strong_prime random_maurer_prime miller_rabin_random is_bpsw_prime valuation vecequal /; # TODO: ExponentialIntegral # LogarithmicIntegral # RiemannR use Math::BigInt try=>"GMP,GMPz"; use Math::BigFloat try=>"GMP,GMPz"; use bigint; # <-------- large numbers ahead! > 2^64 my $usegmp = Math::Prime::Util::prime_get_config->{gmp}; my $bigintver = $bigint::VERSION; my $mbigintver = $Math::BigInt::VERSION; my $mbigfltver = $Math::BigFloat::VERSION; my $bigintlib = Math::BigInt->config()->{lib}; $bigintlib =~ s/^Math::BigInt:://; my $mpugmpver = $usegmp ? $Math::Prime::Util::GMP::VERSION : ""; diag "BigInt $bigintver/$mbigintver/$mbigfltver, 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'; subtest 'arithmetic ops', sub { # The test numbers used are randomly chosen, nothing special about them my $n = 29326327445836963809762302067795652280; my $negn = negint($n); is("".$negn, -29326327445836963809762302067795652280, "negint(n)"); is("".negint($negn), $n, "negint(negint(n))"); is("".absint($negn), $n, "absint(negint(n))"); is(signint($n), 1, "signint(n)"); is(signint($negn), -1, "signint(negint(n))"); is(cmpint($n,$n),0,"cmpint(n,n) = 0"); is(cmpint($n,$negn),1,"cmpint(n,-n) = 1"); is(cmpint($negn,$n),-1,"cmpint(-n,n) = -1"); my $n2 = 58652654891673927619524604135591304560; my $n3 = 87978982337510891429286906203386956840; is("".addint($n,$n),$n2,"addint(n,n) = 2n"); is("".addint($n,$n2),$n3,"addint(2*n,n) = 3n"); is(addint($negn,$n),"0","addint(-n,n) = 0"); is("".subint($n3,$n2),$n,"subint(3n,2n) = n"); is("".subint($n,$negn),$n2,"subint(n,-n) = 2n"); is("".add1int(19437056586806593268),19437056586806593269,"add1int(n) = n+1"); is("".sub1int(19437056586806593268),19437056586806593267,"sub1int(n) = n-1"); my $nsqr = 860033481460450377515108424533203603187404404374382196284947588070669198400; my $ncub = 25221623491692321487348209824650128345904008945462108558207852225847625066929594776910302455742481841632732352000; is("".mulint(2,$n),$n2,"mulint(2,n) = 2n"); is("".mulint($n,3),$n3,"mulint(n,3) = 3n"); is("".mulint($n,-3),"".negint($n3),"mulint(n,-3) = -3n"); is("".mulint($n,$n),$nsqr,"mulint(n,n) = n^2"); is(powint($n,0),"1","powint(n,0) = 1"); is("".powint($n,1),"$n","powint(n,1) = n"); is("".powint($n,2),$nsqr,"powint(n,2) = n^2"); is("".powint($n,3),$ncub,"powint(n,3) = n^3"); is(powint($negn,0),"1","powint(-n,0) = 1"); is("".powint($negn,1),"$negn","powint(-n,1) = -n"); is("".powint($negn,2),$nsqr,"powint(-n,2) = n^2"); is("".powint($negn,3),"".negint($ncub),"powint(-n,3) = -n^3"); is("".lshiftint($n),$n2,"lshiftint(n) = 2n"); is("".lshiftint($n3,14),1441447646617778445177436671236291900866560,"lshiftint(3n,14) = 3n * 2^14"); is("".rshiftint($n2),$n,"rshiftint(2n) = n"); is("".rshiftint($n,7),229111933170601279763767984904653533,"rshiftint(n,7) = n / 2^7"); is("".rshiftint($negn,7),-229111933170601279763767984904653533,"rshiftint(-n,7) = -(n >> 7)"); is("".rashiftint($negn,7),-229111933170601279763767984904653534,"rashiftint(-n,7) = (fdivrem(n,2**7))[0] [Python right shift]"); is("".divint($n2,2),$n,"divint(2n,2) = n"); is("".divint(negint($n3),3),"$negn","divint(-3n,3) = -n"); is(modint($n3,$n),"0","mod(3n,n) = 0"); is(modint($n,1),"0","mod(n,1) = 0"); is(modint($n,29),"5","mod(n,29)"); is(modint($negn,37),"30","mod(-n,37)"); is("".divint($negn,511),-57390073279524391017147362167897559,"divint(-n,511)"); is("".cdivint($negn,511),-57390073279524391017147362167897558,"cdivint(-n,511)"); my $m = -891149066616685318069719273514027361488599736308638170770; my $d = 11081041228439474651; is_deeply([map{"$_"}divrem($m,$d)], [-80421058657335617430773462550803594698,5116452384810829628], "divrem(-m,d)"); is_deeply([map{"$_"}fdivrem($m,$d)], [-80421058657335617430773462550803594698,5116452384810829628], "fdivrem(-m,d)"); is_deeply([map{"$_"}cdivrem($m,$d)], [-80421058657335617430773462550803594697,-5964588843628645023], "cdivrem(-m,d)"); is_deeply([map{"$_"}tdivrem($m,$d)], [-80421058657335617430773462550803594697,-5964588843628645023], "tdivrem(-m,d)"); is("".sqrtint($nsqr),$n,"sqrtint(n^2) = n"); is("".sqrtint($ncub),158813171656800310523242313199648286862899164761029420165,"sqrtint(n^3) = n^(3/2)"); { my($r,$v,$e); $r = rootint($ncub, 7, \$v); $e = 11412903582751672; is_deeply(["$r","$v"], [$e,"".powint($e,7)], "rootint(n^3,7,\\\$r)"); $r = logint($n, 18, \$v); $e = 29; is_deeply(["$r","$v"], [$e,"".powint(18,$e)], "logint(n,18,\\\$r)"); } }; subtest 'basic mod ops', sub { # Randomly chosen integers my $A = 400189273193594088451869468713181466450681802689782908252400244075; my $B = 990429319976107635118049598881942833305583; my $C = 130716934118556849942; my $Ca = 10540222481731305179; # a composite my $D = 95045564778113305157; # a prime my $Da = 95045564778113305482; # a non-squarefree composite is("".negmod($A,$D),12736484928456701970,"negmod"); is("".addmod($A,$B,$C),15656969117801514554,"addmod"); is("".submod($A,$B,$C),74721010532486795616,"submod"); is("".mulmod($A,$B,$C),4443724024613552983,"mulmod"); is("".muladdmod($A,$B,$D,$C),99489288802726858140,"muladdmod"); is("".mulsubmod($A,$B,$D,$C),40115093365057097768,"mulsubmod"); is("".divmod($A,$B,$C),71001221878922773879,"divmod"); is("".powmod($A,$B,$C),80999932714432421083,"powmod"); is("".invmod($A,$C),33944411285878109917,"invmod"); is("".sqrtmod($C,$D),8765086989354512719,"sqrtmod [prime modulus]"); my @all2 = (2960938399489571940,22255231847764978494,72790332930348326988,92084626378623733542); ok(is_one_of(sqrtmod($C,$Da),@all2), "sqrtmod [composite modulus]"); SKIP: { skip "another sqrtmod skipped without EXTENDED_TESTING",1 unless $extra; my @all1 = (269348601420886766,4581843100180665863,5958379381550639316,10270873880310418413); ok(is_one_of(sqrtmod($D,$Ca),@all1), "sqrtmod [composite modulus]"); } is("".rootmod($C,5,$D),81379717162684976939,"rootmod(C,5,D) [prime modulus]"); my @all3 = qw/1653087340990329197 15231025166435087123 28808962991879845049 42386900817324602975 55964838642769360901 69542776468214118827 83120714293658876753/; ok(is_one_of(rootmod($D,35,$Da),@all3),"rootmod(C,35,Da) [composite modulus]"); is_deeply([map{"$_"}allsqrtmod($C,$D)],[8765086989354512719,86280477788758792438],"allsqrtmod"); is_deeply([map{"$_"}allrootmod($D,35,$Da)], \@all3, "allrootmod"); }; subtest 'other mod ops', sub { my $A = 400189273193594088451869468713181466450681802689782908252400244075; my $B = 990429319976107635118049598881942833305583; my $C = 130716934118556849940; is(is_congruent($A,$B,$C),0,"is_congruent"); is(is_congruent(addint($A,20208865721792522128),$B,$C),1,"is_congruent"); is(is_qr($B,$C),0,"is_qr"); is(is_qr(addint($B,142),$C),1,"is_qr"); is(qnr($C), 2, "qnr"); is(qnr(130716934118556861071), 37, "qnr"); my $N = 72574551534231909331741171093173785967490646405143; # 7^59 is(is_primitive_root(3,$N),1,"is_primitive_root"); is(is_primitive_root(7,$N),0,"is_primitive_root"); is("".factorialmod(777, $C), 27183400742691213580, "factorialmod"); is("".factorialmod(36893488147432436565, $C), "0", "factorialmod"); is("".binomialmod($C,73,$B),8314965924716374520974024285356149070687,"binomialmod"); # lucasumod lucasvmod lucasuvmod done in t/25-lucas_sequences.t is("".lucasumod(17,1,7777777778888999,$B),363910679494422198934676182699576192782510,"lucasumod with Q=1"); is("".lucasvmod(17,1,7777777778888999,$B),68398397794084099557151356283528547714286,"lucasvmod with Q=1"); }; subtest 'gcd and lcm', sub { 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)" ); }; subtest 'gcdext and chinese', sub { # Work around a Math::BigInt::Lite issue is_deeply( [map{"$_"}gcdext(803028077895224634710139483024654235947,101394830246542359478030280778952246347)], [7687627417944666569835322284775478836, -60884570288210047004733169112173096587, "3"], "gcdext(a,b)" ); is( chinese([26,17179869209],[17,34359738421]), 103079215280, "chinese([26,17179869209],[17,34359738421] = 103079215280" ); }; ############################################################################### subtest 'primality', sub { my @primes = (100000982717289000001); foreach my $n (@primes) { ok( is_prime($n), "$n is prime" ); ok( is_prob_prime($n), "$n is probably prime"); } my @composites = ( 36893488147419103233, # div 3 36893488147419103249, # div 7 36893488147419103261, # div 61 36893488147419103253, # no small factors 21652684502221, # small pseudoprime 1195068768795265792518361315725116351898245581, # big pseudoprime ); foreach my $n (@composites) { #ok( !is_prime($n), "$n is not prime" ); ok( !is_prob_prime($n), "$n is not probably prime"); } # The t/23-primality-proofs.t test does: # is_provable_prime # is_provable_prime_with_cert # prime_certificate # verify_prime # using bigints. Don't do it again here. }; ############################################################################### subtest 'range primes', sub { # Used to be (2**66, 2**66+100), but old ActiveState chokes for some reason. is_deeply( [map{"$_"}@{primes(73786976294838206464, 73786976294838206564)}], [73786976294838206473,73786976294838206549], "primes( 2^66, 2^66 + 100 )" ); is_deeply( [map{"$_"}@{twin_primes(18446744073760736000,18446744073760737000)}], [18446744073760736057,18446744073760736717], "twin_primes(18446744073760736000,+1000)" ); }; ############################################################################### subtest 'next and prev', sub { is( "".next_prime(777777777777777777777777), 777777777777777777777787, "next_prime(777777777777777777777777)"); is( "".prev_prime(777777777777777777777777), 777777777777777777777767, "prev_prime(777777777777777777777777)"); }; ############################################################################### subtest 'prime iterator', sub { my $it = prime_iterator(10**24+910); is_deeply( [map {"$_"} map { $it->() } 1..3], [1000000000000000000000921,1000000000000000000000931,1000000000000000000000949], "iterator 3 primes starting at 10^24+910" ); }; ############################################################################### subtest 'prime counts', sub { # Testing prime_count only on a small range for time reasons is(prime_count(877777777777777778417252,877777777777777778417352), 1, "prime_count(87..7252, 87..7352)"); # test bounds for a number just outside of native size if ($use64) { check_pcbounds(31415926535897932384, 716115441142294636, '2e-8', '2e-8'); } else { check_pcbounds(12345678901, 556442213, '1e-5', '1e-5'); } 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'); } }; ############################################################################### subtest 'factoring', sub { my($n,@f); ($n,@f) = (1234567890, 2,3,3,5,3607,3803); is_deeply([factor($n)],\@f,"factor($n)"); is_deeply([factor_exp($n)],[linear_to_exp(@f)],"factor_exp($n)"); ($n,@f) = (3493005066479, 61,101,1063,533353); is_deeply([factor($n)],\@f,"factor($n)"); is_deeply([factor_exp($n)],[linear_to_exp(@f)],"factor_exp($n)"); ($n,@f) = (23489223467134234890234680, 2,2,2,5,4073,4283,33662485846146713); is_deeply([factor_exp($n)],[linear_to_exp(@f)],"factor_exp($n)"); is_deeply([map {"$_"} divisors(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/], "divisors(23489223467134234890234680)"); }; ############################################################################### subtest 'znorder znprimroot znlog', sub { # Calc/FastCalc are slugs with this function, so tone things down. #is( znorder(82734587234,927208363107752634625923555185111613055040823736157), # 4360156780036190093445833597286118936800, # "znorder" ); is("".znorder(8267,927208363107752634625925),2838011904800209433220,"znorder(8267,927208363107752634625925)"); is(znorder(902,827208363107752634625947),undef,"znorder(902,827208363107752634625947"); is( znprimroot(2985417419712080156311), 12, "znprimroot(2985417419712080156311)" ); is( znlog(232752345212475230211680, 23847293847923847239847098123812075234, 804842536444911030681947), 13, "znlog(b,g,p): find k where b^k = g mod p" ); }; ############################################################################### subtest 'divisor sum', sub { # Done wrong, the following will have a bunch of extra zeros. my $fiftyfac = Math::BigInt->new(50)->bfac; is( "".divisor_sum($fiftyfac), 218174515904456969581674334837521529647143055709686266261790720000, "Divisor sum of 50!" ); # 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#)" ); } }; ############################################################################### { my $n = 618970019642690137449562110; is( moebius($n), -1, "moebius($n)" ); is( "".euler_phi($n), 145857122964987051805507584, "euler_phi($n)" ); is( carmichael_lambda($n), 3271601336256, "carmichael_lambda($n)" ); is( kronecker(878944444444444447324234,216539985579699669610468715172511426009), -1, "kronecker(..., ...)" ); is( valuation(6**625-1,5), 5, "valuation(6^625,5) = 5" ); } subtest 'jordan totient', sub { my $n = 438200690176361625211; is( "".jordan_totient(3,$n), 84124269617190384716582485856111491726462952451043939343099904, "jordan_totient(3,$n)" ); $n = 1876829427493875207697; is( divisor_sum( $n, sub { my $d=shift; $d**5 * moebius($n/$d); }), 23287561853962265648116308453678279123352511321660254762457516668293390975559516726247126212641359652904000, "jordan totient using divisor_sum and moebius" ); if ($extra) { my $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" ); } }; subtest 'liouville', sub { is( liouville(14964156817349780894766767),"-1", "liouville(a x b x c) = -1" ); is( liouville( 14277153908541447331733), "1", "liouville(a x b x c x d) = 1" ); }; ############################################################################### subtest 'is_power', sub { 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; # Make sure to test Math::BigInt::Pari with Perl pre-5.18. my(@gotpow0,@gotpow,@gotroot,@exproot); for (0 .. $#negpowers) { my $r; my $n = 7 ** $_; push @gotpow0, is_power("-$n"); push @gotpow, is_power("-$n", int("0"), \$r); push @gotroot, $r; my $p = $gotpow[-1]; push @exproot, $p == 0 ? undef : -(7 ** int($_/$p)); } is_deeply(\@gotpow0, \@negpowers, "is_power( -(7^i) ) for 0 .. $#negpowers"); is_deeply(\@gotpow, \@negpowers, "same result with is_power(n,0,\\\$r)"); is_deeply(\@gotroot, \@exproot, "correct roots in \$r"); }; ############################################################################### # We have a separate test file for random primes (t/16-randomprime.t) # These tests should all be moved there. subtest 'random primes', sub { my $randprime; SKIP: { # \/ \/ \/ skipped without $extra skip "Skipping random prime tests without EXTENDED_TESTING", 26 unless $extra; $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"); # This routine is very slow without GMP $randprime = random_safe_prime(100); cmp_ok( $randprime, '>', 2**99, "random 100-bit safe prime is not too small"); cmp_ok( $randprime, '<', 2**100, "random 100-bit safe prime is not too big"); ok( is_prime($randprime), "random 100-bit safe 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 } # ^^^ skipped without $extra }; ############################################################################### subtest 'vecequal', sub { my $ten = Math::BigInt->new("10"); my $six = Math::BigInt->new("6"); is( vecequal([$ten,20],[$ten,20]), 1, "vecequal with Math::BigInt" ); is( vecequal([$ten,20],[10,20]), 1, "vecequal with Math::BigInt and scalar" ); is( vecequal([$ten,$six],[$ten,$six]), 1, "vecequal with equal Math::BigInt" ); is( vecequal([$ten,20],[$six,20]), "0", "vecequal with unequal Math::BigInt" ); ok(!eval { vecequal([$ten,{}],[$ten,{}]); }, "vecequal with hash should error"); }; ############################################################################### 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); my $pcuprhf = Math::BigFloat->new($pcup_rh); my $pcupf = Math::BigFloat->new($pcup); #diag "" . ($pcapf - $pclo_rh)/($pcapf) . " " . $percentrh/100.0 . ""; cmp_ok( ($pcapf - $pclo_rh)/$pcapf, '<=', $percentrh , "PC lower with RH"); cmp_ok( ($pcuprhf - $pcapf)/$pcapf, '<=', $percentrh , "PC upper with RH"); cmp_ok( ($pcapf - $pclo)/$pcapf, '<=', $percent , "PC lower"); cmp_ok( ($pcupf - $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); } sub is_one_of { my($n, @list) = @_; if (defined $n) { for (@list) { return 1 if defined $_ && "$n" eq $_; } } else { for (@list) { return 1 if !defined $_; } } 0; } Math-Prime-Util-0.74/t/26-binomialmod.t000644 000765 000024 00000003255 15146553566 017564 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/binomialmod/; #use Math::Prime::Util qw/binomial modint/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my @tests = ( [0,0,7, 1], [0,1,7, 0], [0,2,7, 0], [3,0,7, 1], [7,5,11, 10], [950,100,123456, 24942], [950,100,7, 2], [8100,4000,1155, 924], [950,100,1000000007, 640644226], [189,34,877, 81], [189,34,253009, 47560], [189,34,36481, 14169], [1900,17,41, 0], [5000,654,101223721, 59171352], [-112,5,351, 313], [-189,34,877, 141], [-23,-29,377, 117], [189,-34,877, 0], ); if ($usexs) { push @tests, [100000000,87654321,1005973, 937361], [100000000,7654321,1299709, 582708], [100000000,7654321,12345678, 4152168], [100000,7654,32768, 12288], [100000,7654,196608, 110592], [100000,7654,101223721, 5918452]; } if ($usexs && $extra) { push @tests, [100000000,7654321,32768, 24576], [100000000,7654321,196608, 122880], [100000000,7654321,101223721, 5463123]; } plan tests => 1 + scalar(@tests) ; for my $data (@tests) { my($n,$k,$m,$exp) = @$data; is( binomialmod($n,$k,$m), $exp, "binomialmod($n,$k,$m) = $exp" ); #is( modint(binomial($n,$k),$m), $exp, "binomial($n,$k) mod $m = $exp" ); } { my $sum = 0; for my $p (1 .. 27) { for my $n (1..40) { for my $k (1 .. $n) { $sum += binomialmod($n,$k,$p); } } } # s=0;for(p=1,27,for(n=1,40,for(k=1,n,s+=lift(binomod(n,k,p))))); s is( $sum, 99531, "Small binomialmod works" ); } Math-Prime-Util-0.74/t/24-partitions.t000644 000765 000024 00000013752 15146553566 017467 0ustar00danastaff000000 000000 #!/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}; # About 5x faster if available. #Math::Prime::Util::prime_set_config(bigint => "Math::GMPz"); plan tests => 3; subtest 'partitions', sub { 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", ); foreach my $n (0..$#parts) { is( partitions($n), $parts[$n], "partitions($n)" ); } while (my($n, $epart) = each (%bparts)) { SKIP: { skip "partition($n) w/out EXTENDED_TESTING",1 unless $n <= 300 || $extra; is( "".partitions($n), $epart, "partitions($n)" ); } } }; ################### forpart subtest 'forpart', sub { { 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 subtest 'forcomp', sub { { 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.74/t/26-congruentnum.t000644 000765 000024 00000014274 15146553566 020021 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_congruent_number/; 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 @cn200 = (5,6,7,13,14,15,20,21,22,23,24,28,29,30,31,34,37,38,39,41,45,46,47,52,53,54,55,56,60,61,62,63,65,69,70,71,77,78,79,80,84,85,86,87,88,92,93,94,95,96,101,102,103,109,110,111,112,116,117,118,119,120,124,125,126,127,133,134,135,136,137,138,141,142,143,145,148,149,150,151,152,154,156,157,158,159,161,164,165,166,167,173,174,175,180,181,182,183,184,188,189,190,191,194,197,198,199); my @cn1e6 = (1,5,6,7,9); my @ncfilters = ( ["p3", [19,43,59]], ["(1+sqrt2,p)", [17,73,89]], ["2p Bastien", [26,58,74,82]], ["pq 33", [33,57,129]], ["pq 13", [51,123,187]], ["pq 57", [35,91,115]], ["2pq 55", [130,290,370]], ["2pq 33", [66,114,258]], ["2pq 15", [170,730,970]], ["2pq 37", [42,186,266]], ["2pq 77", [1442,2338,2786,4354,4738,6146,7042]], ["2pq 11", [1394,2482,7922,7954]], ["pqr 133", [969,2193,2409]], ["pqr 357", [105,273,345]], ["pqr 377", [483,1491,2387,3619]], ["pqr 131", [2091,4539,5763]], ["pqr 131 (2)", [3723,4947,9843,11931,12291,13243]], ["pqr 157", [595,1435,1547,1955]], ["pqr 355", [195,435,555,715,795]], ["pqr 333", [1947,2211,2451,2739,3363]], ["pqr 111", [78761,95489,120377]], ["2pqr 133", [1938,4386,4818]], ["2pqr 155", [2210,5330,9010]], ["2pqr 357", [690,770,930,1218]], ["2pqr 111", [135218,157522,240754,269042]], ["2pqr 577", [4186,4970,5530,7130]], ["2pqr 115", [6970,12410,16490,18122,19210]], ["2pqr 335", [570,858,1290,1914,2010,2090]], ["2pqr 555", [3770,7930,13130,15370,17690]], ["pqrs 5577", [10465,14105,29785,31465,32305,40145]], ["pqrs 3357", [8715,23835,29667,29715,32235,49035,54915]], ["pqrs 1333", [60027,73491,90651,91443,127347,156579,194667]], ["pqrs 3333", [161601,255057,293073,317361,340689,348513]], ["pqrs 1357", [30849,31161,51865,63609,89585,100113,104673]], ["pqrs 1133", [214401,316217,330033,386097,396321,419577]], ["2pqrs 1133", [79458,81906,126786,141474,179826,187986]], ["2pqrs 3557", [36330,61530,75530,142170,162330,163770,167370]], ["2pqrs 1335", [32538,54570,78474,83130,115770,135546,144330]], ["2pqrs 3337", [47082,110922,169818,181146,205674,225834]], ["2pqrs 1555", [466570,928330,1697930,1742330,1869530,2198170]], ["2pqrs 3333", [323202,510114,586146,634722,681378,697026]], ["2pqrs 5555", [2679170,4102930,7181330,7681570,8118370,10167170]], ["2pqrs 3355", [106530,131970,193314,395970,449970,555330]], ); my @ncfilters2 = ( # Most of the 1/2/3/4-factor results are in the first filter set. [1,"Iskra 1996",[qw/161601 255057 293073 317361 323202 340689 348513/]], #[1,"Reinholz 2013",[qw/26961 36993 42009 52041 67089 82137 83721 87153/]], [1,"Reinholz 2013",[qw/203433 615201 717369 924801 1085793 1988673/]], [1,"Cheng 2019",[qw/761442 981618 1155858 1201794 1490082 1550274/]], [1,"Cheng 2018 T1.1",[qw/2679170 4102930 7181330 7681570 8118370/]], [1,"Cheng 2018 T1.2",[qw/15073995 24459690 24649707 26534010 28219395/]], [1,"Cheng 2018 T1.3",[qw/4451145 5322345 5488305 5676555 9122505 12063594/]], [1,"Cheng 2018 T1.4",[qw/505155 1147755 1404795 1529745 2129505 2172345/]], [1,"Das 2020",[qw/432502235 1085236971 1332878635 1445059707 1641579115/]], # These only work if the factor ordering is allowed to permute. # The 0 indicates we're going to skip them. [0,"Reinholz 2013",[qw/26961 36993 42009 52041 82137 83721 87153 112233/]], [0,"Cheng 2019 (ord)",[qw/53922 73986 84018 104082 164274 167442 174306/]], [0,"Cheng 2018 T1.1",[qw/71885379 83674803 106112739 112768059 159654099/]], [0,"Cheng 2018 T1.2 (ord)",[qw/5221227 7981347 11477499 14789643 15709683/]], [0,"Cheng 2018 T1.3 (ord)",[qw/1334058 1978305 4069905 4072593 4190298/]], [0,"Cheng 2018 T1.4 (ord)",[qw/405195 504339 2239755 3403995/]], [0,"Das 2020 (ord)",[qw/332868235 682507315 881126547 932968715 1180617347/]], ); plan tests => 0 + 3 + scalar(@ncfilters) + scalar(@ncfilters2) ; # This covers all simple special cases in the code is_deeply([grep { is_congruent_number($_) } 1..200], \@cn200, "congruent numbers to 200"); is_deeply([grep { is_congruent_number(1000000+$_) } 1..10], \@cn1e6, "congruent numbers 10^6 + (1..10)"); # Skip the filters and directly test the Tunnell loop SKIP: { skip "PP doesn't have test interfaces", 1 unless $usexs; is_deeply([grep { Math::Prime::Util::_is_congruent_number_tunnell($_) } 1..200], \@cn200, "congruent numbers to 200 (no filtering)"); } # Test the various filters finding non-congruent families SKIP: { skip "PP doesn't have all the NC families",scalar(@ncfilters) unless $usexs; for my $td (@ncfilters) { my($name,$narr) = @$td; my @got = map {Math::Prime::Util::_is_congruent_number_filter($_)} @$narr; my @exp = map {0} @$narr; # Any return value of -1 means the filter didn't work. is_deeply(\@got, \@exp, "Non-congruent family of $name"); } } SKIP: { skip "PP doesn't have all the NC families",scalar(@ncfilters2) unless $usexs; for my $td (@ncfilters2) { my($order,$name,$narr) = @$td; SKIP: { skip "NC filters don't use arbitrary factor order", 1 unless $order; my @got = map {Math::Prime::Util::_is_congruent_number_filter($_)} @$narr; my @exp = map {0} @$narr; # Any return value of -1 means the filter didn't work. is_deeply(\@got, \@exp, "Non-congruent family of $name"); } } } #my @das = (17*3*409*19,17*3*859*3697,19*409*3697*859,17*3*409*19*3697*859, 5*7*29*79,5*7*821*151,29*79*821*151,5*7*29*79*821*151); #@das = grep { $_ <= ~0 } @das; # Only test native integers #is_deeply([map { is_congruent_number($_) } @das], # [map { 0 } @das], # "Non-congruent examples from Das and Saikia 2020 section 5"); # 30849, 52865, 63609, .... 4 factors # 432502235 6 factors # no 8/10/12 factor results below 5e11 # 311199575628433 8 factors (probably not the smallest) Math-Prime-Util-0.74/t/26-factorial.t000644 000765 000024 00000012143 15150474171 017217 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/factorial subfactorial fubini falling_factorial rising_factorial/; use Math::BigInt try => "GMP,Pari"; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; plan tests => 5; subtest 'factorial', sub { ok(!defined eval { factorial(-5); }, "factorial(-5) gives error"); is_deeply([map { "".factorial($_) } 0..100], [map { Math::BigInt->new($_)->bfac->bstr } 0..100], "factorial(0..100) matched Math::BigInt"); }; subtest 'subfactorial', sub { ok(!defined eval { subfactorial(-5); }, "subfactorial(-5) gives error"); is_deeply( [ map { "".subfactorial($_) } 0..23 ], [qw/1 0 1 2 9 44 265 1854 14833 133496 1334961 14684570 176214841 2290792932 32071101049 481066515734 7697064251745 130850092279664 2355301661033953 44750731559645106 895014631192902121 18795307255050944540 413496759611120779881 9510425471055777937262/], "subfactoral(n) for 0..23" ); is("".subfactorial(110), "5842828822584214646127804296800556812003401310647230252823417994828330749128488139372248218138294820842482275906806317309680576864190217329860297083368061950972635498019334565561", "subfactorial(110)"); }; my @fubini = qw/1 1 3 13 75 541 4683 47293 545835 7087261 102247563 1622632573 28091567595 526858348381 10641342970443 230283190977853 5315654681981355 130370767029135901 3385534663256845323 92801587319328411133 2677687796244384203115 81124824998504073881821 2574844419803190384544203 85438451336745709294580413/; my $nfubini = $extra ? 23 : 19; is_deeply( [ map { "".fubini($_) } 0..$nfubini ], [@fubini[0..$nfubini]], "fubini(n) for 0..$nfubini" ); subtest 'falling_factorial', sub { my $k; is_deeply( [map { $k=$_; map { "".falling_factorial($_,$k) } -10..10 } 0..10], [qw/1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6 7 8 9 10 110 90 72 56 42 30 20 12 6 2 0 0 2 6 12 20 30 42 56 72 90 -1320 -990 -720 -504 -336 -210 -120 -60 -24 -6 0 0 0 6 24 60 120 210 336 504 720 17160 11880 7920 5040 3024 1680 840 360 120 24 0 0 0 0 24 120 360 840 1680 3024 5040 -240240 -154440 -95040 -55440 -30240 -15120 -6720 -2520 -720 -120 0 0 0 0 0 120 720 2520 6720 15120 30240 3603600 2162160 1235520 665280 332640 151200 60480 20160 5040 720 0 0 0 0 0 0 720 5040 20160 60480 151200 -57657600 -32432400 -17297280 -8648640 -3991680 -1663200 -604800 -181440 -40320 -5040 0 0 0 0 0 0 0 5040 40320 181440 604800 980179200 518918400 259459200 121080960 51891840 19958400 6652800 1814400 362880 40320 0 0 0 0 0 0 0 0 40320 362880 1814400 -17643225600 -8821612800 -4151347200 -1816214400 -726485760 -259459200 -79833600 -19958400 -3628800 -362880 0 0 0 0 0 0 0 0 0 362880 3628800 335221286400 158789030400 70572902400 29059430400 10897286400 3632428800 1037836800 239500800 39916800 3628800 0 0 0 0 0 0 0 0 0 0 3628800/], "falling_factorial(-10..10, 0..10)" ); is_deeply( [map { "".falling_factorial($_->[0],$_->[1]) } ([515,7],[516,7],[568,7],[89,10],[103,101],["36893488147419103233",2])], [qw/9222879462222182400 9349716704335257600 18378924259448108160 18452514066426316800 49514503582430902037733576272908866745450829110572462415026402773499383329208111416070720536941769246326758192988646046611441067207574945792000000000000000000000000 1361129467683753853890391917874491949056/], "falling_factorial selected values"); }; subtest 'rising_factorial', sub { my $k; is_deeply( [map { $k=$_; map { "".rising_factorial($_,$k) } -10..10 } 0..10], [qw/1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6 7 8 9 10 90 72 56 42 30 20 12 6 2 0 0 2 6 12 20 30 42 56 72 90 110 -720 -504 -336 -210 -120 -60 -24 -6 0 0 0 6 24 60 120 210 336 504 720 990 1320 5040 3024 1680 840 360 120 24 0 0 0 0 24 120 360 840 1680 3024 5040 7920 11880 17160 -30240 -15120 -6720 -2520 -720 -120 0 0 0 0 0 120 720 2520 6720 15120 30240 55440 95040 154440 240240 151200 60480 20160 5040 720 0 0 0 0 0 0 720 5040 20160 60480 151200 332640 665280 1235520 2162160 3603600 -604800 -181440 -40320 -5040 0 0 0 0 0 0 0 5040 40320 181440 604800 1663200 3991680 8648640 17297280 32432400 57657600 1814400 362880 40320 0 0 0 0 0 0 0 0 40320 362880 1814400 6652800 19958400 51891840 121080960 259459200 518918400 980179200 -3628800 -362880 0 0 0 0 0 0 0 0 0 362880 3628800 19958400 79833600 259459200 726485760 1816214400 4151347200 8821612800 17643225600 3628800 0 0 0 0 0 0 0 0 0 0 3628800 39916800 239500800 1037836800 3632428800 10897286400 29059430400 70572902400 158789030400 335221286400/], "rising_factorial(-10..10, 0..10)" ); is_deeply( [map { "".rising_factorial($_->[0],$_->[1]) } ([509,7],[510,7],[562,7],[80,10],[103,101])], [qw/9222879462222182400 9349716704335257600 18378924259448108160 18452514066426316800 6760937240727169751346751449031021029092236987417146776093364751481076175432048515956305908925637116481562056123160956910787676051553407749205364947724300581490631820332063331242347041889126973440000000000000000000000000/], "rising_factorial selected values"); }; Math-Prime-Util-0.74/t/19-mangoldt.t000644 000765 000024 00000001557 14105215267 017067 0ustar00danastaff000000 000000 #!/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, # Non-negative inputs 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.74/t/26-issquarefree.t000644 000765 000024 00000001336 15146553566 017766 0ustar00danastaff000000 000000 #!/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("1716716933610412497881337454598508842322"),"1716716933610412497881337454598508842322 is square free"); ok(!is_square_free("638277566021123181834824715385258732627350"),"638277566021123181834824715385258732627350 is not square free"); Math-Prime-Util-0.74/t/26-contfrac.t000644 000765 000024 00000011027 15153250561 017050 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/contfrac from_contfrac/; plan tests => 7; subtest 'contfrac and from_contfrac roundtrip' => sub { my @data = ( [0,1,[0]], [1,3,[0,3]], [4,11,[0, 2, 1, 3]], [67,29,[2, 3, 4, 2]], [121,23,[5, 3, 1, 5]], [3,4837,[0,1612,3]], [0xfff1,0x7fed,[2, 1423, 1, 6, 1, 2]], [83116,51639,[1, 1, 1, 1, 1, 3, 1, 1, 2, 2, 4, 1, 2, 1, 1, 1, 3]], [9238492834,2398702938777,[0, 259, 1, 1, 1, 3, 1, 7, 2, 3, 7, 2, 1, 1, 2, 4, 2, 1, 10, 5, 3, 1, 5, 6]], ["243224233245235253407096734543059","4324213412343432913758138673203834",[0,17,1,3,1,1,12,1,2,33,2,1,1,1,1,49,1,1,1,1,17,34,1,1,304,1,2,1,1,1,2,1,48,1,20,2,3,5,1,1,16,9,1,1,5,1,2,2,7,4,3,1,7,1,1,17,1,1,29,1,12,2,5]], [415,93,[4,2,6,7]], [649,200,[3,4,12,4]], [4,9,[0,2,4]], ); for my $t (@data) { my($n,$d,$exp) = @$t; is_deeply( [contfrac($n,$d)], $exp, "contfrac($n,$d)" ); is_deeply( [map{"$_"}from_contfrac(@$exp)], [$n,$d], "from_contfrac(@$exp)" ); } }; subtest 'pi convergents' => sub { my @data = ( [22,7,[3,7]], [333,106,[3,7,15]], [355,113,[3,7,16]], [377,120,[3,7,17]], [3927,1250,[3,7,16,11]], [103993,33102,[3,7,15,1,292]], [104348,33215,[3,7,15,1,293]], [208341,66317,[3,7,15,1,292,2]], [312689,99532,[3,7,15,1,292,1,2]], [833719,265381,[3,7,15,1,292,1,1,1,2]], [1146408,364913,[3,7,15,1,292,1,1,1,3]], [4272943,1360120,[3,7,15,1,292,1,1,1,2,1,3]], [80143857,25510582,[3,7,15,1,292,1,1,1,2,1,3,1,14]], ["262452630335382199398","83541266890691994833",[3,7,15,1,292,1,1,1,2,1,3,1,14,2,1,1,2,2,2,2,1,84,2,1,1,15,3,13,1,4,2,6,6,99]], ); for my $t (@data) { my($n,$d,$exp) = @$t; is_deeply( [contfrac($n,$d)], $exp, "contfrac($n/$d)" ); is_deeply( [map{"$_"}from_contfrac(@$exp)], [$n,$d], "from_contfrac pi convergent" ); } }; subtest 'Fibonacci ratio convergents' => sub { my @data = ( # F(n)/F(n+1) gives CF [0, (1)x(n-2), 2] with n terms [144,233,[0,1,1,1,1,1,1,1,1,1,1,2]], ["7540113804746346429","12200160415121876738",[0,(1)x90,2]], ["280571172992510140037611932413038677189525","453973694165307953197296969697410619233826",[0,(1)x198,2]], ); for my $t (@data) { my($n,$d,$exp) = @$t; is_deeply( [map{"$_"}contfrac($n,$d)], [map{"$_"}@$exp], "contfrac(F/F) len ".scalar(@$exp) ); is_deeply( [map{"$_"}from_contfrac(@$exp)], [$n,$d], "from_contfrac(F/F) len ".scalar(@$exp) ); } }; subtest 'non-coprime inputs' => sub { # contfrac reduces to lowest terms; from_contfrac won't recover original my @data = ( [62832,20000,[3,7,16,11]], [0,2,[0]], [8,22,[0, 2, 1, 3]], ); for my $t (@data) { my($n,$d,$exp) = @$t; is_deeply( [contfrac($n,$d)], $exp, "contfrac($n,$d) non-coprime" ); } }; subtest 'negative numerator' => sub { my @data = ( [-93,37,[-3,2,18]], [-312689,99532,[-4,1,6,15,1,292,1,2]], [-4,11,[-1,1,1,1,3]], [-4,5837,[-1,1,1458,4]], [-4,11111,[-1,1,2776,1,3]], [-1,11111,[-1,1,11110]], [-11110,11111,[-1,11111]], [-11112,11111,[-2,1,11110]], [-1,1,[-1]], [-7,1,[-7]], [-100,1,[-100]], ); for my $t (@data) { my($n,$d,$exp) = @$t; is_deeply( [contfrac($n,$d)], $exp, "contfrac($n,$d)" ); is_deeply( [from_contfrac(@$exp)], [$n,$d], "from_contfrac(@$exp)" ); } }; subtest 'edge cases' => sub { # Integers (d=1): CF is a single element for my $n (0, 1, 7, 100) { is_deeply( [contfrac($n,1)], [$n], "contfrac($n,1)" ); is_deeply( [from_contfrac($n)], [$n,1], "from_contfrac($n)" ); } # Unit fractions (1/d): CF is [0, d] for my $d (2, 3, 100) { is_deeply( [contfrac(1,$d)], [0,$d], "contfrac(1,$d)" ); is_deeply( [from_contfrac(0,$d)], [1,$d], "from_contfrac(0,$d)" ); } # from_contfrac with no arguments is_deeply( [from_contfrac()], [0,1], "from_contfrac() = (0,1)" ); # from_contfrac with negative first element is_deeply( [from_contfrac(-3)], [-3,1], "from_contfrac(-3)" ); is_deeply( [from_contfrac(-3,7)], [-20,7], "from_contfrac(-3,7)" ); # 0/d reduces to 0/1 is_deeply( [contfrac(0,100)], [0], "contfrac(0,100)" ); is_deeply( [from_contfrac(0)], [0,1], "from_contfrac(0) = (0,1)" ); }; subtest 'bigint' => sub { my @data = ( ["1180591620717411303425","590295810358705651712", [2,"590295810358705651712"]], ); for my $t (@data) { my($n,$d,$exp) = @$t; is_deeply( [map{"$_"}contfrac($n,$d)], [map{"$_"}@$exp], "contfrac($n,$d) bigint" ); is_deeply( [map{"$_"}from_contfrac(@$exp)], [$n,$d], "from_contfrac bigint" ); } }; Math-Prime-Util-0.74/t/26-isperfectnumber.t000644 000765 000024 00000001547 14622646245 020464 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_perfect_number/; #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 @true = (qw/8128 33550336 8589869056 137438691328 2305843008139952128 2658455991569831744654692615953842176/); my @false = (qw/8505 12285 19845 28665 31185 198585576189 8 32 2096128 35184367894528 144115187807420416 9444732965670570950656/); plan tests => 1 + 2; ; is_deeply([grep { is_perfect_number($_) } -10 .. 500], [6,28,496], "is_perfect_number(-10 .. 500)"); is_deeply([map { is_perfect_number($_) } @true], [map { 1 } @true], "perfect: [@true]"); is_deeply([map { is_perfect_number($_) } @false], [map { 0 } @false], "not perfect: [@false]"); Math-Prime-Util-0.74/t/26-isalmostprime.t000644 000765 000024 00000004133 14056645657 020160 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_almost_prime is_prime is_semiprime/; my %kap=( 0 => [1], 1 => [2,3,5,7,11,13,17,19,23,29], 2 => [4,6,9,10,14,15,21,22,25,26], 3 => [8,12,18,20,27,28,30,42,44,45], 4 => [16,24,36,40,54,56,60,81,84,88], 5 => [32,48,72,80,108,112,120,162,168,176], 6 => [64,96,144,160,216,224,240,324,336,352], 7 => [128,192,288,320,432,448,480,648,672,704], 8 => [256,384,576,640,864,896,960,1296,1344,1408], 9 => [512,768,1152,1280,1728,1792,1920,2592,2688,2816], 10 => [1024,1536,2304,2560,3456,3584,3840,5184,5376,5632], 11 => [2048,3072,4608,5120,6912,7168,7680,10368,10752,11264], 12 => [4096,6144,9216,10240,13824,14336,15360,20736,21504,22528], 13 => [8192,12288,18432,20480,27648,28672,30720,41472,43008,45056], 14 => [16384,24576,36864,40960,55296,57344,61440,82944,86016,90112], 15 => [32768,49152,73728,81920,110592,114688,122880,165888,172032,180224], 16 => [65536,98304,147456,163840,221184,229376,245760,331776,344064,360448], 17 => [131072,196608,294912,327680,442368,458752,491520,663552,688128,720896], 18 => [262144,393216,589824,655360,884736,917504,983040,1327104,1376256,1441792], 19 => [524288,786432,1179648,1310720,1769472,1835008,1966080,2654208,2752512,2883584], 20 => [1048576,1572864,2359296,2621440,3538944,3670016,3932160,5308416,5505024,5767168], ); plan tests => 11 + scalar(keys(%kap)); for my $k (0 .. 10) { my @exp = map { fac_is_almost_prime($k, $_) } 0 .. 40; my @got = map { is_almost_prime($k, $_) } 0 .. 40; is_deeply( \@got, \@exp, "is_almost_prime($k, 0..40)" ); } while (my($k, $pvals) = each (%kap)) { my $failed = 0; my $nvals = scalar(@$pvals); for my $n (@$pvals) { $failed++ if is_almost_prime($k, $n) != 1; } is( 0, $failed, "Test first $nvals $k-almost-primes return true" ); } # TODO: bignums sub fac_is_almost_prime { my($k, $n) = @_; return 0+($n==1) if $k == 0; return (is_prime($n) ? 1 : 0) if $k == 1; return is_semiprime($n) if $k == 2; return (scalar(Math::Prime::Util::factor($n)) == $k) ? 1 : 0; } Math-Prime-Util-0.74/t/19-znorder.t000644 000765 000024 00000002172 14013441045 016730 0ustar00danastaff000000 000000 #!/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.74/t/23-random-certs.t000644 000765 000024 00000003074 15146553566 017664 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_prime logint verify_prime random_maurer_prime_with_cert random_shawe_taylor_prime_with_cert random_proven_prime_with_cert /; 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 $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 $bits = $usegmp ? 80 : ~0 > 4294967295 ? 67 : 35; { my($n,$cert) = random_maurer_prime_with_cert($bits); ok( is_prime($n) && logint($n,2) == $bits-1, "Random Maurer prime returns a $bits-bits 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($bits); ok( is_prime($n) && logint($n,2) == $bits-1, "Random Shawe-Taylor prime returns a $bits-bits prime" ); ok( verify_prime($cert), " with a valid certificate" ); } { my($n,$cert) = random_proven_prime_with_cert($bits); ok( is_prime($n) && logint($n,2) == $bits-1, "Random proven prime returns a $bits-bits prime" ); ok( verify_prime($cert), " with a valid certificate" ); } Math-Prime-Util-0.74/t/26-setops.t000644 000765 000024 00000054106 15152607540 016575 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; # Any integer lists as input: # toset # is_sidon_set # is_sumfree_set # setbinop # # Any integer lists as input, more efficient if set form: # setunion # setintersect # setminus # setdelta # set_is_disjoint # sumset # # BOTH lists MUST not have duplicates # set_is_equal # set_is_subset # set_is_superset # set_is_proper_subset # set_is_proper_superset # set_is_proper_intersection (XS dups ok, PP not ok) # # If given exactly two array references, both MUST be in set form. # If given one array reference and zero or more scalars, # the first MUST be in set form. The scalars are any integer list. # setinsert # setremove # setinvert # setcontains # setcontainsany # Returns boolean. Sets as input. # set_is_equal($S,$T) # set_is_subset($S,$T) # set_is_superset($S,$T) # set_is_proper_subset($S,$T) # set_is_proper_superset($S,$T) # set_is_proper_intersection($S,$T) # set_is_disjoint($S,$T) # is_sidon_set($S) # is_sumfree_set($S) # setcontains($S,$T) / setcontains($S,...) # setcontainsany($S,$T) / setcontainsany($S,...) # # Returns integer (new_size - old_size). # MODIFIES $S <<<<<<<<<< # takes either a set or an unordered list # setinsert($S,$T) / setinsert($S,$v,...) # setremove($S,$T) / setremove($S,$v,...) # setinvert($S,$T) / setinvert($S,$v,...) # # Returns set. List as input. # toset(...) # Returns set. Sets as input. # setunion($S,$T) # setintersect($S,$T) # setminus($S,$T) # setdelta($S,$T) # setbinop { } $S,$T # sumset($S,$T) use Test::More; use Math::Prime::Util qw/setunion setintersect setminus setdelta setcontains setcontainsany setinsert setremove setinvert toset is_sidon_set is_sumfree_set set_is_disjoint set_is_equal set_is_subset set_is_superset set_is_proper_subset set_is_proper_superset set_is_proper_intersection powint addint subint negint/; use Math::BigInt; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $bi1 = Math::BigInt->new("59724578844314338843734830435499460367"); my $bi2 = Math::BigInt->new("98198086365677506205371483123156488634"); my $bi3 = Math::BigInt->new("606571739116749108206251582180042583662"); my $pr = "1844674407370955161"; # Inputs, description, results: union, intersection, minus, delta # Generic numeric lists (not sorted, maybe duplicates). my @vecs = ( [ [7,1,3,5,1], [3,7,8,3,9], "simple unsigned unsorted with dups", [1,3,5,7,8,9], [3,7], [1,5], [1,5,8,9] ], [ ["9223372036854775808","9223372036854775807"],["9223372036854775807","9223372036854775810"], "too big for IV", ["9223372036854775807","9223372036854775808","9223372036854775810"], ["9223372036854775807"], ["9223372036854775808"],["9223372036854775808","9223372036854775810"] ], [ ["10223372036854775808","-9223372036854775807"],["-9223372036854775807","10223372036854775810"], "range bigger than IV or UV", ["-9223372036854775807","10223372036854775808","10223372036854775810"], ["-9223372036854775807"], ["10223372036854775808"],["10223372036854775808","10223372036854775810"] ], [ [$bi1,$bi2],[$bi3,$bi2], "bigints", [$bi2,$bi1,$bi3],[$bi2],[$bi1],[$bi1,$bi3] ], # This tests that we sort correctly even when given strings that Perl # doesn't compare properly. This will fail if we try to use sort {$a<=>$b}. [ [$pr.6,$pr.5,$pr.7,$pr.4,$pr.8], [$pr.6,$pr.5,$pr.3], "mix 64-bit and 65-bit as strings", [map { $pr.$_ } 3..8], [$pr.5,$pr.6], [$pr.4,$pr.7,$pr.8], [$pr.3,$pr.4,$pr.7,$pr.8] ], ); # Inputs in proper set form (numerically sorted with no duplicates). my @sets = ( [ [0,1,2], [2,3,4], "simple unsigned", [0,1,2,3,4], [2], [0,1], [0,1,3,4] ], [ [0,1,2], [0,2,3,4], "simple unsigned", [0,1,2,3,4], [0,2], [1], [1,3,4] ], [ [], [1,2,3], "empty first list", [1,2,3], [], [], [1,2,3] ], [ [1,2,3], [], "empty second list", [1,2,3], [], [1,2,3], [1,2,3] ], [ [], [], "empty lists", [], [], [], [] ], [ [-5..1],[-1..5], "signed overlap", [-5..5],[-1..1],[-5..-2],[-5..-2,2..5] ], [ ["-9223372036854775807","10223372036854775808"],["-9223372036854775807","10223372036854775810"], "range bigger than IV or UV", ["-9223372036854775807","10223372036854775808","10223372036854775810"], ["-9223372036854775807"], ["10223372036854775808"],["10223372036854775808","10223372036854775810"] ], # More sign overlap [ [-20,-16,-14,-12,-10,0,12,14], [-30,-18,-14,-11,-10,-8,1,13,14], "sign overlap", [qw/-30 -20 -18 -16 -14 -12 -11 -10 -8 0 1 12 13 14/], [qw/-14 -10 14/], [qw/-20 -16 -12 0 12/], [qw/-30 -20 -18 -16 -12 -11 -8 0 1 12 13/] ], ); # Sets equal disjoint subset psubset pintersection my @set2 = ( [ [], [], "empty sets", [1,1,1,0,0] ], [ [1,2,3], [], "set and empty set", [0,1,1,1,0] ], [ [], [1,2,3], "empty set and set", [0,1,0,0,0] ], [ [-10..10], [-5..5], "proper subset", [0,0,1,1,0] ], [ [-10..10], [-10..10], "equal set", [1,0,1,0,0] ], [ [5..8], [4..7], "overlapping set", [0,0,0,0,1] ], [ [5..8], [1..3], "disjoint set", [0,1,0,0,0] ], [ ["-9223372036854775807"], [0], "big neg int", [0,1,0,0,0] ], [ ["18446744073709551615"], ["18446744073709551616"], "big pos int", [0,1,0,0,0] ], [ ["18446744073709551615","18446744073709551616"], ["18446744073709551616"], "big pos int subset", [0,0,1,1,0] ], ); plan tests => 2 # specific tests + 1 # toset + 4 # union etc. on sets and lists + 1 + 1 # sidon and sumfree + 1 # setcontains + 1 # setcontainsany + 1 # setinsert + 1 # set_is_subset + 7 # equal, disjoint, etc. + 1 # setremove + 1 # setinvert + 0; ###### some specific tests is_deeply(setunion([1,2,3],[-11,-5,10]),[-11,-5,1,2,3,10],"setunion signed properly sorted"); is_deeply(setdelta([7,1,3,5,1], [3,7,8,3,9]), [1,5,8,9], "setdelta with unsorted and dups works" ); subtest 'toset', sub { is_deeply( toset(),[],"toset: empty list" ); is_deeply( toset(1),[1],"toset: one value" ); is_deeply( toset(3,-2,1,3,3,-14),[-14,-2,1,3],"toset: simple" ); is_deeply( toset(qw/1 -2147483647 3 2 2147483648/), [qw/-2147483647 1 2 3 2147483648/], "toset: 32-bit mix of sign and unsigned" ); is_deeply( stoset(qw/1 -9223372036854775807 3 2 9223372036854775808/), [qw/-9223372036854775807 1 2 3 9223372036854775808/], "toset: 64-bit mix of sign and unsigned" ); is_deeply( stoset(qw/9223372036854775812 9223372036854775809 9223372036854775810 9223372036854775811/), [qw/9223372036854775809 9223372036854775810 9223372036854775811 9223372036854775812/], "toset: 63-bit values should be sorted correctly" ); { my $b = powint(2,129); my @L = map { addint($b,$_) } (-2,3,0,0,-2,0,3); my @R = map { "".addint($b,$_) } (-2,0,3); is_deeply( stoset(@L), \@R, "toset: 129-bit unsigned inputs" ); } }; subtest 'union', sub { for my $info (@sets) { my($x,$y,$str,$aunion,$ainter,$aminus,$adelta) = @$info; is_deeply( setunion($x,$y), $aunion, $str ); } for my $info (@vecs) { my($x,$y,$str,$aunion,$ainter,$aminus,$adelta) = @$info; my($got,$exp) = map { [sort map {"$_"} @$_] } (setunion($x,$y), $aunion); is_deeply($got, $exp, "vec $str"); } }; subtest 'intersect', sub { for my $info (@sets) { my($x,$y,$str,$aunion,$ainter,$aminus,$adelta) = @$info; is_deeply( setintersect($x,$y), $ainter, $str ); } for my $info (@vecs) { my($x,$y,$str,$aunion,$ainter,$aminus,$adelta) = @$info; my($got,$exp) = map { [sort map {"$_"} @$_] } (setintersect($x,$y), $ainter); is_deeply($got, $exp, "vec $str"); } }; subtest 'minus (difference)', sub { for my $info (@sets) { my($x,$y,$str,$aunion,$ainter,$aminus,$adelta) = @$info; is_deeply( setminus($x,$y), $aminus, $str ); } for my $info (@vecs) { my($x,$y,$str,$aunion,$ainter,$aminus,$adelta) = @$info; my($got,$exp) = map { [sort map {"$_"} @$_] } (setminus($x,$y), $aminus); is_deeply($got, $exp, "vec $str"); } }; subtest 'delta (symmetric difference)', sub { for my $info (@sets) { my($x,$y,$str,$aunion,$ainter,$aminus,$adelta) = @$info; is_deeply( setdelta($x,$y), $adelta, $str ); } for my $info (@vecs) { my($x,$y,$str,$aunion,$ainter,$aminus,$adelta) = @$info; my($got,$exp) = map { [sort map {"$_"} @$_] } (setdelta($x,$y), $adelta); is_deeply($got, $exp, "vec $str"); } }; ###### setcomplement #is_deeply([setcomplement([1,3,5],0,8)], [0,2,4,6,7,8], "setcomplement 0..8"); #is_deeply([setcomplement([1,3,5],-2,8)], [-2,-1,0,2,4,6,7,8], "setcomplement -2..8"); #is_deeply([setcomplement([],0,5)], [0..5], "setcomplement 0..5 with empty set"); #is_deeply([setcomplement([],0,5)], [0..5], "setcomplement 0..5 with empty set"); #is_deeply([setcomplement([0..5],6,8)], [6..8], "setcomplement 0..5 with 6..8"); #is_deeply([setcomplement(["-9223372036854775810","-9223372036854775806"],"-9223372036854775810","-9223372036854775806")], ["-9223372036854775809","-9223372036854775808","-9223372036854775807"], "setcomplement crossing IV"); #is_deeply([setcomplement(["18446744073709551614","18446744073709551617"],"18446744073709551614","18446744073709551617")], ["18446744073709551615","18446744073709551616"], "setcomplement crossing UV"); subtest 'is_sidon_set', sub { my @sidons = ( [], [0], [0,1], [0,1,3], [0,1,4,6], [0,1,4,9,11], [0,1,4,10,12,17], [0,1,8,11,13,17], [qw/239 106 56 53 161/],[qw/9 10 1 3 14/], [qw/18446744073709551614 18446744073709551612 18446744073709551606/], [qw/0 5 20 51 57 83 136 169 196 292 425 434 544 586 786 910 1016 1187 1210 1228 1350 1369 1405 1453 1507 1760 1785 1850 1920 1964 2130 2223 2237 2318 2352 2390 2429 2439 2533 2601 2609 2622 2683 2808 2848 2870 2872 2917 2928 2945 3016 3045 3075 3229 3230 3321 3356 3576 3579 3677 3684 3727 3901 3905 3917/], ); my @nonsidons = ( [2,7,12], [1,10,11,12], [2,5,13,21,26], [0,1,4,10,12,16], [-1], [0,-1],[-9,17], ); is_deeply( [map { is_sidon_set($_) } @sidons], [map { 1 } 0..$#sidons], "Sidon sets" ); is_deeply( [map { is_sidon_set($_) } @nonsidons], [map { 0 } 0..$#nonsidons], "non-Sidon sets" ); }; subtest 'is_sumfree_set', sub { my @sf = ( [], [1], [~0], [10,25], [3,24,28], [1,7,16,31], [7,11,15,12,13], [2],[2,3],[2,3,7],[2,3,7,11],[2,3,7,11,15], [-2,-5,8],[-1,2,10,-5], [12,1000000,2147483647],[12,1000000,2147483648], [12,-1073741824],[12,-1073741825], [12,2147483648,"9223372036854775807"],[12,2147483648,"9223372036854775808"], [12,"-4611686018427387904"],[12,"-4611686018427387905"], ); my @nsf = ( [0], [8,16], [3,8,11], [4,5,25,30],[3,8,9,14,23], [15,-14,1],[-5,8,-13,5], [2,1],[2,3,5],[2,3,7,9],[2,3,7,11,13], [-1073741824,-536870912,536870912,1073741824], [qw/2149735939 922201092 418574715 4154626798 2077313399/], ); is_deeply( [map { is_sumfree_set($_) } @sf], [map { 1 } 0..$#sf], "sumfree sets" ); is_deeply( [map { is_sumfree_set($_) } @nsf], [map { 0 } 0..$#nsf], "non-sumfree sets" ); }; ###### setcontains subtest 'setcontains', sub { is( setcontains([],[]), 1, "empty set contains empty set"); is( setcontains([1],[]), 1, "regular set contains empty set"); is( setcontains([],[1]), 0, "empty set does not contain regular set"); is( setcontains([1,3,5,8],[1,3,5]), 1, "setcontains basic true"); is( setcontains([1,3,5,8],[3,5,9]), 0, "setcontains basic false"); is( setcontains([1,8],[1,8,9]), 0, "setcontains with bigger subset"); is( setcontains([1..8],[-5..-1]), 0, "setcontains with smaller subset"); is( setcontains([1..8],[-5..-1]), 0, "setcontains with smaller subset"); is( setcontains([-5..5],[-7..-3]), 0, "setcontains with small bottom overlap"); is( setcontains([-5..5],[3..8]), 0, "setcontains with small top overlap"); is( setcontains([-5..5],[-3..3]), 1, "setcontains both signs subset true"); is( setcontains([-5..5],[-1..6]), 0, "setcontains both signs subset false"); is( setcontains([-5..-1],[-5,-3,-1]), 1, "setcontains neg true"); is( setcontains([-5..-1],[-6,-4,-2]), 0, "setcontains neg false"); my $ivpos = subint(powint(2,63),1000000); my $ivneg = negint($ivpos); my $uvpos = addint(powint(2,63),1000000); my $uvneg = negint($uvpos); # mix large IVs near min/max is( setcontains([$ivneg,$ivpos],[$ivneg]), 1, "setcontains ivneg 1"); is( setcontains([$ivneg,$ivpos],[$ivpos]), 1, "setcontains ivneg 2"); is( setcontains([$ivpos],$ivneg), 0, "setcontains ivneg 3"); is( setcontains([$ivneg],$ivneg), 1, "setcontains ivneg 4"); is( setcontains([$ivpos],$ivpos), 1, "setcontains ivneg 5"); is( setcontains([$ivneg],$ivpos), 0, "setcontains ivneg 6"); # mix negative IV and positive UV is( setcontains([$ivneg,$uvpos],[$ivneg]), 1, "setcontains ivneg 1"); is( setcontains([$ivneg,$uvpos],[$uvpos]), 1, "setcontains ivneg 2"); is( setcontains([$uvpos],$ivneg), 0, "setcontains ivneg 3"); is( setcontains([$ivneg],$ivneg), 1, "setcontains ivneg 4"); is( setcontains([$uvpos],$uvpos), 1, "setcontains ivneg 5"); is( setcontains([$ivneg],$uvpos), 0, "setcontains ivneg 6"); # mix negative and positive both near 64-bit is( setcontains([$uvneg,$uvpos],[$uvneg]), 1, "setcontains uvneg 1"); is( setcontains([$uvneg,$uvpos],[$uvpos]), 1, "setcontains uvneg 2"); is( setcontains([$uvpos],$uvneg), 0, "setcontains uvneg 3"); is( setcontains([$uvneg],$uvneg), 1, "setcontains uvneg 4"); is( setcontains([$uvpos],$uvpos), 1, "setcontains uvneg 5"); is( setcontains([$uvneg],$uvpos), 0, "setcontains uvneg 6"); is( setcontains([$uvneg],-1000000), 0, "setcontains uvneg 7"); is( setcontains([1,3,5,8],$bi1), 0, "setcontains bigint false"); is( setcontains([$bi2,$bi3],$bi1), 0, "setcontains bigint false"); is( setcontains([$bi1,$bi3],$bi1), 1, "setcontains bigint true"); is( setcontains([$bi1,$bi3],[]), 1, "setcontains bigint empty set"); is( setcontains([$bi1,$bi3],[1]), 0, "setcontains bigint false"); is( setcontains([$bi1,$bi3],[$bi2]), 0, "setcontains bigint false"); is( setcontains([$bi1,$bi2],[$bi2]), 1, "setcontains bigint true"); # List arg works even unordered and with duplications is(setcontains([1..8],5,4,5,1,3), 1, "setcontains with list"); # Cover big sets { my @odd = map { 2*$_+1 } 0..300; is( setcontains(\@odd,[2,4,8,16,32,64,128]), 0, "odds < 600 does not contain an even set"); is( setcontains(\@odd,[1,3,7,15,31,63,127]), 1, "odds < 600 contains an odd set"); } }; subtest 'setcontainsany', sub { is( setcontainsany([],[]), 0, "empty set has no elements of empty set"); is( setcontainsany([1],[]), 0, "regular set has no elements of empty set"); is( setcontainsany([],[1]), 0, "empty set has no elements of other set"); is( setcontainsany([1,3,5,8],1), 1, "setcontainsany scalar true"); is( setcontainsany([1,3,5,8],4), 0, "setcontainsany scalar false"); is( setcontainsany([1,3,5,8],[1,3,12]), 1, "setcontainsany basic true"); is( setcontainsany([1,3,5,8],[2,4,7]), 0, "setcontainsany basic false"); is( setcontainsany([-5..-1],[-3]), 1, "setcontainsany neg true"); is( setcontainsany([-5..-1],[-65536]), 0, "setcontainsany neg false"); }; subtest 'setinsert', sub { my @insert_refs = ( [ [], [], "insert nothing into nothing" ], [ [1,3,5], [], "insert nothing" ], [ [-10,0,10], [-9], "single element list middle" ], [ [-10,0,10], [-1,1], "two element list" ], [ [-10,0,10], [-11,-9,-1,1,9,11], "list on all sides" ], [ [-10,0,10], [-100,-90], "list on front" ], [ [-10,0,10], [90,100], "list on back" ], [ [15,17,19,22,24], [18,20,21], "inserts into middle" ], [ [15,17,19,22,24], [14,20,25], "inserts into front, middle, back" ], [ [negint(powint(2,63)),0], [10,100,1000], "negative set, add small pos" ], [ [negint(powint(2,63)),0], [10,100,addint(powint(2,63),1000)], "negative set, add big pos" ], [ [101..200], [95..105,195..205], "insert overlapping edges" ], ); for my $test (@insert_refs) { my($s,$v,$what) = @$test; my $exp = stoset(@$s,@$v); setinsert($s,$v); is_deeply( [map{"$_"}@$s], $exp, "insert a set: $what" ); } my @insert_lists = ( [ [], [], "insert nothing into nothing" ], [ [1,3,5], [], "insert nothing" ], [ [1,3,5], [0], "insert at start" ], [ [1,3,5], [7], "insert at end" ], [ [1,3,5], [2], "insert in middle" ], [ [1,3,5], [4], "insert in middle" ], [ [1,3,5], [1], "duplicate" ], [ [1,3,5], [3], "duplicate" ], [ [1,3,5], [-12], "negative entries ok" ], [ [-12,1,3,5], [-11], "negative entries ok" ], [ [], ["-9223372037410331363"], "insert negative 64-bit int" ], [ [], [ "9223372037410331363"], "insert positive 64-bit int" ], [ [1,3,5], [6,4,4,6,4,4,4], "list with duplicates" ], ); for my $test (@insert_lists) { my($s,$v,$what) = @$test; my $exp = stoset(@$s,@$v); setinsert($s,@$v); is_deeply( [map{"$_"}@$s], $exp, "insert a list: $what" ); } { my $S = [1..500]; setinsert($S,[501..1000]); is_deeply($S,[1..1000],"insert many integers at once"); } }; subtest 'set_is_subset', sub { is_deeply( [ set_is_subset([1,2,3],[3,1]), set_is_subset([1,2,3],[]), set_is_subset([~0],[]), ], [1,1,1], "Basic subset tests" ); is_deeply( [ set_is_subset([],[]), set_is_subset([0],[0]), set_is_subset([1,2,3],[1,2,3]), set_is_subset([~0],[~0]), set_is_subset(["-9223372036854775807"],["-9223372036854775807"]), set_is_subset(["-9223372036854775808"],["-9223372036854775808"]), set_is_subset(["18446744073709551615"],["18446744073709551615"]), set_is_subset([0,"18446744073709551615"],[0,"18446744073709551615"]), set_is_subset(["-9223372036854775808",0,"18446744073709551615"],["-9223372036854775808",0,"18446744073709551615"]), ], [1,1,1,1,1,1,1,1,1], "Every list is a subset of itself" ); is_deeply( [ set_is_subset([qw/4 12 14 17 18 19 20/],[14,17,18]), ], [1], "Test some subsets"); is_deeply( [ set_is_subset([1,2,3],[0]), set_is_subset([1,2,3],[~0]), set_is_subset(["-9223372036854775808"],["18446744073709551615"]), set_is_subset([-1],["18446744073709551615"]), set_is_subset([2,3,5,8],[2,3,5,7]), set_is_subset([qw/2 5 8 11 12 13 17 18 20/],[14,17,18]), ], [0,0,0,0,0,0], "Test some non-subsets"); }; subtest 'set_is_equal', sub { for my $info (@set2) { my($s,$t,$str,$exp) = @$info; is( set_is_equal($s,$t), $exp->[0], $str ); } }; subtest 'set_is_disjoint', sub { for my $info (@set2) { my($s,$t,$str,$exp) = @$info; is( set_is_disjoint($s,$t), $exp->[1], $str ); } }; subtest 'set_is_subset', sub { for my $info (@set2) { my($s,$t,$str,$exp) = @$info; is( set_is_subset($s,$t), $exp->[2], $str ); } }; subtest 'set_is_superset', sub { for my $info (@set2) { my($s,$t,$str,$exp) = @$info; is( set_is_superset($t,$s), $exp->[2], $str ); } }; subtest 'set_is_proper_subset', sub { for my $info (@set2) { my($s,$t,$str,$exp) = @$info; is( set_is_proper_subset($s,$t), $exp->[3], $str ); } }; subtest 'set_is_proper_superset', sub { for my $info (@set2) { my($s,$t,$str,$exp) = @$info; is( set_is_proper_superset($t,$s), $exp->[3], $str ); } }; subtest 'set_is_proper_intersection', sub { for my $info (@set2) { my($s,$t,$str,$exp) = @$info; is( set_is_proper_intersection($s,$t), $exp->[4], $str ); } is(set_is_proper_intersection([1,2],[1,3]), 1, "[1,2] and [1,3]"); }; subtest 'setremove', sub { my @remove_refs = ( [ [], [], 0, [], "empty sets" ], [ [1,2,3], [], 0, [1,2,3], "remove empty set" ], [ [1,2,3], [2], 1, [1,3], "remove middle element" ], [ [1,2,3], [0], 0, [1,2,3], "remove non element" ], [ [1,2,3], [1], 1, [2,3], "remove first element" ], [ [1,2,3], [1,2,3], 3, [], "remove all elements" ], [ [1..8], [-4,6,9], 1, [1..5,7,8], "remove mix" ], [ [5], [5], 1, [], "remove single aref to empty" ], ); for my $test (@remove_refs) { my($A,$B,$exp,$NEWA,$what) = @$test; my $res = setremove($A,$B); is_deeply( [$res,$A], [$exp,$NEWA], $what ); } my @remove_lists = ( [ [], [], 0, [], "empty sets" ], [ [1,2,3], [3,2,1], 3, [], "remove all elements" ], [ [1,2,3], [1,1,1], 1, [2,3], "list with duplicates" ], [ [5], [5], 1, [], "remove single scalar to empty" ], ); for my $test (@remove_lists) { my($A,$B,$exp,$NEWA,$what) = @$test; my $res = setremove($A,@$B); is_deeply( [$res,$A], [$exp,$NEWA], $what ); } }; subtest 'setinvert', sub { # # setinvert($A,$B) can be done via: # @$A = setdelta($A,$B); # # Or alternately: # @$A = setminus(setunion($A,$B),setintersect($A,$B)) # # 1. Invert $A with a set $B my @invert_refs = ( [ [], [], 0, [], "two empty sets" ], [ [1,2,3], [], 0, [1,2,3], "invert with an empty set" ], [ [1,2,3], [1], -1, [2,3], "invert with a small set" ], [ [1,2,3], [1,2,3],-3, [], "invert with duplicate set" ], [ [0..10], [5,10,15,20], 0, [0..4,6,7,8,9,15,20], "mixed set inversions" ], ); for my $test (@invert_refs) { my($A,$B,$exp,$NEWA,$what) = @$test; my $res = setinvert($A,$B); is_deeply( [$res,$A], [$exp,$NEWA], $what ); } # 2. Invert $A with an unordered list of integers my @invert_lists = ( [ [], [], 0, [], "empty set and empty list" ], [ [1,2,3], [], 0, [1,2,3], "invert with an empty list" ], [ [1,2,3], [2], -1, [1,3], "invert with single middle element" ], [ [1,2,3], [-12], 1, [-12,1,2,3], "invert with single non element" ], [ [1,2,3], [3,2,1],-3, [], "invert with a list of all elements" ], [ [1,2,3], [1,1], -1, [2,3], "list with duplicates" ], [ [0..10], [5,10,15,20], 0, [0..4,6,7,8,9,15,20], "mixed list inversions" ], ); for my $test (@invert_lists) { my($A,$B,$exp,$NEWA,$what) = @$test; my $res = setinvert($A,@$B); is_deeply( [$res,$A], [$exp,$NEWA], $what ); } }; sub stoset { return [map {"$_"} @{toset(@_)}]; } # stringify the set Math-Prime-Util-0.74/t/19-legendrephi.t000644 000765 000024 00000001706 14056645657 017563 0ustar00danastaff000000 000000 #!/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], [4000,255,296], ); 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.74/t/19-gcd.t000644 000765 000024 00000005533 14424345103 016012 0ustar00danastaff000000 000000 #!/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], [ [-5], 5], [ [-5,5], 5], [ [-5,7], 1], ); my @lcms = ( [ [], 1], [ [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], [ [-5], 5], [ [-5,5], 5], [ [-5,7], 35], ); 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.74/t/51-randfactor.t000644 000765 000024 00000001201 13667653334 017400 0ustar00danastaff000000 000000 #!/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.74/t/97-synopsis.t000644 000765 000024 00000000644 13025437630 017153 0ustar00danastaff000000 000000 #!/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.74/t/20-primorial.t000644 000765 000024 00000004270 15146553566 017260 0ustar00danastaff000000 000000 #!/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.74/t/12-nextprime.t000644 000765 000024 00000011436 15146553566 017300 0ustar00danastaff000000 000000 #!/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.74/t/29-mersenne.t000644 000765 000024 00000001114 13025437630 017064 0ustar00danastaff000000 000000 #!/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.74/t/15-probprime.t000644 000765 000024 00000011730 15151734725 017256 0ustar00danastaff000000 000000 #!/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.74/t/022-can-ntheory.t000644 000765 000024 00000000222 13025437630 017547 0ustar00danastaff000000 000000 #!/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.74/t/26-isfundamental.t000644 000765 000024 00000001453 15146553566 020122 0ustar00danastaff000000 000000 #!/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("147573952589676413001"), 1, "is_fundamental(2^67+73)" ); is( is_fundamental("-147573952589676412911"), 1, "is_fundamental(-2^67+17)" ); Math-Prime-Util-0.74/t/26-pisano.t000644 000765 000024 00000003027 15146553566 016560 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/pisano_period factorial/; 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 @tests = ( [28657, 92], # F_23 [64079, 46], # L_23 [3590807, 3264380], [3628800, 86400], ["2980232238769531250","17881393432617187500"], ["14901161193847656250","89406967163085937500"], ["74505805969238281250","447034835815429687500"], ); my @pisano = (qw/0 1 3 8 6 20 24 16 12 24 60 10 24 28 48 40 24 36 24 18 60 16 30 48 24 100 84 72 48 14 120 30 48 40 36 80 24 76 18 56 60 40 48 88 30 120 48 32 24 112 300 72 84 108 72 20 48 72 42 58 120 60 30 48 96 140 120 136 36 48 240 70 24 148 228 200 18 80 168 78 120 216 120 168 48 180 264 56 60 44 120 112 48 120 96 180 48 196 336 120 300 50 72 208 84 80 108 72 72 108 60 152 48 76 72 240 42 168 174 144 120 110 60 40 30 500 48 256 192 88 420 130 120 144 408 360 36 276 48 46 240 32 210 140 24 140 444 112 228 148 600 50 36 72 240 60 168 316 78 216 240 48 216 328 120 40 168 336 48 364 180 72 264 348 168 400 120 232 132 178 120/); plan tests => 1 + scalar(@tests) + 1 ; is_deeply([map {pisano_period($_)} 0..180], \@pisano, "pisano_period(0..180)"); for my $data (@tests) { my($n,$exp) = @$data; is("".pisano_period($n), $exp, "pisano_period($n) = $exp"); } is("".pisano_period(factorial(30)), "204996473853050880000000", "pisano_period(30!)"); Math-Prime-Util-0.74/t/19-moebius.t000644 000765 000024 00000010032 15146553566 016726 0ustar00danastaff000000 000000 #!/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, 444444 => -37, 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, 3*10**10 => 42411, 4*10**10 => -25295, 10**11 => -87856, ); } # 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 + 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" ); # near end points is_deeply([[moebius(4294967293,4294967295)], [moebius(4294967293,4294967296)], [moebius(4294967295,4294967297)], [moebius(4294967296,4294967298)]], [[1,1,-1],[1,1,-1,0],[-1,0,1],[0,1,-1]], "moebius ranges around 2^32"); SKIP: { skip "ranges around 2^64 only on 64-bit",1 unless $use64; is_deeply([[moebius("18446744073709551613","18446744073709551615")], [moebius("18446744073709551613","18446744073709551616")], [moebius("18446744073709551615","18446744073709551617")]], [[-1,0,-1],[-1,0,-1,0],[-1,0,1]], "moebius ranges around 2^64"); } { 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.74/t/18-24-powint.t000644 000765 000024 00000003337 15152432373 017024 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/powint negint/; my @vals = ( [5, 6, 15625], [2, 16, 65536], [-544, 7, "-14099129446552305664"], [4294967295, 2, "18446744065119617025"], [2097152, 3, "9223372036854775808"], [2097153, 3, "9223385231000600577"], [65535, 4, "18445618199572250625"], [65536, 4, "18446744073709551616"], [4096, 5, "1152921504606846976"], [4097, 5, "1154329566852960257"], [16, 13, "4503599627370496"], [17, 13, "9904578032905937"], [8, 17, "2251799813685248"], [9, 17, "16677181699666569"], ); plan tests => 7 + 1 + 4 + 6 + 2; ###### powint for my $a (-3 .. 3) { my @got = map { powint($a, $_) } 0..3; my @exp = (1, $a, $a*$a, $a*$a*$a); is_deeply( \@got, \@exp, "powint($a,0..3) = [@got] expect [@exp]" ); } is_deeply( [map { "".powint($_->[0],$_->[1]) } @vals], [map { $_->[2] } @vals], "powint a**b=c" ); is("".powint(powint(2,32),3),"79228162514264337593543950336","(2^32)^3"); is("".powint(3,powint(2,7)),"11790184577738583171520872861412518665678211592275841109096961","3^(2^7)"); ok(ref(powint(46,22)), "powint returns a bigint for 46,22"); ok(ref(powint(-544,7)), "powint returns a bigint for -544,7"); # --- Edge cases: 0^0, 0^n, 1^n, (-1)^n --- is(powint(0,0), 1, "0^0 = 1"); is(powint(0,1), 0, "0^1 = 0"); is(powint(0,5), 0, "0^5 = 0"); is(powint(1,0), 1, "1^0 = 1"); is(powint(1,100),1, "1^100 = 1"); is_deeply([map { powint(-1,$_) } 0..7], [1,-1,1,-1,1,-1,1,-1], "(-1)^n alternates 1,-1"); # --- Negative base parity --- { my($a,$b) = (-7, 6); is("".powint($a,$b), "".powint(-$a,$b), "(-7)^6 == 7^6 (even exp)"); is("".negint(powint(-$a,$b+1)), "".powint($a,$b+1), "(-7)^7 == -(7^7) (odd exp)"); } Math-Prime-Util-0.74/t/03-init.t000644 000765 000024 00000005540 15150344475 016217 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util qw/prime_precalc prime_memfree prime_get_config/; use Math::Prime::Util::MemFree; use Test::More tests => 3 + 3 + 3 + 6; # 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 $x = Math::Prime::Util::_to_bigint(0); } my $biclass = Math::Prime::Util::prime_get_config->{bigintclass}; my $diag = "" . ((Math::Prime::Util::prime_get_config->{xs}) ? "XS" : "PP") . ((Math::Prime::Util::prime_get_config->{gmp}) ? ", MPU::GMP $Math::Prime::Util::GMP::VERSION" : "") . ($biclass ? ", BI $biclass" : "") . ".\n"; diag $diag; my $init_size = prime_get_config->{'precalc_to'}; my $bigsize = $init_size + 50_000; 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.74/t/22-aks-prime.t000644 000765 000024 00000004615 15146553566 017157 0ustar00danastaff000000 000000 #!/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 $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $usegmp = Math::Prime::Util::prime_get_config->{'gmp'}; plan tests => 6 # range + 1 # small number + 2 # medium numbers + 1*$extra + 4 # Numbers for BERN41 version + 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. # These run the polynomial test with the V6 code is( is_aks_prime(69197), 1, "is_aks_prime(69197) is true" ); is( is_aks_prime(69199), 0, "is_aks_prime(69199) is false" ); if ($extra) { # A composite (product of two 3-digit primes) #is( is_aks_prime(370781), 0, "is_aks_prime(370781) is false" ); # A composite (product of two 4-digit primes) #is( is_aks_prime(37809463), 0, "is_aks_prime(37809463) is false" ); # A composite (product of two 5-digit primes) is( is_aks_prime(1262952907), 0, "is_aks_prime(1262952907) is false" ); } # With Bernstein 4.1, we need to use different numbers. # It is highly unlikely that a composite will even run the polynomial test. { is(is_aks_prime(101), 1, "is_aks_prime(101)=1"); is(is_aks_prime(15481), 0, "is_aks_prime(15481)=0"); is(is_aks_prime(12109), 1, "is_aks_prime(12109)=1"); SKIP: { skip "Skipping 29-bit prime in PP",1 unless $usexs; # 0.006 s XS 64-bit # 0.08 s XS 32-bit # 0.02 s GMP # 0.8 s 64-bit PP # 7m 50 s 32-bit PP (ouch) is(is_aks_prime(536891893), 1, "is_aks_prime(536891893)=1"); } } Math-Prime-Util-0.74/t/26-rootmod.t000644 000765 000024 00000015372 15152527253 016747 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/ sqrtmod allsqrtmod rootmod allrootmod /; my @sqrtmods = ( [ 0, 0, undef ], [ 1, 0, undef ], [ 0, 1, 0 ], [ 1, 1, 0 ], # prime moduli [ -1, 17, [4,13], 1 ], # github #51 [ 58, 101, [19,82], 1 ], [ 111, 113, [26,87], 1 ], [ 160, 461, undef ], [ 37, 999221, [9946,989275], 1 ], [ 30, 1000969, [89676,911293], 1 ], [ 2, 72388801, [20312446,52076355], 1 ], [ "9223372036854775808", "5675921253449092823", ["22172359690642254","5653748893758450569"], 1 ], [ "18446744073709551625", "1093717762081589963407", ["419016687038042104847","674701075043547858560"], 1 ], # composite moduli [ 30, 74, [20,54] ], [ 56, 1018, [458,560] ], [ 42, 979986, [356034,623952] ], [ 5, 301, undef ], [ 5, 302, [55,247] ], [ 5, 404, [45,157,247,359] ], [ 5, 400, undef ], [ 9, 400, [3,53,147,197,203,253,347,397] ], [ 15, 402, [45,357] ], [ 1242, 1849, [851, 998] ], # prime power [ 0, 4, [0,2] ], [ 1, 4, [1,3] ], [ 4, 8, [2,6] ], # github #52 [ 4, 16, [2,6,10,14] ], [ 0, 9, [0,3,6] ], [ 3, 9, undef ], [ 0, 27, [0,9,18] ], [ 9, 27, [3,6,12,15,21,24] ], [ 0, 36, [0,6,12,18,24,30] ], [ 4, 36, [2,16,20,34] ], [ 13556, 26076, undef ], [ 15347, 38565, undef ], [ 588,2912, undef ], [ 24684, 69944, [2138,17126,17846,32834,37110,52098,52818,67806] ], ); # Check: # p {prime, prime power, square-free composite, non-SF composite} # k {prime, prime power, square-free composite, non-SF composite} my @rootmods = ( # prime moduli [14,-3, 101, 17], [13, 6, 107, [24,83]], [13,-6, 107, [49,58]], [64, 6, 101, [2, 99]], [9, -2, 101, [34, 67]], [ 2, 3, 3, 2], [ 2, 3, 7, undef], [17, 29, 19, 6], [ 5, 3, 13, [7,8,11]], [53, 3, 151, [15,27,109]], [3,3,73, [25,54,67]], [7,3,73, [13,29,31]], [49,3,73, [12,23,38]], [44082,4,100003, [2003,98000]], [90594,6,100019, [37071,62948]], [6,5,31, [11,13,21,22,26]], [0,2,2, 0], [2,4,5, undef], [51,12,10009,[64,1203,3183,3247,3999,4807,5202,6010,6762,6826,8806,9945]], [15,3,"1000000000000000000117",[qw/72574612502199260377 361680004182786118804 565745383315014620936/]], [1,0,13, [0,1,2,3,4,5,6,7,8,9,10,11,12]], [2,0,13, undef], [0,5,0, undef], [0,-1,3, undef], # composite moduli. # Pari will usually give a *wrong* answer for these if using Mod(a,p). # The right way with Pari is to use p-adic. [ 4, 2, 10, [2,8]], [ 4, 2, 18, [2,16]], [ 2, 3, 21, undef], # Pari says 2 [ 8, 3, 27, [2,11,20]], # Pari says 26 [22, 3, 1505, [148,578,673,793,813,1103,1243,1318,1458] ], # Pari says 1408 [58787, 3, 100035, [3773,8633,10793,13763,19163,24293,26183,26588,31313,37118,41978,44138,47108,52508,57638,59528,59933,64658,70463,75323,77483,80453,85853,90983,92873,93278,98003]], [3748, 2, 4992, [154,262,314,518,730,934,986,1094,1402,1510,1562,1766,1978,2182,2234,2342,2650,2758,2810,3014,3226,3430,3482,3590,3898,4006,4058,4262,4474,4678,4730,4838]], [68,2,2048, [46,466,558,978,1070,1490,1582,2002]], [96,5,128, [6,14,22,30,38,46,54,62,70,78,86,94,102,110,118,126]], [2912,5,4992, [182,494,806,1118,1430,1742,2054,2366,2678,2990,3302,3614,3926,4238,4550,4862]], [ 2, 3, 4, undef], [ 3, 2, 4, undef], [ 3, 4, 19, undef], [ 1, 4, 20, [1,3,7,9,11,13,17,19]], [ 9, 2, 24, [3,9,15,21]], [ 6, 6, 35, undef], [ 36,2, 40, [6,14,26,34]], [ 16, 12, 48, [2,4,8,10,14,16,20,22,26,28,32,34,38,40,44,46]], [ 13, 6, 112, undef], [ 52, 6, 117, undef], [ 48, 3, 128, undef], [ 382, 3, 1000, undef], [ 10, 3, 81, [13,40,67]], [ 26, 5, 625, [81,206,331,456,581]], [ 51, 5, 625, [61,186,311,436,561]], ["9833625071",3,"10000000071", [qw/3333332807 6666666164 9999999521/]], #[2131968,5,10000000000, [...]], # Far too many [198,-1,519, undef], ); plan tests => 0 + scalar(@sqrtmods)*2 # sqrtmod / allsqrtmod + 5 # rootmod + scalar(@rootmods)*2 # allrootmod + 1 # more rootmod + 0; ###### sqrtmod foreach my $r (@sqrtmods) { my($a, $n, $exp, $prime) = @$r; if (!defined $exp) { is( sqrtmod($a,$n), $exp, "sqrtmod($a,$n) = "); is_deeply( [allsqrtmod($a,$n)], [], "allsqrtmod($a,$n) = ()"); } elsif (!ref($exp)) { is( "".sqrtmod($a,$n), $exp, "sqrtmod($a,$n) = $exp"); is_deeply( [map{"$_"}allsqrtmod($a,$n)], [$exp], "allsqrtmod($a,$n) = ($exp)"); } else { my $val = sqrtmod($a,$n); if ($prime) { # sqrtmod() must return least root for prime modulus is("$val", $exp->[0], "sqrtmod($a,$n) = $exp->[0]"); } else { ok( is_one_of($val, @$exp), "sqrtmod($a,$n) = $val, roots [@$exp]" ); } is_deeply([map{"$_"}allsqrtmod($a,$n)], $exp, "allsqrtmod($a,$n) = (@$exp)"); } } ###### rootmod { my(@out0,@out1); for my $a (0..3) { for my $k (0..3) { push @out0, "$a,$k,0" if defined rootmod($a,$k,0); push @out1, "$a,$k,1" unless iseq(0,rootmod($a,$k,1)); } } is(join(' ',@out0),'',"rootmod(a,k,0) should be undef"); is(join(' ',@out1),'',"rootmod(a,k,1) should be 0"); } { my(@out0,@out1,@out2); for my $a (0..19) { my $a17 = $a % 17; push @out0, "$a,0,17" if ($a17 == 1 && !iseq(1,rootmod($a,0,17))) || ($a17 != 1 && defined rootmod($a,0,17)); push @out1, "$a,1,17" unless iseq($a17,rootmod($a,1,17)); push @out2, "$a,2,17" unless iseq(sqrtmod($a,17), rootmod($a,2,17)); } is(join(' ',@out0),'',"rootmod(a,0,17) should be 1 or undef"); is(join(' ',@out1),'',"rootmod(a,1,17) should be a mod 17"); is(join(' ',@out2),'',"rootmod(a,2,17) should be sqrtmod(a,17)"); } foreach my $r (@rootmods) { my($a, $k, $n, $exp) = @$r; if (!defined $exp) { is( rootmod($a,$k,$n), $exp, "rootmod($a,$k,$n) = "); is_deeply( [allrootmod($a,$k,$n)], [], "allrootmod($a,$k,$n) = ()"); } elsif (!ref($exp)) { is( "".rootmod($a,$k,$n), $exp, "rootmod($a,$k,$n) = $exp"); is_deeply( [map{"$_"}allrootmod($a,$k,$n)], [$exp], "allrootmod($a,$k,$n) = ($exp)"); } else { my $val = rootmod($a,$k,$n); ok( is_one_of($val, @$exp), "rootmod($a,$k,$n) = $val, roots [@$exp]" ); is_deeply([map{"$_"}allrootmod($a,$k,$n)], $exp, "allrootmod($a,$k,$n) = (@$exp)"); } } # is(powmod(rootmod(12,41,1147),41,1147), 12, "41st root of 12 mod 1147 is correct"); is(rootmod(12,41,1147),1106, "41st root of 12 mod 1147 is correct"); # Example with 383 roots: # say scalar allrootmod(32247425005, 383, 64552988163); sub is_one_of { my($n, @list) = @_; if (defined $n) { for (@list) { return 1 if defined $_ && "$n" eq $_; } } else { for (@list) { return 1 if !defined $_; } } 0; } # sub iseq { vecequal([$_[0]],[$_[1]]); } sub iseq { # numerical comparison allowing undef = undef my($x,$y) = @_; return 1 if !defined $x && !defined $y; return 0 if !defined $x || !defined $y; $x == $y; } Math-Prime-Util-0.74/t/34-random.t000644 000765 000024 00000016271 13667653334 016553 0ustar00danastaff000000 000000 #!/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.74/t/26-mex.t000644 000765 000024 00000002272 14402563240 016041 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/vecmex vecpmex powint forpart/; plan tests => 0 + 8 # vecmex + 8 # vecpmex + 1 # vecpmex + 0; ###### vecmex is(vecmex(), 0, "vecmex() = 0"); is(vecmex(0), 1, "vecmex(0) = 1"); is(vecmex(1), 0, "vecmex(1) = 0"); is(vecmex(1,2,4), 0, "vecmex(1,2,4) = 0"); is(vecmex(0,1,2,4), 3, "vecmex(0,1,2,4) = 3"); is(vecmex(0,1,24,4), 2, "vecmex(0,1,24,4) = 2"); is(vecmex(4,2,1,0), 3, "vecmex(4,2,1,0) = 3"); is(vecmex(3,powint(10,20),0,2), 1, "vecmex(3,10^20,0,2) = 1"); ###### vecpmex is(vecpmex(), 1, "vecpmex() = 1"); is(vecpmex(1), 2, "vecpmex(1) = 2"); is(vecpmex(2), 1, "vecpmex(2) = 1"); is(vecpmex(2,3,5), 1, "vecpmex(2,3,5) = 1"); is(vecpmex(1,2,3,5), 4, "vecpmex(1,2,3,5) = 4"); is(vecpmex(1,2,24,5), 3, "vecpmex(1,2,24,5) = 3"); is(vecpmex(5,3,2,1), 4, "vecpmex(5,3,2,1) = 4"); is(vecpmex(4,powint(10,20),1,3), 2, "vecpmex(4,10^20,1,3) = 2"); ###### A022567 # See https://arxiv.org/pdf/2303.05332.pdf sub sigmamex { my $s=0; forpart { $s += vecpmex(@_); } $_[0]; $s; } is_deeply([map { sigmamex($_) } 1..10], [2,3,6,9,14,22,32,46,66,93], "sigmaxmex(1..10)"); Math-Prime-Util-0.74/t/26-rationaltrees.t000644 000765 000024 00000021351 15153473604 020133 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/next_calkin_wilf next_stern_brocot calkin_wilf_n stern_brocot_n nth_calkin_wilf nth_stern_brocot nth_stern_diatomic farey next_farey farey_rank/; my $extended = $ENV{EXTENDED_TESTING}; my @CW = ([1,1],[1,2],[2,1],[1,3],[3,2],[2,3],[3,1],[1,4],[4,3],[3,5],[5,2],[2,5],[5,3],[3,4],[4,1],[1,5],[5,4],[4,7],[7,3],[3,8],[8,5],[5,7],[7,2],[2,7],[7,5],[5,8],[8,3],[3,7],[7,4],[4,5],[5,1],[1,6],[6,5],[5,9],[9,4],[4,11],[11,7],[7,10],[10,3],[3,11],[11,8],[8,13],[13,5],[5,12],[12,7],[7,9],[9,2],[2,9],[9,7],[7,12],[12,5],[5,13],[13,8],[8,11],[11,3],[3,10],[10,7],[7,11],[11,4],[4,9],[9,5],[5,6],[6,1],[1,7],[7,6],[6,11],[11,5],[5,14],[14,9],[9,13],[13,4],[4,15],[15,11],[11,18],[18,7],[7,17],[17,10],[10,13],[13,3],[3,14],[14,11],[11,19],[19,8],[8,21],[21,13],[13,18],[18,5],[5,17],[17,12],[12,19],[19,7],[7,16],[16,9],[9,11],[11,2],[2,11],[11,9],[9,16],[16,7],[7,19]); my @SB = ([1,1],[1,2],[2,1],[1,3],[2,3],[3,2],[3,1],[1,4],[2,5],[3,5],[3,4],[4,3],[5,3],[5,2],[4,1],[1,5],[2,7],[3,8],[3,7],[4,7],[5,8],[5,7],[4,5],[5,4],[7,5],[8,5],[7,4],[7,3],[8,3],[7,2],[5,1],[1,6],[2,9],[3,11],[3,10],[4,11],[5,13],[5,12],[4,9],[5,9],[7,12],[8,13],[7,11],[7,10],[8,11],[7,9],[5,6],[6,5],[9,7],[11,8],[10,7],[11,7],[13,8],[12,7],[9,5],[9,4],[12,5],[13,5],[11,4],[10,3],[11,3],[9,2],[6,1],[1,7],[2,11],[3,14],[3,13],[4,15],[5,18],[5,17],[4,13],[5,14],[7,19],[8,21],[7,18],[7,17],[8,19],[7,16],[5,11],[6,11],[9,16],[11,19],[10,17],[11,18],[13,21],[12,19],[9,14],[9,13],[12,17],[13,18],[11,15],[10,13],[11,14],[9,11],[6,7],[7,6],[11,9],[14,11],[13,10],[15,11]); plan tests => 4 + ($extended ? 1 : 0); subtest 'Calkin-Wilf tree' => sub { my @data = ( # n d idxCW [4, 11, 36], [22,7,519], [37,53,1990], [144,233,2730], [83116,51639,123456789], [64,65,"36893488147419103230"], [66,65,"36893488147419103233"], [32,1,4294967295], [64,1,"18446744073709551615"], ["228909276746","645603216423","1054982144710410407556"], ); # next_calkin_wilf: generate first 100 terms my @s=([1,1]); push @s, [next_calkin_wilf($s[-1]->[0],$s[-1]->[1])] for 1..99; is_deeply( \@s, \@CW, "next_calkin_wilf first 100 terms" ); # calkin_wilf_n: index of first 100 terms my @idx; push @idx, calkin_wilf_n($_->[0],$_->[1]) for @CW; is_deeply( \@idx, [1..100], "calkin_wilf_n first 100 terms" ); # nth_calkin_wilf: recover first 100 terms from index my @nth; push @nth,[nth_calkin_wilf($_)] for 1..100; is_deeply( \@nth, \@CW, "nth_calkin_wilf first 100 terms" ); # Roundtrip on selected larger values for my $t (@data) { my($n,$d,$idx) = @$t; is( "".calkin_wilf_n($n,$d), "$idx", "calkin_wilf_n($n,$d) = $idx" ); is_deeply( [map{"$_"}nth_calkin_wilf($idx)], ["$n","$d"], "nth_calkin_wilf($idx) = ($n,$d)" ); } }; subtest 'Stern-Brocot tree' => sub { my @data = ( # n d idxSB [4, 11, 36], [22,7,960], [37,53,1423], [144,233,2730], [83116,51639,111333227], [64,65,"27670116110564327423"], [66,65,"55340232221128654848"], [32,1,4294967295], [64,1,"18446744073709551615"], ["228909276746","645603216423","667408827216638861715"], ); # next_stern_brocot: generate first 100 terms my @s=([1,1]); push @s, [next_stern_brocot($s[-1]->[0],$s[-1]->[1])] for 1..99; is_deeply( \@s, \@SB, "next_stern_brocot first 100 terms" ); # stern_brocot_n: index of first 100 terms my @idx; push @idx, stern_brocot_n($_->[0],$_->[1]) for @SB; is_deeply( \@idx, [1..100], "stern_brocot_n first 100 terms" ); # nth_stern_brocot: recover first 100 terms from index my @nth; push @nth,[nth_stern_brocot($_)] for 1..100; is_deeply( \@nth, \@SB, "nth_stern_brocot first 100 terms" ); # Roundtrip on selected larger values for my $t (@data) { my($n,$d,$idx) = @$t; is( "".stern_brocot_n($n,$d), "$idx", "stern_brocot_n($n,$d) = $idx" ); is_deeply( [map{"$_"}nth_stern_brocot($idx)], ["$n","$d"], "nth_stern_brocot($idx) = ($n,$d)" ); } }; subtest 'Stern diatomic (fusc)' => sub { my @A002487 = (0,1,1,2,1,3,2,3,1,4,3,5,2,5,3,4,1,5,4,7,3,8,5,7,2,7,5,8,3,7,4,5,1,6,5,9,4,11,7,10,3,11,8,13,5,12,7,9,2,9,7,12,5,13,8,11,3,10,7,11,4,9,5,6,1,7,6,11,5,14,9,13,4,15,11,18,7,17,10,13,3,14,11,19,8,21,13,18,5,17,12,19); my @fuscs = ( # A212288 selected values [4691,257], [87339,2312], [1222997,13529], [9786539,57317], [76895573,238605], [357214891,744095], [1431655083,1948354], [5726623019,5102687], [22906492075,13354827], [91625925291,34961522], ); # First terms of A002487 my @s = map { nth_stern_diatomic($_) } 0 .. $#A002487; is_deeply( \@s, \@A002487, "A002487 first terms" ); # Selected larger values for my $t (@fuscs) { is( nth_stern_diatomic($t->[0]), $t->[1], "fusc($t->[0]) = $t->[1]" ); } # Edge cases is( nth_stern_diatomic(0), 0, "fusc(0) = 0" ); is( nth_stern_diatomic(1), 1, "fusc(1) = 1" ); # Recurrence: fusc(2n) = fusc(n), fusc(2n+1) = fusc(n) + fusc(n+1) for my $n (1..45) { is( nth_stern_diatomic(2*$n), nth_stern_diatomic($n), "fusc(2*$n) = fusc($n)" ); is( nth_stern_diatomic(2*$n+1), nth_stern_diatomic($n) + nth_stern_diatomic($n+1), "fusc(2*$n+1) = fusc($n)+fusc($n+1)" ); } }; subtest 'Farey sequences' => sub { my @Farey = ( undef, [[0,1],[1,1]], [[0,1],[1,2],[1,1]], [[0,1],[1,3],[1,2],[2,3],[1,1]], [[0,1],[1,4],[1,3],[1,2],[2,3],[3,4],[1,1]], [[0,1],[1,5],[1,4],[1,3],[2,5],[1,2],[3,5],[2,3],[3,4],[4,5],[1,1]], [[0,1],[1,6],[1,5],[1,4],[1,3],[2,5],[1,2],[3,5],[2,3],[3,4],[4,5],[5,6],[1,1]], [[0,1],[1,7],[1,6],[1,5],[1,4],[2,7],[1,3],[2,5],[3,7],[1,2],[4,7],[3,5],[2,3],[5,7],[3,4],[4,5],[5,6],[6,7],[1,1]], [[0,1],[1,8],[1,7],[1,6],[1,5],[1,4],[2,7],[1,3],[3,8],[2,5],[3,7],[1,2],[4,7],[3,5],[5,8],[2,3],[5,7],[3,4],[4,5],[5,6],[6,7],[7,8],[1,1]], [[0,1],[1,9],[1,8],[1,7],[1,6],[1,5],[2,9],[1,4],[2,7],[1,3],[3,8],[2,5],[3,7],[4,9],[1,2],[5,9],[4,7],[3,5],[5,8],[2,3],[5,7],[3,4],[7,9],[4,5],[5,6],[6,7],[7,8],[8,9],[1,1]], ); # Full Farey sequences orders 1-9 for my $n (1 .. $#Farey) { my @expf = @{$Farey[$n]}; my @gotf = farey($n); my $gotlen = farey($n); my $explen = scalar(@expf); is( $gotlen, $explen, "scalar farey($n) = $explen" ); is_deeply( \@gotf, \@expf, "farey($n)" ); # Index access: farey(n,k) for each k my @gotf1 = map { farey($n,$_) } 0 .. $gotlen; is_deeply( \@gotf1, [@expf,undef], "farey($n,k) for k=0.." ); # next_farey iteration my @gotf2 = ([0,1]); for (1..10000) { my $next = next_farey($n,$gotf2[-1]); last unless defined $next; push @gotf2, $next; } is_deeply( \@gotf2, \@expf, "next_farey($n,...) iteration" ); # farey_rank roundtrip my @gotrank = map { farey_rank($n,$_) } @expf; is_deeply( \@gotrank, [0 .. $#expf], "farey_rank($n,...)" ); } # Spot-check larger orders my @farey_ex = ( [24, 16, [2,21]], [507,427, [3,505]], ); for my $t (@farey_ex) { my($n,$k,$frac) = @$t; my $fracstr = join "/",@$frac; is_deeply( farey($n,$k), $frac, "farey($n,$k) = $fracstr" ); is( farey_rank($n,$frac), $k, "farey_rank($n,[$fracstr]) = $k" ); } # Edge cases is_deeply( [farey(1)], [[0,1],[1,1]], "farey(1)" ); is( farey_rank(5,[0,1]), 0, "farey_rank(5,[0,1]) = 0" ); is( farey_rank(5,[1,1]), 10, "farey_rank(5,[1,1]) = last" ); ok( !defined(next_farey(5,[1,1])), "next_farey(5,[1,1]) = undef" ); }; if ($extended) { subtest 'extended tests' => sub { # Farey count for larger orders (|F_n| = 1 + sum_{k=1}^{n} euler_phi(k)) my @farey_counts = ( # n |F_n| [10, 33], [20, 129], [50, 775], [100, 3045], ); for my $t (@farey_counts) { my($n, $expcount) = @$t; is( farey($n), $expcount, "scalar farey($n) = $expcount" ); } # next_farey iteration count for larger order { my $n = 50; my $count = 1; my $frac = [0,1]; while (defined($frac = next_farey($n, $frac))) { $count++; } is( $count, 775, "next_farey($n,...) iterates 775 terms" ); } # Stern diatomic: fusc(2^k) = 1 for all k for my $k (0, 1, 10, 20, 30, 40) { my $pow2 = 1 << $k; is( nth_stern_diatomic($pow2), 1, "fusc(2^$k) = 1" ); } # Stern diatomic: fusc(2^k - 1) = k for my $k (1, 2, 10, 20, 30) { my $m = (1 << $k) - 1; is( nth_stern_diatomic($m), $k, "fusc(2^$k - 1) = $k" ); } # farey_rank and farey(n,k) roundtrip for larger order { my $n = 100; for my $k (0, 1, 100, 1000, 3044) { my $frac = farey($n, $k); ok( defined $frac, "farey($n,$k) defined" ); is( farey_rank($n, $frac), $k, "farey_rank($n, farey($n,$k)) = $k" ); } } }; } Math-Prime-Util-0.74/t/18-52-rootint.t000644 000765 000024 00000006401 15150457573 017205 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/rootint/; 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"], [ 2, 40, "1099511627776"], [ 3, 40, "12157665459056928801"], [213, 15, "84274086103068221283760416414557757"], ); my @rootints = ( ["18446744073709551615", 63, 2], ["4544344858450091399", 6, 1286], ["4544344858450091404", 6, 1286], ["4544344858450091408", 6, 1286], ["4544344858450091409", 6, 1287], ["4544344858450091410", 6, 1287], ["4293595042302394368", 5, 5328], ["4444763232114353115", 5, 5364], ["4444763232114353124", 5, 5364], ["4444763232114353125", 5, 5365], ["266667176579895999", 3, 643659], ["11821500311773607999", 3, 2278019], ["11821500311773608000", 3, 2278020], ["11821500311773608001", 3, 2278020], ["18446703239944862784", 3, 2642244], ["18446724184312856125", 3, 2642245], ["18446745128696702936", 3, 2642246], ["18446744073709551615", 17, 13], ["18446744039349813264", 39, 3], ); plan tests => 2 + 3 + 2 + 2; ok(!defined eval { rootint(377,0); }, "rootint(n,0) gives error"); ok(!defined eval { rootint(-377,2); }, "rootint(-n,k) gives error"); 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" ); } { my(@got, @expected); for my $arr (@rootints) { my($n, $k, $exp) = @$arr; push @expected, $exp; push @got, map{"$_"} rootint($n,$k); } is_deeply( \@got, \@expected, "rootint on selected 64-bit values" ); } # These make LibTomMath's mp_root_n misbehave badly. #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" ); is( rootint("210624581277440375104075455121440552596840260401487569333688203125",7), 2147483645, "integer 7th root of a large 7th power" ); is( rootint("210624581277440375104075455121440552596840260401487569333688203124",7), 2147483644, "integer 7th root of almost a large 7th power" ); Math-Prime-Util-0.74/t/26-modops.t000644 000765 000024 00000033267 15152462675 016576 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/negmod invmod addmod submod mulmod muladdmod mulsubmod divmod powmod/; use Math::BigInt try=>"GMP,GMPz,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 $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my @invmods = ( [ 0, 0, undef], [ 1, 0, undef], [ 0, 1, 0], [ 0, 2, undef], [ 1, 1, 0], [ 45, 59, 21], [ 42, 2017, 1969], [ 42, -2017, 1969], [ -42, 2017, 48], [ -42, -2017, 48], [ 14, 28474, undef], [ 13, "9223372036854775808", "5675921253449092805" ], [ 14, "18446744073709551615", "17129119497016012214" ], ); plan tests => 0 + 10 # negmod + 5 + scalar(@invmods) # invmod + 5*2 + 1 # addmod + 2 # submod / addmod + 2 # mulmod + 2 + 1 # divmod + 2 # powmod + 6 # large negative args + 1 # muladdmod + 1 # mulsubmod + 4 # muladdmod and mulsubmod large inputs + 1 # large negative modulus + 1 # negmod round-trip + 1 # invmod round-trip + 1 # invmod undef cases + 1 # divmod round-trip + 1 # divmod undef cases + 1 # addmod/mulmod commutativity + 1 # Fermat's little theorem + 1 # modulus 2 parity + 1 # negative modulus + 0; ###### negmod # For n != 0, negmod(a,n) = modint(-a,n). # For all inputs, negmod(a,n) = $n ? submod(0, modint(a,n), n) : undef; is(negmod(0,0), undef, "negmod(0,0) = undef"); is(negmod(1,0), undef, "negmod(1,0) = undef"); is(negmod(0,1), 0, "negmod(0,1) = 0"); is(negmod(100,1), 0, "negmod(100,1) = 0"); is(negmod( 100, 123), 23, "negmod(100, 123) = 23"); is(negmod( 100,-123), 23, "negmod(100,-123) = 23"); is(negmod(-100, 123), 100, "negmod(-100, 123) = 100"); is(negmod( 10000, 123), 86, "negmod(10000, 123) = 86"); is(negmod( 10000,-123), 86, "negmod(10000,-123) = 86"); is(negmod(-10000, 123), 37, "negmod(-10000, 123) = 37"); ###### 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; my $got = invmod($a,$n); if (!defined $exp) { is($got, $exp, "invmod($a,$n) = "); } elsif (!defined $got) { is($got, $exp, "invmod($a,$n) = $exp"); } else { is("$got", $exp, "invmod($a,$n) = $exp"); } } # Pari, Mathematica, SAGE, Math::BigInt all return 0 for this case. is( invmod(0,1), 0, "invmod(0,1) = 0"); is( invmod(0,-1), 0, "invmod(0,-1) = 0"); # my $res = invmod(0,1); $res = "" if !defined $res; # ok($res eq '0' || $res eq '', "invmod(0,1) = $res"); 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() || 1 } 0 .. $num; my(@exp,@res); ###### add/mul/div/pow with small arguments @exp = map { undef } 0..27; is_deeply(\@exp, [map { addmod($_ & 3, ($_>>2)-3, 0) } 0..27], "addmod(..,0)"); is_deeply(\@exp, [map { submod($_ & 3, ($_>>2)-3, 0) } 0..27], "submod(..,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)"); @exp = map { 0 } 0..27; is_deeply(\@exp, [map { addmod($_ & 3, ($_>>2)-3, 1) } 0..27], "addmod(..,1)"); is_deeply(\@exp, [map { submod($_ & 3, ($_>>2)-3, 1) } 0..27], "submod(..,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, submod($i1[$_], $i2t[$_], $i3[$_]); } is_deeply( \@res, \@exp, "submod on ".($num+1)." random inputs" ); ##### addmod with negative @res = (); for (0 .. $num) { 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" ); ###### large negative args (github issue 43) { my($a, $b, $m) = (1363362182, "-26315271553053477373", 2000000011); is( addmod($a,$b,$m), 1043877553, "addmod with large negative arg" ); is( submod($a,$b,$m), 1682846811, "submod with large negative arg" ); is( mulmod($a,$b,$m), 1486752452, "mulmod with large negative arg" ); is( divmod($a,$b,$m), 160625959, "divmod with large negative arg" ); is( powmod($a,$b,$m), 1550454861, "powmod with large negative arg" ); is( powmod($b,$a,$m), 16491583, "powmod with large negative arg" ); } my @ic = map { nrand() } 0 .. $num; ###### muladdmod @exp = (); @res = (); for (0 .. $num) { push @exp, Math::BigInt->new($i1[$_])->bmul(-$i2t[$_])->badd($ic[$_])->bmod($i3[$_]); push @res, muladdmod($i1[$_], -$i2t[$_], $ic[$_], $i3[$_]); } is_deeply( \@res, \@exp, "muladdmod on ".($num+1)." random inputs" ); ###### mulsubmod @exp = (); @res = (); for (0 .. $num) { push @exp, Math::BigInt->new($i1[$_])->bmul(-$i2t[$_])->bsub($ic[$_])->bmod($i3[$_]); push @res, mulsubmod($i1[$_], -$i2t[$_], $ic[$_], $i3[$_]); } is_deeply( \@res, \@exp, "mulsubmod on ".($num+1)." random inputs" ); # Arbitrary non-tiny values is("".muladdmod("293482938498234","982498230923490234234","982349823092355","87777777777757"), "20728855000562", "muladdmod with medium size inputs"); is("".mulsubmod("293482938498234","982498230923490234234","982349823092355","87777777777757"), "74918097704263", "mulsubmod with medium size inputs"); # 128-bit inputs mod a 126-bit prime is("".muladdmod("175109911729618543589989257539043768012","21887412602962542281538131483385626868","263466159656861646486075450888763957942","83494980727347746728226137271418851789"), "28511529282241296497665677199750506129", "muladdmod with 128-bit inputs mod a 126-bit prime"); is("".mulsubmod("171821502870939196679518625154011220409","182569474286058024586486590841354369890","329619958784558749434516006469339236320","49684876044205406960769234394385141897"), "43334010019275970236275282850802256285", "mulsubmod with 128-bit inputs mod a 126-bit prime"); subtest 'big raw negative mod ', sub { is("".addmod("18446744073709551615","18446744073709551615","-19446744073709551616"),"17446744073709551614"); is("".submod("17446744073709551614",0,"-19446744073709551616"),"17446744073709551614"); is("".mulmod("18446744073709551615",2,"-19446744073709551616"),"17446744073709551614"); }; ###### negmod round-trip: addmod(a, negmod(a,m), m) == 0 { my @cases = ([0,1],[1,1],[0,7],[1,7],[6,7],[100,123],[-100,123],[10000,123]); push @cases, [1000000006, 1000000007], ["9223372036854775806", "9223372036854775807"], ["18446744073709551614", "18446744073709551615"] if $use64; my $ok = 1; for my $c (@cases) { my($a,$m) = @$c; my $neg = negmod($a,$m); $ok = 0 if addmod($a, $neg, $m) != 0; } ok($ok, "addmod(a, negmod(a,m), m) == 0"); } ###### invmod round-trip: mulmod(a, invmod(a,m), m) == 1 { my @cases = ([1,2],[1,7],[3,7],[6,7],[42,2017],[-42,2017],[45,59]); push @cases, [13, "9223372036854775808"], [14, "18446744073709551615"] if $use64; my $ok = 1; for my $c (@cases) { my($a,$m) = @$c; my $inv = invmod($a,$m); next unless defined $inv; $ok = 0 if mulmod($a, $inv, $m) != 1; } ok($ok, "mulmod(a, invmod(a,m), m) == 1"); } ###### invmod returns undef when gcd(a,m) > 1 { my @cases = ([0,0],[1,0],[0,2],[2,4],[3,6],[6,12],[14,28474]); my $ok = 1; for my $c (@cases) { my($a,$m) = @$c; $ok = 0 if defined invmod($a,$m); } ok($ok, "invmod returns undef when no inverse exists"); } ###### divmod round-trip: mulmod(divmod(a,b,m), b, m) == a mod m { my @cases; for my $m (7, 13, 97, 1000000007) { for my $a (0, 1, 3) { for my $b (1, 2, 3) { push @cases, [$a, $b, $m]; } } } push @cases, [1, 3, "9223372036854775783"] if $use64; # large prime mod my $ok = 1; for my $c (@cases) { my($a,$b,$m) = @$c; my $d = divmod($a, $b, $m); next unless defined $d; my $back = mulmod($d, $b, $m); $ok = 0 if "$back" ne "".addmod($a, 0, $m); } ok($ok, "mulmod(divmod(a,b,m), b, m) == a mod m"); } ###### divmod returns undef when b has no inverse mod m { my @cases = ([1,2,4],[1,3,6],[5,6,12]); my $ok = 1; for my $c (@cases) { my($a,$b,$m) = @$c; $ok = 0 if defined divmod($a,$b,$m); } ok($ok, "divmod returns undef when gcd(b,m) > 1"); } ###### addmod and mulmod commutativity { my @vals = (0, 1, 2, 1000000006); push @vals, ("9223372036854775806", "18446744073709551614") if $use64; my @mods = (7, 1000000007); push @mods, "18446744073709551615" if $use64; my $ok = 1; for my $m (@mods) { for my $a (@vals) { for my $b (@vals) { $ok = 0 if addmod($a,$b,$m) != addmod($b,$a,$m); $ok = 0 if mulmod($a,$b,$m) != mulmod($b,$a,$m); }}} ok($ok, "addmod and mulmod are commutative"); } ###### powmod: Fermat's little theorem a^(p-1) == 1 mod p for prime p, a != 0 mod p { my @primes = (2, 3, 5, 7, 13, 97, 1000000007); push @primes, "9223372036854775783" if $use64; my @bases = (1, 2, 3, 5, 42); my $ok = 1; for my $p (@primes) { for my $a (@bases) { next if addmod($a, 0, $p) == 0; # skip a == 0 mod p my $pm1 = Math::BigInt->new("$p")->bsub(1); $ok = 0 if powmod($a, "$pm1", $p) != 1; } } ok($ok, "powmod: Fermat's little theorem a^(p-1) == 1 mod p"); } ###### modular ops with modulus 2 (parity) { my $ok = 1; for my $a (0 .. 15) { $ok = 0 if addmod($a, 0, 2) != ($a % 2); $ok = 0 if mulmod($a, 1, 2) != ($a % 2); $ok = 0 if addmod($a, $a, 2) != 0; # a+a is always even $ok = 0 if mulmod($a, 2, 2) != 0; # 2a is always even $ok = 0 if powmod($a, 1, 2) != ($a % 2); } # odd * odd = odd, odd * even = even $ok = 0 if mulmod(3, 5, 2) != 1; $ok = 0 if mulmod(3, 4, 2) != 0; ok($ok, "modular operations with modulus 2 (parity)"); } ###### negative modulus: all ops should use |m| { my @mods = (-7, -13, -1000000007); my $ok = 1; for my $negm (@mods) { my $m = -$negm; for my $a (0, 1, 3, 5) { for my $b (1, 2, 3) { $ok = 0 if "".addmod($a,$b,$negm) ne "".addmod($a,$b,$m); $ok = 0 if "".submod($a,$b,$negm) ne "".submod($a,$b,$m); $ok = 0 if "".mulmod($a,$b,$negm) ne "".mulmod($a,$b,$m); $ok = 0 if "".powmod($a,$b,$negm) ne "".powmod($a,$b,$m); } } } ok($ok, "negative modulus: results match positive |m|"); } sub nrand { my $r = int(rand(4294967296)); $r = ($r << 32) + int(rand(4294967296)) if $use64; $r; } Math-Prime-Util-0.74/t/11-clusters.t000644 000765 000024 00000013423 15150471232 017106 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/sieve_prime_cluster is_prime primes twin_primes addint subint powint/; 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,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], ); push @patterns,[0,4,6] if $extra; my @high_check = ( [ "999961920817", 'A022008', [4,6,10,12,16] ], ); my @high_check2 = ( [ "999999217031", 'A022006', [2,6,8,12] ], [ "999998356957", 'A022007', [4,6,10,12] ], [ "9999956467211", 'A022009', [2,6,8,12,18,20] ], [ "9996858589169", 'A022010', [2,8,12,14,18,20] ], [ "99996813484481", 'A022011', [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] ], ); push @high_check, @high_check2 if $extra; #[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 + 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,1e9,2,4)], [3], "Inadmissible pattern (0,2,4) finds (3,5,7)"); is_deeply( [sieve_prime_cluster(1,1e9,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 @pcache; # holds primes in two ranges my($sbeg,$send) = (0, 100000); $send += 1000000 if $extra; $pcache[0] = primes($sbeg,$send+256); my $mbeg = powint(10,21); my $mend = $mbeg + 10000 + int(rand(100000)); $mend += 100000 if $extra; if ($usegmp) { $pcache[1] = primes($mbeg,$mend+256); } else { # Without GMP and using the Calc backend, this is just painful slow $mend = $mbeg + 5000; $pcache[1] = [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/)]; } ###### twin primes native { my $beg = 0; my $end = $extra ? $send : 20000; my @sieve = sieve_prime_cluster($beg,$end,2); my @tuple = ktuple($beg,$end,$pcache[0],2); my $num = scalar(@tuple); is_deeply( \@sieve, \@tuple, "Pattern [2] $num in range $beg .. $end"); } ###### twin primes bigint { my $beg = $mbeg; my $end = $extra ? $mend : $mbeg + 1000; my @sieve = map {"$_"} sieve_prime_cluster($beg,$end,2); my @tuple = map {"$_"} ktuple($beg,$end,$pcache[1],2); my $num = scalar(@tuple); is_deeply( \@sieve, \@tuple, "Pattern [2] $num in range $beg .. $end"); } ###### extended patterns native 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,$pcache[0],@pat); my $num = scalar(@tuple); is_deeply( \@sieve, \@tuple, "Pattern [@pat] $num in range $sbeg .. $send"); } ###### extended patterns bigint for my $pat (@patterns) { my @pat = @$pat; shift @pat if $pat[0] == 0; my @sieve = map {"$_"} sieve_prime_cluster($mbeg,$mend,@pat); my @tuple = map {"$_"} ktuple($mbeg,$mend,$pcache[1],@pat); my $num = scalar(@tuple); is_deeply( \@sieve, \@tuple, "Pattern [@pat] $num in range $mbeg .. $mend"); } ####### target a small window around known large clusters for my $test (@high_check) { my($n,$name,$cl) = @$test; my $window = ($usexs && $usegmp) ? 1000000 : 1000; my @res = sieve_prime_cluster(subint($n,$window), addint($n,$window), @$cl); is_deeply(\@res, [$n], "Window around $name high cluster finds the cluster"); } sub ktuple { my($beg, $end, $pcache, @pat) = @_; my @p = grep { $_ >= $beg && $_ <= $end } @$pcache; my %prhash = map { $_ => 1; } @$pcache; foreach my $c (@pat) { @p = grep { $prhash{$_+$c} } @p; } @p; } Math-Prime-Util-0.74/t/19-valuation.t000644 000765 000024 00000001500 14105215267 017250 0ustar00danastaff000000 000000 #!/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], error #[1,0, 0], [0,2, undef], [1,2, 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) = ".(defined($exp)?$exp:"")); } Math-Prime-Util-0.74/t/35-rand-tag.t000644 000765 000024 00000002750 13667653032 016761 0ustar00danastaff000000 000000 #!/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.74/t/18-26-shiftint.t000644 000765 000024 00000020675 15152452670 017344 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/lshiftint rshiftint rashiftint/; my $use64 = (~0 > 4294967295); my $bits = $use64 ? 64 : 32; # Negative right shifts: # ">>" MPU, Pari/GP, Mathematica = -rshiftint(-n,k] # ">>a" Math::BigInt, Python, Java my @negshifts = ( # n, k, <<, >>, >>arith [ 0, 1, 0, 0, 0], [-1, 1, -2, 0, -1], [-5, 1, -10, -2, -3], [-8, 2, -32, -2, -2], [qw/-65535 15 -2147450880 -1 -2/], [qw/-65536 15 -2147483648 -2 -2/], [qw/-65535 16 -4294901760 0 -1/], [qw/-65536 16 -4294967296 -1 -1/], [qw/-65535 47 -9223231299366420480 0 -1/], # 8 [qw/-65536 47 -9223372036854775808 0 -1/], # 9 [qw/-65535 48 -18446462598732840960 0 -1/], # 10 [qw/-65536 48 -18446744073709551616 0 -1/], # 11 [qw/-65536 80 -79228162514264337593543950336 0 -1/], # 12 [qw/-307385513 6 -19672672832 -4802898 -4802899/], [qw/-637526413 6 -40801690432 -9961350 -9961351/], [qw/-2045651239 6 -130921679296 -31963300 -31963301/], [qw/-3675663743 6 -235242479552 -57432245 -57432246/], [qw/-2332267979728172537 6 -149265150702603042368 -36441687183252695 -36441687183252696/], [qw/-8408654401686460807 6 -538153881707933491648 -131385225026350950 -131385225026350951/], [qw/-17640827963513397449 6 -1129012989664857436736 -275637936929896835 -275637936929896836/], [qw/-32659506018295865747 6 -2090208385170935407808 -510304781535872902 -510304781535872903/], [qw/-79231600218559026832557301750107210001 6 -5070822413987777717283667312006861440064 -1237993753414984794258707839845425156 -1237993753414984794258707839845425157/], [qw/-131954888069700539887213633881194728277 6 -8445112836460834552781672568396462609728 -2061795126089070935737713029393667629 -2061795126089070935737713029393667630/], [qw/-254262665582332530470619504253273698569 6 -16272810597269281950119648272209516708416 -3972854149723945788603429753957401540 -3972854149723945788603429753957401541/], [qw/-416649423645764932216789232242651032187 6 -26665563113328955661874510863529666059968 -6510147244465077065887331753791422377 -6510147244465077065887331753791422378/], ); plan tests => 4 + 3 + 2 # original tests + 3 # shift by 0 + 1 # rshiftint == rashiftint for non-negative + 1 # big right shift positive n + 1 # big right shift negative n (rshiftint) + 1 # big right shift negative n (rashiftint) + 1 # big right shift exactly BITS_PER_WORD + 1 # negative k flips direction + 1 # lshift at UV boundary produces bigint + 1 # round-trip: rshift(lshift(n,k),k) == n + 1 # rshiftint at k = bits-1 + 1 # rashiftint at k = bits-1 for negative + 1 # lshiftint k = bits-1 for small n ; ###### Basic: small ranges with implied k=1 is_deeply([map { lshiftint($_) } 0..50], [map { $_ << 1 } 0..50], "lshiftint(0..50)"); is_deeply([map { rshiftint($_) } 0..50], [map { $_ >> 1 } 0..50], "rshiftint(0..50)"); is_deeply([map { rashiftint($_) } 0..50], [map { $_ >> 1 } 0..50], "rashiftint(0..50)"); is_deeply([map { lshiftint($_,5) } -65 .. 65], [map { $_ * 32 } -65 .. 65], "lshiftint(-65 .. 65, 5)"); # lshiftint for native size k is: mulint($n, 1 << $k) # but for testing we want to avoid using our other functions. ###### Negative n table is_deeply( [map { "".lshiftint($_->[0], $_->[1]) } @negshifts], [map { $_->[2] } @negshifts], "left shift negative inputs" ); is_deeply( [map { "".rshiftint($_->[0], $_->[1]) } @negshifts], [map { $_->[3] } @negshifts], "right shift negative inputs" ); is_deeply( [map { "".rashiftint($_->[0], $_->[1]) } @negshifts], [map { $_->[4] } @negshifts], "signed arithmetic right shift negative inputs" ); ###### Boundary left shifts is("".lshiftint("2147483648"),"4294967296","left shift of 2^31 with implied 1 bit"); is("".lshiftint("9223372036854775808"),"18446744073709551616","left shift of 2^63 with implied 1 bit"); ###### Shift by 0 is identity { my @vals = (0, 1, -1, 127, -128, "4294967295", "-4294967296", "9223372036854775807", "-9223372036854775808", "18446744073709551615", "18446744073709551616", "340282366920938463463374607431768211456"); # 2^128 is_deeply([map{"$_"}map { lshiftint($_,0) } @vals], [map{"$_"} @vals], "lshiftint(n,0) == n"); is_deeply([map{"$_"}map { rshiftint($_,0) } @vals], [map{"$_"} @vals], "rshiftint(n,0) == n"); is_deeply([map{"$_"}map {rashiftint($_,0) } @vals], [map{"$_"} @vals], "rashiftint(n,0) == n"); } ###### rshiftint == rashiftint for non-negative n { my @cases; for my $n (0, 1, 2, 7, 255, 65535, "4294967295", "9223372036854775807", "18446744073709551615", "340282366920938463463374607431768211456") { for my $k (0, 1, 3, 7, 15, 31, 63, 65, 128) { push @cases, [$n, $k]; } } is_deeply( [map { "".rshiftint($_->[0],$_->[1]) } @cases], [map { "".rashiftint($_->[0],$_->[1]) } @cases], "rshiftint == rashiftint for non-negative n" ); } ###### Big right shift (k >= BITS_PER_WORD): positive n gives 0 { my @nvals = (1, 7, "4294967295"); push @nvals, ("9223372036854775807", "18446744073709551615") if $use64; my @kvals = ($bits, $bits+1, $bits+10, 128, 256); my @got; for my $n (@nvals) { for my $k (@kvals) { push @got, rshiftint($n,$k), rashiftint($n,$k); }} is_deeply(\@got, [(0) x scalar(@got)], "big right shift of positive n gives 0"); } ###### Big right shift: negative n, rshiftint gives 0 when |n| < 2^k { my @nvals = (-1, -7, "-4294967296"); push @nvals, "-9223372036854775808" if $use64; my @kvals = ($bits+1, 128); my @got; for my $n (@nvals) { for my $k (@kvals) { push @got, "".rshiftint($n,$k); } } is_deeply(\@got, [(0) x scalar(@got)], "rshiftint(negative, big k) == 0"); } ###### Big right shift: negative n, rashiftint gives -1 { my @nvals = (-1, -7, "-4294967296"); push @nvals, ("-9223372036854775808", "-18446744073709551616") if $use64; my @kvals = ($bits, $bits+1, 128); my @got; for my $n (@nvals) { for my $k (@kvals) { push @got, "".rashiftint($n,$k); } } is_deeply(\@got, [(-1) x scalar(@got)], "rashiftint(negative, big k) == -1"); } ###### Exactly BITS_PER_WORD shift { my $maxuv = $use64 ? "18446744073709551615" : "4294967295"; is(rshiftint($maxuv, $bits), 0, "rshiftint(UV_MAX, BITS_PER_WORD) == 0"); } ###### Negative k flips direction { my @cases; for my $n (0, 5, -5, 255, -255, "4294967295", "-4294967295", "18446744073709551615") { for my $k (1, 3, 7, 15) { push @cases, [$n, $k]; } } my $ok = 1; for my $c (@cases) { my($n,$k) = @$c; $ok = 0 if "".lshiftint($n, -$k) ne "".rshiftint($n, $k); $ok = 0 if "".rshiftint($n, -$k) ne "".lshiftint($n, $k); $ok = 0 if "".rashiftint($n, -$k) ne "".lshiftint($n, $k); } ok($ok, "negative k flips direction for all three shift functions"); } ###### Left shift at UV boundary produces bigint { my $maxuv = $use64 ? "18446744073709551615" : "4294967295"; my $expect = $use64 ? "36893488147419103230" : "8589934590"; is("".lshiftint($maxuv, 1), $expect, "lshiftint(UV_MAX, 1) produces correct bigint"); } ###### Round-trip: rshiftint(lshiftint(n,k),k) == n for non-negative n { my @cases; for my $n (0, 1, 7, 255, 65535, "4294967295", "18446744073709551615", "340282366920938463463374607431768211456") { for my $k (1, 5, 16, 32, 64) { push @cases, [$n, $k]; } } my $ok = 1; for my $c (@cases) { my($n,$k) = @$c; $ok = 0 if "".rshiftint(lshiftint($n,$k), $k) ne "$n"; } ok($ok, "rshiftint(lshiftint(n,k),k) == n for non-negative n"); } ###### rshiftint at k = BITS_PER_WORD - 1 { my $k = $bits - 1; # Right shift UV_MAX by BITS-1 gives 1. my $maxuv = $use64 ? "18446744073709551615" : "4294967295"; is(rshiftint($maxuv, $k), 1, "rshiftint(UV_MAX, BITS-1) == 1"); } ###### rashiftint at k = BITS_PER_WORD - 1 for negative n { # rashiftint(-1, k) == -1 for all k (floor(-1/2^k) = -1) my $k = $bits - 1; is("".rashiftint(-1, $k), "-1", "rashiftint(-1, BITS-1) == -1"); } ###### lshiftint k = BITS_PER_WORD - 1 for small positive n { my $k = $bits - 1; # lshiftint(1, BITS-1) = 2^(BITS-1) my $expect = $use64 ? "9223372036854775808" : "2147483648"; is("".lshiftint(1, $k), $expect, "lshiftint(1, BITS-1) == 2^(BITS-1)"); } Math-Prime-Util-0.74/t/30-relations.t000644 000765 000024 00000002224 15146553566 017260 0ustar00danastaff000000 000000 #!/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/; push @trials, 1000001 if defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; push @trials, 2573622 if defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; 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.74/t/80-pp.t000644 000765 000024 00000211227 15150505036 015671 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; # This is not a comprehensive test for all functions, but very basic # functionality of the PP code, covering all functions. # # For proper testing of the PP code, use: # # MPU_NO_XS=1 MPU_NO_GMP=1 make test # # which runs the whole test suite without any C code. # Add EXTENDED_TESTING=1 if desired. # Set these first thing, before loading the package. This will turn off # both XS and GMP entirely, so everything is the PPFE + PP code. # A reminder that the caller's versions of these are not changed. # These are local versions of the environment variables. BEGIN { $ENV{MPU_NO_XS} = 1; $ENV{MPU_NO_GMP} = 1; } 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 /; plan tests => 2 + # require_ok 1 + # arithmetic 1 + # primality 1 + # trial_primes (non-exported function) 1 + # primes 1 + # sieve_range 1 + # next_prime, prev_prime 1 + # prime_count 1 + # nth_prime 1 + # pseudoprimes 1 + # omega_primes 1 + # almost_primes 1 + # prime powers 1 + # twin primes 1 + # semi primes 1 + # clusters 1 + # ramanujan_primes 1 + # real functions 1 + # factoring 1 + # AKS primality 1 + # is_gaussian_prime 1 + # is_*_prime 1 + # primality proofs 1 + # misc ntheory 1 + # more misc ntheory 1 + # Lucky numbers 1 + # perfect powers 1 + # powerful 1 + # powerfree 1 + # set functions 1 + # vector (list) functions 1 + # rationals 1 + # Goldbach 1 + # config 1; # $_ is ok use Math::Prime::Util qw/:all/; use Math::BigInt; use Math::BigFloat; require_ok 'Math::Prime::Util::PP'; require_ok 'Math::Prime::Util::PrimalityProving'; my $default_precalc = prime_get_config->{'precalc_to'}; # 5003 ############################################################################### $_ = 'this should not change'; subtest 'arithmetic ops', sub { is(addint(677,24),701,"addint"); is(subint(677,24),653,"subint"); is(add1int(677),678,"add1int"); is(sub1int(677),676,"sub1int"); is(mulint(677,24),16248,"mulint"); is("".powint(677,24),"85926683248715705094727267680997536840479271741501353165435057377441","powint"); is(divint(677,24),28,"divint"); is(cdivint(677,24),29,"cdivint"); is(modint(677,24),5,"modint"); is_deeply([divrem(677,24)],[28,5],"divrem"); is_deeply([fdivrem(677,24)],[28,5],"fdivrem"); is_deeply([cdivrem(677,24)],[29,-19],"cdivrem"); is_deeply([tdivrem(677,24)],[28,5],"tdivrem"); is(lshiftint(677,3),5416,"lshiftint"); is(rshiftint(677,3),84,"rshiftint"); is(rashiftint(677,3),84,"rashiftint"); is(absint(-677),677,"absint"); is(negint(677),-677,"negint"); is_deeply([cmpint(-2,0), cmpint(0,2), cmpint(2,2), cmpint(-7,-7), cmpint(-8,-9)], [-1,-1,0,0,1], "cmpint"); is_deeply([map { signint($_) } (-7,-1,0,1,7)], [-1,-1,0,1,1], "signint"); is(sqrtint(677),26,"sqrtint"); is(rootint(677,3),8,"rootint"); is(logint(677,2),9,"logint"); is(negmod(24,9),3,"negmod"); is(addmod(24,17,9),5,"addmod"); is(submod(24,170,9),7,"submod"); is(mulmod(24,170,9),3,"mulmod"); is(muladdmod(24,170,37,91),22,"muladdmod"); is(mulsubmod(24,170,37,91),39,"mulsubmod"); is(powmod(24,170,11),1,"powmod"); is(divmod(24,29,11),5,"divmod"); 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(sqrtmod(124,137),undef,"sqrtmod(124,137) = undef"); is(sqrtmod(11,137),55,"sqrtmod(11,137) = 55"); is(rootmod(2,0,4725),undef,"rootmod k=0 => undef"); is(rootmod(0,7,4725),0,"rootmod a=0 => 0"); is(rootmod(2,11,4725),3623,"rootmod(2,11,4725) = 3623"); is(rootmod(2,-11,4725),4412,"rootmod with neg k = invmod of pos k"); is(rootmod(577,3,137),95,"rootmod"); is_deeply([allsqrtmod(4,13791)],[2,4595,9196,13789],"allsqrtmod"); is_deeply([allrootmod(581,5,151)],[34,42,43,62,121],"allrootmod"); is_deeply([allsqrtmod(4,72)],[2,34,38,70],"allsqrtmod highly composite mod"); is_deeply([allsqrtmod(4,4725)],[2,677,1402,2077,2648,3323,4048,4723],"allsqrtmod highly composite mod"); is_deeply([allrootmod(406, 72, 9450)], [qw/112 238 266 434 616 784 812 938 1162 1288 1316 1484 1666 1834 1862 1988 2212 2338 2366 2534 2716 2884 2912 3038 3262 3388 3416 3584 3766 3934 3962 4088 4312 4438 4466 4634 4816 4984 5012 5138 5362 5488 5516 5684 5866 6034 6062 6188 6412 6538 6566 6734 6916 7084 7112 7238 7462 7588 7616 7784 7966 8134 8162 8288 8512 8638 8666 8834 9016 9184 9212 9338/], "allrootmod with composite k and n"); }; subtest 'primality', sub { { 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" ); } ok(is_prime("18446744073709551521"),"is_prime(18446744073709551521) true") if $extra; }; 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" ); ############################################################################### subtest 'primes', sub { 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" ); 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]] ); foreach my $cinfo (@small_single) { my($n,$L) = @$cinfo; is_deeply(primes($n),$L,"primes($n) should return [@{$L}]"); } 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",[]], ); foreach my $cinfo (@small_range) { my($rangestr, $L) = @$cinfo; my($lo,$hi) = $rangestr =~ /(\d+) to (\d+)/; is_deeply(primes($lo,$hi),$L,"primes($lo,$hi) should return [@{$L}]"); } }; subtest 'sieve range', sub { is_deeply( [sieve_range(4, 4, 1)], [map { $_-4 } 4,5,6,7], "sieve range depth 1" ); is_deeply( [sieve_range(10, 20, 2)], [1,3,5,7,9,11,13,15,17,19], "sieve range depth 2" ); is_deeply( [sieve_range(10, 20, 3)], [1,3,7,9,13,15,19], "sieve range depth 3" ); is_deeply( [sieve_range(10, 20, 5)], [1,3,7,9,13,19], "sieve range depth 5" ); }; ############################################################################### subtest 'next and prev prime', sub { foreach my $gap ([19609,52], [360653,96], [2010733,148]) { my($base,$range)=@$gap; 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" ); { my $n = ~0 > 4294967295 ? 18446744073709551611 : 4294967291; my $exp = ~0 > 4294967295 ? "18446744073709551629" : "4294967311"; my $got = next_prime($n); ok(ref($got) =~ /^Math::/ && "$got" eq $exp, "next_prime(~0-4) returns bigint result"); } { my @samples = (2010733, 2010768, 2010870, 2010880); @samples = (2010733..2010880) if $extra; is_deeply([map{next_prime($_)}@samples],[map {2010881} 0..$#samples], "next_prime in primegap before 2010881"); } { my @samples = (2010734, 2010768, 2010870, 2010881); @samples = (2010734..2010881) if $extra; is_deeply([map{prev_prime($_)}@samples],[map {2010733} 0..$#samples], "prev_prime in primegap after 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)"); # We were getting this wrong is(next_prime("18446744073709551515"),"18446744073709551521","next_prime(18446744073709551515) = 18446744073709551521") if $use64; }; ############################################################################### subtest 'prime_count', sub { my @pivals = ([1,0],[10,4],[100,25],[1000,168],[10000,1229],[60067,6062],[65535,6542]); push @pivals, [100000,9592] if $extra; for my $pv (@pivals) { my($n,$count) = @$pv; is(prime_count($n), $count, "prime_count($n) = $count" ); } my @piintervals = ( ["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], ); push @piintervals, ["868396 to 9478505",563275], ["1118105 to 9961674",575195], ["24689 to 7973249",535368] if $extra; for my $pi (@piintervals) { my($rangestr, $count) = @$pi; my($lo,$hi) = parse_range($rangestr); is(prime_count($lo,$hi), $count, "prime_count($rangestr) = $count"); } # 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" ); my $pca = prime_count_approx(128722248); ok( $pca >= 7309252 && $pca <= 7310044, "prime_count_approx(128722248) in range" ); }; ############################################################################### subtest 'nth_prime', sub { is(nth_prime(0),undef,"nth_prime(0) returns undef"); my @nthvals = ([1,2],[4,7],[25,97],[168,997],[1229,9973],[6062,60041],[6542,65521]); push @nthvals, [9592,99991] if $extra; for my $nv (@nthvals) { my($n,$nth) = @$nv; is(nth_prime($n),$nth,"nth_prime($n) = $nth"); } my @nthprimes32=(2,29,541,7919,104729,1299709,15485863,179424673,2038074743); for my $i (0..$#nthprimes32) { my($n, $nth) = (10**$i, $nthprimes32[$i]); last if $n > ($extra ? 2000000 : 5000); is( nth_prime($n), $nth, "nth_prime($n) = $nth" ); } { my $ntha = nth_prime_approx(1287248); ok( $ntha >= 20274907 && $ntha <= 20284058, "nth_prime_approx(1287248) in range" ); } { my($n,$c) = (15460811,998491); my $lo = nth_prime_lower($c); my $hi = nth_prime_upper($c); my $ap = nth_prime_approx($c); my $tol = int($n*.02); ok($lo <= $n && $lo+$tol >= $n, "nth_prime_lower($c)"); ok($hi >= $n && $hi-$tol <= $n, "nth_prime_upper($c)"); cmp_closeto($ap, $n, $tol, "nth_prime_approx($c)"); } }; ############################################################################### subtest 'pseudoprime tests', sub { 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"); my @psp = ([2,341],[2,561],[2,29341],[2,4259905], [3, 91],[3,121],[3,44287],[3,4252381]); is_deeply([grep { !is_pseudoprime($_->[1],$_->[0]) } @psp], [],"Small pseudoprimes"); my @spsp = ([2,2047],[2,42799],[2,4335241],[2,1078467589],[2,75792980677], [3, 121],[3,44287],[3,4252381],[3,1075490821], [5, 781],[5,38081],[5,4265257], [31,15],[31,49],[31,29341],[31,4270657]); is_deeply([grep { !is_strong_pseudoprime($_->[1],$_->[0]) } @spsp], [],"Small strong pseudoprimes"); ok(is_strong_pseudoprime(75792980677),"is_strong_pseudoprime(75792980677)"); is_deeply([grep {!is_lucas_pseudoprime($_)} qw/9179 10877 44099 4259789/], [], "Small Lucas pseudoprimes"); is_deeply([grep {!is_strong_lucas_pseudoprime($_)} qw/5459 5777 75077 4309631/], [], "Small strong Lucas pseudoprimes"); is_deeply([grep {!is_extra_strong_lucas_pseudoprime($_)} qw/989 3239 5777 72389 4226777 1076503199/], [], "Small extra strong Lucas pseudoprimes"); is_deeply([grep {!is_almost_extra_strong_lucas_pseudoprime($_)} qw/989 3239 5777 72389 4226777/], [], "Small AES Lucas pseudoprimes"); is_deeply([grep {!is_almost_extra_strong_lucas_pseudoprime($_,2)} qw/4531 12209 62479 4403027/], [], "Small AES-2 Lucas pseudoprimes"); is_deeply([grep {is_bpsw_prime($_)} qw/2047 42799 4335241 121 781 989 5777 72389/], [], "Small pure BPSW test"); { # n is a SPSP to bases: 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47 my $n = Math::BigInt->new("168790877523676911809192454171451"); # We don't need to verify that in this test. is( is_strong_pseudoprime( $n, 47), 1, "168790877523676911809192454171451 (SPSP to 2..52) test base 47" ); is( is_strong_pseudoprime( $n, 53), 0, "168790877523676911809192454171451 found composite with base 53" ); #is( is_strong_lucas_pseudoprime($n), 0, "368105533664589636823262455488673 is not a strong Lucas pseudoprime" ); } { my $n = "153515674455111174527"; ok(is_extra_strong_lucas_pseudoprime($n), "$n is an ESLSP"); ok(!is_bpsw_prime($n), "is_bpsw_prime($n) = 0 as expected"); # Could verify with other tests e.g. frobenius_{khashin,underwood} } is(is_perrin_pseudoprime(517697641), 1, "517697641 is a Perrin pseudoprime"); is(is_perrin_pseudoprime(102690901,3), 1, "102690901 is a Perrin pseudoprime (Grantham)"); is(is_frobenius_pseudoprime(517697641), 0, "517697641 is not a Frobenius pseudoprime"); is(is_frobenius_khashin_pseudoprime(517697659),1,"517697659 is prime via Frobenius-Khashin test"); SKIP: { # TODO: 2026 does this still happen? skip "Old Perl+bigint segfaults in F-U code", 1 if $] < 5.008; ok(is_frobenius_underwood_pseudoprime(517697659), "517697659 is prime via Frobenius-Underwood test" ); } is(is_euler_pseudoprime(703, 3), 1, "703 is a base 3 Euler pseudoprime"); is(is_euler_plumb_pseudoprime(3277), 1, "3277 is a Euler-Plumb pseudoprime"); is(is_catalan_pseudoprime(17), 1, "is_catalan_pseudoprime(17) true"); is(is_catalan_pseudoprime(15127), 0, "is_catalan_pseudoprime(15127) false"); SKIP: { # Maybe if we make a faster binomialmod skip "Skipping PP Catalan pseudoprime test without EXTENDED_TESTING", 1 unless $extra; is(is_catalan_pseudoprime(5907), 1, "5907 is a Catalan pseudoprime"); } is( miller_rabin_random(4294967281, 20), "0", "Miller-Rabin random 40 on composite" ); }; ############################################################################### subtest 'omega primes', sub { # omega primes(k), where n is divisible by exactly k primes # with multiplicity, meaning these are numbers with prime_omega(n) == k is_deeply(omega_primes(1,20),[2,3,4,5,7,8,9,11,13,16,17,19],"omega_primes(1,20)"); is_deeply(omega_primes(2,20),[6,10,12,14,15,18,20],"omega_primes(2,20)"); is_deeply(omega_primes(3,100),[30,42,60,66,70,78,84,90],"omega_primes(3,100)"); is_deeply(omega_primes(4,500),[210,330,390,420,462],"omega_primes(4,500)"); my @n6 = (8,18,78,510,4620); is_deeply([map { nth_omega_prime($_,6) } 1..5],\@n6,"nth_omega_prime(k,6)"); is_deeply([map { omega_prime_count($_,$n6[$_-1]-1) } 1..5],[5,5,5,5,5],"omega_prime_count(k,n)"); my @fn7 = (10000019, 10000000, 10000005, 10000002, 10000012, 10000080, 10002930, 11741730, 223092870); is_deeply( [map { is_omega_prime($_+1,$fn7[$_]) } 0..$#fn7], [(1) x scalar(@fn7)], "is_omega_prime (true)" ); is_deeply( [map { is_omega_prime($_+1,$fn7[$_]+6) } 0..$#fn7], [(0) x scalar(@fn7)], "is_omega_prime (false)" ); # random numbers with the result we want is_deeply([map { prime_omega($_) } (2,3777,893828,392580,451902,8111460,16265634,9699690,917896980,1084183870770)],[1..10],"prime_omega(n)"); is_deeply(omega_primes(10,"6469693230","9469693230"), [qw/6469693230 6915878970 8254436190 8720021310 9146807670/], "omega_primes(10,6469693230,9469693230)") if $extra; }; subtest 'almost primes', sub { # almost primes(k), where n has exactly k prime factors # no multiplicity, meaning these are numbers with prime_bigomega(n) == k is_deeply(almost_primes(1,20),[2,3,5,7,11,13,17,19],"almost_primes(1,20)"); is_deeply(almost_primes(2,20),[4,6,9,10,14,15],"almost_primes(2,20)"); is_deeply(almost_primes(3,20),[8,12,18,20],"almost_primes(3,20)"); is_deeply(almost_primes(4,60),[16,24,36,40,54,56,60],"almost_primes(4,60)"); my @n12 = (37,34,52,100,200,400,800,1600,3200,6400,12800,25600); is_deeply([map { nth_almost_prime($_,12) } 1..12],\@n12,"nth_almost_prime(k,12)"); is_deeply([map { almost_prime_count($_,$n12[$_-1]-1) } 1..12],[(11) x 12],"almost_prime_count(k,n)"); my @isa = (10000019,10000001,10000005,10000002,10000004,10000008,10000016,10000096,10000032,10000080,10000128,10000896); is_deeply( [map { is_almost_prime($_,$isa[$_-1]) } 1..12], [(1) x scalar(@isa)], "is_almost_prime (true)" ); is_deeply( [map { is_almost_prime($_,$isa[$_-1]+10) } 1..12], [(0) x scalar(@isa)], "is_almost_prime (false)" ); is_deeply([map { prime_bigomega($_) } (2,299021,382353,437943,787216,1004848,765264,333882,508640,175872)],[1..10],"prime_bigomega(n)"); cmp_closeto( almost_prime_count_approx(3,10000),2569, 40, "almost_prime_count_approx(3,10000) in range" ); # These approximations could be better cmp_closeto( almost_prime_count_approx(5,10000), 963, 100, "almost_prime_count_approx(5,10000) in range" ); cmp_closeto( almost_prime_count_approx(7,"1000000000000"), "62981797962", "10000000000", "almost_prime_count_approx(7,1000000000000) in range" ); { my($k,$n,$c) = (3,389954,98699); my $lo = almost_prime_count_lower($k,$n); my $hi = almost_prime_count_upper($k,$n); my $ap = almost_prime_count_approx($k,$n); my $tol = int($c*.05); is(almost_prime_count($k,$n),$c,"almost_prime_count($k,$n) = $c"); ok($lo <= $c && $lo+$tol >= $c, "almost_prime_count_lower($k,$n)"); ok($hi >= $c && $hi-$tol <= $c, "almost_prime_count_upper($k,$n)"); cmp_closeto($ap, $c, $tol, "almost_prime_count_approx($k,$n)"); } { my($k,$n,$c) = (7,489954,16527); my $lo = almost_prime_count_lower($k,$n); my $hi = almost_prime_count_upper($k,$n); my $ap = almost_prime_count_approx($k,$n); my $tol = int($c*.15); is(almost_prime_count($k,$n),$c,"almost_prime_count($k,$n) = $c"); ok($lo <= $c && $lo+$tol >= $c, "almost_prime_count_lower($k,$n)"); ok($hi >= $c && $hi-$tol <= $c, "almost_prime_count_upper($k,$n)"); cmp_closeto($ap, $c, $tol, "almost_prime_count_approx($k,$n)"); } { my($k,$n,$c) = (4,10000000,47997635); my $lo = nth_almost_prime_lower($k,$n); my $hi = nth_almost_prime_upper($k,$n); my $ap = nth_almost_prime_approx($k,$n); my $tol = int(0.1 * $c); cmp_closeto( $ap, $c, $tol, "nth_almost_prime_approx($k,$n)"); ok($lo <= $c && $lo+$tol >= $c, "nth_almost_prime_lower($k,$n)"); ok($hi >= $c && $hi-$tol <= $c, "nth_almost_prime_upper($k,$n)"); ok($ap >= $lo && $ap <= $hi, "nth_almost_prime_approx inside lo/hi bounds"); } }; ############################################################################### subtest 'prime powers', sub { is_deeply([map {$_-100500} @{prime_powers(100500,101000)}], [qw/1 11 17 19 23 37 47 49 59 91 109 113 121 149 169 173 193 199 203 233 241 247 269 287 299 301 311 323 329 347 353 407 413 427 431 437 443 457 481 487 499/], "prime_powers(100500,101000)"); is(next_prime_power(13579), 13591, "next_prime_power"); is(next_prime_power(13591), 13597, "next_prime_power"); is(prev_prime_power(13579), 13577, "prev_prime_power"); is(prev_prime_power(13577), 13567, "prev_prime_power"); { my($n,$c) = (389954,33234); my $lo = prime_power_count_lower($n); my $hi = prime_power_count_upper($n); my $ap = prime_power_count_approx($n); my $tol = int($c*.05); is(prime_power_count($n),$c,"prime_power_count($n) = $c"); ok($lo <= $c && $lo+$tol >= $c, "prime_power_count_lower($n)"); ok($hi >= $c && $hi-$tol <= $c, "prime_power_count_upper($n)"); cmp_closeto($ap, $c, $tol, "prime_power_count_approx($n)"); } is(nth_prime_power(5123),49033,"nth_prime_power(5123) = 49033"); { my($n,$c) = (15460801,999154); my $lo = nth_prime_power_lower($c); my $hi = nth_prime_power_upper($c); my $ap = nth_prime_power_approx($c); my $tol = int($n*.05); ok($lo <= $n && $lo+$tol >= $n, "nth_prime_power_lower($c)"); ok($hi >= $n && $hi-$tol <= $n, "nth_prime_power_upper($c)"); cmp_closeto($ap, $n, $tol, "nth_prime_power_approx($c)"); } }; ############################################################################### subtest 'Twin primes', sub { is_deeply([map {$_-100500} @{twin_primes(100500,101500)}], [qw/17 47 299 611 617 659 707 779/], "twin_primes(100500,101500)"); is(twin_prime_count(4321), 114, "twin_prime_count(4321)"); is(twin_prime_count(5000,5500), 8, "twin_prime_count(5000,5500)"); cmp_closeto(twin_prime_count_approx("4123456784123"), "6950213327", 14937 * 2, "twin_prime_count_approx(4123456784123)"); cmp_closeto("".twin_prime_count_approx("412345678412345678412345678"), "149939117920176008847283", 1e11, "twin_prime_count_approx(412345678412345678412345678)") if $extra; is(nth_twin_prime(249), 13217, "nth_twin_prime(249)"); cmp_closeto("".nth_twin_prime_approx("1234567890"), "637769466671", 50000000, "nth_twin_prime_approx(1234567890)"); }; ############################################################################### subtest 'Semi primes', sub { is_deeply([map {$_-101500} @{semi_primes(101500,101600)}], [qw/6 9 21 34 39 46 51 53 54 57 67 71 78 79 89 93 97/], "semi_primes(101500,101600)"); is(semiprime_count(12000,123456),25459,"semiprime_count(12000, 123456)"); cmp_closeto( semiprime_count_approx("100294967494"), "14000000000", 4000000, "semiprime_count_approx(100294967494) in range" ); is(nth_semiprime(1400),5137,"nth_semiprime(1400) = 5137"); cmp_closeto( nth_semiprime_approx("14000000000"), "100294967494", 120000000, "nth_emiprime_approx(14000000000) in range" ); }; ############################################################################### subtest 'Clusters', sub { is_deeply([sieve_prime_cluster(0,50,2)], [3,5,11,17,29,41], "sieve_prime_cluster(0,50, 2)"); is_deeply([sieve_prime_cluster(0,50,2,4)], [3], "sieve_prime_cluster(0,50, 2,4)"); is_deeply([sieve_prime_cluster(0,50,2,6)], [5,11,17,41], "sieve_prime_cluster(0,50, 2,6)"); is_deeply([sieve_prime_cluster(0,50,4,6)], [7,13,37], "sieve_prime_cluster(0,50, 4,6)"); is_deeply([sieve_prime_cluster(100,1000,2,6,8)], [101,191,821], "sieve_prime_cluster(100,1000, 2,6,8)"); }; ############################################################################### subtest 'Ramanujan primes', sub { is_deeply(ramanujan_primes(0,100), [2,11,17,29,41,47,59,67,71,97], "Ramanujan primes under 100"); { my($n,$c) = (8840,500); my $lo = ramanujan_prime_count_lower($n); my $hi = ramanujan_prime_count_upper($n); my $ap = ramanujan_prime_count_approx($n); my $tol = int($c*.05); is(ramanujan_prime_count($n),$c,"ramanujan_prime_count($n) = $c"); ok($lo <= $c && $lo+$tol >= $c, "ramanujan_prime_count_lower($n)"); ok($hi >= $c && $hi-$tol <= $c, "ramanujan_prime_count_upper($n)"); cmp_closeto($ap, $c, $tol, "ramanujan_prime_count_approx($n)"); } is(nth_ramanujan_prime(28),311,"nth_ramanujan_prime(28) = 311"); { my($n,$c) = (1088761,39999); my $lo = nth_ramanujan_prime_lower($c); my $hi = nth_ramanujan_prime_upper($c); my $ap = nth_ramanujan_prime_approx($c); my $tol = int($n*.05); #is(nth_ramanujan_prime($c),$n,"nth_ramanujan_prime($c) = $n"); ok($lo <= $n && $lo+$tol >= $n, "nth_ramanujan_prime_lower($c)"); ok($hi >= $n && $hi-$tol <= $n, "nth_ramanujan_prime_upper($c)"); cmp_closeto($ap, $n, $tol, "nth_ramanujan_prime_approx($c)"); } }; ############################################################################### subtest 'real (float) functions', sub { my %eivals = ( -10 => -0.00000415696892968532438, -0.5 => -0.55977359477616, -0.1 => -1.8229239584193906660809, -0.001 => -6.33153936413615, -0.00001 => -10.9357198000436956, -0.00000001 => -17.843465089050832587, 0.693147180559945 => 1.0451637801174927848446, # log2 1 => 1.8951178163559367554665, 1.5 => 3.3012854491297978379574, 2 => 4.9542343560018901633795, 5 => 40.185275355803177455091, 10 => 2492.2289762418777591384, 12 => 14959.532666397528852292, 20 => 25615652.664056588820481, 40 => 6039718263611241.5783592, 41 => 16006649143245041.110700, ); while (my($n, $ein) = each (%eivals)) { cmp_closeto( ExponentialIntegral($n), $ein, 0.00000001 * abs($ein), "Ei($n) ~= $ein"); } my %livals = ( 0 => 0, 1.01 => -4.0229586739299358695031, 2 => 1.0451637801174927848446, 10 => 6.1655995047872979375230, 24 => 11.200315795232698830550, 1000 => 177.60965799015222668764, 100000 => 9629.8090010507982050343, 100000000 => 5762209.3754480314675691, 4294967295 => 203284081.95454158906409, 10000000000 => 455055614.58662307560953, 100000000000 => 4118066400.6216115150394, ); while (my($n, $lin) = each (%livals)) { cmp_closeto( LogarithmicIntegral($n), $lin, 0.00000001 * abs($lin), "li($n) ~= $lin"); } my %rvals = ( 1.01 => 1.0060697180622924796117, 2 => 1.5410090161871318832885, 10 => 4.5645831410050902398658, 1000 => 168.35944628116734806491, 1000000 => 78527.399429127704858870, 10000000 => 664667.44756474776798535, 4294967295 => 203280697.51326064541983, 10000000000 => 455050683.30684692446315, 18446744073709551615 => 4.25656284014012122706963685602e17, ); while (my($n, $rin) = each (%rvals)) { cmp_closeto( RiemannR($n), $rin, 0.00000001 * abs($rin), "R($n) ~= $rin"); } my %rzvals = ( 2 => 0.6449340668482264364724151666, 2.5 => 0.3414872572509171797567696934, 4.5 => 0.0547075107614542640229672890, 7 => 0.0083492773819228268397975498, 8.5 => 0.0028592508824156277133439825, 20.6 => 0.0000006293391573578212882457, 80 => 8.27180612553034e-25, 180 => 6.52530446799852e-55, ); 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) = (2, $rzvals{2}); cmp_closeto( RiemannZeta(Math::BigFloat->new($n)), $zin, 0.00000001 * abs($zin), "Zeta($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) = (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"); } }; ############################################################################### subtest 'factoring', sub { #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"); } is_deeply([factor_exp(9147600)],[[2,4],[3,3],[5,2],[7,1],[11,2]],"factor_exp"); is(join(" ",divisors(252)),"1 2 3 4 6 7 9 12 14 18 21 28 36 42 63 84 126 252","divisors"); is(divisor_sum(252),728,"divisor_sum(252)"); is(join(" ",map{divisor_sum(1254,$_)}(0..7)),"16 2880 2208200 2302655040 2659995565256 3210983462174400 3954705863524605800 4916556716966553418560","divisor_sum(1254, {0..7})"); is(znlog(5678, 5, 10007), 8620, "znlog(5678, 5, 10007)"); # 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::prho_factor(4294968337) ], [ 11,390451667 ], "prho(4294968337)" ); 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::pbrent_factor(4294968971)], [ 601, 7146371 ], "pbrent(4294968971)" ); 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::cheb_factor(2424869) ], [ 37, 65537 ], "cheb(2424869)" ); #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)" ); ##### factoring subs with BigInts # 1013 4294967197 4294967291 my $nbig = Math::BigInt->new("18686551294184381720251"); test_facres("prho", $nbig, Math::Prime::Util::PP::prho_factor($nbig)); test_facres("pbrent", $nbig, Math::Prime::Util::PP::pbrent_factor($nbig)); test_facres("pminus1", $nbig, Math::Prime::Util::PP::pminus1_factor($nbig)); SKIP: { skip "Skipping ecm test", 1 if defined $Math::Prime::Util::GMP::VERSION && $Math::Prime::Util::GMP::VERSION < 0.20; test_facres("ecm", $nbig, Math::Prime::Util::PP::ecm_factor($nbig)); } # Test backtracking after finding multiple factors $nbig = "73786976294838213647"; test_facres("pminus1", $nbig, Math::Prime::Util::PP::pminus1_factor($nbig)); # Test stage 2 $nbig = "73786976294838206467"; test_facres("pminus1", $nbig, Math::Prime::Util::PP::pminus1_factor($nbig,100,2000)); $nbig = Math::BigInt->new("73786976930493367637"); # Check stage 2 p-1. Fast with Math::BigInt::GMP, slow without. SKIP: { skip "Skipping expensive p-1 stage 2 test", 1 unless $extra; test_facres("pminus1", $nbig, Math::Prime::Util::PP::pminus1_factor($nbig, 27000, 35000)); } test_facres("fermat", $nbig, Math::Prime::Util::PP::fermat_factor($nbig)); SKIP: { skip "Skipping HOLF big test without extended testing", 1 unless $extra; test_facres("holf", $nbig, Math::Prime::Util::PP::holf_factor($nbig)); } { $nbig = Math::BigInt->new("99999999999979999998975857"); my @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", 1 unless $extra; $nbig = Math::BigInt->new("14270401808568703916861"); test_facres("ecm(5,2000)", $nbig, Math::Prime::Util::PP::ecm_factor($nbig, 5, 2000, 40)); } ##### Some numbers that go to stage 2 of tests SKIP: { skip "stage 2 factoring tests for extended testing", 3 unless $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" ); } }; sub test_facres { my($name, $n, @facs) = @_; my $eq = cmpint($n, vecprod(@facs)) == 0; if (scalar @facs > 1 && $eq && vecnone { $_ == 1 } @facs) { pass("$name: $n => [@facs]"); } else { fail("$name: $n => [@facs]"); } } ##### AKS primality test. Be very careful with performance. subtest 'AKS primality', sub { 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)" ); } }; subtest 'is_gaussian_prime', sub { ok( !is_gaussian_prime(29,0), "29 is not a Gaussian Prime" ); ok( is_gaussian_prime(31,0), "31 is a Gaussian Prime" ); ok( !is_gaussian_prime(0,-29), "0-29i is not a Gaussian Prime" ); ok( is_gaussian_prime(0,-31), "0-31i is a Gaussian Prime" ); ok( is_gaussian_prime(58924,132000511), "58924+132000511i is a Gaussian Prime" ); ok( is_gaussian_prime(519880,-2265929), "519880-2265929i is a Gaussian Prime" ); ok( !is_gaussian_prime(20571,150592260), "20571+150592260i is not a Gaussian Prime" ); }; subtest 'other is * prime', sub { ok( is_semiprime(1110000001), "1110000001 is a semiprime" ); ok( !is_semiprime(1110000201), "1110000201 is not a semiprime" ); is(is_prime_power("11398895185373143"),19,"is_prime_power(7^19) = 19"); {my $r; is_prime_power("11398895185373143",\$r); is($r,7,"is_prime_power(7^19,0,r) => r=7");} ok( is_ramanujan_prime(41), "41 is a Ramanujan prime"); ok( !is_ramanujan_prime(43), "43 is not a Ramanujan prime"); ok( is_delicate_prime(294001), "294001 is a delicate prime" ); ok( is_delicate_prime(862789,16), "862789 is a delicate prime in base 16" ); ok( is_chen_prime(167), "is_chen_prime" ); is(next_chen_prime(167), 179, "next_chen_prime" ); ok( is_mersenne_prime(107), "2^107-1 is a Mersenne prime"); ok( !is_mersenne_prime(113), "2^113-1 is not a Mersenne prime"); { my(@got,@exp); for my $d ([1,143,0],[1,11,1], [2,313,0],[2,209,1], [3,513,0],[3,1331,1], [4,1331,0],[4,14641,1]) { push @got, is_almost_prime($d->[0], $d->[1]); push @exp, $d->[2]; } is_deeply(\@got, \@exp, "is_almost_prime"); } my @ipp_2 = (5,347,7080233,17471059,36010357); my @ipp_0 = (10,49,697,7080249,17471061,36010359); is_deeply([map{is_prob_prime($_)}@ipp_2], [map{2}@ipp_2], "is_prob_prime(p)"); is_deeply([map{is_prob_prime($_)}@ipp_0], [map{0}@ipp_0], "is_prob_prime(c)"); }; subtest 'primality proofs', sub { 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)" ); } }; subtest 'misc number theory functions', sub { is( consecutive_integer_lcm(13), 360360, "consecutive_integer_lcm(13)" ); is( "".consecutive_integer_lcm(52), "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(219), 4, "mertens(219)" ); is( mertens(24219), -67, "mertens(24219)" ); 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("".znorder(5,"1180591620717411303462"), "92595421232738141424", "znorder(2,1180591620717411303462) = 92595421232738141424"); 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(join(" ",map{fubini($_)}0..6,18),"1 1 3 13 75 541 4683 3385534663256845323","fubini(n) for n in {0..6,18}"); is_deeply([numtoperm(11,33967658)],[9,3,6,4,7,1,10,0,5,2,8],"numtoperm"); is(permtonum([9,3,6,4,7,1,10,0,5,2,8]),33967658,"permtonum"); { my @P = randperm(50,4); my @Q; my $tries = 0; do { @Q = randperm(50,4); } until "@P" ne "@Q" || $tries++ > 1000; ok( $tries < 1000, "randperm(50,4) generates different permutations" ); } { my @P = randperm(8,6); my @Q; my $tries = 0; do { @Q = randperm(8,6); } until "@P" ne "@Q" || $tries++ > 1000; ok( $tries < 1000, "randperm(8,6) generates different permutations" ); } is_deeply([map{[bernfrac($_)]}(0,1,2,3,12,13)], [[1,1],[1,2],[1,6],[0,1],[-691,2730],[0,1]], "bernfrac"); cmp_closeto(bernreal(18),54.971177944862155,1e-5,"bernreal"); is_deeply([map{[harmfrac($_)]}(0,1,2,3,12,13)], [[0,1],[1,1],[3,2],[11,6],[86021,27720],[1145993,360360]], "harmfrac"); cmp_closeto(harmreal(18),3.49510807819631349,1e-5,"harmreal"); 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)"); 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"); is(inverse_totient(42), 4, "inverse totient 42 count"); is_deeply([inverse_totient(42)], [43,49,86,98], "inverse totient 42 list"); 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(legendre_phi(54321,5),11287,"legendre_phi(54321,5) = 11287"); is(inverse_li(13579),146261,"inverse_li"); cmp_closeto(inverse_li_nv(135790),1808203.25662372,1e-4,"inverse_li_nv"); { my @t; forprimes(sub {push @t,$_}, 2387234,2387303); is_deeply( [@t], [2387237,2387243,2387249,2387269,2387291,2387299,2387303], "forprimes 2387234,2387303" ); } { my @t; forcomposites(sub {push @t,$_}, 15202630,15202641); is_deeply( [@t], [15202630,15202632,15202634,15202635,15202636,15202638,15202640,15202641], "forcomposites 15202630,15202641" ); } { my @t; foroddcomposites(sub {push @t,$_}, 15202630,15202641); is_deeply( [@t], [15202635,15202641], "foroddcomposites 15202630,15202641" ); } { my @t; forsemiprimes(sub {push @t,$_}, 152026,152060); is_deeply( [@t], [152049,152051,152059], "forsemiprimes 152026,152060" ); } { my $k = 0; fordivisors(sub {$k += $_+int(sqrt($_))},92834); is( $k, 168921, "fordivisors: d|92834: k+=d+int(sqrt(d))" ); } { my @t; forfactored(sub {push @t,[@_]}, 15202630,15202641); is_deeply( \@t, [[2,5,433,3511],[15202631],[2,2,2,3,23,27541],[15202633],[2,37,205441],[3,5,7,67,2161],[2,2,41,92699],[15202637],[2,3,3,11,76781],[15202639],[2,2,2,2,5,307,619],[3,17,19,29,541]], "forfactored" ); } { 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)" ); } { my @p; forcomp(sub { push @p, [@_] }, 7,{amin=>2,nmin=>3}); is_deeply(\@p, [ [2,2,3],[2,3,2],[3,2,2] ], "forcomp(7,{amin=>2,nmin=>3})"); } { my @p; forderange(sub { push @p,join "",@_; }, 4); is(join(" ",@p),"1032 1230 1302 2031 2301 2310 3012 3201 3210","forderange(4)"); } { my @out; forsetproduct {push @out,"@_"} [1,2],[qw/a b c/]; is_deeply(\@out, ['1 a','1 b','1 c','2 a','2 b','2 c'], "forsetproduct([1,2],[qw/a b c/])" ); } 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(sum_primes(14400),11297213,"sum_primes(14400)"); is(sum_primes(2100000),"156999759090","sum_primes(2100000)") if $extra; is(sum_primes(2440000,2500000),"10099224219","sum_primes(2440000,2500000)") if $extra; is(mertens(5443),9,"mertens(5443)"); is(sumtotient(5443),9008408,"sumtotient(5443)"); is(sumliouville(5443),-21,"sumliouville(5443)"); is_deeply([map {"".powersum(5443,$_)} 1..8],[qw/14815846 53766705134 219509292695716 955919057077963010 4336287761695106589076 20232498884989465784893754 96368654823259273645222916236 466295787313885438803232358983490/],"powersum"); is(sumdigits("0b10101110101"),7,"sumdigits with binary string"); is(sumdigits(5443),16,"sumdigits with integer"); is(sumdigits("4def",16),46,"sumdigits with hex"); is(sumdigits("x4ldef",36),100,"sumdigits with base 36"); is(hammingweight(5443),6,"hammingweight"); is_deeply([kronecker(18,106),kronecker(19,106),kronecker(11,106)],[0,1,-1],"kronecker"); is_deeply([[cornacchia(17,131)],[cornacchia(2,131)],[cornacchia(2,136)]],[[undef],[9,5],[8,6]],"cornacchia"); is(hclassno(320),168,"hclassno"); is_deeply([ramanujan_tau(81),ramanujan_tau(41),ramanujan_tau(44)],[1665188361,308120442,-786948864],"ramanujan_tau"); is(lucasu(6,1,14),9228778026,"lucasu"); is(lucasv(6,1,14),52205852194,"lucasv"); is(lucasumod(1,-1,281,17779),5050,"lucasumod"); is(lucasvmod(1,-1,281,17779),8665,"lucasvmod"); is_deeply([lucasuvmod(1,-1,2811,17779)],[6323,16441],"lucasuvmod"); is(pisano_period(1777),3556,"pisano_period"); }; subtest 'more misc ntheory functions', sub { ok( is_totient(381554124), "381554124 is a totient"); ok(!is_totient(1073024875), "1073024875 is not a totient"); ok(!is_carmichael(5049), "5049 is not a Carmichael number"); ok(!is_carmichael(2792834247), "2792834247 is not a Carmichael number"); ok(!is_carmichael(2399550475), "2399550475 is not a Carmichael number"); ok(!is_carmichael(219389), "219389 is not a Carmichael number"); ok( is_carmichael(1125038377), "1125038377 is a Carmichael number"); ok( is_quasi_carmichael(1517), "1517 is quasi-Carmichael"); ok( is_quasi_carmichael(10001), "10001 is quasi-Carmichael"); ok( is_quasi_carmichael(10373), "10373 is quasi-Carmichael"); ok(!is_cyclic(1521), "1521 is not cyclic"); ok( is_cyclic(10001), "10001 is cyclic"); ok( is_pillai(26657), "26657 is Pillai"); ok(!is_practical(1701), "1701 is not practical"); ok( is_practical(1710), "1710 is practical"); ok( is_fundamental(-168), "-168 is fundamental"); ok( is_fundamental(172), "172 is fundamental"); my @congruents = qw/34 41 206 207 692/; is_deeply( [map { is_congruent_number($_) } @congruents], [map { 1 } @congruents], "congruent numbers: [@congruents]" ); my @noncongruents = qw/17 19 26 33 35 42 51 130 170 986 1819/; is_deeply( [map { is_congruent_number($_) } @noncongruents], [map { 0 } @noncongruents], "non-congruent numbers: [@noncongruents]" ); is(is_happy(536), 7, "536 is a happy number"); is(is_happy(571,7), 3, "571 is a happy number in base 7"); is(is_happy(347,6), 4, "347 is a happy number in base 6"); is(is_happy(514,16,3), 3, "514 is a happy number in base 16 with exponent 3"); is(ramanujan_sum(12,36), 4, "ramanujan_sum(12,36) = 4"); is(is_power(16926659444736),17,"is_power(6^17) = 17"); {my $r; is_power(16926659444736,0,\$r); is($r,6,"is_power(6^17,0,r) => r=6");} is(is_square(603729), 1, "603729 is a square"); is_deeply( [map { is_sum_of_squares($_) } (-10 .. 10, 437)], [1,1,1,0,0,1,1,0,1,1,1,1,1,0,1,1,0,0,1,1,1,0], "is_sum_of_squares (k=2) for -10 .. 10, 437" ); ok( is_polygonal(6,3), "6 is a 3-polygonal number" ); ok( is_polygonal(9,4), "9 is a 4-polygonal number" ); ok(!is_odd(576),"is_odd(576)"); ok( is_odd(577),"is_odd(577)"); ok( is_even(576),"is_even(576)"); ok(!is_even(577),"is_even(577)"); ok(!is_divisible(30,7),"is_divisible(30,7)"); ok( is_divisible(30,5),"is_divisible(30,5)"); ok(!is_congruent(100007,176,177),"is_congruent(100007,176,177)"); ok( is_congruent(100007,2,177),"is_congruent(100007,2,177)"); ok(!is_square_free(331483),"is_square_free(331483)"); ok( is_square_free(370481),"is_square_free(370481)"); ok(!is_primitive_root(3,1777),"is_primitive_root(3,1777)"); ok( is_primitive_root(5,1777),"is_primitive_root(5,1777)"); ok(!is_perfect_number(2048),"is_perfect_number(2048)"); ok( is_perfect_number(8128),"is_perfect_number(8128)"); is(fromdigits([1,1,0,1],2), 13, "fromdigits binary"); is(fromdigits([0,1,1,0,1],16), 4353, "fromdigits base 16"); 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(todigitstring(-143,16), "8f", "todigitstring base 16"); is(tozeckendorf(1025),"100000010000101","tozeckendorf"); is(fromzeckendorf("100000010000101"),1025,"fromzeckendorf"); ok(!is_qr(177,10256), "177 is not a quadratic residue mod 10256"); ok( is_qr(180,10256), "180 is a quadratic residue mod 10256"); is(qnr(10271),7,"qnr(10271) = 7"); is(chinese([14,643], [254,419], [87,733]), 87041638, "chinese"); is_deeply([chinese2([14,643], [254,419], [87,733])], [87041638,197482661], "chinese2"); is(frobenius_number(5,13,29),37,"frobenius_number"); is("".factorial(53),"4274883284060025564298013753389399649690343788366813724672000000000000","factorial(53)"); is(factorialmod(53,177),30,"factorialmod(53,177)"); is(factorialmod(830,1777),1771,"factorialmod(830,1777)") if $extra; is(subfactorial(15),481066515734,"subfactorial(15)"); is(binomialmod(53,7,177),152,"binomialmod"); is(falling_factorial(17,5),742560,"falling_factorial"); is(rising_factorial(17,5),2441880,"rising_factorial"); # "A k-rough number, as defined by Finch in 2001 and 2003, is a positive # integer whose prime factors are all greater than or equal to k." ok( is_rough("62000279000279",31),"is_rough(31*n,31) = 1"); ok(!is_rough("62000279000279",32),"is_rough(31*n,32) = 0"); # "[An n-smooth number] is an integer whose prime factors are all # less than or equal to n." ok( is_smooth(1291677,50),"is_smooth(1291677,50) = 1"); ok( is_smooth(1291677,43),"is_smooth(1291677,43) = 1"); ok(!is_smooth(1291677,42),"is_smooth(1291677,42) = 0"); is(smooth_count(1291677,43),32842,"smooth_count"); is(rough_count(1291677,43),187389,"rough_count"); }; subtest 'Lucky numbers', sub { ok(!is_lucky(1772),"1772 is not a lucky number"); ok( is_lucky(1771),"1771 is a lucky number"); is_deeply(lucky_numbers(600,700), [map {600+$_}1,13,15,19,21,31,39,43,45,51,55,73,79,85,93,99], "lucky numbers between 600 and 700"); { my($n,$c) = (8840,1004); my $lo = lucky_count_lower($n); my $hi = lucky_count_upper($n); my $ap = lucky_count_approx($n); my $tol = int($c*.05); is(lucky_count($n),$c,"lucky_count($n) = $c"); ok($lo <= $c && $lo+$tol >= $c, "lucky_count_lower($n)"); ok($hi >= $c && $hi-$tol <= $c, "lucky_count_upper($n)"); cmp_closeto($ap, $c, $tol, "lucky_count_approx($n)"); } is(nth_lucky(28),129,"nth_lucky(28) = 129"); { my($n,$c) = (18605821,1088761); my $lo = nth_lucky_lower($c); my $hi = nth_lucky_upper($c); my $ap = nth_lucky_approx($c); my $tol = int($n*.05); ok($lo <= $n && $lo+$tol >= $n, "nth_lucky_lower($c) $lo <= $n"); ok($hi >= $n && $hi-$tol <= $n, "nth_lucky_upper($c) $hi >= $n"); cmp_closeto($ap, $n, $tol, "nth_lucky_approx($c) $ap =~ $n"); } }; subtest 'perfect powers', sub { is(is_perfect_power(19487172),0,"19487172 is not a perfect power"); is(is_perfect_power(19487171),1,"19487171 is a perfect power"); is(next_perfect_power(161051),161604,"next_perfect_power(5^7) = 402^2"); is(prev_perfect_power(161051),160801,"prev_perfect_power(5^7) = 401^2"); is(perfect_power_count(123456),404,"perfect_power_count(123456) = 404"); is(perfect_power_count(123456,234567),148,"perfect_power_count(123456,234567) = 148"); ok(perfect_power_count_lower("9999999999900000000000000") <= 3162493192548,"perfect_power_count_lower"); ok(perfect_power_count_upper("9999999999900000000000000") >= 3162493192548,"perfect_power_count_upper"); cmp_closeto(perfect_power_count_approx("9999999999900000000000000"),3162493192548,1000,"perfect_power_count_approx"); #is("".nth_perfect_power(1234567890),"1521310467887050801","nth_perfect_power"); is(nth_perfect_power(1234567),1495530880561,"nth_perfect_power"); ok(nth_perfect_power_lower(1234567) <= 1495530880561,"nth_perfect_power_lower"); ok(nth_perfect_power_upper(1234567) >= 1495530880561,"nth_perfect_power_lower"); cmp_closeto(nth_perfect_power_approx(1234567),1495530880561,10000000,"nth_perfect_power_approx"); }; subtest 'powerful', sub { ok(!is_powerful(260),"260 is not a powerful number"); ok( is_powerful(243),"243 is a powerful number"); ok( is_powerful("2011901648110693",3),"157^3 * 151^4 is a 3-powerful number"); is_deeply(powerful_numbers(10500,11000),[10584,10609,10648,10800,10816,10952,10976],"powerful_numbers(10500,11000)"); is(powerful_count(1234567),2255,"powerful_count(1234567)"); is(powerful_count(1234567,3),329,"powerful_count(1234567,3)"); is(nth_powerful(1000),253472,"nth_powerful"); is_deeply([map {sumpowerful(5443,$_)} 1..8],[14815846,262303,66879,30528,14445,11045,10252,7937],"sumpowerful"); }; subtest 'powerfree', sub { is(is_powerfree(1000),0,"1000 is not powerfree"); is(is_powerfree(1001),1,"1001 is powerfree"); is(powerfree_count(10500),6385,"powerfree_count"); is(nth_powerfree(10500),17266,"nth_powerfree"); is(powerfree_part(100040),25010,"powerfree_part(100040) = 25010"); is(powerfree_part(100040,3),12505,"powerfree_part(100040,3) = 12505"); is(squarefree_kernel(100040),25010,"squarefree_kernel(100040) = 25010"); is(powerfree_part(10004),2501,"powerfree_part(10040) = 2501"); is(squarefree_kernel(10004),5002,"squarefree_kernel(10004) = 5002"); is_deeply([map {powerfree_sum(5443,$_)} 1..8],[1,8999622,12322494,13687065,14286122,14561514,14693701,14756710],"powerfree_sum"); is(powerfree_part_sum(100040),3292589515,"powerfree_part_sum(100040)"); is(powerfree_part_sum(100040,3),4234954627,"powerfree_part_sum(100040,3)"); is(powerfree_part_sum(100040,4),4642253940,"powerfree_part_sum(100040,4)"); is(powerfree_count(27000000,3),22461494,"powerfree_count(27000000,3)"); is(powerfree_count(400040001,2),243195224,"powerfree_count(400040001,2)"); is(powerfree_count("10000000000",6),9829525925,"powerfree_count(10000000000,6)"); #is("".powerfree_count("27000000000000",3),"22461499059723","powerfree_count(30000^3,3)"); is("".powerfree_count("100000000000000000000",15),"99996941269930456119","powerfree_count(10^20,15)"); }; ############################################################################### subtest 'set functions', sub { my @OS = (-5,0,1,2,8,17,20); is_deeply(toset(-5,17,2,8,2,0,20,1,2),\@OS,"toset"); { my @S = @OS; my $r = setinsert(\@S,1); is_deeply([$r,@S],[0,-5,0,1,2,8,17,20],"setinsert one element already in set"); } { my @S = @OS; my $r = setinsert(\@S,3); is_deeply([$r,@S],[1,-5,0,1,2,3,8,17,20],"setinsert one element not in set"); } { my @S = @OS; my $r = setinsert(\@S,[1,3,18,21]); is_deeply([$r,@S],[3,-5,0,1,2,3,8,17,18,20,21],"setinsert 4 elements, one in set"); } { my @S = @OS; my $r = setremove(\@S,4); is_deeply([$r,@S],[0,-5,0,1,2,8,17,20],"setremove 1 element not in set"); } { my @S = @OS; my $r = setremove(\@S,1); is_deeply([$r,@S],[1,-5,0,2,8,17,20],"setremove 1 element in set"); } { my @S = @OS; my $r = setremove(\@S,[1,2,3]); is_deeply([$r,@S],[2,-5,0,8,17,20],"setremove 2 elements in set"); } { my @S = @OS; my $r = setinvert(\@S,1); is_deeply([$r,@S],[-1,-5,0,2,8,17,20],"setinvert"); } { my @S = @OS; my $r = setinvert(\@S,3); is_deeply([$r,@S],[1,-5,0,1,2,3,8,17,20],"setinvert"); } { my @S = @OS; my $r = setinvert(\@S,[2,3]); is_deeply([$r,@S],[0,-5,0,1,3,8,17,20],"setinvert"); } is(setcontains(\@OS,3),0,"setcontains one not found"); is(setcontains(\@OS,1),1,"setcontains one found"); is(setcontains(\@OS,[-1,8]),0,"setcontains subset not found"); is(setcontains(\@OS,[-5,0,8]),1,"setcontains subset found"); is(setcontainsany(\@OS,[-1,7]),0,"setcontainsany not found"); is(setcontainsany(\@OS,[-1,8]),1,"setcontainsany found"); ok(setcontains(primes(500),353),"setcontains with primes"); ok(setcontains(primes(2000),229,541,863,1223),"setcontains with more primes"); { my $S = primes(5,487); push @$S, 499; my $SE = [3,@$S]; setinsert($S,3); is_deeply($S,$SE,"setinsert at the front"); my $T = primes(4000); setinsert($S,$T); is_deeply($S,$T,"setinsert many values, to front, middle, and back"); } is_deeply(setbinop(sub{$a * $b},[1,2,3],[2,3,4]),[2,3,4,6,8,9,12],"setbinop"); is_deeply(sumset([-1,0,1]), [-2,-1,0,1,2], "sumset"); { my @A = (1,2,3,4); my @B = (3,4,5,6); is_deeply(setunion(\@A,\@B),[1,2,3,4,5,6],"setunion"); is_deeply(setintersect(\@A,\@B),[3,4],"setintersect"); is_deeply(setminus(\@A,\@B),[1,2],"setminus"); is_deeply(setminus(\@B,\@A),[5,6],"setminus"); is_deeply(setdelta(\@A,\@B),[1,2,5,6],"setdelta"); is(is_sidon_set(\@A),0,"is_sidon_set (false)"); is(is_sidon_set([1,2,4,8,16,29,58]),1,"is_sidon_set (true)"); is(is_sidon_set([0,1,4,6]),1,"is_sidon_set (true)"); is(is_sumfree_set(\@B),0,"is_sumfree_set (false)"); is(is_sumfree_set([2,3,15]),1,"is_sumfree_set (true)"); is(set_is_disjoint(\@A,\@B),0,"set_is_disjoint"); is(set_is_disjoint(\@A,[6,7]),1,"set_is_disjoint"); is(set_is_equal(\@A,\@B),0,"set_is_equal"); is(set_is_equal(\@A,\@A),1,"set_is_equal"); is(set_is_subset(\@A,[5,6]),0,"set_is_subset"); is(set_is_subset(\@A,[3,4]),1,"set_is_subset"); is(set_is_proper_subset(\@A,[2,3,4]),1,"set_is_proper_subset"); is(set_is_proper_subset(\@A,[1,2,3,4]),0,"set_is_proper_subset"); is(set_is_superset(\@A,\@B),0,"set_is_superset"); is(set_is_superset(\@A,[1..8]),1,"set_is_superset"); is(set_is_proper_superset(\@A,[1..8]),1,"set_is_proper_superset"); is(set_is_superset(\@A,\@A),1,"set_is_superset"); is(set_is_proper_superset(\@A,\@A),0,"set_is_proper_superset"); is(set_is_proper_intersection(\@A,\@A),0,"set_is_proper_intersection"); is(set_is_proper_intersection(\@A,\@B),1,"set_is_proper_intersection"); } }; ############################################################################### subtest 'vector (list) functions', sub { 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)"); is(vecmin(2,-2,7,-1,5,-3,400,0),-3,"vecmin"); is(vecmax(2,-2,7,-1,5,-3,400,0),400,"vecmax"); is(vecsum(2,-2,7,-1,5,-3,400,0),408,"vecsum"); is(vecprod(15,30,4,3),5400,"vecprod"); is(vecreduce(sub{$a+$b},(5,6,-9,12)),14,"vecreduce"); is(join("", vecextract(['a'..'z'],[15,4,17,11])), "perl", "vecextract"); is(vecequal([1,2,3],[1,2,3]), 1, "vecequal([1,2,3],[1,2,3]) = 1"); is(vecequal([1,2,3],[3,2,1]), 0, "vecequal([1,2,3],[3,2,1]) = 0"); ok( (vecany { $_ == 1 } 1, 2, 3), 'vecany true' ); ok( !(vecall { $_ == 1 } 1, 2, 3), 'vecall false' ); ok( (vecnotall { $_ == 1 } 1, 2, 3), 'vecnotall true' ); ok( (vecnone { $_ == 1 } 2, 3, 4), 'vecnone true' ); is_deeply([vecsort(3,-1,3,0,1,3,-5,4,1,-3)],[-5,-3,-1,0,1,1,3,3,3,4],"vecsort"); { my @L=(0,-4,3,4,-1,-4,4,-2,2,3); vecsorti(\@L); is_deeply(\@L,[-4,-4,-2,-1,0,2,3,3,4,4],"vecsorti"); } is(vecfirst(sub{$_>6},(3,6,-7,17,7,8,9)),17,"vecfirst"); is(vecfirstidx(sub{$_>6},(3,6,-7,17,7,8,9)),3,"vecfirstidx"); is_deeply([vecuniq(1,1,3,2,4,0,4,0,3,1)],[1,3,2,4,0],"vecuniq"); is_deeply([vecsingleton(1,1,3,2,4,0,4,0,3,1)],[2],"vecsingleton"); { my @L = (-1,14,4,-4,2,2,3,4,3,4,4,1); my %got = vecfreq(@L); my %exp = (-1=>1, 14=>1, 4=>4, -4=>1, 2=>2, 3=>2, 1=>1); is_deeply(\%got, \%exp, "vecfreq"); } is(vecmex(0,1,2,4), 3, "vecmex(0,1,2,4) = 3"); is(vecpmex(1,2,24,5), 3, "vecpmex(1,2,24,5) = 3"); { my @d128 = (1..128); my @s128 = shuffle(@d128); my @t128 = sort {$a<=>$b} @s128; is(scalar @s128, scalar @d128, "shuffle n items returns n items"); isnt("@s128","@d128", "shuffled 128-element array isn't identical"); is("@t128","@d128", "shuffled outputs are the same elements as input"); } is(scalar @{[vecsample(4,[8..11])]}, 4, "vecsample returns all items with exact k"); is_deeply([vecslide {$a+$b} 1..5],[3,5,7,9],"vecslide {\$a+\$b} 1..5"); }; ############################################################################### subtest 'rationals', sub { is_deeply([contfrac(25999,17791)],[1,2,5,1,31,1,2,1,4,2],"contfrac"); is_deeply([from_contfrac(1,2,5,1,31,1,2,1,4,2)],[25999,17791],"from_contfrac"); # Both the Perl and Python code on Rosettacode (Jan 2026) is wrong for these. is(calkin_wilf_n(1249,9469), 10000000, "calkin_wilf_n(1249,9469) = 10000000"); is_deeply([nth_calkin_wilf(10000000)],[1249,9469],"nth_calkin_wilf(10000000)"); is_deeply([next_calkin_wilf(25999,17791)],[17791,27374],"next_calkin_wilf"); is("".calkin_wilf_n(25999,17791), "834529325481721", "calkin_wilf_n(25999,17791)"); is_deeply([nth_calkin_wilf("834529325481721")],[25999,17791],"nth_calkin_wilf(834529325481721)"); is(stern_brocot_n(1249,9469), 8434828, "stern_brocot_n(1249,9469) = 8434828"); is_deeply([nth_stern_brocot(8434828)],[1249,9469],"nth_stern_brocot(1249,9469)"); is_deeply([next_stern_brocot(1249,9469)],[1409,10682],"next_stern_brocot"); is(stern_brocot_n(1409,10682), 8434829, "stern_brocot_n(1409,10682)"); is(nth_stern_diatomic(10000000), 1249, "nth_stern_diatomic"); is_deeply([farey(6)],[[0,1],[1,6],[1,5],[1,4],[1,3],[2,5],[1,2],[3,5],[2,3],[3,4],[4,5],[5,6],[1,1]],"farey(6)"); is_deeply(farey(144,146),[3,125],"farey(144,146)"); is(scalar farey(1445), 635141, "scalar farey(1445) = 635141"); is_deeply(next_farey(188,[3,5]),[113,188],"next_farey"); is_deeply([farey_rank(188,[3,5]),farey_rank(188,[113,188])],[6478,6479],"farey_rank"); }; ############################################################################### subtest 'Goldbach', sub { is(minimal_goldbach_pair(258),7,"minimal_goldbach_pair"); is(goldbach_pair_count(4620),190,"goldbach_pair_count"); is_deeply([goldbach_pairs(180)],[7,13,17,23,29,31,41,43,53,67,71,73,79,83],"goldbach_pairs"); is_deeply([goldbach_pairs(175)],[2],"goldbach_pairs for odd n where n-2 is prime"); is_deeply([goldbach_pairs(177)],[],"goldbach_pairs for odd n where n-2 is not prime"); is_deeply([map { scalar goldbach_pairs($_) } (180,175,177)], [14,1,0], "scalar goldbach_pairs returns count"); }; subtest 'config', sub { is($default_precalc, 5003, "default PP precalc = 5003"); my $new_precalc = 2000 + prime_get_config->{'precalc_to'}; prime_precalc($new_precalc); is(prime_get_config->{'precalc_to'}, $new_precalc, "after prime_precalc($new_precalc) = $new_precalc"); prime_memfree(); is(prime_get_config->{'precalc_to'}, $default_precalc, "after memfree = $default_precalc"); is(prime_get_config->{'assume_rh'}, 0, "default is not assume Riemann hypothesis"); prime_set_config(assume_rh => 1); is(prime_get_config->{'assume_rh'}, 1, "We are now assuming it"); }; # Not here: # is_provable_prime # is_provable_prime_with_cert # prime_certificate # verify_prime # # print_primes # # irand # irand64 # drand # random_bytes # entropy_bytes # urandomb # urandomm # csrand # rand # random_factored_integer # # random_prime # random_ndigit_prime # random_nbit_prime # random_safe_prime # random_strong_prime # random_proven_prime # random_maurer_prime # random_shawe_taylor_prime # random_unrestricted_semiprime # random_semiprime # foralmostprimes {...} k,[beg,],end loop over k-almost-primes in range # forsquarefree {...} [start,] end loop with factors of square-free n # forsquarefreeint {...} [start,] end loop over square-free n # formultiperm { ... } \@n loop over multiset permutations # prime_iterator returns a simple prime iterator # prime_iterator_object returns a prime iterator object # lastfor stop iteration of for.... loop 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.74/t/26-delicateprime.t000644 000765 000024 00000005323 15151735756 020076 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_delicate_prime primes/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my @a050249 = (294001, 505447, 584141, 604171, 971767, 1062599, 1282529, 1524181, 2017963, 2474431, 2690201, 3085553, 3326489, 4393139, 5152507, 5564453, 5575259, 6173731, 6191371, 6236179, 6463267, 6712591, 7204777, 7469789, 7469797); my @a186995 = (127, 2, 373, 83, 28151, 223, 6211, 2789, 294001, 3347, 20837899, 4751, 6588721, 484439, 862789, 10513, 2078920243, 10909, 169402249, 2823167, 267895961, 68543, 1016960933671, 181141, 121660507, 6139219, 11646280537, 488651); plan tests => 4 + 5 + 3*$extra; # If we forget to change digits to zeros: is(is_delicate_prime(504991), 0, "is_delicate_prime(504991) = 0"); # If we don't change the leading digit to zero (OEIS A158124): is(is_delicate_prime(929573), 0, "is_delicate_prime(929573) = 0"); is_deeply( [map { is_delicate_prime($_) } @a050249], [map { 1 } @a050249], "is_delicate_prime(n) = 1 for first ".scalar(@a050249)." known."); if ($extra) { is_deeply( [map { is_delicate_prime($a186995[$_-2],$_) } 2..2+$#a186995], [map { 1 } @a186995], "first delicate primes for bases 2 to ".(2+$#a186995)."."); } else { is_deeply( [map { is_delicate_prime($a186995[$_-2],$_) } 2,5,8,10,16], [1,1,1,1,1], "first delicate primes for bases 2, 5, 8, 10, and 16."); } is_deeply( [grep { is_delicate_prime($_,2) } 2..277], [qw/127 173 191 223 233 239 251 257 277/], "First 9 delicate primes base 2" ); is_deeply( [grep { is_delicate_prime($_,3) } 2..283], [qw/2 7 13 19 31 41 149 239 283/], "First 9 delicate primes base 3" ); is_deeply( [grep { is_delicate_prime($_,5) } 2..739], [qw/83 233 277 397 487 509 593 647 739/], "First 9 delicate primes base 5" ); is_deeply( [grep { is_delicate_prime($_,7) } 200..1381], [qw/223 409 491 587 701 1051 1163 1237 1361/], "First 9 delicate primes base 7" ); is_deeply( [grep { is_delicate_prime($_,11) } @{primes(3000,11500)}], [qw/3347 3761 5939 6481 8831 9257 9749 10487 11411/], "First 9 delicate primes base 11" ); if ($extra) { is(is_delicate_prime("999999999998832431"), 1, "is_delicate_prime(999999999998832431) = 1"); is(is_delicate_prime("999999999999999543767"), 1, "is_delicate_prime(999999999999999543767) = 1"); my $range = 1062599; is_deeply( [grep { is_delicate_prime($_) } 0..$range], [grep { $_ <= $range } @a050249], "is_practical(0 .. $range) returns first 6 delicate primes"); } # 500 digits: 2021 * powint(10, 500-4) + 7543997 # 1000 digits: 2021 * powint(10,1000-4) + 2550219 # 2021 digits: 2021 * powint(10,2021-4) + 4523733 #  500 digits: 2021 * 10^(500-4) + 7543997 # 1000 digits: 2021 * 10^(1000-4) + 2550219 # 2021 digits: 2021 * 10^(2021-4) + 4523733 Math-Prime-Util-0.74/t/26-digits.t000644 000765 000024 00000010512 15146553566 016547 0ustar00danastaff000000 000000 #!/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 + 7 + 3 + 2 + 1 # fromdigits + 6 + 4 + 1 + 1 # todigits + 4 + 2*$extra + 1 # sumdigits + 3 + 2 # todigitstring + 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([1..15,1..15,1..15],16), "108977460683796539709587792812439445667270661579197935", "fromdigits base 16 with many digits"); 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"); is_deeply([todigits(-143)], [1,4,3], "todigits ignores negative sign"); ###### 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!"); } is(sumdigits(-143), 8, "sumdigits ignores negative sign"); ####### some longer todigitstring examples is(todigitstring("3" x 21, 3), "10001020211011120202011020201202220201012100", "todigitstring base 3"); is(todigitstring("7" x 26, 9), "1303055203367717374834745502", "todigitstring base 9"); is(todigitstring("9" x 27, 11), "92586630a001888a8112250349", "todigitstring base 11"); is(todigitstring(-143,16), "8f", "todigitstring ignores negative sign"); is(todigitstring(12345,8,10), "0000030071", "todigitstring will 0 pad"); ###### 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.74/t/19-liouville.t000644 000765 000024 00000004645 15146553566 017304 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/liouville sumliouville/; 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/); } my @sums = (qw/0 1 0 -1 0 -1 0 -1 -2 -1 0 -1 -2 -3 -2 -1 0 -1 -2 -3 -4 -3 -2 -3 -2 -1 0 -1 -2 -3 -4 -5 -6 -5 -4 -3 -2 -3 -2 -1 0/); my %suml = ( 100 => -2, # OEIS A090410 L(10^n) 1000 => -14, 10000 => -94, 100000 => -288, 1000000 => -530, 10000000 => -842, 100000000 => -3884, # 1000000000 => -25216, # 10000000000 => -116026, # 100000000000 => -342224, # 1000000000000 => -522626, # 10000000000000 => -966578, # 100000000000000 => -7424752, # 1000000000000000 => -29445104, # 10000000000000000 => -97617938, 293 => -21, 468 => -24, 684 => -28, 96862 => -414, 76015169 => -10443, 10097286319 => -123643, 48512 => -2, 444444 => -368, 906150257 => 1, # 906180359 => 1, # 906316571 => 829, ); if (!$usexs) { %suml = map { $_ => $suml{$_} } grep { $_ < 10000000 } keys %suml; } delete $suml{"10097286319"} unless $extra && $use64; plan tests => scalar(@liouville_pos) + scalar(@liouville_neg) + 1 + scalar(keys %suml); ###### 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" ); } ###### sumliouville is_deeply( [map { sumliouville($_) } 0 .. $#sums], \@sums, "sumliouville L(n) for small n" ); while (my($n,$L) = each (%suml)) { is( sumliouville($n), $L, "sumliouville($n) = $L" ); } Math-Prime-Util-0.74/t/18-22-mulint.t000644 000765 000024 00000004321 15152432111 016772 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/mulint negint/; my @vals = ( [qw/13282407956253574712 14991082624209354397 199117675120653046511338473800925208664/], [qw/65536 65536 4294967296/], [qw/28778071877862015 641 18446744073709551615/], [qw/4294967295 4294967295 18446744065119617025/], [qw/4294967295 4294967296 18446744069414584320/], [qw/4294967296 4294967296 18446744073709551616/], [qw/9223372036854775807 1 9223372036854775807/], [qw/9223372036854775808 1 9223372036854775808/], [qw/9223372036854775807 -1 -9223372036854775807/], [qw/9223372036854775808 -1 -9223372036854775808/], [qw/-9223372036854775807 1 -9223372036854775807/], [qw/-9223372036854775808 1 -9223372036854775808/], [qw/-9223372036854775807 -1 9223372036854775807/], [qw/-9223372036854775808 -1 9223372036854775808/], [qw/18446744073709551615 1 18446744073709551615/], [qw/18446744073709551615 -1 -18446744073709551615/], [qw/18446744073709551616 1 18446744073709551616/], [qw/18446744073709551616 -1 -18446744073709551616/], [qw/18446744073709551615 2 36893488147419103230/], ); plan tests => 1 + 2 + 2 + 1; ###### mulint { my(@got,@exp); for my $a (-3 .. 3) { for my $b (-3 .. 3) { push @got, mulint($a,$b); push @exp, $a == 0 || $b == 0 ? 0 : $a*$b; # Perl 5.6: -1*0 = -0 } } is_deeply( \@got, \@exp, "mulint( -3 .. 3, -3 .. 3)" ); } is_deeply( [map{"$_"}map { mulint($_->[0],$_->[1]) } @vals], [map { $_->[2] } @vals], "mulint a*b=c" ); is_deeply( [map{"$_"}map { mulint($_->[1],$_->[0]) } @vals], [map { $_->[2] } @vals], "mulint b*a=c" ); { my @big = qw/9223372036854775808 18446744073709551616 13282407956253574712 199117675120653046511338473800925208664/; is_deeply([map {mulint($_,0)} @big], [(0) x @big], "mulint(big,0) == 0"); is_deeply([map {mulint(0,$_)} @big], [(0) x @big], "mulint(0,big) == 0"); } { my @signed = qw/1 7 4294967295 9223372036854775808 18446744073709551615 13282407956253574712/; is_deeply( [map{"$_"}map { mulint($_,-1) } @signed], [map{"$_"}map { negint($_) } @signed], "mulint(n,-1) == negint(n)" ); } Math-Prime-Util-0.74/t/26-cornacchia.t000644 000765 000024 00000002237 14603233402 017340 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/cornacchia/; #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 @tests = ( [0,0, [0,0]], [0,13, [undef]], [0,16, [4,0]], [1,113, [8,7]], [5,29, [3,2]], # Examples from NZMATH [7,4*29, [2,4]], [5,12829, [52,45]], # Example from Buhler and Wagon [6,103, [7,3]], [1, 4*113, [16,14]], # Some examples from Pari/GP [1, 4*109, [20,6]], [2,603, [21,9]], [24,"122838793181521", [10547339,694995]], [59551,100123456, [135,41]], # Can find with sqrtmod [57564,100123456, [9934,5]], # Can find with allsqrtmod [56892,100123456, [3016,40]], # Can find with loop ); plan tests => 0 + scalar(@tests) ; for my $data (@tests) { my($d,$n,$exp) = @$data; my @got = cornacchia($d,$n); is_deeply( \@got, $exp, defined $exp->[0] ? "Expected ($exp->[0],$exp->[1]) for x^2 + $d*y^2 = $n" : "Expected no solution for for x^2 + $d*y^2 = $n" ); } Math-Prime-Util-0.74/t/20-jordantotient.t000644 000765 000024 00000010245 13667653334 020145 0ustar00danastaff000000 000000 #!/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.74/t/26-practical.t000644 000765 000024 00000002004 14056645657 017225 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_practical/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my @a005153 = (1, 2, 4, 6, 8, 12, 16, 18, 20, 24, 28, 30, 32, 36, 40, 42, 48, 54, 56, 60, 64, 66, 72, 78, 80, 84, 88, 90, 96, 100, 104, 108, 112, 120, 126, 128, 132, 140, 144, 150, 156, 160, 162, 168, 176, 180, 192, 196, 198, 200, 204, 208, 210, 216, 220, 224, 228, 234, 240, 252); my @a174533 = (70, 350, 490, 770, 910, 945, 1190, 1330, 1575, 1610, 1750, 2030, 2170, 2205, 2450, 2584, 2590, 2835, 2870, 3010, 3128, 3290, 3430, 3465, 3710, 3850, 3944, 4095, 4130, 4216, 4270, 4550, 4690, 4725, 5355, 5390, 5775, 5950, 5985, 6370, 6615, 6650, 6825); plan tests => 3; is_deeply( [grep { is_practical($_) } 0..$a005153[-1]], \@a005153, "is_practical(0 .. $a005153[-1])"); is(is_practical(429606), 1, "is_practical(429606) = 1"); is_deeply( [map { is_practical($_) } @a174533], [map { 0 } @a174533], "is_practical(n) = 0 for almost practical numbers"); Math-Prime-Util-0.74/t/52-primearray.t000644 000765 000024 00000010520 15145557026 017427 0ustar00danastaff000000 000000 #!/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.74/t/26-polygonal.t000644 000765 000024 00000004517 14056645657 017302 0ustar00danastaff000000 000000 #!/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 + 5; ; 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"); { my($is,$r); $is = is_polygonal(0, 4294967297, \$r); ok( $is, "0 is a polygonal number" ); is( $r, 0, "is_polygonal with 0 sets r to 0" ); $is = is_polygonal(1, 4294967297, \$r); ok( $is, "1 is a polygonal number" ); is( $r, 1, "is_polygonal with 1 sets r to 1" ); ok( !is_polygonal(-1, 3), "-1 is not a polygonal number" ); } Math-Prime-Util-0.74/t/91-release-pod-syntax.t000644 000765 000024 00000000627 14113024507 020775 0ustar00danastaff000000 000000 #!/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 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(); Math-Prime-Util-0.74/t/90-release-perlcritic.t000644 000765 000024 00000001253 15036405765 021040 0ustar00danastaff000000 000000 #!/usr/bin/env 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) # We probably shouldn't do this, but this is tiresome -exclude => [qw/ProhibitExplicitReturnUndef/], ); all_critic_ok(); Math-Prime-Util-0.74/t/26-chenprimes.t000644 000765 000024 00000001536 15146553566 017427 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/ is_chen_prime next_chen_prime /; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my @chen200 = (2,3,5,7,11,13,17,19,23,29,31,37,41,47,53,59,67,71,83,89,101,107,109,113,127,131,137,139,149,157,167,179,181,191,197,199); plan tests => 4; is_deeply( [grep { is_chen_prime($_) } 0..200], \@chen200, "is_chen_prime(0..200)" ); is_deeply( [map { next_chen_prime($chen200[$_]) } 0..$#chen200-1], [@chen200[1..$#chen200]], "next_chen_prime for small values" ); is(is_chen_prime("10000000000687"), 1, "is_chen_prime(10^13+687)"); SKIP: { skip "large next_chen_prime only with EXTENDED_TESTING", 1 unless $extra; is("".next_chen_prime("10000000000000000"), "10000000000000079", "next_chen_prime(10^16)"); } Math-Prime-Util-0.74/t/10-isprime.t000644 000765 000024 00000011731 13025437630 016714 0ustar00danastaff000000 000000 #!/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.74/t/17-pseudoprime.t000644 000765 000024 00000045162 15151735773 017627 0ustar00danastaff000000 000000 #!/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 lucasumod kronecker powmod submod modint vecsample irand urandomb/; 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 41 43 47 53 59 61 67 71 73 79 83 89 97/; plan tests => 1 # invalid inputs + 1 # simple + 1 # strong pseudoprimes + 1 # pseudoprimes + 1 # Lucas pseudoprimes + 1 # other pseudoprimes + 1 # Perrin pseudoprimes + 1 # Catalan pseudoprimes + 1; # Frobenius pseudoprimes subtest 'invalid inputs should croak', sub { ok(!eval { is_strong_pseudoprime(2047,0); }, "MR base 0 fails"); ok(!eval { is_strong_pseudoprime(2047,1); }, "MR base 1 fails"); }; subtest 'basic functionality', sub { 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"); is_deeply([map{is_pseudoprime($_)} 162193,452051],[1,1],"is_pseudoprime(n) = is_pseudoprime(n,2)"); my @b235 = (2,3,5); is_deeply([map{is_pseudoprime($_,2,3,5)} 18595801,22066201], [map{is_pseudoprime($_,@b235)} 18595801,22066201],"is_pseudoprime(n,\@baselist)"); my @bnull = (); is_deeply([map{is_pseudoprime($_,2) } 40165093,66437841], [map{is_pseudoprime($_,@bnull)} 40165093,66437841],"is_pseudoprime(n,())"); }; subtest 'pseudoprimes (Fermat test)', sub { my @psp = ( [qw/2 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/], [qw/3 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/], ); for my $pdata (@psp) { my($base, @vals) = @$pdata; my @fails = grep { !is_pseudoprime($_,$base) } @vals; is_deeply(\@fails, [], "Small PSP-$base"); } ok(is_pseudoprime(4398117272641,3),"Large PSP-3") if $use64; ok(is_pseudoprime(143168581, 2, 3, 5, 7, 11), "143168581 is a Fermat pseudoprime to bases 2,3,5,7,11"); }; subtest 'strong pseudoprimes (Miller-Rabin test)', sub { # Using a different codebase to get reference values: # perl -E '$|=1; use Math::Primality ":all"; for (2 .. 1000000) { print "$_ " if $_&1 && is_strong_pseudoprime($_,17) && !is_prime($_); } print "\n"' # # Compare to: # perl -E '$|=1; use ntheory ":all"; foroddcomposites { print "$_ " if is_strong_pseudoprime($_,17); } 1000000; print "\n";' # strong pseudoprimes from 2-100k for various bases (base is the first value) my @spsp = ( [qw/2 2047 3277 4033 4681 8321 15841 29341 42799 49141 52633 65281 74665 80581 85489 88357 90751 1194649/ ], [qw/3 121 703 1891 3281 8401 8911 10585 12403 16531 18721 19345 23521 31621 44287 47197 55969 63139 74593 79003 82513 87913 88573 97567/ ], [qw/5 781 1541 5461 5611 7813 13021 14981 15751 24211 25351 29539 38081 40501 44801 53971 79381/ ], [qw/7 25 325 703 2101 2353 4525 11041 14089 20197 29857 29891 39331 49241 58825 64681 76627 78937 79381 87673 88399 88831/ ], [qw/11 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/ ], [qw/13 85 1099 5149 7107 8911 9637 13019 14491 17803 19757 20881 22177 23521 26521 35371 44173 45629 54097 56033 57205 75241 83333 85285 86347/ ], [qw/17 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/ ], [qw/19 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/ ], [qw/23 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/ ], [qw/29 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/ ], [qw/31 15 49 133 481 931 6241 8911 9131 10963 11041 14191 17767 29341 56033 58969 68251 79003 83333 87061 88183/ ], [qw/37 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/ ], [qw/61 217 341 1261 2701 3661 6541 6697 7613 13213 16213 22177 23653 23959 31417 50117 61777 63139 67721 76301 77421 79381 80041/ ], [qw/73 205 259 533 1441 1921 2665 3439 5257 15457 23281 24617 26797 27787 28939 34219 39481 44671 45629 64681 67069 76429 79501 93521/ ], [qw/325 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/ ], [qw/9375 11521 14689 17893 18361 20591 28093 32809 37969 44287 60701 70801 79957 88357 88831 94249 96247 99547/ ], [qw/28178 28179 29381 30353 34441 35371 37051 38503 43387 50557 51491 57553 79003 82801 83333 87249 88507 97921 99811/ ], [qw/75088 75089 79381 81317 91001 100101 111361 114211 136927 148289 169641 176661 191407 195649/ ], [qw/450775 465991 468931 485357 505441 536851 556421 578771 585631 586249 606361 631651 638731 641683 645679/ ], [qw/642735 653251 653333 663181 676651 714653 759277 794683 805141 844097 872191 874171 894671/ ], [qw/9780504 9780505 9784915 9826489 9882457 9974791 10017517 10018081 10084177 10188481 10247357 10267951 10392241 10427209 10511201/ ], [qw/203659041 204172939 204456793 206407057 206976001 207373483 209301121 210339397 211867969 212146507 212337217 212355793 214400629 214539841 215161459/ ], [qw/553174392 553174393 553945231 554494951 554892787 555429169 557058133 557163157 557165209 558966793 559407061 560291719 561008251 563947141/ ], [qw/1005905886 1005905887 1007713171 1008793699 1010415421 1010487061 1010836369 1012732873 1015269391 1016250247 1018405741 1020182041/ ], [qw/1340600841 1345289261 1345582981 1347743101 1348964401 1350371821 1353332417 1355646961 1357500901 1361675929 1364378203 1366346521 1367104639/ ], [qw/1795265022 1795265023 1797174457 1797741901 1804469753 1807751977 1808043283 1808205701 1813675681 1816462201 1817936371 1819050257/ ], [qw/3046413974 3046413975 3048698683 3051199817 3068572849 3069705673 3070556233 3079010071 3089940811 3090723901 3109299161 3110951251 3113625601/ ], [qw/3613982119 3626488471 3630467017 3643480501 3651840727 3653628247 3654142177 3672033223 3672036061 3675774019 3687246109 3690036017 3720856369/ ], ); for my $pdata (@spsp) { my($base, @vals) = @$pdata; my @fails = grep { !is_strong_pseudoprime($_,$base) } @vals; is_deeply(\@fails, [], "Small SPSP-$base"); } ok( is_strong_pseudoprime(1099558795087,3),"Large SPSP-3") if $use64; # Verify MR for bases >= n is( is_strong_pseudoprime( 3, 3), 1, "spsp( 3, 3)"); is( is_strong_pseudoprime( 11, 11), 1, "spsp( 11, 11)"); is( is_strong_pseudoprime( 89, 5785), 1, "spsp( 89, 5785)"); is( is_strong_pseudoprime(257, 6168), 1, "spsp(257, 6168)"); is( is_strong_pseudoprime(367, 367), 1, "spsp(367, 367)"); is( is_strong_pseudoprime(367, 1101), 1, "spsp(367, 1101)"); is( is_strong_pseudoprime(49001, 921211727), 0, "spsp(49001, 921211727)"); is( is_strong_pseudoprime( 331, 921211727), 1, "spsp( 331, 921211727)"); is( is_strong_pseudoprime(49117, 921211727), 1, "spsp(49117, 921211727)"); { # Verify MR base 2 for all small numbers my $range = 4032; my @got = map { is_strong_pseudoprime($_) } 2..$range; my @exp = map { ($_==2047 || $_==3277 || is_prime($_)) ? 1 : 0 } 2..$range; is_deeply(\@got, \@exp, "MR base 2 for 2..$range"); } SKIP: { skip "base 2,3 without EXTENDED_TESTING",1 unless $extra; my $range = 1373652; my @tnum = vecsample(10000, 1..$range); my $fails = 0; for (@tnum) { $fails++ if !!is_strong_pseudoprime($_,2,3) != !!is_prime($_); } is($fails, 0, "is_strong_pseudoprime bases 2,3 matches is_prime"); } { # strong pseudoprimes for all prime bases 2 .. pn my @phis = qw/2047 1373653 25326001 3215031751 2152302898747 3474749660383 341550071728321 341550071728321/; $#phis = 3 unless $use64; my @got = map { is_strong_pseudoprime($phis[$_], @sp[0 .. $_]) } 0..$#phis; my @exp = map { 1 } 0 .. $#phis; is_deeply(\@got, \@exp, "A014233: first strong pseudoprime to N prime bases"); } # A 77-bit composite that passes many bases ok(is_strong_pseudoprime("318665857834031151167461", 2,3,5,7,11,13,17,19,23,29,31,37),"318665857834031151167461 is a pseudoprime to many bases"); # I don't think we benefit from doing these tests. # '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/ ], }; subtest 'Lucas pseudoprimes', sub { my @P; @P = qw/323 377 1159 1829 3827 5459 5777 9071 9179 10877 11419 11663 13919 14839 16109 16211 18407 18971 19043/; is_deeply([grep{ !is_lucas_pseudoprime($_)} @P],[],"Small Lucas"); @P = qw/5459 5777 10877 16109 18971 22499 24569 25199 40309 58519 75077 97439 100127 113573 115639 130139/; is_deeply([grep{ !is_strong_lucas_pseudoprime($_)} @P],[],"Small strong Lucas"); @P = qw/989 3239 5777 10877 27971 29681 30739 31631 39059 72389 73919 75077 100127 113573 125249 137549 137801 153931 155819/; is_deeply([grep{ !is_extra_strong_lucas_pseudoprime($_)} @P],[],"Small extra strong Lucas"); @P = qw/989 3239 5777 10469 10877 27971 29681 30739 31631 39059 72389 73919 75077 100127 113573 125249 137549 137801 153931 154697 155819/; is_deeply([grep{ !is_almost_extra_strong_lucas_pseudoprime($_)} @P],[],"Small almost extra strong Lucas"); @P = 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/; is_deeply([grep{ !is_almost_extra_strong_lucas_pseudoprime($_,2)} @P],[],"Small almost extra strong Lucas (increment 2)"); # Verify extra strong for a few small primes is_deeply( [grep { is_extra_strong_lucas_pseudoprime($_) } 2..100], [grep { $_ >= 2 && $_ <= 100 } @sp], "The first 100 primes are selected by is_extra_strong_lucas_pseudoprime" ); # Verify Lucas for some small numbers ok(is_strong_lucas_pseudoprime(2),"is_strong_lucas_pseudoprime(2) = 1"); my @C = (9, 16, 100, 102, 2047, 2048, 5781, 9000, 14381); is_deeply([grep{is_lucas_pseudoprime($_)}@C],[],"Not SLPSP: [@C]"); if ($use64) { my @LPSP = (2199055761527); my @SLPSP = (4294967311,4294967357,12598021314449); my @ESLPSP = (4294967311,4294967357,10099386070337); my @AESLPSP = (4294967311,4294967357,10071551814917); is_deeply([map {is_lucas_pseudoprime($_)} @LPSP], [map{1}@LPSP], "LPSP: @LPSP"); is_deeply([map {is_strong_lucas_pseudoprime($_)} @SLPSP], [map{1}@SLPSP], "SLPSP: @SLPSP"); is_deeply([map {is_extra_strong_lucas_pseudoprime($_)} @ESLPSP], [map{1}@ESLPSP], "ESLPSP: @ESLPSP"); is_deeply([map {is_almost_extra_strong_lucas_pseudoprime($_)} @AESLPSP], [map{1}@AESLPSP], "AESLPSP: @AESLPSP"); } }; subtest 'other pseudoprimes', sub { my @P; @P = 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/; is_deeply([grep{ !is_euler_plumb_pseudoprime($_)} @P],[],"Small Euler-Plumb"); @P = 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/; is_deeply([grep{ !is_euler_pseudoprime($_)} @P],[],"Small Euler base 2"); @P = 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/; is_deeply([grep{ !is_euler_pseudoprime($_,3)} @P],[],"Small Euler base 2"); @P = 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/; is_deeply([grep{ !is_euler_pseudoprime($_,29)} @P],[],"Small Euler base 29"); # Following are not used for anything, but interesting # Euler-Jacobi (A047713) @P = 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/; is_deeply([grep{ powmod(2,$_>>1,$_) != modint(kronecker(2,$_),$_) } @P],[],"Small Euler-Jacobi base 2"); # Fibonacci (A081264, Wikipedia first definition) @P = qw/323 377 1891 3827 4181 5777 6601 6721 8149 10877 11663 13201 13981 15251 17119 17711 18407 19043 23407 25877 27323/; my @fmod5 = (0,-1,1,1,-1); is_deeply([grep{lucasumod(1,-1,$_+$fmod5[$_%5],$_)} @P],[],"Small Fibonacci"); @P = 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/; is_deeply([grep { submod(lucasumod(2,-1,$_,$_),kronecker(2,$_),$_) } @P],[],"Small Pell"); }; subtest 'Perrin pseudoprimes', sub { my @P = qw/271441 904631 16532714 24658561 27422714 27664033 46672291/; is_deeply([grep{ !is_perrin_pseudoprime($_)} @P],[],"Small Perrin"); SKIP: { skip "larger Perrin",1 unless $extra; my @P = qw/102690901 130944133 196075949 214038533 517697641 545670533 801123451/; is_deeply([grep{ !is_perrin_pseudoprime($_)} @P],[],"Larger Perrin"); } # Perrin restrictions is( is_perrin_pseudoprime(271441,0), 1, "271441 is an unrestricted Perrin pseudoprime"); is( is_perrin_pseudoprime(271441,1), 0, "271441 is not a minimal restricted Perrin pseudoprime"); SKIP: { skip "restrictions without EXTENDED_TESTING on 32-bit",4 unless $use64 || $extra; 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"); } # Large Perrin pseudoprime. Very slow without GMP. SKIP: { skip "very large pseudoprime without EXTENDED_TESTING",1 unless $extra; skip "very large pseudoprime without GMP backend",1 unless $usegmp && $Math::Prime::Util::GMP::VERSION >= 0.40; my $perrinpsp = "1872702918368901354491086980308187833191468631072304770659547218657051750499825897279325406141660412842572655186363032039901203993254366727915836984799032960354882761038920216623610400227219443050113697104123375722324640843102690830473074828429679607154504449403902608511103291058038852618235905156930862492532896467422733403061010774542590301998535381232230279731082501"; is( is_perrin_pseudoprime($perrinpsp), 1, "18727...2501 is a Perrin PRP" ); } }; subtest 'Catalan pseudoprimes', sub { my @P = (5907); # Without XS or GMP, these are soooo slow. push @P, 1194649, 12327121 if $usexs || ($extra && $usegmp && defined &Math::Prime::Util::GMP::binomial && $Math::Prime::Util::GMP::VERSION >= 0.27); is_deeply([grep{ !is_catalan_pseudoprime($_)} @P],[],"Catalan [@P]"); }; subtest 'Frobenius type pseudoprimes', sub { my @P; @P = qw/4181 5777 6721 10877 13201 15251 34561 51841 64079 64681 67861 68251 75077 90061 96049 97921 100127/; is_deeply([grep{ !is_frobenius_pseudoprime($_,1,-1)} @P],[],"Small Frobenius(1,-1)"); @P = qw/13333 44801 486157 1615681 3125281 4219129 9006401 12589081 13404751 15576571 16719781/; is_deeply([grep{ !is_frobenius_pseudoprime($_,3,-5)} @P],[],"Small Frobenius(3,-5)"); # These have no known counterexamples { my $ntests = $usexs ? 100 : 2; @P = map { irand() & 1 } 1 .. $ntests; # Random odd @P = map { $_ % 3 ? $_ : $_-2 } @P; # not divisible by 3 @P = map { $_ % 5 ? $_ : $_+6 } @P; # not divisible by 5 my @ISP = map { [$_,!!is_prime($_)] } @P; is_deeply([map { [$_,!!is_frobenius_underwood_pseudoprime($_)] } @P],\@ISP,"32-bit Frobenius Underwood ($ntests random)"); is_deeply([map { [$_,!!is_frobenius_khashin_pseudoprime($_)] } @P],\@ISP,"32-bit Frobenius Khashin ($ntests random)"); } if ($use64) { my $ntests = 2; @P = map { urandomb(64) & 1 } 1 .. $ntests; @P = map { $_ % 3 ? $_ : $_-2 } @P; # not divisible by 3 @P = map { $_ % 5 ? $_ : $_+6 } @P; # not divisible by 5 my @ISP = map { [$_,!!is_prime($_)] } @P; is_deeply([map { [$_,!!is_frobenius_underwood_pseudoprime($_)] } @P],\@ISP,"64-bit Frobenius Underwood ($ntests random)"); is_deeply([map { [$_,!!is_frobenius_khashin_pseudoprime($_)] } @P],\@ISP,"64-bit Frobenius Khashin ($ntests random)"); } }; Math-Prime-Util-0.74/t/26-stirling.t000644 000765 000024 00000020706 15146553566 017125 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/stirling/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; plan tests => 4; subtest 'input validations', sub { # We are using UV prototypes, so don't catch this. #ok(!defined eval { stirling(-4, -3) }, "Expected fail: stirling with negative args"); ok(!defined eval { stirling(4,3,4) }, "Expected fail: stirling type 4"); }; subtest 'stirling numbers of the first kind', sub { 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/], ); $#stirling1 = 12 unless $extra; 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++; } SKIP: { skip "stirling(132,67) only with EXTENDED_TESTING", 1 unless $extra; is( "".stirling(132,67,1), '-6132458966070920781607687809239433538883836871765225500351514785120957322534135782514155513931693375104995311496306605620444680401484569675682191339176710', "s(132,67)" ); } }; subtest 'stirling numbers of the second kind', sub { # 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/], ); $#stirling2 = 12 unless $extra; 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++; } SKIP: { skip "large stirling tests only with EXTENDED_TESTING", 1 unless $extra; is( "".stirling(114,85,2), '722095587897382907118640452680242028195738761915144254970925658656935934040', "S(114,85)" ); my $sum = 0; $sum += $_ for split(//, stirling(234,96)); is($sum, 1504, "sumdigits(stirling(234,96) = 1504"); } }; subtest 'stirling numbers of the third kind', sub { # 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 /], ); 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++; } }; Math-Prime-Util-0.74/t/18-15-cmpint.t000644 000765 000024 00000001612 15146553566 017003 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/cmpint/; plan tests => 7 + 1; ###### cmpint is(cmpint(1,2),-1,"1 < 2"); is(cmpint(2,1), 1,"2 > 1"); is(cmpint(2,2), 0,"2 == 2"); is(cmpint("18446744073709553664","18446744073709551615"),1,"2^64+2048 > 2^64-1"); is(cmpint("18446744073709551664","18446744073709551615"),1,"2^64+1048 > 2^64-1"); is(cmpint("18446744073709551615","18446744073709551616"),-1,"2^64-1 < 2^64"); is(cmpint("-18446744073709551615","18446744073709551615"),-1,"-2^64-1 < 2^64-1"); my @arr = (-36, 1, 17, 19, 2400); is_deeply( [map { mediancmp($_,\@arr) } -50,-36,0,1,2,17,18,19,20,2400,3000], [-5,-4,-3,-2,-1,0,1,2,3,4,5], "Use cmpint as part of array median comparator" ); sub mediancmp { my($val,$ar) = @_; #return vecsum(map { cmpint($val,$_) } @$ar); my $sum = 0; $sum += cmpint($val,$_) for @$ar; $sum; } Math-Prime-Util-0.74/t/16-randomprime.t000644 000765 000024 00000022102 15146553566 017576 0ustar00danastaff000000 000000 #!/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 random_safe_prime random_strong_prime factor is_prime is_semiprime is_smooth logint prime_set_config/; 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; 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; }; plan tests => 1 # expected failures + 1 # random_prime(lo,hi) + 1 # random_prime(hi) + 1 # random_ndigit_prime + 1 # random_nbit_prime + 1 # 80-bit + 30-digit random + 1 # random_semiprime + 1 # random_safe_prime + 1 # random_strong_prime + 0; subtest 'expected failures', sub { my $infinity = 20**20**20; 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)"); }; subtest 'random_prime(lo,hi)', sub { is_deeply([map { random_prime($_->[0],$_->[1]) } ([0,0],[0,1],[2,1],[3,2],[1294268492,1294268778],[3842610774,3842611108])], [undef,undef,undef,undef,undef,undef], "random_prime(lo,hi) returns undef when no primes in range"); my @edges = ( [0,2,2,2], [2,2,2,2], [2,3,2,3], [3,5,3,5], [10,20,11,19], [8,12,11,11], [10,12,11,11], [16706143,16706143,16706143,16706143], [16706142,16706144,16706143,16706143], [3842610773,3842611109,3842610773,3842611109], [3842610772,3842611110,3842610773,3842611109] ); for my $edata (@edges) { my($lo,$hi,$lores,$hires) = @$edata; my $got = random_prime($lo,$hi); ok($got >= $lores && $got <= $hires && is_prime($got), "($lo,$hi) => $got in [$lores,$hires]"); } my @ranges = ( [2,20,2,19], [3,7,3,7], [20,100,23,97], [5678,9876,5683,9871], [27767,88493,27767,88493], [27764,88498,27767,88493], [27764,88493,27767,88493], [27767,88498,27767,88493], [17051687,17051899,17051687,17051899], [17051688,17051898,17051707,17051887] ); for my $rdata (@ranges) { my($lo,$hi,$lores,$hires) = @$rdata; my $got = random_prime($lo,$hi); ok($got >= $lores && $got <= $hires && is_prime($got), "($lo,$hi) => $got in [$lores,$hires]"); } }; subtest 'random_prime(hi)', sub { my @random_to = (2, 3, 4, 5, 6, 7, 8, 100, 1000, 1000000, 4294967295); my $nrandom_range_samples = $extra ? 1000 : 50; foreach my $high (@random_to) { my $isprime = 1; my $inrange = 1; for (1 .. $nrandom_range_samples) { my $got = random_prime($high); $isprime = 0 if !is_prime($got); $inrange = 0 if $got < 2 || $got > $high; } ok($isprime && $inrange, "returned prime values in [2,$high]"); } }; subtest 'random_ndigit_prime', sub { prime_set_config(nobigint=>1); # No bigints returned for maxdigits my @T = $use64 ? (1..11,15,19,20) : (1..10); foreach my $digits (@T) { SKIP: { skip "Broken 64-bit, skipping random_ndigit_prime($digits)",1 if $use64 && $broken64 && $digits >= 10; my $n = random_ndigit_prime($digits); ok(!ref($n) && length($n) == $digits && is_prime($n), "($digits) is a $digits-digit prime (got $n)"); } } prime_set_config(nobigint=>0); # Turn this back off }; subtest 'random_nbit_prime', sub { my @T = $extra ? (2..$maxbits) : $use64 ? (2..10,15..17,28,32,34) : (2..10,15..17,28,32); foreach my $bits (@T) { SKIP: { skip "Broken 64-bit, skipping random_nbit_prime($bits)",1 if $use64 && $broken64 && $bits >= 50; check_bits( random_nbit_prime($bits), $bits, "nbit" ); } } }; # These are handled in t/23-random-certs.t # check_bits( random_maurer_prime($bits), $bits, "Maurer" ); # check_bits( random_shawe_taylor_prime($bits), $bits, "Shawe-Taylor" ); # check_bits( random_proven_prime($bits), $bits, "proven" ); subtest 'large random nbit/ndigit', sub { my $n = random_nbit_prime(80); ok( ref($n) =~ /^Math::/, "random 80-bit prime returns a BigInt" ); ok( 1+logint($n,2) == 80, "random 80-bit prime '$n' is in range" ); my $D = $use64 ? 30 : 16; SKIP: { skip "Skipping $D-digit random prime with broken 64-bit Perl", 2 if $broken64; my $n = random_ndigit_prime($D); ok( ref($n) =~ /^Math::/, "random $D-digit prime returns a BigInt" ); ok( 1+logint($n,10) == $D, "random $D-digit prime '$n' is in range" ); } }; subtest 'semiprimes', sub { 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"); for my $bits (4 .. 10) { check_semi_bits(random_semiprime($bits), $bits, "random_semiprime"); check_semi_bits(random_unrestricted_semiprime($bits), $bits, "random_unrestricted_semiprime"); } $n = random_semiprime(26); ok($n >= 33554432 && $n < 67108864 && scalar(factor($n)) == 2, "random_semiprime(26) is a 26-bit semiprime"); $n = random_semiprime(81); ok( 1+logint($n,2) == 81, "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( 1+logint($n,2) == 81, "random_unrestricted_semiprime(81) is 81 bits"); } }; subtest 'safe primes', sub { ok(!eval { random_safe_prime(2); }, "random_safe_prime(2) is invalid"); # This can be very slow over 65 bits for my $bits (3, 5, 8, 40, 70) { SKIP: { skip "Skip larger safe prime on 32-bit",1 if $bits > 50 && !$use64; my $p = random_safe_prime($bits); my $q = ($p-1) >> 1; ok ( is_nbit($p, $bits) && is_prime($p) && is_prime($q), "random_safe_prime($bits) is in range and is a safe prime"); } } }; subtest 'strong primes', sub { ok(!eval { random_strong_prime(127); }, "random_strong_prime(127) throws error as expected"); for my $bits (128, 247, 512) { SKIP: { skip "skipping random_strong_prime($bits) without GMP", 2 unless $usegmp; my $p = random_strong_prime($bits); check_bits($p,$bits, 'strong'); ok (!is_smooth($p-1, 10000) && !is_smooth($p+1, 10000), "random_strong_prime($bits) isn't obviously weak"); } } }; sub is_nbit { my($n, $bits) = @_; return 1+logint($n,2) == $bits ? 1 : 0; } sub check_bits { my($n, $bits, $what) = @_; my $strn = length($n) <= 24 ? "$n" : substr($n,0,12)."...".substr($n,-12,12); ok(is_nbit($n,$bits) && is_prime($n), "random $what prime '$strn' is a $bits-bit prime"); } sub check_semi_bits { my($n, $bits, $name) = @_; ok(is_nbit($n,$bits) && is_semiprime($n), "$name($bits) is in range and semiprime"); } Math-Prime-Util-0.74/t/11-sumprimes.t000644 000765 000024 00000003732 15146553566 017310 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/sum_primes vecsum primes/; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my %sums = ( "189695660 to 189695892" => 0, "0 to 300000" => 3709507114, "12345 to 54321" => 132980191, "10000000 to 10001000" => 610034659, "1960000 to 2000050" => 5445653916, # Should trigger _sum_primes_n ); my @large = ( ["100", "1060"], ["1000", "76127"], ["10000", "5736396"], ["65535", "202288087"], ["65536", "202288087"], ["65537", "202353624"], ["321059", "4236201628"], ["321060", "4236201628"], ["321072", "4236201628"], ["321073", "4236522701"], ["1000000", "37550402023"], ["10000000", "3203324994356"], ["100000000", "279209790387276"], ["1000000000", "24739512092254535"], ["2000000000", "95673602693282040"], ["4000000000", "370412807102643725"], ["4294967295", "425649736193687430"], ["4294967296", "425649736193687430"], ["5000000000", "572840944428163514"], ["10000000000", "2220822432581729238"], ["19505444491", "8205714352685564257"], ["20705000000", "9222267677559724371"], ["29505444490", "18446744057541225032"], ["29505444491", "18446744087046669523"], ); @large = grep { ($_->[0] <= 1000000) || ($extra && (($usexs && $use64) || $_->[0] <= 100000000)) } @large; plan tests => 1 + scalar(keys %sums) + scalar(@large); { 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" ); } foreach my $pair (@large) { my($n,$sum) = @$pair; is( "".sum_primes(0,$n), $sum, "sum_primes($n) = $sum" ); } Math-Prime-Util-0.74/t/51-znlog.t000644 000765 000024 00000004256 15146553566 016423 0ustar00danastaff000000 000000 #!/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,2,4,6,8]], [ [3,3,8], [1,3,5,7]], [ [10,2,101], 25], [ [2,55,101], 73], # 2 = 55^73 mod 101 [ [5,2,401], [48,248]], # 5 = 2^48 mod 401 (Pari #1285) [ [228,2,383], [110,301]], [ [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) { # 5675 = 5^2003974 mod 10000019 push @znlogs, [[5675,5,10000019], [2003974,7003983]]; push @znlogs, [[18478760,5,314138927], 34034873]; push @znlogs, [[553521,459996,557057], [qw/15471 48239 81007 113775 146543 179311 212079 244847 277615 310383 343151 375919 408687 441455 474223 506991 539759/]]; push @znlogs, [[7443282,4,13524947], [6762454,13524927]]; } 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); if (defined $exp && ref($exp)) { ok( is_one_of($k, @$exp), "znlog($a,$g,$p) = $k [@$exp]" ); } else { is( $k, $exp, "znlog($a,$g,$p) = " . ((defined $exp) ? $exp : "") ); } } sub is_one_of { my($n, @list) = @_; if (defined $n) { for (@list) { return 1 if defined $_ && "$n" eq $_; } } else { for (@list) { return 1 if !defined $_; } } 0; } Math-Prime-Util-0.74/t/26-pillai.t000644 000765 000024 00000001712 13667653334 016540 0ustar00danastaff000000 000000 #!/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.74/t/19-ramanujan.t000644 000765 000024 00000007754 15146553566 017260 0ustar00danastaff000000 000000 #!/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.74/t/25-lucas_sequences.t000644 000765 000024 00000024244 15150473505 020441 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/lucasu lucasv lucasuv lucasumod lucasvmod lucasuvmod foroddcomposites modint/; #my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; 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'}; # 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 || $Math::Prime::Util::GMP::VERSION >= 0.53) { 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 %lucas_sequences = ( "323 1 1 324" => [0,2], "323 4 1 324" => [170,308], "323 4 5 324" => [194,156], "323 3 1 324" => [0,2], "323 3 1 81" => [0,287], "323 5 -1 81" => [153,195], "49001 25 117 24501" => [20933,18744], "18971 10001 -1 4743" => [5866,14421], "18971 10001 -1 4743" => [5866,14421], "3613982123 1 -1 3613982124" => [0,3613982121], "3613982121 1 -1 3613982122" => [2586640546,2746447323], "3613982121 1 -1 1806991061" => [3535079342,1187662808], "547968611 1 -1 547968612" => [1,3], "547968611 1 -1 136992153" => [27044236,448467899], ); my %lucas_dcheck = (); if ($usexs || !$usegmp || $Math::Prime::Util::GMP::VERSION >= 0.53) { %lucas_dcheck = ( "7777 -6 9 77" => [5467,4624], # D=0 "7777 -6 7 77" => [2521,4663], # D=8 "7777 4 3 77" => [2732,5466], # D=4 "7777 4 4 77" => [6237,6889], # D=0 "7777 3 5834 77" => [ 30,4509], # D=4 mod n "7777 3 5835 77" => [4004,2883], # D=0 mod n "7777 1 5833 77" => [ 385,4449], # D=0 mod n "7777 2 1 77" => [ 77, 2], # D=0 mod n "7777 -8882 1 77"=> [6964, 687], # D=32 mod n "7778 7776 1 32" => [7746, 2], # D=0 mod n and not invertible "7778 7776 1 33" => [ 33,7776], # D=0 mod n and not invertible "7778 1976 5 32" => [7764,1080], # D=0 mod n and not invertible "7778 1976 5 33" => [6153,1454], # D=0 mod n and not invertible ); } my %lucas_large = (); if (!$usegmp || $Math::Prime::Util::GMP::VERSION >= 0.53) { $lucas_large{"10891238901329801329843210 8823012438914798 7334809241809243190243 37"} = [qw/9793462298071844822738199 7806353955219259067966732/]; if ($extra) { $lucas_large{"10891238901329801329801234 9823092438924798 9234809243809243890243 390"} = [qw/6124196139840885691066464 8614669321673340197867400/]; } } 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; my @issue47 = ( [4,1,-1,951, "2 0"], [4,2,-1,951, "1 2"], [8,1,-1,47, "1 7"], [8,2,-1,47, "1 6"], [5,1,-1,0, "0 2"], [5,2,-1,0, "0 2"], [5,1,-1,66, "3 3"], [5,2,-1,66, "0 3"], [1001,-4,4,50, "173 827"], [1001,-4,7,50, "87 457"], [1001,1,-1,50, "330 486"], [5,1,-1,4, "3 2"], [3,6,9,36, "0 0"], [5,10,25,101, "0 0"], [6,10,25,101, "5 4"], [3,-6,9,0, "0 2"], [1,30,1,15, "0 0"], [3,3,3,1, "1 0"], [3,-30,-30,1, "1 0"], [1,9,5,0, "0 0"], # Everything mod 1 [104,-14,49,0, "0 2"], [104,-14,49,1, "1 90"], [8,2,1,1, "1 2"], [16,0,0,1, "1 0"], [2,11,-27,0, "0 0"], [3,30,-2,1, "1 0"], ); plan tests => 0 + 2*scalar(@lucas_seqs) + 1 + 3 + 3 * scalar(keys %lucas_sequences) + 6 * scalar(keys %lucas_dcheck) + 6 * scalar(keys %lucas_large) + scalar(@issue47) + 3 + 3; # large inputs foreach my $seqs (@lucas_seqs) { my($apq, $isneg, $uorv, $name, $exp) = @$seqs; my($P,$Q) = @$apq; my $idx = ($uorv eq 'U') ? 0 : 1; my @seq = map { (lucasuvmod($P,$Q,$_,2**32-1))[$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; my($P,$Q) = @$apq; if ($uorv eq 'U') { is_deeply([map { lucasu($P,$Q,$_) } 0..$#$exp], $exp, "lucasu(@$apq) -- $name"); } else { is_deeply([map { lucasv($P,$Q,$_) } 0..$#$exp], $exp, "lucasv(@$apq) -- $name"); } } { my @p; foroddcomposites { my $t = (($_%5)==2||($_%5)==3) ? $_+1 : $_-1; push @p, $_ if lucasumod(1,-1,$t,$_) == 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) = lucasuvmod(1, -1, $n+$e, $n); is_deeply( [$U,$V], [0,5466722], "First entry of OEIS A141137: Even Fibonacci pseudoprimes" ); is(lucasumod(1, -1, $n+$e, $n), 0, "lucasumod agrees"); is(lucasvmod(1, -1, $n+$e, $n), 5466722, "lucasvmod agrees"); } # Simple Lucas sequences while (my($params, $expect) = each (%lucas_sequences)) { my($n,$P,$Q,$k) = split(' ', $params); is_deeply( [lucasuvmod($P,$Q,$k,$n)], $expect, "lucasuvmod($P,$Q,$k,$n)" ); is( lucasumod($P,$Q,$k,$n), $expect->[0], "lucasumod($P,$Q,$k,$n)" ); is( lucasvmod($P,$Q,$k,$n), $expect->[1], "lucasvmod($P,$Q,$k,$n)" ); # Don't run these through lucasuv, lucasu, lucasv } # Check D values my %allcheck = (%lucas_dcheck, %lucas_large); while (my($params, $expect) = each %allcheck) { my($n,$P,$Q,$k) = split(' ', $params); is_deeply( [map{"$_"}lucasuvmod($P,$Q,$k,$n)], $expect, "lucasuvmod($P,$Q,$k,$n)" ); is( "".lucasumod($P,$Q,$k,$n), $expect->[0], "lucasumod($P,$Q,$k,$n)" ); is( "".lucasvmod($P,$Q,$k,$n), $expect->[1], "lucasvmod($P,$Q,$k,$n)" ); is_deeply( [map {"$_"} map { $_ % $n } lucasuv($P,$Q,$k)], $expect, "lucasuv($P,$Q,$k) % $n" ); is( "".lucasu($P,$Q,$k) % $n, $expect->[0], "lucasu($P,$Q,$k) % $n" ); is( "".lucasv($P,$Q,$k) % $n, $expect->[1], "lucasv($P,$Q,$k) % $n" ); } for my $i (@issue47) { my($n,$P,$Q,$k,$expstr) = @$i; is( join(" ",lucasuvmod($P,$Q,$k,$n)), $expstr, "lucasuvmod($P,$Q,$k,$n) = $expstr"); } { my $n = 257; my @u1 = map { lucasumod(1,-1,$_,$n) } 0 .. 100; my @v1 = map { lucasvmod(1,-1,$_,$n) } 0 .. 100; my @u2 = map { modint(lucasu(1,-1,$_),$n) } 0 .. 100; my @v2 = map { modint(lucasv(1,-1,$_),$n) } 0 .. 100; my @uv1 = map { [lucasuvmod(1,-1,$_,$n)] } 0 .. 100; my @uv2 = map { [map { modint($_,$n) } lucasuv(1,-1,$_)] } 0 .. 100; is_deeply(\@u1, \@u2, "lucasumod comparison with modint lucasu"); is_deeply(\@v1, \@v2, "lucasvmod comparison with modint lucasv"); is_deeply(\@uv1, \@uv2, "lucasuvmod comparison with modint lucasuv"); } # Arbitrary large inputs is_deeply([map{"$_"}lucasuvmod("98230984092384092384", "-2938094809238420923423423234", 1777, "398908340943094334094290237")], [qw/281234951900970815965553779 286001090644956921206996074/], "lucasuvmod with all large bigint inputs" ); is("".lucasumod("98230984092384092384", "-2938094809238420923423423234", 1777, "398908340943094334094290237"), "281234951900970815965553779", "lucasumod with all large bigint inputs" ); is("".lucasvmod("98230984092384092384", "-2938094809238420923423423234", 1777, "398908340943094334094290237"), "286001090644956921206996074", "lucasvmod with all large bigint inputs" ); Math-Prime-Util-0.74/t/19-chebyshev.t000644 000765 000024 00000003626 14056645657 017260 0ustar00danastaff000000 000000 #!/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.59350713646702688959187294159019343, 123456 => 123034.09173991353285470434178654771360, 69201234 => 69192285.907794531021524894279820294952, ); 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.74/t/26-ishappy.t000644 000765 000024 00000006501 14773770075 016745 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/ is_happy vecall addint /; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my @a007770 = (1,7,10,13,19,23,28,31,32,44,49,68,70,79,82,86,91,94,97,100,103,109,129,130,133,139,167,176,188,190,192,193,203,208,219,226,230,236,239,262,263,280,291,293,301,302,310,313,319,320,326,329,331,338,356,362,365,367,368,376,379,383,386,391,392,397,404,409,440,446,464,469,478,487,490,496,536,556,563,565,566,608,617,622,623,632,635,637,638,644,649,653,655,656,665,671,673,680,683,694,700,709); my @a090425 = (1,6,2,3,5,4,4,3,4,5,5,3,6,4,4,3,5,5,4,2,3,5,4,3,6,6,4,4,5,5,4,6,4,4,4,6,4,6,6,6,6,4,4,6,3,4,3,6,6,4,6,6,6,5,7,6,7,6,6,6,7,5,6,6,6,7,5,5,5,4,4,7,5,5,5,7,7,4,7,4,5,3,4,6,6,6,7,6,6,4,7,7,4,5,5,4,6,3,6,7,6,4); my @a239320 = (1,3,9,13,17,23,25,27,31,35,37,39,47,51,53,59,61,65,69,71,73,75,77,79,81,85,89,91,93,101,105,107,109,111,117,137,141,143,153,155,159,161,167,169,173,177,179,181,183,185,187,191,195,197,207,209,213); my @a240849 = (1,5,7,11,19,23,25,27,33,35,41,43,49,51,55,79,81,83,91,93,95,99,103,109,115,119,121,123,125,127,133,135,141,143,149,153,157,159,161,165,169,171,173,175,181,189,193,197,201,203,205,209,213,215,217,219,221,223,229,231,233,237,241,243,245,249); my @base16 = (1,2,4,6,8,11,16,17,20,24,27,32,34,36,38,39,40,53,59,64,65,66,68,71,74,83,87,88,89,96,98,105,106,110,114,116,117,119,121,122,127,128,129,130,133,136,138,141,142,143,149); my @base36 = (1,6,36,216,467); my @k3 = (1,10,100,112,121,211,778,787,877,1000,1012,1021,1102,1120,1189,1198,1201,1210,1234,1243,1324,1342,1423,1432,1579,1597,1759,1795,1819,1891,1918,1957,1975,1981,2011,2101,2110,2134,2143,2314,2341,2413,2431,2779,2797,2977); my %ex = ( 10234456789 => 4, 1234456789 => 4, "1034567892987654301" => 6, "13456789298765431" => 6, 7777777777 => 6, 778688 => 7, 11025 => 4, "99194853094755497" => 7, 69378 => 7, ); plan tests => 4 + 6 + 1 + 5; is_deeply( [grep { is_happy($_) } 0..715], \@a007770, "is_happy(0..715) boolean" ); is_deeply( [map { is_happy($_) } @a007770], \@a090425, "is_happy(0..709) heights" ); is(is_happy(78999), 8, "78999 has a happy height of 8"); is(is_happy("3788" . ("9"x973)), 9, "3788(9)_973 has a happy height of 9"); { my @happy_consec = (0,0,31,1880,7839,44488,"7899999999999959999999996","7899999999999959999999996"); for my $k (2..7) { my $n = $happy_consec[$k]; my $pass = vecall { is_happy(addint($n,$_)) } 0..$k-1; ok($pass, "$n is the start of $k consecutive happy numbers"); } } { my(@N,@H); for my $n (keys %ex) { push @N, $n; push @H, $ex{$n}; } is_deeply([map { is_happy($_) } @N], \@H, "some selected examples"); } is_deeply( [grep { is_happy($_,3,2) } 0..214], \@a239320, "is_happy(0..214,3,2) boolean (base 3)" ); is_deeply( [grep { is_happy($_,5,2) } 0..250], \@a240849, "is_happy(0..250,5,2) boolean (base 5)" ); is_deeply( [grep { is_happy($_,16,2) } 0..149], \@base16, "is_happy(0..149,16,2) boolean (base 16)" ); is_deeply( [grep { is_happy($_,36,2) } 0..500], \@base36, "is_happy(0..500,36,2) boolean (base 36)" ); is_deeply( [grep { is_happy($_,10,3) } 0..3000], \@k3, "is_happy(0..3000,10,3) boolean (sum of cubes of digits)" ); Math-Prime-Util-0.74/t/26-smooth.t000644 000765 000024 00000007343 15146553566 016605 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_smooth is_rough smooth_count rough_count factor vecnone/; 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 $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; plan tests => 4 # small is_smooth / is_rough + 4+3 # special case is_smooth / is_rough + 4+4 # is_smooth large + 4+2; # smooth_count / rough_count ###### is_smooth / is_rough { my(@sexp, @sgot, @sngot, @rexp, @rgot, @rngot); for my $k (0..9,11,13,17,29) { for my $n (0..12, 143, 187, 253, 319, 341, 851, 1073, 1147) { push @sexp, fac_is_smooth($n, $k); push @rexp, fac_is_rough($n, $k); push @sgot, is_smooth($n, $k); push @rgot, is_rough($n, $k); push @sngot, is_smooth(-$n, $k); push @rngot, is_rough(-$n, $k); } } is_deeply( \@sgot, \@sexp, "is_smooth(n,k) for small inputs" ); is_deeply( \@sngot, \@sexp, "is_smooth(-n,k) for small inputs" ); is_deeply( \@rgot, \@rexp, "is_rough(n,k) for small inputs" ); is_deeply( \@rngot, \@rexp, "is_rough(-n,k) for small inputs" ); } is(is_smooth(1000000,10000),1,"1000000 is 10000-smooth"); is(is_smooth(1000127,10000),0,"1000127 is not 10000-smooth"); is(is_rough(1000127,3000),0,"1000127 is not 3000-rough"); is(is_rough(1000157,3000),0,"1000157 is not 3000-rough"); is(is_rough("137438953481",3000),1,"137438953481 is 3000-rough"); is(is_rough("137438953493",3000),0,"137438953493 is not 3000-rough"); is(is_rough("137438953529",3000),1,"137438953529 is 3000-rough"); { my $n = "1377276413364943226363244108454842276965894752197358387200000"; # 97 is( is_smooth($n, 23), 0, "large 97-smooth number" ); is( is_smooth($n, 96), 0, "large 97-smooth number" ); is( is_smooth($n, 97), 1, "large 97-smooth number" ); is( is_smooth($n, 98), 1, "large 97-smooth number" ); } { my $n = "172864518041328651521584134678230948270774322090771071422829"; # 2081 is( is_smooth($n, 4073), 1, "large 4073-smooth, 2081-rough number" ); is( is_rough($n, 2080), 1, "large 4073-smooth, 2081-rough number" ); is( is_rough($n, 2081), 1, "large 4073-smooth, 2081-rough number" ); is( is_rough($n, 2082), 0, "large 4073-smooth, 2081-rough number" ); } ###### smooth_count { # mpu 'for $n (0..5){for $k (0..5){push @v,vecsum(map{is_smooth($_,$k)}1..$n)}} say join ",",@v;' my @exp = (0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,1,1,2,3,3,3,1,1,3,4,4,4,1,1,3,4,4,5); my @got; for my $n (0..5) { for my $k (0..5) { push @got, smooth_count($n,$k); } } is_deeply( \@got, \@exp, "smooth_count(0..5, 0..5)" ); } is(smooth_count(100,17), 67, "smooth_count(100,17)"); is(smooth_count(1980627498,9), 5832, "smooth_count(1980627498,9)"); SKIP: { skip "skipping slow smooth count test with PP", 1 unless $usexs || $extra; is(smooth_count(10000000,400), 1132424, "smooth_count(10000000,400)"); } ###### rough_count { # mpu 'for $n (0..5){for $k (0..5){push @v,vecsum(map{is_rough($_,$k)}1..$n)}} say join ",",@v;' my @exp = (0,0,0,0,0,0,1,1,1,1,1,1,2,2,2,1,1,1,3,3,3,2,1,1,4,4,4,2,1,1,5,5,5,3,2,2); my @got; for my $n (0..5) { for my $k (0..5) { push @got, rough_count($n,$k); } } is_deeply( \@got, \@exp, "rough_count(0..5, 0..5)" ); } is(rough_count(3700621409,15), 709809501, "rough_count(3700621409,15)"); ###### ---- helper functions ---- sub fac_is_smooth { my($n, $k) = @_; # True if no prime factors of n are larger than k return 0+(vecnone { $_ > $k } factor($n)); } sub fac_is_rough { my($n, $k) = @_; # True if no prime factors of n are smaller than k return 0+(vecnone { $_ < $k } factor($n)); } Math-Prime-Util-0.74/t/11-primepowers.t000644 000765 000024 00000020057 15146553566 017637 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/prime_powers is_prime_power next_prime_power prev_prime_power prime_power_count prime_power_count_approx prime_power_count_lower prime_power_count_upper nth_prime_power nth_prime_power_approx nth_prime_power_lower nth_prime_power_upper /; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my @small = (2, 3, 4, 5, 7, 8, 9, 11, 13, 16, 17, 19, 23, 25, 27, 29, 31, 32, 37, 41, 43, 47, 49, 53, 59, 61, 64, 67, 71, 73, 79, 81, 83, 89, 97); my @A025528 = (0, 1, 2, 3, 4, 4, 5, 6, 7, 7, 8, 8, 9, 9, 9, 10, 11, 11, 12, 12, 12, 12, 13, 13, 14, 14, 15, 15, 16, 16, 17, 18, 18, 18, 18, 18, 19, 19, 19, 19, 20, 20, 21, 21, 21, 21, 22, 22, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 25, 25, 26, 26, 26, 27, 27, 27, 28, 28, 28, 28, 29, 29, 30, 30); my @A267712 = (7, 35, 193, 1280, 9700, 78734, 665134, 5762859, 50851223, 455062595, 4118082969, 37607992088, 346065767406, 3204942420923, 29844572385358, 279238346816392, 2623557174778438, 24739954338671299, 234057667428388198, 2220819603016308079); $#A025528 = 40; $#A267712 = ($usexs || $extra) ? 7 : 6; my %samples = (72=>263, 89=>353, 311=>1831, 423=>2677, 814=>5857, 1509=>12149, 4484=>42089, 9163=>93893); $samples{10957} = 114671 if $usexs; $samples{20942} = 234599 if $usexs; $samples{51526} = 629819 if $usexs; $samples{417867} = 6071249 if $usexs; $samples{717421} = 10843321 if $usexs || $extra; $samples{1031932} = 16002401 if $usexs || $extra; $samples{2687492} = 44442791 if $usexs || $extra; $samples{8337143} = 147948547 if $usexs || $extra; $samples{21208173} = 397416121 if $usexs || $extra; $samples{47490104} = 930475697 if $usexs || $extra; plan tests => 0 # is_prime_power (not tested here) + 5 # prime_powers + 3 # next_prime_power + 4 # prev_prime_power + 6 # prime_power_count (first set) + 2 # prime_power_count (second set) + 4 # prime_power_count bounds + 3 # nth_prime_power + $extra * scalar(keys %samples) + 9 # nth_prime_power bounds + 0; ###### is_prime_power # See t/26-ispower.t ###### prime_powers my $pp1k = prime_powers(1000); is( scalar(@$pp1k), 193, "prime_powers(1000) has 193 powers"); is( $pp1k->[-1], 997, "last power from prime_powers(1000) is 997"); is_deeply( [grep { $_ <= 300 } @$pp1k], [grep { is_prime_power($_) } 1..300], "prime_powers(300)" ); is_deeply( [map { prime_powers($_) } 1..50], [map { my $n=$_; [grep { $_ <= $n } @small] } 1..50], "prime_powers(1..50)" ); my $base1 = 1441897; is_deeply( prime_powers($base1,$base1+1000), [map { $base1+$_ } (34,36,52,66,84,106,112,120,156,160,172,174,190,246,262,276,294,312,330,354,370,382,402,420,424,430,436,444,454,480,496,504,514,532,540,556,562,612,616,630,634,652,682,694,702,714,724,730,736,744,756,760,772,820,826,834,846,886,900,930,952,966,972,976,990,1000)], "prime_powers($base1, $base1 + 1000)" ); ###### next_prime_power is_deeply( [map { next_prime_power($_-1) } @small], \@small, "next_prime_power"); is_deeply( [map { next_prime_power(2**$_-1) } 1..9], [2, 4, 8, 16, 32, 64, 128, 256, 512], "next_prime_power(2^i+1)" ); is_deeply( [map { next_prime_power(2**$_) } 0..9], [2, 3, 5, 9, 17, 37, 67, 131, 257, 521], "next_prime_power(2^i)" ); ###### prev_prime_power is_deeply( [map { prev_prime_power($_) } 0..2], [undef,undef,undef], "prev_prime_power(0..2) = undef" ); is_deeply( [map { prev_prime_power($_+1) } @small], \@small, "prev_prime_power"); is_deeply( [map { prev_prime_power(2**$_+1) } 1..9], [2, 4, 8, 16, 32, 64, 128, 256, 512], "prev_prime_power(2^i+1)" ); is_deeply( [map { prev_prime_power(2**$_) } 1..9], [undef, 3, 7, 13, 31, 61, 127, 251, 509], "prev_prime_power(2^i)" ); ###### prime_power_count is(prime_power_count(0), 0, "prime_power_count(0) = 0"); is(prime_power_count(1), 0, "prime_power_count(1) = 0"); is_deeply( [map { prime_power_count(1+$_) } 0..$#A025528], \@A025528, "prime_power_count(n) for 1..".scalar(@A025528) ); is_deeply( [map { prime_power_count(10**(1+$_)) } 0..$#A267712], \@A267712, "prime_power_count(10^n) for 1..".scalar(@A267712) ); is(prime_power_count(12345678), 809830, "prime_power_count(12345678) = 809830"); is(prime_power_count(123456, 133332), 847, "prime_power_count(123456,133332) = 847"); is_deeply( [map { prime_power_count(30*$_) } 0..19], [0,16,25,34,40,48,55,60,66,73,79,83,90,96,100,106,111,116,120,125], "prime_power_count(0,30,60,...,570)" ); { my(@expect,@got); for my $lo (0..8,15,16,17,31,32,33,40) { for my $i (0 .. 5,8) { my $hi = $lo + 4*$i; push @expect, [$lo,$hi,scalar(grep { $_ >= $lo && $_ <= $hi } @small)]; push @got, [$lo,$hi,prime_power_count($lo,$hi)]; } } is_deeply( \@got, \@expect, "prime_power_count ranges 0 .. 80" ); } ###### prime_power_count_{upper,lower,approx} is(check_count_bounds(513, 117), 1, "prime_power count bounds for 513"); is(check_count_bounds(5964377, 411055), 1, "prime_power count bounds for 5964377"); my @selc = (0..10,20,30,40,50,60,70,80,90,95,100); is_deeply( [map { check_count_bounds($_, prime_power_count($_)) } @selc], [map { 1 } @selc], "prime_power count bounds for small numbers" ); is_deeply( [map { check_count_bounds($samples{$_},$_) } keys %samples], [map { 1 } keys %samples], "prime_power count bounds for small samples" ); ###### nth_prime_power is( nth_prime_power(0), undef, "nth_prime_power(0) returns undef" ); is_deeply( [map { nth_prime_power($_) } 1 .. 50], [@$pp1k[0..50-1]], "first 50 prime powers with nth_prime_power" ); is( nth_prime_power(1 << 12), 37993, "37993 is the 2^12th prime power" ); if ($extra) { while (my($n, $npp) = each (%samples)) { is( nth_prime_power($n), $npp, "nth_prime_power($n) = $npp" ); } } ###### nth_prime_power{upper,lower,approx} is( nth_prime_power_lower(0), undef, "nth_prime_power_lower(0) returns undef" ); is( nth_prime_power_upper(0), undef, "nth_prime_power_upper(0) returns undef" ); is( nth_prime_power_approx(0), undef, "nth_prime_power_approx(0) returns undef" ); is(check_nth_bounds(86, 343), 1, "nth_prime_power(86) bounds"); is(check_nth_bounds(123456, 1628909), 1, "nth_prime_power(123456) bounds"); is(check_nth_bounds(5286238, 91241503), 1, "nth_prime_power(5286238) bounds"); SKIP: { skip "only with EXTENDED_TESTING", 1 unless $extra; is(check_nth_bounds(46697909, 914119573), 1, "nth_prime_power(46697909) bounds"); } my @seln = $extra ? (1..5,10,18,24,33,35,41,47,52,56,59,65,68,70) : (1..5,12,37,59,64,71); is_deeply( [map { check_nth_bounds($_, $pp1k->[$_-1]) } @seln], [map { 1 } @seln], "nth_prime_power bounds for small powers" ); is_deeply( [map { check_nth_bounds($_, $samples{$_}) } keys %samples], [map { 1 } keys %samples], "nth_prime_power bounds for small samples" ); sub check_count_bounds { my($n, $count) = @_; return "bad lower count for $n" if prime_power_count_lower($n) > $count; return "bad upper count for $n" if prime_power_count_upper($n) < $count; my $approx = prime_power_count_approx($n); return "approx count too low for $n" if $approx < 0.9 * $count; return "approx count too high for $n" if $approx > 1.1 * $count; 1; } sub check_nth_bounds { my($n, $nth) = @_; return "bad nth lower for $n" if nth_prime_power_lower($n) > $nth; return "bad nth upper for $n" if nth_prime_power_upper($n) < $nth; my $approx = nth_prime_power_approx($n); return "approx nth too low for $n" if $approx < 0.9 * $nth; return "approx nth too high for $n" if $approx > 1.1 * $nth; 1; } Math-Prime-Util-0.74/t/26-randperm.t000644 000765 000024 00000012772 15146553566 017106 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/randperm shuffle vecsample csrand/; 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'}; plan tests => 4 + 2; subtest 'randperm', sub { is(@{[randperm(0)]},0,"randperm(0) returns 0 elements"); is(@{[randperm(1)]},1,"randperm(1) returns 1 element"); is(@{[randperm(4,0)]},0,"randperm(4,0) returns 0 elements"); is(@{[randperm(4,1)]},1,"randperm(4,1) returns 1 element"); is(@{[randperm(4,8)]},4,"randperm(4,8) returns 4 elements"); is(@{[randperm(100,4)]},4,"randperm(100,4) returns 4 elements"); my @p128 = randperm(128); isnt("@p128", join(" ",0..127), "randperm(128) shuffles"); is(join(" ",sort {$a<=>$b}@p128), join(" ",0..127), "randperm(128) gives expected indices"); # sub loop_randperm { my($n, $k, $min) = @_; ... } is(join(" / ",loop_randperm(2,2,2)), "0 1 / 1 0", "randperm(2,2) can return all permutations"); is(join(" / ",loop_randperm(3,2,6)), "0 1 / 0 2 / 1 0 / 1 2 / 2 0 / 2 1", "randperm(3,2) can return all permutations"); is(scalar loop_randperm(16,undef,10), 10, "randperm(16) can return multiple permutations"); is(scalar loop_randperm(4,8,6), 6, "randperm(4,8) can return multiple permutations"); is(scalar loop_randperm(42,1,6), 6, "randperm(42,1) can return multiple permutations"); is(scalar loop_randperm(1024,2,6), 6, "randperm(1024,2) can return multiple permutations"); is(scalar loop_randperm(75,6,16), 16, "randperm(75,6) can return multiple permutations"); is(scalar loop_randperm(30,12,2), 2, "randperm(30,12) can return multiple permutations"); is(scalar loop_randperm(54321,10,2), 2, "randperm(54321,10) can return multiple permutations"); is(scalar loop_randperm(123456789,37,2), 2, "randperm(123456789,37) can return multiple permutations"); }; subtest 'shuffle', sub { is_deeply([shuffle()], [], "shuffle() = ()"); is_deeply([shuffle(-277)], [-277], "shuffle(x) = (x)"); my @d128 = (1..128); my @s128 = shuffle(@d128); my @t128 = sort { $a<=>$b } @s128; is(scalar @s128, scalar @d128, "shuffle n items returns n items"); isnt("@s128","@d128", "shuffled 128-element array isn't identical"); is("@t128","@d128", "outputs are the same elements as input"); { my @L = (3,1,2); my %seen; my $tries = 0; # Average tries is 14.7, but could be 100+. for (1 .. 1000) { $tries++; my @S = shuffle(@L); undef $seen{"@S"}; last if 6 <= scalar keys %seen; } my $fs = join " / ", sort keys %seen; is($fs, "1 2 3 / 1 3 2 / 2 1 3 / 2 3 1 / 3 1 2 / 3 2 1", "shuffle(a,b,c) selected each permutation at least once ($tries tries)"); } }; subtest 'vecsample', sub { is_deeply([map {[vecsample($_)]} 0,1,1000], [[],[],[]], "vecsample(k) = ()"); is_deeply([map {[vecsample($_,())]} 0,1,999],[[],[],[]], "vecsample(k,()) = ()"); is_deeply([map {[vecsample($_,[])]} 0,1,999],[[],[],[]], "vecsample(k,[]) = ()"); is_deeply([map {[vecsample(1,($_))]} 0,1,999],[[0],[1],[999]], "vecsample(1,(n)) = (n)"); is_deeply([map {[vecsample(1,[$_])]} 0,1,999],[[0],[1],[999]], "vecsample(1,(n)) = (n)"); is(scalar @{[vecsample(2,[80..100])]}, 2, "returns k items with a large list"); is(scalar @{[vecsample(45,[8,9,10])]}, 3, "returns all items with large k"); is(scalar @{[vecsample(4,[8..11])]}, 4, "returns all items with exact k"); is_deeply([sort {$a<=>$b} vecsample(5,[177,888,15,4,-2])], [-2,4,15,177,888], "returns all items"); ok(is_one_of(vecsample(1,500..600), 500..600), "vecsample(1,L) returns something from L"); { my $L = [87,388,657,890]; my %seen; my $tries = 0; # Average tries is 3.8, but could be 20+. for (1 .. 300) { $tries++; my @S = vecsample(2,$L); undef @seen{@S}; last if 4 <= scalar keys %seen; } my @S = sort { $a<=>$b } keys %seen; is_deeply(\@S, $L, "vecsample(2,a,b,c,d) selected each value at least once ($tries tries)"); } { my @L = (1588..1620); vecsample(5,@L); is_deeply(\@L, [1588..1620], "Input list is not modified"); vecsample(5,\@L); is_deeply(\@L, [1588..1620], "Input aref is not modified"); } }; subtest 'using csrand', sub { my @x; for (1..4) { csrand(14); push @x, join " ",shuffle(1..128); } ok($x[0] eq $x[1] && $x[0] eq $x[2] && $x[0] eq $x[3], "shuffles are repeatable with csrand"); # Entropy seed the RNG for further tests csrand(); }; # Destruction test, from List::MoreUtils { my $dcount; sub TObjSample::DESTROY { $dcount++; } my @ret = vecsample(3, map { bless [], "TObjSample" } 1..10); is($dcount, 7, "vecsample unselected items destroyed"); @ret=(); is($dcount, 10, "vecsample all items destroyed"); } sub loop_randperm { my($n, $k, $min) = @_; my $explen = !defined $k ? $n : $k > $n ? $n : $k; my %seen; my $tries = 0; for (1..10000) { $tries++; my @S = defined $k ? randperm($n,$k) : randperm($n); return () if scalar @S != $explen; #diag "??? expected $explen but got ",scalar(@S),"" if scalar @S != $explen; undef $seen{"@S"}; last if $min <= scalar keys %seen; } diag "loop_randperm($n,$k,$min) took $tries tries" if $tries > 60; my @S = sort keys %seen; @S; } # veccontains should do this, except for the undef part sub is_one_of { my($n, @list) = @_; if (!defined $n) { for (@list) { return 1 if !defined $_; } return 0; } for (@list) { return 1 if defined $_ && $n eq $_; } 0; } Math-Prime-Util-0.74/t/26-zeckendorf.t000644 000765 000024 00000002737 15146553566 017430 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/tozeckendorf fromzeckendorf fromdigits todigits/; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my @z20 = (qw/0 1 10 100 101 1000 1001 1010 10000 10001 10010 10100 10101 100000 100001 100010 100100 100101 101000 101001 101010/); my @toz = ( [24, "1000100"], [27, "1001001"], [568, "1010010100000"], ["4294967295", "1010001000010101000101000100000001000100100100"], ["18446744073709551615", "10100101000100000101000100010010001001000000001001000100100010101000100000101000101000001010"], ["79228162514264337593543950335", "101010010101000101000100010010101010101010010100001010000100000001010101000010000101000000101000010010010001010010001000101000100000101001"], ); plan tests => 0 + 1 + scalar(@toz) # tozeckendorf + 1 + scalar(@toz) # fromzeckendorf + 1; ###### tozeckendorf is_deeply([map { tozeckendorf($_) } 0..20], \@z20, "tozeckendorf for 0..20"); for my $pair (@toz) { my($n,$s) = @$pair; is(tozeckendorf($n), $s, "tozeckendorf($n)"); } ###### fromzeckendorf is_deeply([map { fromzeckendorf($_) } @z20], [0..20], "fromzeckendorf(Z(0..20))"); for my $pair (@toz) { my($n,$s) = @$pair; my $sp = $s; $sp = substr($sp,0,30)."..." if length($s) > 33; is("".fromzeckendorf($s), $n, "fromzeckendorf($sp)"); } ###### is(fromdigits(tozeckendorf(24),2), 68, "fromdigits(tozeckendorf(24),2) = 68"); # TODO: Test for invalid inputs Math-Prime-Util-0.74/t/26-powerfree.t000644 000765 000024 00000011646 15146553566 017273 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_powerfree powerfree_count powerfree_sum powerfree_part powerfree_part_sum nth_powerfree squarefree_kernel is_square_free vecsum vecmax factor_exp/; my @simple = (0 .. 16, 758096738,434420340,870589313,695486396,602721315,418431087, 752518565,723570005,506916483,617459403); my @neg = map { -$_ } (1..32); plan tests => 3 # simple is square free + 11*2 # powerfree_count, powerfree_sum + 6+2 # "" + 7 # nth_powerfree + 2+8 # powerfree_part + 8*2 # powerfree_part_sum + 2; # powerfree_part and squarefree_kernel ##### is_powerfree is_deeply( [map { is_powerfree($_) } @simple, @neg], [map { is_square_free($_) } @simple, @neg], "is_powerfree(n) matches is_square_free(n)" ); is_deeply( [map { is_powerfree($_) } @simple, @neg], [map { ipf($_) } @simple, @neg], "is_powerfree(n) works for simple inputs" ); is_deeply( [map { is_powerfree($_,3) } @simple, @neg], [map { ipf($_,3) } @simple, @neg], "is_powerfree(n,3) works for simple inputs" ); ##### powerfree_count and powerfree_sum foreach my $k (0..10) { my $n = 100; is_deeply( [map { powerfree_count($_, $k) } 0..$n], [map { scalar grep { is_powerfree($_, $k) } 1..$_ } 0..$n], "powerfree_count(0..$n, $k)" ); is_deeply( [map { powerfree_sum($_, $k) } 0..$n], [map { vecsum(grep { is_powerfree($_, $k) } 1..$_) } 0..$n], "powerfree_sum(0..$n, $k)" ); } is( powerfree_count(12345,2), 7503, "powerfree_count(12345,2) = 7503"); is( powerfree_count(12345,3), 10272, "powerfree_count(12345,3) = 10272"); is( powerfree_count(12345,4), 11408, "powerfree_count(12345,4) = 11408"); is( powerfree_sum(12345,2), 46286859, "powerfree_sum(12345,2) = 46286859"); is( powerfree_sum(12345,3), 63404053, "powerfree_sum(12345,3) = 63404053"); is( powerfree_sum(12345,4), 70415676, "powerfree_sum(12345,4) = 70415676"); is( powerfree_count(123456,32), 123456, "powerfree_count(123456,32) = 123456"); is("".powerfree_sum(123456,32), 7620753696, "powerfree_sum(123456,32) = 7620753696"); ##### nth_powerfree is(nth_powerfree(7503), 12345, "nth_powerfree(7503) = 12345"); is(nth_powerfree(10272,3), 12345, "nth_powerfree(10272,3) = 12345"); is(nth_powerfree(11408,4), 12345, "nth_powerfree(11408,4) = 12345"); is(nth_powerfree(915099,3), 1099999, "nth_powerfree(915099,3) = 1099999"); is(nth_powerfree("1000000",2), 1644918, "nth_powerfree(10^6,2) = 1644918"); is(nth_powerfree("1000000",3), 1202057, "nth_powerfree(10^6,3) = 1202057"); is(nth_powerfree("100000000",5), 103692775, "nth_powerfree(10^8,5) = 103692775"); ##### powerfree_part is_deeply( [map { powerfree_part($_) } 0..30], [0,1,2,3,1,5,6,7,2,1,10,11,3,13,14,15,1,17,2,19,5,21,22,23,6,1,26,3,7,29,30], "powerfree_part(0..30)" ); is(powerfree_part(-4000), -10, "powerfree_part(-4000) = -10"); { my $n = "3709362688507618309707310743757146859608351353598858915828644464895074572939593330420817674692554750"; is(powerfree_part($n,0), 0, "powerfree_part(n,0) = 0"); is(powerfree_part($n,1), 0, "powerfree_part(n,1) = 0"); is(powerfree_part($n,2), 1333310, "powerfree_part(n,2) = 1333310"); is("".powerfree_part($n,3), "2607554680038", "powerfree_part(n,3)"); is("".powerfree_part($n,4), "11841796277238534750", "powerfree_part(n,4)"); is("".powerfree_part($n,5), "1653305696539190388308250", "powerfree_part(n,5)"); is("".powerfree_part($n,6), "1315461663807740740160892737772750", "powerfree_part(n,6)"); is("".powerfree_part($n,7), "65926023382783093515719030419129876118250", "powerfree_part(n,7)"); } ##### powerfree_part my @pfpst = (1,1,971014567,1248722293,1368821452,1424239488,1450660380,1463313419); for my $k (0 .. 7) { is_deeply( [map { powerfree_part_sum($_, $k) } 0..32], [map { vecsum(map { powerfree_part($_, $k) } 1..$_) } 0..32], "powerfree_part_sum(0..64, $k)" ); is(powerfree_part_sum(54321,$k), $pfpst[$k], "powerfree_part_sum(54321,$k) = $pfpst[$k]"); } ##### powerfree_part and squarefree_kernel my @T = ( # powerfree part, squarefree_kernel [0, [0, 0]], [1, [1, 1]], [2, [2, 2]], [ 48, [3, 6]], [-48, [-3, -6]], [2*2*3*5, [3*5, 2*3*5]], [2*3*3*3*5*5*7, [2*3*7, 2*3*5*7]], ["15110906613599", [1511, 151104533]], ["4011892804050009", ["4174706351769", "129415896904839"]], ); is_deeply( [map { powerfree_part($_->[0]) } @T], [map { $_->[1]->[0] } @T], "powerfree_part" ); is_deeply( [map { squarefree_kernel($_->[0]) } @T], [map { $_->[1]->[1] } @T], "squarefree_kernel" ); ##### subs sub ipf { my($n,$k) = @_; $k = 2 unless defined $k; $n = -$n if $n < 0; return 0 if $n == 0; return 1 if $n == 1; (vecmax(map { $_->[1] } factor_exp($n)) < $k) ? 1 : 0; } Math-Prime-Util-0.74/t/14-nthprime.t000644 000765 000024 00000017407 15146553566 017121 0ustar00danastaff000000 000000 #!/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 inverse_li_nv/; 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 $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, ); if ($usexs || $extra) { $nthprimes64{ "1000000000000000"} = "37124508045065437"; $nthprimes64{ "10000000000000000"} = "394906913903735329"; $nthprimes64{"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, ); $nthsemi{1234567} = 6365389 if $usexs || $extra; $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 => 1 # nth_prime + 1 # nth_prime lower/upper/approx + 1 # nth_twin_prime and approx + 1 # nth_semiprime + 1 # inverse_li and inverse_li_nv + 0; subtest 'nth_prime', sub { is(nth_prime(0), undef, "nth_prime(0) = undef"); my @pri100 = @{primes(541)}; # First 100 primes my @nth100 = map { nth_prime($_) } 1 .. 100; is_deeply(\@nth100, \@pri100, "nth_prime(1..100)"); is_deeply([map { nth_prime($_) } 1229,1230,9592,9593,78498,78499], [9973,10007,99991,100003,999983,1000003], "nth_prime(n) results around 10k, 100k, 1M"); is_deeply([map { nth_prime($_) } 6305537, 6305540, 6305543], [110040379,110040407,110040503], "nth_prime(6305537, 6305540, 6305543)"); is_deeply([map { nth_prime($_) } 1000,10000,100000,1000000,10000000], [7919,104729,1299709,15485863,179424673], "nth_prime(n) 1k,10k,100k,1M,10M"); # Test an nth prime value that uses the binary-search-on-R(n) algorithm SKIP: { # TODO: Can we use the NV R to solve this with PP? skip "nth_prime(21234567890) for 64-bit XS EXTENDED_TESTING", 1 unless $extra && $use64 && $usexs; is( nth_prime(21234567890), 551990503367, "nth_prime(21234567890)" ); } }; subtest 'nth_prime upper/lower/approx', sub { 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 $okpct = ($n >= 775) ? 1 : 2; cmp_within(nth_prime_approx($n), $nth, $okpct, "nth_prime_approx($n)"); } 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"); cmp_within(nth_prime_approx($n), $nth, .001, "nth_prime_approx($n)"); } } 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)"); }; #################################### subtest 'nth_twin_prime and approx', sub { 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)) { cmp_within(nth_twin_prime_approx($n), $nthtpc, 2, "nth_twin_prime_approx($n)"); } }; #################################### subtest 'nth_semiprime', sub { 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" ); } }; #################################### subtest 'inverse_li and inverse_li_nv', sub { 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)"); cmp_within(inverse_li_nv(4), 5.60927669305089, .001, "inverse_li_nv(4)"); cmp_within(inverse_li_nv(64.2731216921018), 277, .001, "inverse_li_nv(64.2731216921018)"); cmp_within(inverse_li_nv(40000), 478956.000953764, .001, "inverse_li_nv(40000)"); cmp_within(inverse_li_nv(1234567890123), 37301814610592.3, .1, "inverse_li_nv(1234567890123)"); }; sub cmp_within { my($got, $exp, $tolpct, $mess) = @_; my $diffok = 0.01 * $tolpct * abs("$exp") + 0.5; my($diff) = map { 0.0+"$_" } ($got > $exp ? $got-$exp : $exp-$got); my $diffstr = ($got == $exp) ? "0" : ($got > $exp) ? "+$diff" : "-$diff"; ok($diff <= $diffok, "$mess =~ $exp ($diffstr)") or diag "$mess got $got with diff $diff > $diffok"; } Math-Prime-Util-0.74/t/04-inputvalidation.t000644 000765 000024 00000005310 15151735240 020455 0ustar00danastaff000000 000000 #!/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', '0-0', '-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") => Math::BigInt->new("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 my $qrnn = qr/ must be a (non-negative|positive) integer/; eval { next_prime(undef); }; like($@, qr/^Parameter must be defined/, "Gives Error: next_prime(undef)"); eval { next_prime(""); }; like($@, $qrnn, "Gives Error: next_prime('')"); foreach my $v (@incorrect) { $v = "$v" if $] < 5.008 && ref($v) eq 'Math::BigFloat'; eval { next_prime($v); }; like($@, $qrnn, "Gives Error: 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 infinity", 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($@, $qrnn, "Gives Error: next_prime( infinity )"); } SKIP: { skip "Your machine does not have NaN", 1 unless $Config{d_isnan}; no warnings 'numeric'; 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($@, $qrnn, "Gives Error: next_prime( nan ) [nan = '$nan']"); } SKIP: { skip "Perl $], Carp $Carp::VERSION. We need a minimum of 5.8 or Carp 1.17 to avoid segfaults.", 1 if $] < 5.008 && $Carp::VERSION < 1.17; eval { next_prime("11111111111111111111111111111111111111111x"); }; like($@, $qrnn, "Gives Error: next_prime('111...111x')"); } Math-Prime-Util-0.74/t/32-iterators.t000644 000765 000024 00000053162 15150500061 017256 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; # Performance note for the bigint for... tests # # On 64-bit, wthout GMP or a good Math::BigInt backend, these are relative slow: # forprimes, forcomposites, foroddcomposites 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 forsquarefreeint forsemiprimes foralmostprimes forsetproduct lastfor is_power is_semiprime is_almost_prime vecsum sqrtint divisors prime_iterator prime_iterator_object/; use Math::BigInt try => "GMP,GMPz,Pari"; use Math::BigFloat; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; my $broken64 = (18446744073709550592 == ~0); plan tests => 8 # forprimes errors + 14 + 7 # forprimes simple + 3 # forcomposites simple + 2 # fordivisors simple + 3 # iterator errors + 7 # iterator simple + 1 # other forprimes + 2 # forprimes/iterator nesting + 1 # forprimes nested function + 3 # forprimes BigInt/BigFloat # + 3 # oo iterator errors + 7 # oo iterator simple + 28 # oo iterator methods + 12 # lastfor + 13 # forfactored and forsquarefree + 1 # forsemiprimes + 1+10 # foralmostprimes + 9 # forsetproduct + 1 # bigint ranges + 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,$_} 0,0; is_deeply( [@t], [], "forprimes 0,0" ); } {my @t; forprimes {push @t,$_} 0,1; is_deeply( [@t], [], "forprimes 0,1" ); } {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; for my $n (1..50) { fordivisors { push @a, $_ } $n; } 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" ); } # Github 66, nesting a function inside forprimes { my $sum = 0; forprimes { my @d = divisors(6486480 * ($_-1)); $sum += 1+$#d; } 2,10; is($sum, 2016, "Nested call to large divisors inside forprimes"); } # 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->peek(), 31, "iterator object peek shows 31"); 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"); $it->rewind(1); is( $it->value(), 2, "iterator object rewind(1) goes to 2"); $it->rewind(0); is( $it->value(), 2, "iterator object rewind(0) goes to 2"); # 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"); # is(x,y) compares the two using eq. # Math::BigInt is fine with this, but Math::GMP and Math::GMPz are not. $big_prime = "$big_prime"; $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..100; is( $it->tell_i(), 101, "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+$_ } 0,0; is($s, 0, "forfactored {} 0,0"); $s=0; forsquarefree { $s += 1+$_ } 0,0; is($s, 0, "forsquarefree {} 0,0"); $s=0; forsquarefreeint { $s += 1+$_ } 0,0; is($s, 0, "forsquarefreeint {} 0,0"); $s=0; forfactored { $s += 1+$_ } 0,1; is($s, 2, "forfactored {} 0,1"); $s=0; forsquarefree { $s += 1+$_ } 0,1; is($s, 2, "forsquarefree {} 0,1"); $s=0; forsquarefreeint { $s += 1+$_ } 0,1; is($s, 2, "forsquarefreeint {} 0,1"); $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"); $s = 0; forsquarefree { $s += $_ } 7193953,7195732; is($s, 7813597636, "forsquarefree {} 7193953,7195732"); $s = 0; forsquarefreeint { $s += $_ } 7193953,7195732; is($s, 7813597636, "forsquarefreeint {} 7193953,7195732"); } ################### forsemiprimes { my @got; forsemiprimes { push @got, $_; } 1000; is_deeply(\@got, [grep { is_semiprime($_) } 0 .. 1000], "forsemiprimes 1000"); } ################### foralmostprimes { my $num = 0; foralmostprimes { $num++; } 0,1,1000; is($num, 0, "foralmostprimes 0,1000 is empty"); } for my $k (1 .. 10) { my @got; foralmostprimes { push @got, $_; } $k,1000; is_deeply(\@got, [grep { is_almost_prime($k,$_) } 0 .. 1000], "foralmostprimes $k,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'); } ###### Bigint range subtest 'for<...> with bigint ranges', sub { my(@r,$E,%d,$a1,$a2); if ($use64) { $E = 66; $d{primes} = [166,199,169]; $d{semi} = [98,99,99]; $d{almost} = [30,32,31]; $d{comp} = [1506,1508,1506,1508]; $d{oddcomp} = [1506,1511,1509,1511]; $d{sf} = [26,29,27,[7,13,19,223,2683,16981,4200451],29,[3,31,379,"2093425718354419"]]; $d{sfint} = [26,29,27,29]; $d{factored} = [29,30,29,[qw/3 31 379 2093425718354419/],30,[qw/2 17 1129 1922236656459079/]]; } else { $E = 36; $d{primes} = [11,71,31]; $d{semi} = [710,711,711]; $d{almost} = [246,248,247]; $d{comp} = [2166,2168,2166,2168]; $d{oddcomp} = [1800,1805,1803,1805]; $d{sf} = [305,308,306,[2,79,3617,120247]]; $d{sfint} = [636,639,637]; $d{factored} = [170,171,170,[2,3,3,19,89,2257687],171,[17,149,1033,26263]]; } { my @r=(); my($a1,$a2,$arg1,$arg2,@res) = split_d($E,$d{primes}); forprimes { push @r,"$_" } $arg1, $arg2; is_deeply(\@r, \@res, "forprimes {} 2^$E+$a1, 2^$E+$a2"); } { my @r=(); my($a1,$a2,$arg1,$arg2,@res) = split_d($E,$d{semi}); forsemiprimes { push @r,"$_" } $arg1, $arg2; is_deeply(\@r, \@res, "forsemiprimes {} 2^$E+$a1, 2^$E+$a2"); } { my @r=(); my($a1,$a2,$arg1,$arg2,@res) = split_d($E,$d{almost}); foralmostprimes { push @r,"$_" } 3, $arg1, $arg2; is_deeply(\@r, \@res, "foralmostprimes {} 3, 2^$E+$a1, 2^$E+$a2"); } { my @r=(); my($a1,$a2,$arg1,$arg2,@res) = split_d($E,$d{comp}); forcomposites { push @r,"$_" } $arg1, $arg2; is_deeply(\@r, \@res, "forcomposites {} 2^$E+$a1, 2^$E+$a2"); } { my @r=(); my($a1,$a2,$arg1,$arg2,@res) = split_d($E,$d{oddcomp}); foroddcomposites { push @r,"$_" } $arg1, $arg2; is_deeply(\@r, \@res, "foroddcomposites {} 2^$E+$a1, 2^$E+$a2"); } { my @r=(); my($a1,$a2,$arg1,$arg2,@res) = split_d($E,$d{sf}); forsquarefree { push @r,"$_",[map{"$_"}@_] } $arg1, $arg2; is_deeply(\@r, \@res, "forsquarefree {} 2^$E+$a1, 2^$E+$a2"); } { my @r=(); my($a1,$a2,$arg1,$arg2,@res) = split_d($E,$d{sfint}); forsquarefreeint { push @r,"$_" } $arg1, $arg2; is_deeply(\@r, \@res, "forsquarefreeint {} 2^$E+$a1, 2^$E+$a2"); } { my @r=(); my($a1,$a2,$arg1,$arg2,@res) = split_d($E,$d{factored}); forfactored { push @r,"$_",[map{"$_"}@_] } $arg1, $arg2; is_deeply(\@r, \@res, "forfactored {} 2^$E+$a1, 2^$E+$a2"); } @r=(); fordivisors { push @r,"$_" } "73786976294838225404"; is_deeply(\@r, [qw/1 2 4 137 274 548 134647766961383623 269295533922767246 538591067845534492 18446744073709556351 36893488147419112702 73786976294838225404/], "fordivisors {} 2^66+18940"); }; sub split_d { my($E,$arr) = @_; my $a1 = $arr->[0]; my $a2 = $arr->[1]; return ($a1,$a2,map { ref($_) ? $_ : 2**$E + $_ } @$arr) if $E < 48; return ($a1,$a2,map { ref($_) ? $_ : plus_2_66($_) } @$arr) if $E == 66; die "unsupported test exponent $E"; } sub plus_2_66 { # add n to 2^66 (73786976294838206464) my $add = shift; my $final = $add + 6464; die "too large" if $final > 99999; return "737869762948382" . sprintf("%05d",$final); } Math-Prime-Util-0.74/t/26-istotient.t000644 000765 000024 00000002551 15150021624 017266 0ustar00danastaff000000 000000 #!/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 + 1 ; 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("9223372036854775842"), 0, "is_totient(2^63+34)" ); } 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("9671406556917033397649492"), 1, "is_totient(2^83+84)" ); } # trizen found this error in 2019 is( is_totient("281474976710656"), 1, "is_totient(2**48)" ); Math-Prime-Util-0.74/t/26-powerful.t000644 000765 000024 00000022616 15150475076 017131 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_powerful powerful_count nth_powerful sumpowerful powerful_numbers factor_exp vecall vecnone/; my $usexs = Math::Prime::Util::prime_get_config->{'xs'}; my $extra = defined $ENV{EXTENDED_TESTING} && $ENV{EXTENDED_TESTING}; my $use64 = Math::Prime::Util::prime_get_config->{'maxbits'} > 32; plan tests => 1 # is_powerful + 1 # powerful_count + 1 # nth_powerful + 1 # sumpowerful + 1 # powerful_numbers + 0; subtest 'is_powerful', sub { { my @exp = map { fac_is_powerful($_, 2) } 0 .. 258; is_deeply([map {is_powerful($_,2)} 0..258], \@exp, "is_powerful(0..258,2)"); is_deeply([map {is_powerful($_) } 0..258], \@exp, "is_powerful(0..258)"); } ok( vecnone(sub { is_powerful(-8,$_) }, 0..10), "is_powerful(-8,n) = 0"); ok( vecnone(sub { is_powerful(0,$_) }, 0..10), "is_powerful(0,n) = 0"); ok( vecall(sub { is_powerful($_,0) }, 1..32), "is_powerful(n,0) = 1 for positive n"); ok( vecall(sub { is_powerful($_,1) }, 1..32), "is_powerful(n,1) = 1 for positive n"); for my $k (3 .. 12) { my @nums = (227411960,105218838,79368063,58308379,210322300,44982156,67831696,165946352,243118692,128757041,150085583); my @exp = map { fac_is_powerful($_, $k) } 0 .. 32, @nums; my @got = map { is_powerful($_, $k) } 0 .. 32, @nums; is_deeply(\@got, \@exp, "is_powerful(n,$k) for 0..32 and 11 larger nums"); } { my @pow2 = map { 5*5 * $_*$_ } 1..50; my @npow2 = map { 149 * $_*$_ } 1..50; my @pow3 = map { 7*7*7 * $_*$_*$_ } 1..50; my @npow3 = map { 4489 * $_*$_*$_ } 1..50; ok( vecall(sub{ is_powerful($_,2) }, @pow2), "small is_powerful(n,2), n powerful" ); ok( vecall(sub{ is_powerful($_,3) }, @pow3), "small is_powerful(n,3), n powerful" ); ok( vecnone(sub{ is_powerful($_,2) }, @npow2), "small is_powerful(n,2), n not powerful" ); ok( vecnone(sub{ is_powerful($_,3) }, @npow3), "small is_powerful(n,3), n not powerful" ); } is( is_powerful("1377276413364943226363244108454842276965894752197358387200000"), 0, "large easy non-powerful number" ); is( is_powerful("2346889178458529643625998598305409091755415961600000"), 1, "large easy powerful number" ); is( is_powerful("56648008573112538662596929676588737208124071038924666321487873929306609840197", 30), 0, "256-bit semiprime is not 30-powerful, without factoring" ); }; subtest 'powerful_count', sub { is_deeply( [map { powerful_count($_) } -16..0], [map{0}-16..0], "powerful_count(-n)=0" ); is_deeply( [map { powerful_count($_,0) } 0..20], [0..20], "powerful_count(n,0)=n" ); is_deeply( [map { powerful_count($_,1) } 0..20], [0..20], "powerful_count(n,1)=n" ); # test with n <= 0 and k = 0,1,2 is_deeply( [map { powerful_count($_,0) } -100, -10, -4, -1, 0, 1, 4, 10, 100], [0, 0, 0, 0, 0, 1, 4, 10, 100], "powerful_count(+/- n, 0)" ); is_deeply( [map { powerful_count($_,0) } -100, -10, -4, -1, 0, 1, 4, 10, 100], [0, 0, 0, 0, 0, 1, 4, 10, 100], "powerful_count(+/- n, 1)" ); is_deeply( [map { powerful_count($_,2) } -100, -10, -4, -1, 0, 1, 4, 10, 100], [0, 0, 0, 0, 0, 1, 2, 4 , 14], "powerful_count(+/- n, 2)" ); is_deeply( [map { powerful_count($_) } 0..20], [0,1,1,1,2,2,2,2,3,4,4,4,4,4,4,4,5,5,5,5,5], "powerful_count(0..20)" ); is_deeply( [map { powerful_count($_,3) } 0..20], [0,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,3,3,3,3,3], "powerful_count(0..20,3)" ); { my $maxk = $extra ? 30 : 15; my @pow14=(0,14,100,432, 2048, 6561, 16384, 59049, 131072, 262144, 531441, 1594323, 4194304, 8388608, 16777216, 43046721, 129140163, 268435456, 536870912, 1162261467, 3486784401, 8589934592, 17179869184, 34359738368, 68719476736, 137438953472, 274877906944, 549755813888, 1099511627776, 2199023255552, 4398046511104); is_deeply( [map { powerful_count($pow14[$_],$_) } 1..$maxk], [map { 14 } 1..$maxk], "powerful_count(x,1..$maxk) = 14" ); is_deeply( [map { powerful_count($pow14[$_]-1,$_) } 1..$maxk], [map { 13 } 1..$maxk], "powerful_count(x-1,1..$maxk) = 13" ); } # Rather slow in PP if ($extra) { my @exp = (4,14,54,185,619,2027,6553,21044,67231,214122,680330,2158391,6840384,21663503); if (!$use64) { pop @exp; pop @exp; } my $fin = scalar @exp; my @got = map { powerful_count(10**$_) } 1..$fin; is_deeply(\@got, \@exp, "2-powerful_count 10^1, 10^2, ..., 10^$fin"); } if ($extra) { my @exp = (1, 1, 4, 10, 16, 26, 46, 77, 129, 204, 318, 495, 761, 1172, 1799, 2740, 4128, 6200, 9224, 13671, 20205, 29764); if (!$use64) { pop @exp; pop @exp; pop @exp; pop @exp; } my $fin = scalar @exp; my @got = map { powerful_count("1".("0"x$_),7) } 1..$fin; is_deeply(\@got, \@exp, "7-powerful_count 10^1, 10^2, ..., 10^$fin"); } }; subtest 'nth_powerful', sub { is(nth_powerful(0), undef, "nth_powerful(0) returns undef"); is(nth_powerful(100),3136,"3136 is the 100th powerful number"); SKIP: { skip "Skipping nth_powerful for k>2 in PP", 2 unless $usexs; is(nth_powerful(100,6),43046721,"43046721 is the 100th 6-powerful number"); is(nth_powerful(12,15),16777216,"16777216 is the 12th 15-powerful number"); } }; subtest 'sumpowerful', sub { is_deeply( [map { sumpowerful($_) } -16..0], [map{0}-16..0], "sumpowerful(-n)=0" ); is_deeply( [map { sumpowerful($_) } 0..48], [0,1,1,1,5,5,5,5,13,22,22,22,22,22,22,22,38,38,38,38,38,38,38,38,38,63,63,90,90,90,90,90,122,122,122,122,158,158,158,158,158,158,158,158,158,158,158,158,158], "sumpowerful(n) for 0 <= n <= 48" ); is_deeply( [map { sumpowerful($_,3) } 0..48], [0,1,1,1,1,1,1,1,9,9,9,9,9,9,9,9,25,25,25,25,25,25,25,25,25,25,25,52,52,52,52,52,84,84,84,84,84,84,84,84,84,84,84,84,84,84,84,84,84], "sumpowerful(n,3) for 0 <= n <= 48" ); is_deeply( [map { sumpowerful(17411,$_) } 0..16], [151580166,151580166,1464625,333416,164098,101342,57807,41389,39074,32257,31745,30721,28673,24577,16385,1,1], "sumpowerful(17411,k) for 0 <= k <= 16" ); is( "".sumpowerful("1234567890123456",1), "762078937661941480719405753696", "sumpowerful(1234567890123456,1) = (n*(n+1))/2" ); SKIP: { skip "Skipping sumpowerful(1234567890,2)",1 unless $extra; is( "".sumpowerful("1234567890",2), "30929622318668", "sumpowerful(1234567890,2)" ); } SKIP: { skip "Skipping sumpowerful(1234567890123456,2)",1 unless $extra && $use64; is( "".sumpowerful("1234567890123456",2), "31374760178828970927228", "sumpowerful(1234567890123456,2)" ); } SKIP: { skip "Skip sumpowerful 2147516495,k) for k=1..33", 1 unless $extra || ($usexs && $use64); is_deeply( [map { "".sumpowerful(2147516495,$_) } 1..33], [qw/2305913549222300760 71073461134258 2727672189281 542650082891 192623487712 91172645015 57240053947 37822907405 26438551880 19617088953 13157238054 7502933431 7258257269 6035951629 6031152276 6016770601 5973658344 5844387109 5456704476 4293918721 4292870145 4290772993 4286578689 4278190081 4261412865 4227858433 4160749569 4026531841 3758096385 3221225473 2147483649 1 1/], "sumpowerful(2147516495,k) for 1 <= k <= 33" ); } SKIP: { skip "Skip sumpowerful(1234567890123456,k) for k=3..32", 1 unless $extra || ($usexs && $use64); is_deeply( [map { "".sumpowerful("1234567890123456",$_) } 3..32], [qw/146043398655792412070 10996713169431264132 2301916287502408997 793628382930863389 358072984365696929 184880296279236241 108043541271736385 72290570743670714 53667950830214223 40306694671659861 28363055737738077 22793155018675414 18357777378614938 13885855208881771 11386819588192744 8343600537655001 5597666622659511 3750512753514143 3655141834040541 3178294213387061 3178262828133148 3178168676565713 3177886230252016 3177038908088141 3174496975150948 3166871243448233 3143994182557816 3075363268322021 2869471062485548 2251795518717953/], "sumpowerful(1234567890123456,k) for 3 <= k <= 32" ); } }; subtest 'powerful_numbers', sub { is_deeply( powerful_numbers(40,180,3), [64,81,125,128], "powerful_numbers(40,180,3)"); is_deeply( powerful_numbers(9,20,0), [9..20], "powerful_numbers(9,20,0) = 9..20"); is_deeply( powerful_numbers(9,20,1), [9..20], "powerful_numbers(9,20,1) = 9..20"); is_deeply( powerful_numbers(120), [1,4,8,9,16,25,27,32,36,49,64,72,81,100,108], "powerful_numbers(120)"); is_deeply( powerful_numbers(9,120), [9,16,25,27,32,36,49,64,72,81,100,108], "powerful_numbers(9,120)"); is_deeply( powerful_numbers(9,200,2), [9,16,25,27,32,36,49,64,72,81,100,108,121,125,128,144,169,196,200], "powerful_numbers(9,200,2)"); is_deeply( powerful_numbers(0,200,3), [1,8,16,27,32,64,81,125,128], "powerful_numbers(0,200,3)"); is_deeply( powerful_numbers(1,200,4), [1,16,32,64,81,128], "powerful_numbers(1,200,4)"); is_deeply( powerful_numbers(1,1000,5), [1,32,64,128,243,256,512,729], "powerful_numbers(1,1000,5)"); is_deeply( [map{"$_"}@{powerful_numbers(1000000000000, 1010000000000,5)}], [qw/1000000000000 1004193907488 1007769600000 1008394404608/], "powerful_numbers(1e12,1e12+1e10,5)"); }; sub fac_is_powerful { my($n, $k) = @_; $k = 2 unless defined $k; return 0 if $n < 1; return 1 if $n == 1 || $k <= 1; return 0 if $n < (1<<$k); return 0 if (!($n%2)) && ($n%4); return (vecall { $_->[1] >= $k } factor_exp($n)) ? 1 : 0; } Math-Prime-Util-0.74/t/26-isgaussianprime.t000644 000765 000024 00000001163 14056645657 020473 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Math::Prime::Util qw/is_gaussian_prime/; plan tests => 7; ok( !is_gaussian_prime(29,0), "29 is not a Gaussian Prime" ); ok( is_gaussian_prime(31,0), "31 is a Gaussian Prime" ); ok( !is_gaussian_prime(0,-29), "0-29i is not a Gaussian Prime" ); ok( is_gaussian_prime(0,-31), "0-31i is a Gaussian Prime" ); ok( is_gaussian_prime(58924,132000511), "58924+132000511i is a Gaussian Prime" ); ok( is_gaussian_prime(519880,-2265929), "519880-2265929i is a Gaussian Prime" ); ok( !is_gaussian_prime(20571,150592260), "20571+150592260i is not a Gaussian Prime" ); Math-Prime-Util-0.74/bin/primes.pl000755 000765 000024 00000050065 14113024167 017004 0ustar00danastaff000000 000000 #!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_sum_of_squares lucky_numbers 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', 'linnik|A079545', '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'} || exists $opts{'linnik'} ) { 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) = @_; # Get all the lucky numbers up to $end (A000959). my $lucky = lucky_numbers($end); # Then restrict to in range and primes to get A031157. grep { is_prime($_) } grep { $_ >= $start } @$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{'linnik'}) { @$p = grep { is_sum_of_squares($_-1); } @$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 --linnik Linnik p = x^2 + y^2 + 1 for x,y >= 0 --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.74/bin/factor.pl000755 000765 000024 00000006242 14113024155 016756 0ustar00danastaff000000 000000 #!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 < '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. =item not_execute Do not try to execute generated binary. Only check that compilation has not failed. =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 _parsewords { return shellwords @_ if $^O ne 'MSWin32'; # for Win32, take off "" but leave \ map { my $s=$_; $s =~ s/^"(.*)"$/$1/; $s } grep defined && length, quotewords '\s+', 1, @_; } sub _compile_cmd { my ($Config_cc, $cc, $cfile, $exefile, $incpaths, $ld, $Config_libs, $lib, $libpaths) = @_; my @sys_cmd = @$cc; if ( $Config_cc eq 'cl' ) { # Microsoft compiler # this is horribly sensitive to the order of arguments push @sys_cmd, $cfile, (defined $lib ? "${lib}.lib" : ()), "/Fe$exefile", (map '/I'.$_, @$incpaths), "/link", @$ld, _parsewords($Config_libs), (defined $lib ? map '/libpath:'.$_, @$libpaths : ()), ; } elsif($Config_cc =~ /bcc32(\.exe)?/) { # Borland push @sys_cmd, @$ld, (map "-I$_", @$incpaths), "-o$exefile", (defined $lib ? ((map "-L$_", @$libpaths), "-l$lib") : ()), $cfile, ; } else { # Unix-ish: gcc, Sun, AIX (gcc, cc), ... push @sys_cmd, (map "-I$_", @$incpaths), $cfile, (!defined $lib ? () : ( (map "-L$_", @$libpaths), ($^O eq 'darwin' ? (map { "-Wl,-rpath,$_" } @$libpaths) : ()), "-l$lib", )), @$ld, "-o", $exefile, ; } @sys_cmd; } sub _make_cfile { my ($use_headers, $function, $debug) = @_; my $code = ''; $code .= qq{#include <$_>\n} for @$use_headers; $code .= "int main(int argc, char *argv[]) { ".($function || 'return 0;')." }\n"; if ($debug) { (my $c = $code) =~ s:^:# :gm; warn "# Code:\n$c\n"; } my ($ch, $cfile) = File::Temp::tempfile( 'assertlibXXXXXXXX', SUFFIX => '.c' ); print $ch $code; close $ch; (my $ofile = $cfile) =~ s/\.c$/$Config{_o}/; ($cfile, $ofile); } sub assert_lib { my %args = @_; $args{$_} = [$args{$_}] for grep $args{$_} && !ref($args{$_}), qw(lib libpath header incpath); my @libs = @{$args{lib} || []}; my @libpaths = @{$args{libpath} || []}; my @headers = @{$args{header} || []}; my @incpaths = @{$args{incpath} || []}; my $analyze_binary = $args{analyze_binary}; my $execute = !$args{not_execute}; 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"; } } } if(defined($args{LIBS})) { foreach my $arg (_parsewords($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 (_parsewords($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 ($cfile, $ofile) = _make_cfile(\@use_headers, '', $args{debug}); my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe}; my @sys_cmd = _compile_cmd($Config{cc}, $cc, $cfile, $exefile, \@incpaths, $ld, $Config{libs}); warn "# @sys_cmd\n" if $args{debug}; my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd); push @missing, $header if $rv != 0 || ! -f $exefile; _cleanup_exe($exefile); unlink $cfile; } # now do each library in turn with headers my ($cfile, $ofile) = _make_cfile(\@use_headers, @args{qw(function debug)}); for my $lib ( @libs ) { last if $Config{cc} eq 'CC/DECC'; # VMS my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe}; my @sys_cmd = _compile_cmd($Config{cc}, $cc, $cfile, $exefile, \@incpaths, $ld, $Config{libs}, $lib, \@libpaths); warn "# @sys_cmd\n" if $args{debug}; local $ENV{LD_RUN_PATH} = join(":", grep $_, @libpaths, $ENV{LD_RUN_PATH}) unless $^O eq 'MSWin32' or $^O eq 'darwin'; 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 || ! -f $exefile) { push @missing, $lib; } else { chmod 0755, $exefile; my $absexefile = File::Spec->rel2abs($exefile); $absexefile = '"'.$absexefile.'"' if $absexefile =~ m/\s/; warn "# Execute($execute): $absexefile\n" if $args{debug}; if ($execute) { my $retval = system($absexefile); warn "# return value: $retval\n" if $args{debug}; push @wrongresult, $lib if $retval != 0; } push @wronganalysis, $lib if $analyze_binary and !$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 (grep -f, @rmfiles) { 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 $Config_ccflags =~ s:-O\S*::; # stop GCC optimising away test code my @Config_ldflags = (); for my $config_val ( @Config{qw(ldflags)} ){ push @Config_ldflags, $config_val if ( $config_val =~ /\S/ ); } my @ccflags = grep { length } _parsewords($Config_ccflags||'', $user_ccflags||''); my @ldflags = grep { length && $_ !~ m/^-Wl/ } _parsewords(@Config_ldflags, $user_ldflags||''); my @paths = split(/$Config{path_sep}/, $ENV{PATH}); my @cc = _parsewords($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) { warn "# Compiler seems to be $compiler\n" if $debug; return 1; } warn "# Compiler was not $compiler\n" if $debug; 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.74/bench/setops.pl000644 000765 000024 00000003741 15152464310 017327 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; $| = 1; # fast pipes use Math::Prime::Util qw/vecequal toset set_is_subset setcontains setintersect setunion setminus setdelta/; use Math::Prime::Util::PP; # Have it available for comparison use Benchmark qw/:all/; my $N = shift || 100000; sub _hash32 { use integer; my $x = shift; $x = (($x >> 16) ^ $x) * 0x45d9f3b; $x = (($x >> 16) ^ $x) * 0x45d9f3b; $x = ($x >> 16) ^ $x; return $x & 0xFFFFFFFF; } my @set4 = map {_hash32($_)} 0..$N-1; # random1 my @set5 = map {_hash32(10*$N+$_)} 0..$N-1; # random2 my @iset4 = @{toset(@set4)}; print "iset4 entries: ",$#iset4+1,"\n"; my @iset5 = @{toset(@set5)}; print "iset5 entries: ",$#iset5+1,"\n"; use Set::Tiny; my $st4 = Set::Tiny->new(@iset4); my $st5 = Set::Tiny->new(@iset5); my $R; my $ts=0; cmpthese(-1, { "is_subset" => sub { $ts += set_is_subset(\@iset4, \@iset5); }, "contains" => sub { $ts += setcontains(\@iset4, \@iset5); }, }) if (0); cmpthese(-1, { "intersect list" => sub { $R=setintersect(\@set4,\@set5); }, "intersect iset" => sub { $R=setintersect(\@iset4,\@iset5); }, "intersect Set::Tiny" => sub { $R=$st4->intersection($st5);}, #"MPUPP iset"=>sub { $R=Math::Prime::Util::PP::setintersect(\@iset4,\@iset5); }, }) if (1); cmpthese(-1, { "union list" => sub { $R=setunion(\@set4,\@set5); }, "union iset" => sub { $R=setunion(\@iset4,\@iset5); }, "union Set::Tiny" => sub { $R=$st4->union($st5);}, }) if (1); cmpthese(-1, { "minus list" => sub { $R=setminus(\@set4,\@set5); }, "minus iset" => sub { $R=setminus(\@iset4,\@iset5); }, "minus Set::Tiny" => sub { $R=$st4->difference($st5);}, }) if (1); cmpthese(-1, { "delta list" => sub { $R=setdelta(\@set4,\@set5); }, "delta iset" => sub { $R=setdelta(\@iset4,\@iset5); }, "delta Set::Tiny" => sub { $R=$st4->symmetric_difference($st5);}, #"MPUPP iset"=>sub { $R=Math::Prime::Util::PP::setdelta(\@iset4,\@iset5); }, }) if (1); Math-Prime-Util-0.74/bench/bench-random-prime.pl000755 000765 000024 00000000752 13025437630 021465 0ustar00danastaff000000 000000 #!/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.74/bench/bench-mp-prime_count.pl000755 000765 000024 00000001742 13667653334 022046 0ustar00danastaff000000 000000 #!/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.74/bench/bench-irand.pl000644 000765 000024 00000006721 15151316722 020167 0ustar00danastaff000000 000000 use 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); print "\n 32-bit\n\n"; cmpthese($trials, { 'CORE::rand' => sub { int(CORE::rand(4294967295)) for 1..1000; }, #'MRMT::irand' => sub { $mt->irand for 1..1000; }, 'MR ISAAC irand' => sub { $isaac->irand for 1..1000; }, '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; }, 'CryptPRNG irand' => sub { Crypt::PRNG::irand for 1..1000; }, 'MRMTA irand' => sub { (0xFFFFFFFF & Math::Random::MT::Auto::irand) for 1..1000; }, 'MTwist irand32' => sub { Math::Random::MTwist::_irand32 for 1..1000; }, #'PCG32 irand' => sub { $pcg->irand for 1..1000; }, 'PCG32 irand' => sub { Math::Random::PCG32::irand($pcg) 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; print "\n 64-bit\n\n"; 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; }, 'MR ISAAC 32x2' => sub { (($isaac->irand <<32)|$isaac->irand) for 1..1000; }, #'MRXorshift irand' => sub { $xor->irand for 1..1000; }, '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; }, 'CryptPRNG prb' => sub { unpack("Q",Crypt::PRNG::random_bytes(8)) for 1..1000; }, #'CryptPRNG 32x2' => sub { ((Crypt::PRNG::irand << 32)|Crypt::PRNG::irand) for 1..1000; }, # These have 64-bit irand functions #'PCG32 irand64' => sub { $pcg->irand64 for 1..1000; }, 'PCG32 irand64' => sub { Math::Random::PCG32::irand64($pcg) for 1..1000; }, 'MRMTA irand' => sub { Math::Random::MT::Auto::irand for 1..1000; }, '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.74/bench/bench-mp-nextprime.pl000755 000765 000024 00000002131 13667651500 021517 0ustar00danastaff000000 000000 #!/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.74/bench/sort.pl000644 000765 000024 00000005301 15146553566 017012 0ustar00danastaff000000 000000 #!perl use warnings; use strict; use feature 'say'; use Time::HiRes qw( gettimeofday tv_interval ); use Math::Prime::Util ":all"; use Sort::XS; use Sort::Key::Radix; use Sort::Key; use List::MoreUtils; my $narrays = 10000; for my $len (10,100,1000,10000,100000,1000000) { $narrays /= 10 if $len == 1000; $narrays /= 10 if $len == 100000; $narrays /= 10 if $len == 1000000; my(@times) = (0) x 5; for (1..20) { my @ints; for (0..$narrays-1) { #$ints[$_] = [map { irand } 1..$len]; # 32-bit random $ints[$_] = [map { irand64 } 1..$len]; # 64-bit random #$ints[$_] = [map { 1..3 } 1..divint($len,3)]; # sawtooth } $times[0] += time_sort(\@ints); $times[1] += time_sortxsq(\@ints); $times[2] += time_sortkey(\@ints); $times[3] += time_sortkeyradix(\@ints); $times[4] += time_vecsort(\@ints); $times[5] += time_lmu(\@ints); } show_res($times[0], $times[5], "LMU::qsort", 20*$narrays, $len); show_res($times[0], $times[0], "sort", 20*$narrays, $len); show_res($times[0], $times[2], "Sort::Key::usort", 20*$narrays, $len); show_res($times[0], $times[1], "Sort::XS::quick_sort", 20*$narrays, $len); show_res($times[0], $times[3], "Sort::Key::Radix::usort", 20*$narrays, $len); show_res($times[0], $times[4], "vecsort", 20*$narrays, $len); print "\n"; } sub show_res { my($tsort, $tthis, $name, $narr, $len) = @_; $tthis = $tsort if $tsort == 0; my $us = $tthis * 1e6 / $narr; my $mult = sprintf "%4.1fx %8.1fuS", $tsort/$tthis, $us; say "$mult $name $len random 64-bit integers"; return $tthis; } sub time_sort { my $ints = shift; my $t0 = [gettimeofday]; for my $t (@$ints) { my @sorted = sort {$a<=>$b} @$t; } return tv_interval($t0); } sub time_vecsort { my $ints = shift; my $t0 = [gettimeofday]; for my $t (@$ints) { my @sorted = vecsort($t); } return tv_interval($t0); } sub time_sortxsq { my $ints = shift; my $t0 = [gettimeofday]; for my $t (@$ints) { my @sorted = Sort::XS::quick_sort($t); } return tv_interval($t0); } sub time_sortxs { my $ints = shift; my $t0 = [gettimeofday]; for my $t (@$ints) { my @sorted = Sort::XS::xsort(list => $t, algorithm => 'quick', type => 'integer'); } return tv_interval($t0); } sub time_sortkey { my $ints = shift; my $t0 = [gettimeofday]; for my $t (@$ints) { my @sorted = Sort::Key::usort(@$t); } return tv_interval($t0); } sub time_sortkeyradix { my $ints = shift; my $t0 = [gettimeofday]; for my $t (@$ints) { my @sorted = Sort::Key::Radix::usort(@$t); } return tv_interval($t0); } sub time_lmu { my $ints = shift; my $t0 = [gettimeofday]; for my $t (@$ints) { my @S=@$t; List::MoreUtils::qsort {$a<=>$b} @S; } return tv_interval($t0); } Math-Prime-Util-0.74/bench/bench-set-tiny.pl000755 000765 000024 00000012705 15146553566 020665 0ustar00danastaff000000 000000 #!/usr/bin/perl use warnings; use strict; use lib 'lib'; # Copied and adapted from Set::Tiny 0.06. # Non-representative benchmark of different Set:: modules use Benchmark qw( cmpthese ); use Set::Tiny; use Set::Scalar; #use Set::Object; use Math::Prime::Util qw/toset setinsert setcontains setremove setinvert setintersect setunion setminus setdelta vecequal/; #my @a = 1 .. 100; #my @b = 51 .. 150; my @a = 1 .. 1000; my @b = 501 .. 2500; #my @a = 1 .. 10000; #my @b = 5001 .. 15000; my $s_t1 = Set::Tiny->new(@a); my $s_t2 = Set::Tiny->new(@b); my $s_m1 = toset(@a); my $s_m2 = toset(@b); my $s_s1 = Set::Scalar->new(@a); my $s_s2 = Set::Scalar->new(@b); #my $s_o1 = Set::Object->new(@a); #my $s_o2 = Set::Object->new(@b); my %tests = ( A_new => { t => sub { Set::Tiny->new(@a) }, m => sub { toset(@a) }, s => sub { Set::Scalar->new(@a) }, #o => sub { Set::Object->new(@a) }, }, A_clone => { t => sub { $s_t1->clone }, m => sub { [@$s_m1] }, s => sub { $s_s1->clone }, #o => sub { }, }, A_insert => { t => sub { Set::Tiny->new->insert(@a) }, m => sub { setinsert([],\@a); }, s => sub { Set::Scalar->new->insert(@a) }, #o => sub { Set::Object->new->insert(@a) }, }, A_deleteone => { t => sub { Set::Tiny->new(@a)->delete(500) }, m => sub { setremove(toset(@a),500); }, s => sub { Set::Scalar->new(@a)->delete(@b) }, #o => sub { Set::Object->new(@a)->delete(@b) }, }, A_delete => { t => sub { Set::Tiny->new(@a)->delete(@b) }, m => sub { setremove(toset(@a),\@b); }, s => sub { Set::Scalar->new(@a)->delete(@b) }, #o => sub { Set::Object->new(@a)->delete(@b) }, }, A_invert => { t => sub { Set::Tiny->new(@a)->invert(@b) }, m => sub { setinvert(toset(@a),\@b); }, s => sub { Set::Scalar->new(@a)->invert(@b) }, #o => sub { Set::Object->new(@a)->invert(@b) }, }, C_is_equal => { t => sub { $s_t1->is_equal($s_t2) }, #m => sub { vecequal($s_m1,$s_m2) }, # Probably much faster m => sub { Math::Prime::Util::set_is_equal($s_m1,$s_m2) }, s => sub { $s_s1->is_equal($s_s2) }, #o => sub { $s_o1->equal($s_o2) }, }, # Set::Tiny $s->is_subset($t) is $s a subset of $t? # MPU: set_is_subset($s,$t) is $t a subset of $s? C_is_subset => { t => sub { $s_t1->is_subset($s_t2) }, #m => sub { setcontains($s_m1, $s_m2) }, # Probably faster m => sub { Math::Prime::Util::set_is_subset($s_m2,$s_m1); }, s => sub { $s_s1->is_subset($s_s2) }, #o => sub { $s_o1->subset($s_o2) }, }, C_is_proper_subset => { t => sub { $s_t1->is_proper_subset($s_t2) }, m => sub { Math::Prime::Util::set_is_proper_subset($s_m2,$s_m1); }, s => sub { $s_s1->is_proper_subset($s_s2) }, #o => sub { $s_o1->proper_subset($s_o2) }, }, C_is_superset => { t => sub { $s_t1->is_superset($s_t2) }, m => sub { Math::Prime::Util::set_is_superset($s_m2,$s_m1); }, s => sub { $s_s1->is_superset($s_s2) }, #o => sub { $s_o1->superset($s_o2) }, }, C_is_proper_superset => { t => sub { $s_t1->is_proper_superset($s_t2) }, m => sub { Math::Prime::Util::set_is_proper_superset($s_m2,$s_m1); }, s => sub { $s_s1->is_proper_superset($s_s2) }, #o => sub { $s_o1->proper_superset($s_o2) }, }, C_is_disjoint => { t => sub { $s_t1->is_disjoint($s_t2) }, m => sub { Math::Prime::Util::set_is_disjoint($s_m1,$s_m2); }, s => sub { $s_s1->is_disjoint($s_s2) }, #o => sub { $s_o1->is_disjoint($s_o2) }, }, # The $set->contains(@elements) methods are not identical: # MPU, Set::Tiny, Set::Object return true if $set contains *all* elements. # Set::Scalar returns true if $set contains *any* elements. B_contains => { t => sub { $s_t1->contains(@b) }, m => sub { setcontains($s_m1,\@b) }, s => sub { $s_s1->contains(@b) }, #o => sub { $s_o1->contains(@b) }, }, # Set::Tiny $s->difference($t) $s minus $t # MPU: set_is_subset($s,$t) $s minus $t B_difference => { t => sub { $s_t1->difference($s_t2) }, m => sub { setminus($s_m1,$s_m2) }, s => sub { $s_s1->difference($s_s2) }, #o => sub { $s_o1->difference($s_o2) }, }, B_union => { t => sub { $s_t1->union($s_t2) }, m => sub { setunion($s_m1,$s_m2) }, s => sub { $s_s1->union($s_s2) }, #o => sub { $s_o1->union($s_o2) }, }, B_intersection => { t => sub { $s_t1->intersection($s_t2) }, m => sub { setintersect($s_m1,$s_m2) }, s => sub { $s_s1->intersection($s_s2) }, #o => sub { $s_o1->intersection($s_o2) }, }, B_symmetric_difference => { t => sub { $s_t1->symmetric_difference($s_t2) }, m => sub { setdelta($s_m1,$s_m2) }, s => sub { $s_s1->symmetric_difference($s_s2) }, #o => sub { $s_o1->symmetric_difference($s_o2) }, }, ); print "running benchmarks with sets of size ", scalar @a, " and ", scalar @b, "\n"; for my $test ( sort keys %tests ) { print "\n$test:\n"; cmpthese( -1, { 'Set::Tiny' => $tests{$test}{t}, 'Set::Scalar' => $tests{$test}{s}, #'Set::Object' => $tests{$test}{o}, 'MPU' => $tests{$test}{m}, } ); } Math-Prime-Util-0.74/bench/bench-random-prime-bigint.pl000755 000765 000024 00000000677 13025437630 022745 0ustar00danastaff000000 000000 #!/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.74/bench/bench-pp-sieve.pl000755 000765 000024 00000030105 13025437630 020616 0ustar00danastaff000000 000000 #!/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.74/bench/bench-factor.pl000755 000765 000024 00000006007 13025437630 020350 0ustar00danastaff000000 000000 #!/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.74/bench/vecequal.pl000644 000765 000024 00000003731 15146553566 017635 0ustar00danastaff000000 000000 #!/usr/bin/perl use strict; use warnings; use ntheory qw/vecequal irand irand64/; use Math::Prime::Util::PP; use Array::Compare; use Benchmark qw( cmpthese ); use List::AllUtils qw( each_arrayref ); use Data::Cmp qw/cmp_data/; use Algorithm::Diff qw/LCS_length/; use List::Compare::Functional qw/is_LequivalentR/; use FreezeThaw qw/cmpStr/; use Storable qw/freeze/; use Sereal qw/encode_sereal/; use match::smart; #my @x = 1 .. 1_000; #my @y = map { "$_" } 1 .. 1_000; my @x = 1 .. 5000, map { irand64 } 1 .. 100; my @y = 1 .. 5000, map { irand64 } 1 .. 100; my $comp = Array::Compare->new; cmpthese -2, { iterator => sub { my $r = elementwise_eq(\(@x, @y)) }, array_comp => sub { my $r = $comp->compare(\(@x, @y)) }, my_comp => sub { my $r = my_comp(\(@x, @y)) }, vecequal => sub { my $r = vecequal(\@x, \@y) }, vecequal_pp => sub { my $r = Math::Prime::Util::PP::vecequal(\@x, \@y) }, msmart => sub { my $r = \@x |M| \@y; }, data_cmp => sub { my $r = cmp_data(\@x, \@y) }, alg_diff => sub { my $r = LCS_length(\@x, \@y) }, list_compare => sub { my $r = is_LequivalentR([\@x, \@y]) }, freezethaw => sub { my $r = 0==cmpStr(\@x, \@y); }, storable => sub { my $r = freeze(\@x) eq freeze(\@y); }, sereal => sub { my $r = encode_sereal(\@x) eq encode_sereal(\@y); }, }; sub elementwise_eq { my ($xref, $yref) = @_; return unless @$xref == @$yref; my $it = each_arrayref($xref, $yref); while ( my ($x, $y) = $it->() ) { return unless $x eq $y; } return 1; } sub my_comp { my ($xref, $yref) = @_; return unless @$xref == @$yref; my $i; for my $e (@$xref) { return unless $e eq $yref->[$i++]; } return 1; } __END__ Rate msmart 204/s list_compare 417/s data_cmp 606/s freezethaw 718/s iterator 1058/s array_comp 1099/s vecequal_pp 1321/s alg_diff 1729/s my_comp 3973/s storable 4773/s sereal 12669/s vecequal 15689/s Math-Prime-Util-0.74/bench/factor-gnufactor.pl000755 000765 000024 00000014333 13667653334 021277 0ustar00danastaff000000 000000 #!/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.74/bench/bench-pcapprox.pl000755 000765 000024 00000002042 13025437630 020721 0ustar00danastaff000000 000000 #!/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.74/bench/bench-primecount.pl000755 000765 000024 00000006504 13667653334 021276 0ustar00danastaff000000 000000 #!/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.74/bench/bench-factor-extra.pl000755 000765 000024 00000007602 15122202053 021460 0ustar00danastaff000000 000000 #!/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.74/bench/bench-pp-isprime.pl000755 000765 000024 00000017707 13667653334 021205 0ustar00danastaff000000 000000 #!/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.74/bench/bench-mp-psrp.pl000755 000765 000024 00000002012 13025437630 020460 0ustar00danastaff000000 000000 #!/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.74/bench/bench-miller-rabin.pl000755 000765 000024 00000003551 13025437630 021450 0ustar00danastaff000000 000000 #!/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.74/bench/bench-factor-semiprime.pl000755 000765 000024 00000006125 15151262074 022341 0ustar00danastaff000000 000000 #!/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 > 18); my $skip_pari = !defined $Math::Pari::VERSION; # 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"; } if (!$skip_pari) { 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"; } else { print "No Math::Pari\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.74/bench/bench-primearray.pl000755 000765 000024 00000020744 15146553566 021266 0ustar00danastaff000000 000000 #!/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 (usually slice or fetch)\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; }, 'pa fetch' => sub { $s=0; my $o = tie my @p, "Math::Prime::Util::PrimeArray"; $s += $o->FETCH($_) for 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 fetch' => sub { $s=0; my $o = tie my @p, "Math::Prime::Util::PrimeArray"; $s += $o->FETCH($_) for 0..$ilimit; die 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; }, 'pa fetch' => sub { $s=0; my $o = tie my @p, "Math::Prime::Util::PrimeArray"; $s += $o->FETCH($_) 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; }, 'pa fetch' => sub { $s=0; my $o = tie my @p, "Math::Prime::Util::PrimeArray"; $s += $o->FETCH($_) 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.74/bench/bench-is-prime.pl000755 000765 000024 00000003731 13667651500 020626 0ustar00danastaff000000 000000 #!/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.74/bench/bench-nthprime.pl000755 000765 000024 00000002164 13025437630 020720 0ustar00danastaff000000 000000 #!/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.74/bench/bench-pp-count.pl000755 000765 000024 00000031174 13025437630 020642 0ustar00danastaff000000 000000 #!/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.74/bench/bench-drand.pl000644 000765 000024 00000010032 15151327373 020154 0ustar00danastaff000000 000000 use 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 53+bit x*2^-64 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 use Math::Random::PCG32; # 32-bit 2^32 # 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. # MTwist can be found here: # https://metacpan.org/release/CGPAN/Math-Random-MTwist-0.23/view/lib/Math/Random/MTwist.pm 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); my $pcg32 = Math::Random::PCG32->new(int($time),1); 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 }, #'MR Xorshift->rand' => sub { $xor->rand for 1..1000 }, 'Xorshift rand' => sub { Math::Random::Xorshift::rand for 1..1000 }, # doubles with only 32-bits of random data #'MR ISAAC XS' => sub { $mrixs->rand for 1..1000 }, #'MR ISAAC PP' => sub { $mripp->rand for 1..1000 }, #'MR ISAAC->rand' => sub { $isaac->rand for 1..1000 }, 'MR Secure rand' => sub { Math::Random::Secure::rand for 1..1000 }, #'MR MT->rand' => sub { $mt->rand for 1..1000 }, 'PCG32 rand' => sub { Math::Random::PCG32::rand($pcg32) for 1..1000 }, # 52-bit, 53-bit doubles 'MRMTA rand' => sub { Math::Random::MT::Auto::rand for 1..1000 }, 'MTwist rand' => sub { Math::Random::MTwist::_rand for 1..1000 }, 'CryptPRNG 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) 'MPU 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.74/bench/bench-random-bytes.pl000644 000765 000024 00000011142 15151277604 021474 0ustar00danastaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Math::Prime::Util; use Math::Prime::Util::GMP; use Math::Prime::Util::ChaCha; use Bytes::Random::XS; # XS version calling Drand01() use Bytes::Random; # Just a loop around CORE::rand! use Bytes::Random::Secure; use Crypt::PRNG; #use Crypt::Random; #use Data::Entropy::Algorithms; use Crypt::OpenSSL::Random; # note rand_bytes == rand_pseudo_bytes use Rand::Urandom; use Math::Random::PCG32; use Benchmark qw/:all/; 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(); my $pcg = Math::Random::PCG32->new( 42, 54 ); # 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. # On 2020 Mac M1 # 2262 MB/s Crypt::OpenSSL::Random (AES-256 with hardware support) # 1031 MB/s Math::Prime::Util::GMP (ISAAC plain C) # 591 MB/s Math::Prime::Util (ChaCha20 plain C) 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); }, # "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 (1) { print "# 256 random bytes\n"; cmpthese($trial,{ "MPU" => sub { Math::Prime::Util::random_bytes(256); }, "MPU GMP" => sub { Math::Prime::Util::GMP::random_bytes(256); }, "BRXS" => sub { Bytes::Random::XS::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); }, "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); }, "PCG32" => sub { pack("L*",map{$pcg->irand64}1..32); }, }); } if (0) { print "# 16384 random bytes\n"; cmpthese($trial,{ "MPU" => sub { Math::Prime::Util::random_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); }, # "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 GMP" => sub { Math::Prime::Util::GMP::random_bytes(64*1024); }, "BRXS" => sub { Bytes::Random::XS::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); }, "rand" => sub { pack('L*', map { int(rand 4294967296) } 1..16384); }, "PCG32" => sub { pack("L*",map{$pcg->irand64}1..8192); }, #"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.74/bench/bench-isprime-bpsw.pl000755 000765 000024 00000003452 13667653334 021531 0ustar00danastaff000000 000000 #!/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.74/bench/setreject.pl000644 000765 000024 00000011063 15146565751 020014 0ustar00danastaff000000 000000 #!perl use strict; use warnings; use feature 'say'; # See https://perlmonks.org/?node_id=11165809 #no warnings "experimental::keyword_any"; #use experimental 'keyword_any'; use ntheory qw/shuffle vecany setcontains setcontainsany set_is_subset/; use Set::Tiny; use Benchmark 'cmpthese'; my $data = ''; for my $r ( shuffle 0 .. 31 ) { for my $c ( shuffle 0 .. 31 ) { $data .= "$c $r whatever\n" } } my @skip = ( 0, 15, 16, 31 ); # If we do this, we have many values to check. # The vecany method (or List::Util any) slows down drastically. # regex and index slow down too, though not as much. # setissubset and setcontainsany slow down a very small amount #my @skip = map { 2*$_ } 0..200; my %skiphash; @skiphash{@skip} = undef; my $skipstr = join " ",@skip; my $skipidxstr = " $skipstr "; my $skipset = Set::Tiny->new(@skip); cmpthese -2, { # Perl 5.42, performance is approximately equal to vecany #any => sub { # while ( $data =~ /^(\d+) (\d+)/mg ) { # next if any { $1 == $_ || $2 == $_ } @skip; # } # return 1 #}, # This is identical to List::Util any vecany => sub { while ( $data =~ /^(\d+) (\d+)/mg ) { next if vecany { $1 == $_ || $2 == $_ } @skip; } return 1 }, # This version is handing in magic variables, so parsing is slow. setcontains => sub { while ( $data =~ /^(\d+) (\d+)/mg ) { next if setcontains(\@skip,$1) || setcontains(\@skip,$2); } return 1 }, Lsetcontains => sub { my @matches = ($data =~ /^(\d+) (\d+)/mg); while (my ($c,$r) = splice @matches,0,2) { next if setcontains(\@skip,$c) || setcontains(\@skip,$r); } return 1 }, # Here we force the input into a numerical value so parsing is very fast. setcontains0 => sub { while ( $data =~ /^(\d+) (\d+)/mg ) { next if setcontains(\@skip,0+$1) || setcontains(\@skip,0+$2); } return 1 }, # Putting $1 etc into an array ref de-magics it (see with Devel::Peek) # It might be very slightly faster with 0+ setcontainsany => sub { while ( $data =~ /^(\d+) (\d+)/mg ) { next if setcontainsany(\@skip,[$1,$2]); } return 1 }, setissubset => sub { while ( $data =~ /^(\d+) (\d+)/mg ) { next if set_is_subset(\@skip,[$1]) || set_is_subset(\@skip,[$2]); } return 1 }, # Can use regex to search a string list regex => sub { while ( $data =~ /^(\d+) (\d+)/mg ) { my($s,$t)=($1,$2); next if $skipstr =~ /\b$s\b/ || $skipstr =~ /\b$t\b/; } return 1 }, # We're doing things the Perl 4 way now. :) index => sub { while ( $data =~ /^(\d+) (\d+)/mg ) { my($s,$t)=(" $1 "," $2 "); next if index($skipidxstr,$s) >= 0 || index($skipidxstr,$t) >= 0; } return 1 }, # Rather obvious hash solution hash => sub { while ( $data =~ /^(\d+) (\d+)/mg ) { next if exists $skiphash{$1} or exists $skiphash{$2}; } return 1; }, # Set::Tiny uses hashes underneath. This looks pretty. settiny => sub { while ( $data =~ /^(\d+) (\d+)/mg ) { next if $skipset->contains($1) || $skipset->contains($2); } return 1; }, }; __END__ Rate regex any vecany setissubset settiny setcontainsany setcontains index setcontains0 hash regex 721/s -- -55% -58% -58% -61% -68% -68% -70% -72% -83% any 1594/s 121% -- -7% -8% -15% -29% -29% -34% -37% -63% vecany 1715/s 138% 8% -- -1% -8% -23% -23% -29% -32% -60% setissubset 1730/s 140% 9% 1% -- -7% -22% -23% -28% -32% -59% settiny 1866/s 159% 17% 9% 8% -- -16% -16% -23% -26% -56% setcontainsany 2231/s 209% 40% 30% 29% 20% -- -0% -8% -12% -48% setcontains 2235/s 210% 40% 30% 29% 20% 0% -- -8% -12% -48% index 2418/s 235% 52% 41% 40% 30% 8% 8% -- -5% -43% setcontains0 2536/s 252% 59% 48% 47% 36% 14% 13% 5% -- -40% hash 4257/s 490% 167% 148% 146% 128% 91% 90% 76% 68% --

,C. Generating both values is typically not much more time than one. Also see L for fast computation mod n. =head2 gcd Given a list of integers, returns the greatest common divisor. This is often used to test for L. Each input C is treated as C<|n|>. =head2 lcm Given a list of integers, returns the least common multiple. Note that we follow the semantics of Mathematica, Pari, and Raku, re: lcm(0, n) = 0 Any zero in list results in zero return lcm(n,-m) = lcm(n, m) We use the absolute values lcm() = 1 lcm of empty list returns 1 =head2 gcdext Given two integers C and C, returns C such that C and C. This uses the extended Euclidean algorithm to compute the values satisfying Bézout's Identity. This corresponds to Pari's C function, which was renamed from C in 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 integers, while the C values must be non-zero integers. Like other mod functions, we use C. 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, ...}] SAGE: crt( [a1,m1], [a2,m2], ... ) crt(a1,m1,a2,m2,...) CRT_list( [a1,a2,...], [m1,m2,...] ) =head2 chinese2 Functions like L but returns two items: the remainder and the modulus. If a solution exists, the second value (the final modulus) is equal to the lcm of the absolute values of all the given moduli. If no solution exists, both return values will be C. =head2 frobenius_number Finds the Frobenius number of a set of positive integers. This is the largest positive integer that cannot be represented as a non-negative linear combination of the input set. Each set element must be positive (all elements greater than zero) and setwise coprime: C. This is sometimes called the "coin problem". This corresponds to Mathematica's C function. Matching their API, we return -1 if any set element is C<1>. =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, including using a 128-bit running sum in the C code. =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 Returns true if any element of a list satisfies a block. See L. =head2 vecall Returns true if all elements of a list satisfy a block. See L. =head2 vecnone Returns true if no element of a list satisfies a block. See L. =head2 vecnotall Returns true if not all elements of a list satisfy a block. See L. =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. Given that Perl has fully functional array slices in the language, this is for completeness with Pari/GP. These are equivalent: vecextract($aref, $iref); @$aref[@$iref]; =head2 vecuniq my @vec = vecuniq(1,2,3,2,-10,-100,1); # returns (1,2,3,-10,-100) Given an array of integers, returns an array with all duplicate entries removed. The original ordering is preserved. All values B be defined. This is similar to L (the integer comparison version of L). Unlike the more generic L and L, all inputs must be integers. With native integers, our function is 2-10x faster. =head2 vecfreq # Produce frequency hash: my %h = vecfreq(1,2,2,2,3,1,4); # (1=>2, 2=>3, 3=>1, 4=>1) # Print most common value: say vecreduce { $h{$a} > $h{$b} ? $a : $b } keys %h; Given an array of items, returns a hash with each key containing the unique items, with the associated value being the occurrence count in the array. This is identical to L. It is typically faster when given only native integers. This is very similar to the Pari/GP function C for vectors, and to Python's C. =head2 vecsingleton my @solo = vecsingleton(1,4,17,1,17,-8); # (4,-8) # Same but slower: my %h = vecfreq(@n); my @onlyuniqs = grep { $h{$_} == 1 } @n; Given an array of items, returns an array with all entries removed that appear more than once in the list. The original ordering is preserved. This is identical to L. When given only native integers, it is typically 2 to 10x faster. =head2 vecsort my @sorted = vecsort(1,2,3,2,-10,-100,1); # returns (-100,-10,1,1,2,2,3) my @sorted = vecsort([1,2,3,2,-10,-100,1]); # same Numerically (ascending) sort a list of integers. The input is either a list or a single array reference which holds the list. All values must be defined and integers. They may be any mix of native IV, native UV, strings, bigints. Perl's built-in numerical sort can sometimes give incorrect results for typical cases we encounter. Prior to version 5.26 (2017), large 64-bit integers were turned into NV (floating point) types. With all current versions of Perl, strings are turned into NV types even if they are the text of a 64-bit integer. In scalar context, C returns the number of items without sorting (but after input validation). This should be expected and what we typically want. E.g. if we only want the number of divisors, we call in scalar context and get the number without requiring actual sorting. Having the same results from C<$x = vecsort(5,6,7)> and C<@v = vecsort(5,6,7); $x=@v;> is what we want. This contrasts with Perl's built-in C which in scalar context has B behaviour (in all current versions of C it returns undef). In particular this forces all programs to use a workaround if they want to return the results of sorting an array. See L for some discussion with no resolution. Using an array reference as input is slightly faster. This is almost always faster than Perl's built-in numerical sort: C<< @a = sort { $a <=> $b } @a >>. See the performance section for more information. =head2 vecsorti my @arr = map { irand } 1..100000; vecsorti \@arr; Given an array reference of integers, numerically (ascending) sorts the integers in-place. The array reference is also returned for convenience. This is more efficient than L. Perl's C has this optimization built-in when doing straightforward sorting on non-references. =head2 vecequal my $is_equal = vecequal( [1,2,-3,[4,5,undef]], [1,2,-3,[4,5,undef]] ); Compare two arrays for equality, including nested arrays. The values inside the two input array references must be either an array reference, a scalar, or undef. Simple integers are tested with integer comparison, while other scalars use string comparison. This is a vector comparison, not set comparison, so ordering is important. For the sake of wider applicability, non-integers are allowed. Types other than integers and strings (e.g. floating point values) are not guaranteed to have consistent results. No circular reference detection is performed. Performance with XS is 3x to 100x faster than perl looping or modules like Array::Compare, Data::Cmp, match::smart, List::Compare, and Algorithm::Diff. Those modules have additional functionality so this is not a complete comparison. =head2 vecmex my $minimum_excluded = vecmex(0,1,2,4,6); # returns 3 Given a list of non-negative integers, returns the smallest non-negative integer that is not in the list. C is short for "minimum excluded". The list can be seen as a set, and the return value is the minimum of the set complement. Repeated values are allowed in the list. C() = 0. C(0,1,2,...,I) = I+1. =head2 vecpmex my $minimum_excluded = vecpmex(1,2,4,6); # returns 3 Given a list of positive integers, returns the smallest positive integer that is not in the list. C is short for "minimum excluded". The list can be seen as a set, and the return value is the minimum of the set complement. Repeated values are allowed in the list. C() = 1. C(1,2,...,I) = I+1. =head2 vecslide @pairsum = vecslide {$a+$b} 1..5; # returns (1+2,2+3,3+4,4+5) say for vecslide { "$a->[0] $b->[1]" } (["hello","world"], ["goodbye","friends"], ["love","hate"]); # hello friends # goodbye hate Given a code block and a list, calls the code block for each pair in the list, setting the local C<$a> and C<$b> to the values in each pair. There is no restriction of what the list contains, as seen in the second example. This is identical to L. =head2 toset my $set = toset(52,-6,14,-6,0); # $set = [-6,0,14,52] say "number of elements in set: ",scalar(@$set); say "smallest value: ",$set->[0]; say "largest value: ",$set->[-1]; Given a list of integers, returns an array reference representing the integer set. The result is numerically sorted with duplicates removed. The input array must only contain integers (signed integers, bigints, objects that evaluate to integers, strings representing integers are all ok). This "set form" is optimal for the set operations. After the set is in this form, the size of the set is simply the length. Similarly the set minimum and maximum are trivial. All values in the output will be typed as either native integers (IV or UV) or bigints. =head2 setinsert my $s=[-10..-1,1..10]; setinsert($s, 0); # $s is now [-10..10] setinsert($s, [5,10,15,20]); # $s is now [-10..10,15,20] Given two array references of integers in set form, inserts all elements of the second set into the first set and returns the number of elements that were inserted. Given an array reference of integers in set form, followed by zero or more integer scalars (possibly unordered and containing duplicates), inserts all list values into the first set and returns the number of elements that were inserted. This is essentially the same as wrapping the list in L but convenient and possibly more efficient. This may be viewed as an in-place L. The one or two sets (array references) must be in set form (numerically sorted with no duplicates) or the results are undefined. =head2 setremove my $s=[-10..10]; setremove($s, 0); # $s is now [-10..-1,1..10] setremove($s, [5,10,15,20]); # $s is now [-10..-1,1..4,6..9] Given two array references of integers in set form, removes all elements of the second set from the first set and returns the number of elements that were removed. Given an array reference of integers in set form, followed by zero or more integer scalars (possibly unordered and containing duplicates), removes all list values from the first set and returns the number of elements that were removed. This is essentially the same as wrapping the list in L but convenient and possibly more efficient. This may be viewed as an in-place L. The one or two sets (array references) must be in set form (numerically sorted with no duplicates) or the results are undefined. =head2 setinvert my $s=[-10..10]; setinvert($s, 0); # $s is now [-10..-1,1..10] setinvert($s, [5,10,15,20]); # $s is now [-10..-1,1..4,6..9,15,20] Given two array references of integers in set form, inverts the containment status in the first set for each element of the second set. That is, for each element of the second set, inserts into the first set if not an element, and removes from the first set if it is an element. Given an array reference of integers in set form, followed by zero or more integer scalars (possibly unordered and containing duplicates), does the same as if the list was wrapped in L. An integer value is returned indicating how many values were inserted, minus the number of values deleted. This may be viewed as an in-place L. The one or two sets (array references) must be in set form (numerically sorted with no duplicates) or the results are undefined. =head2 setcontains my $has_element = setcontains( [-12,1..20], 15 ); my $is_subset = setcontains( [-12,1..20], [-12,5,10,15] ); Given two sets (array references of numerically sorted de-duplicated integers), returns either 1 or 0 indicating whether the second argument is a subset of the first set (i.e. if all elements from the second argument are members of the first set). Given a set and zero or more integers in any form (possibly unordered and can contain duplicates), does the same as if the list was wrapped in L. If the first array reference is not in set form (numerically sorted with no duplicates, and no string forms), the result is undefined. It is unlikely to give a correct answer. Use L to convert an arbitrary integer list into set form. =head2 setcontainsany # True if there is any intersection between the two sets my $intersects = setcontainsany($set1,$set2); my $has_one_of = setcontainsany( [-12,1..20], -14,0,1,100 ); # true Given two sets (array references of numerically sorted de-duplicated integers), returns either 1 or 0 indicating whether B element of the second set is an element of the first set. Alternately, a set followed by a list of unordered integers will do the same, as if the list was wrapped in L. There is some functionality duplication, e.g. checking for disjoint sets can be done with any of these: my $dj1 = set_is_disjoint($set1, $set2); my $dj2 = scalar(@{setintersect($set1, $set2)}) == 0; my $dj3 = !setcontainsany($set1, $set2); This function B the array reference inputs be in set form or the result is undefined. In return it can be thousands of times faster for large sets. =head2 setbinop my $sumset = setbinop { $a + $b } [1,2,3], [2,3,4]; # [3,4,5,6,7] my $difset = setbinop { $a - $b } [1,2,3], [2,3,4]; # [-3,-2,-1,0,1] my $setsum = setbinop { $a + $b } [1,2,3]; # [2,3,4,5,6] Given a code block and two array references containing integers, treats them as integer sets and constructs a new set from applying the cross product to the block. If only one array reference is given, it will be used with itself. The result will be in set form (numerically sorted, no duplicates). The input sets are not aliased inside the block (modifying C<$a> and C<$b> has no effect outside the block). This corresponds to Pari's C function. Our function uses B less memory, as of Pari 2.18.1. =head2 sumset Given two array references of integers, treats them as integer sets and returns the sumset as a set (a sorted de-duplicated array reference). If only one array reference is given, it will be used for both. It is common to see sumset applied to a single set. This is equivalent to: my %r; my @A=(2,4,6,8); my @B=(3,5,7); forsetproduct { $r{vecsum(@_)}=undef; } \@A,\@B; my $sumset = [vecsort(keys %r)]; or my $sumset1 = setbinop { addint($a,$b) } [1,2,3]; my $sumset2 = setbinop { addint($a,$b) } [1,2,3], [2,3,4]; In Mathematica one can use C. In Pari/GP one can use Ca+b,X,Y)>. =head2 setunion Given exactly two array references of integers, treats them as sets and returns the union as a set. The returned set will have all elements that appear in either input set. This is more efficient if the input is in set form (numerically sorted, no duplicates). The result will be in set form. This corresponds to Pari's C function, Mathematica's C function, and Sage's C function on Set objects. =head2 setintersect my $commonset = setintersect($set1,$set2); my $is_disjoint = 0 == @$commonset; # scalar size of the intersection Given exactly two array references of integers, treats them as sets and returns the intersection as a set. The returned set will have all elements that appear in both input sets. This is more efficient if the input is in set form (numerically sorted, no duplicates). The result will be in set form. This corresponds to Pari's C function, Mathematica's C function, and Sage's C function on Set objects. =head2 setminus Given exactly two array references of integers, treats them as sets and returns the difference as a set. The returned set will have all elements that appear in the first set but not in the second. This is more efficient if the input is in set form (numerically sorted, no duplicates). The result will be in set form. This corresponds to Pari's C function, Mathematica's C function, and Sage's C function on Set objects. =head2 setdelta Given exactly two array references of integers, treats them as sets and returns the symmetric difference as a set. The returned set will have all elements that appear in only one of the two input sets. This is more efficient if the input is in set form (numerically sorted, no duplicates). The result will be in set form. This corresponds to Pari's C function, Mathematica's C function, and Sage's C function on Set objects. =head2 is_sidon_set Given an array reference of integers, treats it as a set and returns 1 if it is a Sidon set (sometimes called Sidon sequence), and 0 otherwise. To be a Sidon set, all elements must be non-negative and all pair-wise sums a_i + a_j (i E= j) are unique. All finite Sidon sets are Golomb rulers, and all Golomb rulers are Sidon. =head2 is_sumfree_set Given an array reference of integers, treats it as a set and returns 1 if it is a sum-free set, and 0 otherwise. A sum-free set is one where no sum of two elements from the set is equal to any element of the set. That is, the set and its sumset are disjoint. =head2 set_is_disjoint Given two array references of integers, treats them as sets and returns 1 if the sets have no elements in common, 0 otherwise. This corresponds to Mathematica's C function. =head2 set_is_equal Given two array references of integers in set form, returns 1 if the sets have all elements in common, 0 otherwise. This function works even if the inputs are not sorted. If they are sorted (proper set form) then L can be used and is typically much faster. =head2 set_is_subset Given two array references of integers in set form, returns 1 if the first set also contains all elements of the second set, 0 otherwise. The L function can be used equivalently, and does not require the second list to be in set form. This corresponds to Mathematica's C function (is B a subset of A). =head2 set_is_proper_subset Given two array references of integers in set form, returns 1 if the first set also contains all elements of the second set but are not equal, 0 otherwise. The size of the first set must be strictly larger than the second. =head2 set_is_superset Given two array references of integers in set form, returns 1 if the second set also contains all elements of the first set, 0 otherwise. The L function can be used equivalently (with reversed arguments). =head2 set_is_proper_superset Given two array references of integers in set form, returns 1 if the second set also contains all elements of the first set but are not equal, 0 otherwise. The size of the second set must be strictly larger than the first. =head2 set_is_proper_intersection Given two array references of integers in set form, returns 1 if the two sets have at least one element in common, and each of the two sets have at least one element not present in the other set. Returns 0 otherwise. =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 # arguments are: input integer, base (optional), truncate (optional) 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. The first argument C is the input integer. The sign is ignored. If no other arguments are given, this just returns the string of C. An optional second argument is the base C which must be between 2 and 36. No prefix such as "0x" will be added, and all bases over 9 use lower case C to C. An optional third argument C requires the result to be exactly C digits. This truncates to the last C digits if the result has C or fewer digits, or zero extends if the result has more digits. 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 tozeckendorf say tozeckendorf(24); # "1000100" say fromdigits(tozeckendorf(24),2); # 68 Given a non-negative integer C, return the Zeckendorf representation as a binary string. This represents C as a sum of nonconsecutive Fibonacci numbers. Each set bit indicates summing the corresponding Fibonacci number, e.g. 24 = 21+3 = F(8)+F(4). F(0)=0 and F(1)=1 are not used. This is sometimes also called Fibbinary or the Fibonacci base. The restriction that consecutive values are not used ("11" cannot appear) is required to create a unique mapping to the positive integers. A simple greedy algorithm suffices to construct the encoding. say reverse(tozeckendorf($_)).'1' for 1..20 shows the first twenty Fibonacci C1 codes (Fraenkel and Klein, 1996). This is an example of a self-synchronizing variable length code. This corresponds to Mathematica's C function. Also see L and L. =head2 fromzeckendorf say fromzeckendorf("1000100"); # 24 say fromzeckendorf(todigitstring(68,2)); # 24 Given a binary string in Zeckendorf representation, return the corresponding integer. The string may not contain anything other than the characters C<0> and C<1>, and must not contain C<11>. The resulting number is the sum of the Fibonacci numbers in the position starting from the right (The Fibonacci index is offset by two, as F(0)=0 and F(1)=1 are not used). =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. C version 1.999818 has a similar C function. =head2 valuation say "$n is divisible by 2 ", valuation($n,2), " times."; Given integer C and non-negative integer C, returns the number of times C is divisible by C. This is a very limited version of the algebraic valuation -- here it is just applied to integers. C must be greater than 1. C<|n|> is used, C<|n| = 0> returns undef, and C<|n| = 1> returns zero. This corresponds to Pari and SAGE's C function. =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); Given integer C, returns 1 if C<|n|> has no repeated factor. =head2 is_cyclic Given integer C, returns 1 if C is positive and cyclic in the number theory sense, and returns 0 otherwise. A cyclic number C has only one group of order C. C and C<φ(n)> are relatively prime. This is the L. =head2 is_carmichael for (1..1e6) { say if is_carmichael($_) } # Carmichaels under 1,000,000 Given an integer C, returns 1 if C is positive and a Carmichael number, and returns 0 otherwise. These are composites that satisfy C for all C<< 1 < b < 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