File Coverage

blib/lib/Math/ModInt.pm

Criterion	Covered	Total	%
statement	149	149	100.0
branch	60	60	100.0
condition	36	36	100.0
subroutine	45	45	100.0
pod	19	19	100.0
total	309	309	100.0

# Copyright (c) 2009-2019 Martin Becker, Blaubeuren.
# This package is free software; you can distribute it and/or modify it
# under the terms of the Artistic License 2.0 (see LICENSE file).

package Math::ModInt;

use 5.006;
use strict;
use warnings;
use Math::ModInt::Event
    qw(UsageError Nonexistent LoadingFailure UndefinedResult DifferentModuli);

sub _no_op {
    my ($op) = @_;
    return $op => sub { UsageError->raise('undefined operation', $op) };
}

use overload (
    'neg'      => '_NEG',
    '+'        => \&_oadd,
    '-'        => \&_osub,
    '*'        => \&_omul,
    '/'        => \&_odiv,
    '**'       => \&_opow,
    '=='       => \&_oeq,
    '!='       => \&_oneq,
    '!'        => 'is_zero',
    'bool'     => 'is_not_zero',
    '0+'       => 'residue',
    '""'       => 'as_string',
    'fallback' => undef,
    _no_op('abs'),
    _no_op('int'),
);

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

BEGIN {
    require Exporter;
    our @ISA       = qw(Exporter);
    our @EXPORT_OK = qw(mod divmod qmod);
    our @CARP_NOT  = qw(Math::ModInt::ChineseRemainder);
    our $VERSION   = '0.012';
}

sub _max_modulus_perl {
    my $limit = 32767;
    foreach my $bits (16..96) {
        my $probe = $limit + $limit + 1;
        last if 0.5 != $probe / 2 - ($probe ^ 1) / 2;
        $limit = $probe;
    }
    return int sqrt $limit;
}

use constant _MAX_MODULUS_PERL => _max_modulus_perl();

my $undefined = bless [];                       # singleton
my %loaded = ();                                # collects loaded modules

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

sub _is_integer {
    my ($arg) = @_;
    local $@;
    return
        eval {
            use warnings FATAL => 'all';
            ref $arg?
                $arg->isa('Math::BigInt')
            :
                $arg == int($arg) && abs($arg) <= ~0
        };
}

sub _incompatible {
    my ($this, $that) = @_;
    if ($this->is_defined && $that->is_defined) {
        DifferentModuli->raise($this, $that);
    }
    return $undefined;
}

sub _best_class {
    my ($modulus) = @_;
    if (_is_integer($modulus)) {
        return 'Math::ModInt::BigInt'  if $modulus >  _MAX_MODULUS_PERL;
        return 'Math::ModInt::Perl'    if $modulus >  3;
        return 'Math::ModInt::GF3'     if $modulus == 3;
        return 'Math::ModInt::GF2'     if $modulus == 2;
        return 'Math::ModInt::Trivial' if $modulus == 1;
    }
    UsageError->raise('positive integer modulus expected');
}

sub _load {
    my ($class) = @_;
    do {
        local $@;
        $loaded{$class} ||= eval "require $class"
    }
    or LoadingFailure->raise($class);
    return $class;
}

sub _oadd {
    my ($this, $that) = @_;
    if (!ref $that || !$that->isa(__PACKAGE__)) {
        $that = $this->_NEW($that);
    }
    elsif ($this->modulus != $that->modulus) {
        return _incompatible($this, $that);
    }
    return $this->_ADD($that);
}

sub _osub {
    my ($this, $that, $reversed) = @_;
    if (!ref $that || !$that->isa(__PACKAGE__)) {
        $that = $this->_NEW($that);
    }
    elsif ($this->modulus != $that->modulus) {
        return _incompatible($this, $that);
    }
    return $reversed? $that->_SUB($this): $this->_SUB($that);
}

sub _omul {
    my ($this, $that) = @_;
    if (!ref $that || !$that->isa(__PACKAGE__)) {
        $that = $this->_NEW($that);
    }
    elsif ($this->modulus != $that->modulus) {
        return _incompatible($this, $that);
    }
    return $this->_MUL($that);
}

sub _odiv {
    my ($this, $that, $reversed) = @_;
    if (!ref $that || !$that->isa(__PACKAGE__)) {
        $that = $this->_NEW($that);
    }
    elsif ($this->modulus != $that->modulus) {
        return _incompatible($this, $that);
    }
    return $reversed? $that->_DIV($this): $this->_DIV($that);
}

sub _opow {
    my ($this, $exp, $reversed) = @_;
    # exponent should be in perl integer range or be a big int
    if ($reversed || !_is_integer($exp)) {
        UsageError->raise('integer exponent expected');
    }
    return $this->_POW($exp);
}

sub _oeq {
    my ($this, $that) = @_;
    # note that comparing with $undefined is illegal
    if (!ref $that || !$that->isa(__PACKAGE__)) {
        return $this->residue == $that % $this->modulus;
    }
    return
        $this->residue == $that->residue &&
        $this->modulus == $that->modulus;
}

sub _oneq {
    my ($this, $that) = @_;
    # note that comparing with $undefined is illegal
    if (!ref $that || !$that->isa(__PACKAGE__)) {
        return $this->residue != $that % $this->modulus;
    }
    return
        $this->residue != $that->residue ||
        $this->modulus != $that->modulus;
}

# ----- fallback for implementation interface method -----

sub _NEW2 {
    my ($this, $int, $modulus) = @_;
    my $that;
    if (ref $this) {
        $that = $this->_NEW($int);
        $modulus = $this->modulus;
    }
    else {
        $that = $this->_NEW($int, $modulus);
    }
    my $quot = ($int - $that->residue) / $modulus;
    return ($quot, $that);
}

# ----- public methods -----

# constructors

sub mod {
    my ($int, $modulus) = @_;
    my $class = _load(_best_class($modulus));
    return $class->_NEW($int, $modulus);
}

sub divmod {
    my ($int, $modulus) = @_;
    my $class = _load(_best_class($modulus));
    return $class->_NEW2($int, $modulus);
}

sub qmod {
    my ($rat, $modulus) = @_;
    my $class = _load(_best_class($modulus));
    my $num   = $class->_NEW($rat->numerator, $modulus);
    my $den   = $num->_NEW($rat->denominator);
    return $num / $den;
}

sub new {
    my ($this, $int, $modulus) = @_;
    return $this->_NEW($int) if ref $this;
    return mod($int, $modulus);
}

sub new2 {
    my ($this, $int, $modulus) = @_;
    return $this->_NEW2($int) if ref $this;
    return divmod($int, $modulus);
}

sub undefined {
    UndefinedResult->raise;
    return $undefined;
}

# accessors

sub residue {
    Nonexistent->raise('undefined residue');
}

sub modulus {
    return 0 if __PACKAGE__ eq (caller)[0];     # special case for _oadd etc.
    Nonexistent->raise('undefined modulus');
}

sub signed_residue {
    my ($this) = @_;
    my $r = $this->residue;
    my $m = $this->modulus;
    my $n = $m - $r;
    return $n <= $r? -$n: $r;
}

sub centered_residue {
    my ($this) = @_;
    my $r = $this->residue;
    my $m = $this->modulus;
    my $n = $m - $r;
    return $n < $r? -$n: $r;
}

sub is_defined {
    my ($this) = @_;
    return ref $undefined ne ref $this;
}

sub is_undefined {
    my ($this) = @_;
    return ref $undefined eq ref $this;
}

sub is_zero {
    my ($this) = @_;
    return 0 == $this->residue;
}

sub is_not_zero {
    my ($this) = @_;
    return 0 != $this->residue;
}

sub as_string {
    my ($this) = @_;
    my ($r, $mod) =
        $this->is_defined? ($this->residue, $this->modulus): qw(? ?);
    return "mod($r, $mod)";
}

# operators

sub inverse  { $_[0]->_INV }

BEGIN {
    foreach my $method (qw(
        _NEW _NEG _INV _ADD _SUB _MUL _DIV _POW
    )) {
        no strict 'refs';
        *{$method} = sub { $undefined };
    }
}

# miscellaneous

sub optimize_time    { $_[0] }
sub optimize_space   { $_[0] }
sub optimize_default { $_[0] }

1;

__END__