File Coverage

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


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