File Coverage

blib/lib/Math/ModInt/Perl.pm
Criterion Covered Total %
statement 119 119 100.0
branch 42 42 100.0
condition 10 11 90.9
subroutine 25 25 100.0
pod 5 5 100.0
total 201 202 99.5


line stmt bran cond sub pod time code
1             # Copyright (c) 2009-2015 Martin Becker. All rights reserved.
2             # This package is free software; you can redistribute it and/or modify it
3             # under the same terms as Perl itself.
4             #
5             # $Id: Perl.pm 60 2015-05-18 08:47:12Z demetri $
6              
7             package Math::ModInt::Perl;
8              
9 7     7   904 use 5.006;
  7         24  
  7         299  
10 7     7   87 use strict;
  7         10  
  7         278  
11 7     7   39 use warnings;
  7         11  
  7         272  
12 7     7   46 use Carp qw(croak);
  7         11  
  7         577  
13              
14             # ----- object definition -----
15              
16             # Math::ModInt::Perl=ARRAY(...)
17              
18             # .......... index .......... # .......... value ..........
19 7     7   36 use constant F_RESIDUE => 0; # residue r, 0 <= r < m
  7         10  
  7         479  
20 7     7   36 use constant F_MODULUS => 1; # modulus m
  7         9  
  7         320  
21 7     7   43 use constant NFIELDS => 2;
  7         9  
  7         319  
22              
23             # ----- class data -----
24              
25 7     7   34 use constant _OPT_THRESHOLD => 256;
  7         35  
  7         320  
26 7     7   30 use constant _OPT_LIMIT => 32768;
  7         9  
  7         557  
27              
28             BEGIN {
29 7     7   34 require Math::ModInt;
30 7         117 our @ISA = qw(Math::ModInt);
31 7         7506 our $VERSION = '0.011';
32             }
33              
34             my %inverses = ();
35              
36             # ----- private methods -----
37              
38             # special case of _NEW, not using modulo, no class method
39             sub _make {
40 171     171   157 my ($this, $r) = @_;
41 171         617 return bless [$r, $this->[F_MODULUS]], ref $this;
42             }
43              
44             sub _mod_inv {
45 86     86   88 my ($r, $mod) = @_;
46 86         95 my $inv = $inverses{$mod};
47 86 100 100     164 if ($inv) {
    100          
48 70         58 my $i = $inv->[$r];
49 70 100       128 return $i if defined $i;
50             }
51             elsif (!defined($inv) && $mod <= _OPT_THRESHOLD) {
52 4         13 $inv = $inverses{$mod} = [0];
53             }
54 24         36 my ($d, $dd, $i, $ii) = ($mod, $r, 0, 1);
55 24         47 while ($dd) {
56 51         484 my $f = int($d / $dd);
57 51         283 ($d, $dd) = ($dd, $d - $f * $dd);
58 51         476 ($i, $ii) = ($ii, $i - $f * $ii);
59             }
60 24 100       191 if (1 != $d) {
    100          
61 4         5 $i = 0;
62             }
63             elsif ($i < 0) {
64 5         4 $i += $mod;
65             }
66 24 100       249 if ($inv) {
67 12         23 $inv->[$r] = $i;
68 12 100       39 if ($i) {
69 9         29 $inv->[$i] = $r;
70             }
71             }
72 24         73 return $i;
73             }
74              
75             sub _NEG {
76 9     9   33 my ($this) = @_;
77 9         7 my ($r, $mod) = @{$this};
  9         11  
78 9 100       15 return $this if !$r;
79 7         13 return $this->_make($mod-$r);
80             }
81              
82             sub _ADD {
83 53     53   48 my ($this, $that) = @_;
84 53         62 my $r = $this->[F_RESIDUE] + $that->[F_RESIDUE];
85 53         44 my $mod = $this->[F_MODULUS];
86 53 100       85 if ($mod <= $r) {
87 20         20 $r -= $mod;
88             }
89 53         71 return $this->_make($r);
90             }
91              
92             sub _SUB {
93 42     42   36 my ($this, $that) = @_;
94 42         39 my $r = $this->[F_RESIDUE] - $that->[F_RESIDUE];
95 42         38 my $mod = $this->[F_MODULUS];
96 42 100       61 if ($r < 0) {
97 17         16 $r += $mod;
98             }
99 42         50 return $this->_make($r);
100             }
101              
102             sub _MUL {
103 65     65   65 my ($this, $that) = @_;
104 65         117 return $this->_NEW($this->[F_RESIDUE]*$that->[F_RESIDUE]);
105             }
106              
107             sub _DIV {
108 43     43   37 my ($this, $that) = @_;
109 43         36 my $mod = $this->[F_MODULUS];
110 43         52 my $i = _mod_inv($that->[F_RESIDUE], $mod);
111 43 100       73 return $this->undefined if !$i;
112 30         61 return $this->_NEW($this->[F_RESIDUE]*$i);
113             }
114              
115             sub _POW {
116 81     81   78 my ($this, $exp) = @_;
117 81         66 my ($r, $mod) = @{$this};
  81         88  
118 81 100       124 return $this->_make(1) if !$exp;
119 71 100       123 if ($exp < 0) {
    100          
120 27         37 $r = _mod_inv($r, $mod);
121 27 100       49 return $this->undefined if !$r;
122 21         22 $exp = -$exp;
123             }
124             elsif (!$r) {
125 6         10 return $this;
126             }
127 59         109 my $p = 1;
128 59         95 while ($exp) {
129 201 100       964 if (1 & $exp) {
130 136         126 $p = $p*$r % $mod;
131             }
132 201 100       1499 $exp >>= 1 and $r = $r*$r % $mod;
133             }
134 59         125 return $this->_make($p);
135             }
136              
137             sub _INV {
138 16     16   13 my ($this) = @_;
139 16         16 my ($r, $mod) = @{$this};
  16         114  
140 16         29 my $i = _mod_inv($r, $mod);
141 16 100       54 return $this->undefined if !$i;
142 11         14 return $this->_NEW($i);
143             }
144              
145             sub _NEW {
146 293     293   495 my ($this, $residue, $modulus) = @_;
147 293         356 my $class = ref($this);
148 293 100       423 if ($class) {
149 214         333 $modulus = $this->[F_MODULUS];
150             }
151             else {
152 79         98 $class = $this;
153             }
154 293         1336 return bless [$residue % $modulus, $modulus], $class;
155             }
156              
157             # ----- public methods -----
158              
159             sub residue {
160 816     816 1 2328 my ($this) = @_;
161 816         1835 return $this->[F_RESIDUE];
162             }
163              
164             sub modulus {
165 1249     1249 1 2026 my ($this) = @_;
166 1249         2741 return $this->[F_MODULUS];
167             }
168              
169             sub optimize_time {
170 4     4 1 9 my ($this) = @_;
171 4         8 my $mod = $this->modulus;
172 4 100       9 if ($mod <= _OPT_LIMIT) {
173 3   100     15 $inverses{$mod} ||= [0];
174             }
175 4         8 return $this;
176             }
177              
178             sub optimize_space {
179 2     2 1 5 my ($this) = @_;
180 2         10 $inverses{$this->modulus} = 0;
181 2         5 return $this;
182             }
183              
184             sub optimize_default {
185 5     5 1 14 my ($this) = @_;
186 5         9 my $mod = $this->modulus;
187 5 100 100     30 if (exists $inverses{$mod} and $mod > _OPT_THRESHOLD || !$inverses{$mod}) {
      66        
188 2         4 delete $inverses{$mod};
189             }
190 5         10 return $this;
191             }
192              
193             1;
194              
195             __END__