File Coverage

blib/lib/Math/ModInt/ChineseRemainder.pm

Criterion	Covered	Total	%
statement	81	81	100.0
branch	20	20	100.0
condition	6	6	100.0
subroutine	15	15	100.0
pod	6	6	100.0
total	128	128	100.0

# Copyright (c) 2009-2015 Martin Becker.  All rights reserved.
# This package is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# $Id: ChineseRemainder.pm 60 2015-05-18 08:47:12Z demetri $

package Math::ModInt::ChineseRemainder;

use 5.006;
use strict;
use warnings;
use Math::ModInt qw(mod);
use overload ();

# ----- class data -----

BEGIN {
    require Exporter;
    our @ISA        = qw(Exporter);
    our @EXPORT_OK  = qw(cr_combine cr_extract);
    our $VERSION    = '0.011';
}

use constant _INITIAL_CACHE_SIZE => 1024;

my $cache_size = _INITIAL_CACHE_SIZE;
my %param_cache = ();           # memoizing param arrayrefs, key "m:n"
my @param_fifo  = ();           # list of up to $cache_size keys

# parameter arrayref:
# [
#   ModInt factor for greater modulus,
#   ModInt factor for smaller modulus,
#   greatest common divisor of moduli
# ]

# ----- private subroutines -----

# extended euclidian algorithm to find modulus-specific parameters
# moduli must be in descending order
sub _calculate_params {
    my ($mod_g, $mod_s) = @_;
    my ($g, $s) = ($mod_g, $mod_s);
    my ($gg, $gs, $sg, $ss) = (1, 0, 0, 1);
    while ($s != 0) {
        my $m = $g % $s;
        my $d = ($g - $m) / $s;
        ($g, $gg, $gs, $s,            $sg,            $ss) =
        ($s, $sg, $ss, $m, $gg - $d * $sg, $gs - $d * $ss);
    }
    $ss = abs $ss;
    $sg = abs $sg;
    my $lcm     =            $mod_g * $sg;
    my $coeff_g =           mod($gs * $sg, $lcm);
    my $coeff_s = $coeff_g->new($gg * $ss);
    return ($coeff_g, $coeff_s, $g);
}

# fetch memoized params or calculate them
# moduli must be in descending order
sub _get_params {
    my ($mod_g, $mod_s) = @_;
    my @params;
    if ($cache_size) {
        my $key = "$mod_g:$mod_s";
        if (exists $param_cache{$key}) {
            @params = @{$param_cache{$key}};
        }
        else {
            @params = _calculate_params($mod_g, $mod_s);
            if (@param_fifo >= $cache_size) {
                delete $param_cache{shift @param_fifo};
            }
            push @param_fifo, $key;
            $param_cache{$key} = \@params;
        }
    }
    else {
        @params = _calculate_params($mod_g, $mod_s);
    }
    return @params;
}

# ----- public subroutines -----

sub cr_combine {
    foreach my $arg (@_) {
        return $arg if $arg->is_undefined;
    }
    my @these = sort { $a->modulus <=> $b->modulus } @_;
    return mod(0, 1) if !@these;
    my $this = pop @these;
    while (@these) {
        my $that = pop @these;
        my ($coeff_this, $coeff_that, $gcd) =
            _get_params($this->modulus, $that->modulus);
        if ($gcd != 1 && $this->residue % $gcd != $that->residue % $gcd) {
            return Math::ModInt->undefined;
        }
        $this =
            $coeff_this * $coeff_this->new($this->residue) +
            $coeff_that * $coeff_that->new($that->residue);
    }
    return $this;
}

sub cr_extract {
    my ($this, $desired_modulus) = @_;
    return Math::ModInt->undefined if $this->is_undefined;
    if (0 != $this->modulus % $desired_modulus) {
        return Math::ModInt->undefined;
    }
    my $residue = $this->residue;
    # make sure residue does not exceed the precision of modulus
    if (!ref $desired_modulus && ref $residue) {
        my $as_number = overload::Method($residue, '0+');
        $residue = ($residue % $desired_modulus)->$as_number;
    }
    return mod($residue, $desired_modulus);
}

sub cache_level {
    return scalar @param_fifo;
}

sub cache_flush {
    %param_cache = ();
    @param_fifo  = ();
    return 0;
}

sub cache_size {
    return $cache_size;
}

sub cache_resize {
    my $size = pop;
    $cache_size = $size;
    if ($cache_size < @param_fifo) {
        delete @param_cache{splice @param_fifo, 0, @param_fifo - $cache_size};
    }
    return $cache_size;
}

1;

__END__