This is an automated email from the git hooks/post-receive script. ppm-guest pushed a commit to annotated tag v0.36 in repository libmath-prime-util-perl.
commit b57e1907eeb7fc524d4da8519f9a38ef2cd3328f Author: Dana Jacobsen <d...@acm.org> Date: Mon Jan 13 13:15:34 2014 -0800 Move jordan_totient to XS->PP from Util --- XS.xs | 16 ++++++++++++---- lib/Math/Prime/Util.pm | 35 +---------------------------------- lib/Math/Prime/Util/PP.pm | 23 +++++++++++++++++++++++ t/80-pp.t | 1 + util.c | 28 ++++++++++++++++++++++++++++ util.h | 1 + 6 files changed, 66 insertions(+), 38 deletions(-) diff --git a/XS.xs b/XS.xs index d1ba176..cdf80e6 100644 --- a/XS.xs +++ b/XS.xs @@ -691,7 +691,8 @@ divisor_sum(IN SV* svn, ...) void znorder(IN SV* sva, IN SV* svn) ALIAS: - legendre_phi = 1 + jordan_totient = 1 + legendre_phi = 2 PREINIT: int astatus, nstatus; PPCODE: @@ -705,14 +706,21 @@ znorder(IN SV* sva, IN SV* svn) case 0: ret = znorder(a, n); if (ret == 0) XSRETURN_UNDEF; /* not defined */ break; - case 1: - default: ret = legendre_phi(a, n); break; + case 1: ret = jordan_totient(a, n); + if (ret == 0 && n > 1) + goto overflow; + break; + case 2: + default: ret = legendre_phi(a, n); + break; } XSRETURN_UV(ret); } + overflow: switch (ix) { case 0: _vcallsub_with_pp("znorder"); break; - case 1: + case 1: _vcallsub_with_pp("jordan_totient"); break; + case 2: default: _vcallsub_with_pp("legendre_phi"); break; } return; /* skip implicit PUTBACK */ diff --git a/lib/Math/Prime/Util.pm b/lib/Math/Prime/Util.pm index 6b0217c..4ff112a 100644 --- a/lib/Math/Prime/Util.pm +++ b/lib/Math/Prime/Util.pm @@ -116,6 +116,7 @@ BEGIN { *prev_prime = \&Math::Prime::Util::_generic_prev_prime; *exp_mangoldt = \&Math::Prime::Util::_generic_exp_mangoldt; *euler_phi = \&Math::Prime::Util::_generic_euler_phi; + *jordan_totient= \&Math::Prime::Util::PP::jordan_totient; *moebius = \&Math::Prime::Util::_generic_moebius; *mertens = \&Math::Prime::Util::_generic_mertens; *prime_count = \&Math::Prime::Util::_generic_prime_count; @@ -1317,40 +1318,6 @@ sub _generic_euler_phi { return Math::Prime::Util::PP::euler_phi_range($n, $nend); } -# Jordan's totient -- a generalization of Euler's totient. -sub jordan_totient { - my($k, $n) = @_; - _validate_num($k, 1) || _validate_positive_integer($k, 1); - return euler_phi($n) if $k == 1; - - return 0 if defined $n && $n <= 0; # Following SAGE's logic here. - _validate_num($n) || _validate_positive_integer($n); - return 1 if $n <= 1; - - my @pe = factor_exp($n); - - $n = Math::BigInt->new("$n") if ref($_[1]) eq 'Math::BigInt'; - my $totient = $n - $n + 1; - - if (ref($n) ne 'Math::BigInt') { - foreach my $f (@pe) { - my ($p, $e) = @$f; - my $fmult = int($p ** $k); - $totient *= ($fmult - 1); - $totient *= $fmult for (2 .. $e); - } - } else { - my $zero = $n->copy->bzero; - foreach my $f (@pe) { - my ($p, $e) = @$f; - my $fmult = $zero->copy->badd("$p")->bpow($k); - $totient->bmul($fmult->copy->bdec()); - $totient->bmul($fmult) for (2 .. $e); - } - } - return $totient; -} - sub _generic_divisor_sum { my($n) = @_; _validate_num($n) || _validate_positive_integer($n); diff --git a/lib/Math/Prime/Util/PP.pm b/lib/Math/Prime/Util/PP.pm index ca8fbbb..e9a7d59 100644 --- a/lib/Math/Prime/Util/PP.pm +++ b/lib/Math/Prime/Util/PP.pm @@ -494,6 +494,29 @@ sub prev_prime { #$d*30+$m; } +sub jordan_totient { + my($k, $n) = @_; + _validate_num($k) || _validate_positive_integer($k); + return ($n == 1) ? 1 : 0 if $k == 0; + return euler_phi($n) if $k == 1; + return 0 if defined $n && $n < 0; # Following SAGE's logic here. + _validate_num($n) || _validate_positive_integer($n); + return ($n == 1) ? 1 : 0 if $n <= 1; + + my @pe = Math::Prime::Util::factor_exp($n); + $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt'; + my $totient = BONE->copy; + foreach my $f (@pe) { + my ($p, $e) = @$f; + $p = Math::BigInt->new("$p") unless ref($p) eq 'Math::BigInt'; + $p->bpow($k); + $totient->bmul($p->copy->bdec()); + $totient->bmul($p) for 2 .. $e; + } + $totient = _bigint_to_int($totient) if $totient->bacmp(''.~0) <= 0; + return $totient; +} + sub euler_phi { my($n) = @_; return 0 if $n < 0; diff --git a/t/80-pp.t b/t/80-pp.t index 2240202..d88d550 100644 --- a/t/80-pp.t +++ b/t/80-pp.t @@ -602,6 +602,7 @@ is( is_aks_prime(23), 1, "AKS: 23 is prime (r >= n)" ); is( is_aks_prime(70747), 0, "AKS: 70747 is composite (n mod r)" ); SKIP: { skip "Skipping PP AKS test without EXTENDED_TESTING", 2 unless $extra; + diag "32-bit Perl will be very slow for AKS" unless $use64; is( is_aks_prime(101), 1, "AKS: 101 is prime (passed anr test)" ); is( is_aks_prime(74513), 0, "AKS: 74513 is composite (failed anr test)" ); } diff --git a/util.c b/util.c index 8480572..dcf76a2 100644 --- a/util.c +++ b/util.c @@ -918,6 +918,34 @@ UV totient(UV n) { return totient; } +static const UV jordan_overflow[5] = +#if BITS_PER_WORD == 64 + {UVCONST(4294967311), 2642249, 65537, 7133, 1627}; +#else + {UVCONST( 65537), 1627, 257, 85, 41}; +#endif +UV jordan_totient(UV k, UV n) { + UV factors[MPU_MAX_FACTORS+1]; + int nfac, i, j; + UV totient; + if (k == 0 || n <= 1) return (n == 1); + if (k > 6 || (k > 1 && n >= jordan_overflow[k-2])) return 0; + + totient = 1; + nfac = factor(n,factors); + for (i = 0; i < nfac; i++) { + UV p = factors[i]; + UV pk = p; + for (j = 1; j < k; j++) pk *= p; + totient *= (pk-1); + while (i+1 < nfac && p == factors[i+1]) { + i++; + totient *= pk; + } + } + return totient; +} + UV carmichael_lambda(UV n) { UV fac[MPU_MAX_FACTORS+1]; UV exp[MPU_MAX_FACTORS+1]; diff --git a/util.h b/util.h index 8627110..715e4b7 100644 --- a/util.h +++ b/util.h @@ -37,6 +37,7 @@ extern UV totient(UV n); extern int moebius(UV n); extern UV exp_mangoldt(UV n); extern UV carmichael_lambda(UV n); +extern UV jordan_totient(UV k, UV n); extern UV znprimroot(UV n); extern UV znorder(UV a, UV n); extern UV znlog(UV a, UV g, UV p); -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmath-prime-util-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits