Codebase list libcryptx-perl / 12920b4
fix #26 Math::BigInt::LTM compatibility with Math::BigInt 1.999801+ Karel Miko 7 years ago
4 changed file(s) with 368 addition(s) and 115 deletion(s). Raw diff Collapse all Expand all
+8
-0
inc/CryptX_BigInt_LTM.xs.inc less more
601601 XPUSHs(ST(1)); /* x */
602602
603603 ##############################################################################
604 # _lcm() - least common multiple
605 void
606 _lcm(Class, Math::BigInt::LTM x, Math::BigInt::LTM y)
607 PPCODE:
608 mp_lcm(x, y, x) ;
609 XPUSHs(ST(1)); /* x */
610
611 ##############################################################################
604612 # Storable hooks
605613
606614 void
+356
-111
lib/Math/BigInt/LTM.pm less more
99
1010 sub CLONE_SKIP { 1 } # prevent cloning
1111
12 ##############################################################################
13 # routine to test internal state
14
12 ### same as overloading in Math::BigInt::Lib
13 use overload
14 # overload key: with_assign
15
16 '+' => sub {
17 my $class = ref $_[0];
18 my $x = $class -> _copy($_[0]);
19 my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
20 return $class -> _add($x, $y);
21 },
22
23 '-' => sub {
24 my $class = ref $_[0];
25 my ($x, $y);
26 if ($_[2]) { # if swapped
27 $y = $_[0];
28 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
29 } else {
30 $x = $class -> _copy($_[0]);
31 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
32 }
33 return $class -> _sub($x, $y);
34 },
35
36 '*' => sub {
37 my $class = ref $_[0];
38 my $x = $class -> _copy($_[0]);
39 my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
40 return $class -> _mul($x, $y);
41 },
42
43 '/' => sub {
44 my $class = ref $_[0];
45 my ($x, $y);
46 if ($_[2]) { # if swapped
47 $y = $_[0];
48 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
49 } else {
50 $x = $class -> _copy($_[0]);
51 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
52 }
53 return $class -> _div($x, $y);
54 },
55
56 '%' => sub {
57 my $class = ref $_[0];
58 my ($x, $y);
59 if ($_[2]) { # if swapped
60 $y = $_[0];
61 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
62 } else {
63 $x = $class -> _copy($_[0]);
64 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
65 }
66 return $class -> _mod($x, $y);
67 },
68
69 '**' => sub {
70 my $class = ref $_[0];
71 my ($x, $y);
72 if ($_[2]) { # if swapped
73 $y = $_[0];
74 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
75 } else {
76 $x = $class -> _copy($_[0]);
77 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
78 }
79 return $class -> _pow($x, $y);
80 },
81
82 '<<' => sub {
83 my $class = ref $_[0];
84 my ($x, $y);
85 if ($_[2]) { # if swapped
86 $y = $class -> _num($_[0]);
87 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
88 } else {
89 $x = $_[0];
90 $y = ref($_[1]) ? $class -> _num($_[1]) : $_[1];
91 }
92 return $class -> _blsft($x, $y);
93 },
94
95 '>>' => sub {
96 my $class = ref $_[0];
97 my ($x, $y);
98 if ($_[2]) { # if swapped
99 $y = $_[0];
100 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
101 } else {
102 $x = $class -> _copy($_[0]);
103 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
104 }
105 return $class -> _brsft($x, $y);
106 },
107
108 # overload key: num_comparison
109
110 '<' => sub {
111 my $class = ref $_[0];
112 my ($x, $y);
113 if ($_[2]) { # if swapped
114 $y = $_[0];
115 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
116 } else {
117 $x = $class -> _copy($_[0]);
118 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
119 }
120 return $class -> _acmp($x, $y) < 0;
121 },
122
123 '<=' => sub {
124 my $class = ref $_[0];
125 my ($x, $y);
126 if ($_[2]) { # if swapped
127 $y = $_[0];
128 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
129 } else {
130 $x = $class -> _copy($_[0]);
131 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
132 }
133 return $class -> _acmp($x, $y) <= 0;
134 },
135
136 '>' => sub {
137 my $class = ref $_[0];
138 my ($x, $y);
139 if ($_[2]) { # if swapped
140 $y = $_[0];
141 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
142 } else {
143 $x = $class -> _copy($_[0]);
144 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
145 }
146 return $class -> _acmp($x, $y) > 0;
147 },
148
149 '>=' => sub {
150 my $class = ref $_[0];
151 my ($x, $y);
152 if ($_[2]) { # if swapped
153 $y = $_[0];
154 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
155 } else {
156 $x = $class -> _copy($_[0]);
157 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
158 }
159 return $class -> _acmp($x, $y) >= 0;
160 },
161
162 '==' => sub {
163 my $class = ref $_[0];
164 my $x = $class -> _copy($_[0]);
165 my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
166 return $class -> _acmp($x, $y) == 0;
167 },
168
169 '!=' => sub {
170 my $class = ref $_[0];
171 my $x = $class -> _copy($_[0]);
172 my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
173 return $class -> _acmp($x, $y) != 0;
174 },
175
176 # overload key: 3way_comparison
177
178 '<=>' => sub {
179 my $class = ref $_[0];
180 my ($x, $y);
181 if ($_[2]) { # if swapped
182 $y = $_[0];
183 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
184 } else {
185 $x = $class -> _copy($_[0]);
186 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
187 }
188 return $class -> _acmp($x, $y);
189 },
190
191 # overload key: binary
192
193 '&' => sub {
194 my $class = ref $_[0];
195 my ($x, $y);
196 if ($_[2]) { # if swapped
197 $y = $_[0];
198 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
199 } else {
200 $x = $class -> _copy($_[0]);
201 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
202 }
203 return $class -> _and($x, $y);
204 },
205
206 '|' => sub {
207 my $class = ref $_[0];
208 my ($x, $y);
209 if ($_[2]) { # if swapped
210 $y = $_[0];
211 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
212 } else {
213 $x = $class -> _copy($_[0]);
214 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
215 }
216 return $class -> _or($x, $y);
217 },
218
219 '^' => sub {
220 my $class = ref $_[0];
221 my ($x, $y);
222 if ($_[2]) { # if swapped
223 $y = $_[0];
224 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
225 } else {
226 $x = $class -> _copy($_[0]);
227 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
228 }
229 return $class -> _xor($x, $y);
230 },
231
232 # overload key: func
233
234 'abs' => sub { $_[0] },
235
236 'sqrt' => sub {
237 my $class = ref $_[0];
238 return $class -> _sqrt($class -> _copy($_[0]));
239 },
240
241 'int' => sub { $_[0] -> copy() -> bint(); },
242
243 # overload key: conversion
244
245 'bool' => sub { ref($_[0]) -> _is_zero($_[0]) ? '' : 1; },
246
247 '""' => sub { ref($_[0]) -> _str($_[0]); },
248
249 '0+' => sub { ref($_[0]) -> _num($_[0]); },
250
251 '=' => sub { ref($_[0]) -> _copy($_[0]); },
252
253 ;
254
255 ### same as import() in Math::BigInt::Lib
256 sub import { }
257
258 ### same as _check() in Math::BigInt::Lib
15259 sub _check {
16 my ($c, $x) = @_;
17 return 0 if ref $x eq 'Math::BigInt::LTM';
18 return "$x is not a reference to Math::BigInt::LTM";
19 }
20
21 ##############################################################################
22 # Return the nth digit, negative values count backward.
23
260 # used by the test suite
261 my ($class, $x) = @_;
262 return "Input is undefined" unless defined $x;
263 return "$x is not a reference" unless ref($x);
264 return 0;
265 }
266
267 ### same as _digit() in Math::BigInt::Lib
24268 sub _digit {
25 my ($c, $x, $n) = @_;
26 substr(_str($c, $x), -($n+1), 1);
27 }
28
29 ##############################################################################
30 # Return a Perl numerical scalar.
31
269 my ($class, $x, $n) = @_;
270 substr($class ->_str($x), -($n+1), 1);
271 }
272
273 ### same as _num() in Math::BigInt::Lib
32274 sub _num {
33 my ($c, $x) = @_;
34 return 0 + _str($c, $x);
35 }
36
37 ##############################################################################
38 # _fac() - n! (factorial)
39
275 my ($class, $x) = @_;
276 0 + $class -> _str($x);
277 }
278
279 ### same as _fac() in Math::BigInt::Lib
40280 sub _fac {
41 my ($c, $x) = @_;
42 if (_is_zero($c, $x) || _is_one($c, $x)) {
43 _set($c, $x, 1);
44 }
45 else {
46 my $copy = _copy($c, $x);
47 my $one = _new($c, 1);
48 while(_acmp($c, $copy, $one) > 0) {
49 $copy = _dec($c, $copy);
50 $x = _mul($c, $x, $copy);
51 }
52 }
281 # factorial
282 my ($class, $x) = @_;
283
284 my $two = $class -> _two();
285
286 if ($class -> _acmp($x, $two) < 0) {
287 return $class -> _one();
288 }
289
290 my $i = $class -> _copy($x);
291 while ($class -> _acmp($i, $two) > 0) {
292 $i = $class -> _dec($i);
293 $x = $class -> _mul($x, $i);
294 }
295
53296 return $x;
54297 }
55298
56 ##############################################################################
57 # Return binomial coefficient (n over k).
58 # based on _nok() in Math::BigInt::GMP
59
299 ### same as _nok() in Math::BigInt::Lib
60300 sub _nok {
301 # Return binomial coefficient (n over k).
302 # Given refs to arrays, return ref to array.
61303 # First input argument is modified.
62 my ($c, $n, $k) = @_;
304
305 my ($class, $n, $k) = @_;
63306
64307 # If k > n/2, or, equivalently, 2*k > n, compute nok(n, k) as
65308 # nok(n, n-k), to minimize the number if iterations in the loop.
66309
67310 {
68 my $twok = _mul($c, _two($c), _copy($c, $k)); # 2 * k
69 if (_acmp($c, $twok, $n) > 0) { # if 2*k > n
70 $k = _sub($c, _copy($c, $n), $k); # k = n - k
311 my $twok = $class -> _mul($class -> _two(), $class -> _copy($k));
312 if ($class -> _acmp($twok, $n) > 0) {
313 $k = $class -> _sub($class -> _copy($n), $k);
71314 }
72315 }
73316
77320 # | | = --------- = --------------- = --------- = 5 * - * -
78321 # \ 3 / (7-3)! 3! 1*2*3*4 * 1*2*3 1 * 2 * 3 2 3
79322
80 if (_is_zero($c, $k)) {
81 $n = _one($c);
82 return $n;
323 if ($class -> _is_zero($k)) {
324 return $class -> _one();
83325 }
84326
85327 # Make a copy of the original n, since we'll be modifying n in-place.
86328
87 my $n_orig = _copy($c, $n);
329 my $n_orig = $class -> _copy($n);
88330
89331 # n = 5, f = 6, d = 2 (cf. example above)
90332
91 _sub($c, $n, $k);
92 _inc($c, $n);
93
94 my $f = _copy($c, $n);
95 _inc($c, $f);
96
97 my $d = _two($c);
333 $n = $class -> _sub($n, $k);
334 $n = $class -> _inc($n);
335
336 my $f = $class -> _copy($n);
337 $class -> _inc($f);
338
339 my $d = $class -> _two();
98340
99341 # while f <= n (the original n, that is) ...
100342
101 while (_acmp($c, $f, $n_orig) <= 0) {
343 while ($class -> _acmp($f, $n_orig) <= 0) {
102344
103345 # n = (n * f / d) == 5 * 6 / 2 (cf. example above)
104346
105 _mul($c, $n, $f);
106 _div($c, $n, $d);
347 $n = $class -> _mul($n, $f);
348 $n = $class -> _div($n, $d);
107349
108350 # f = 7, d = 3 (cf. example above)
109351
110 _inc($c, $f);
111 _inc($c, $d);
352 $f = $class -> _inc($f);
353 $d = $class -> _inc($d);
112354 }
113355
114356 return $n;
115357 }
116358
117 ##############################################################################
118 # based on _log_int() in Math::BigInt::GMP
119
359 ### same as _log_int() in Math::BigInt::Lib
120360 sub _log_int {
121 my ($c, $x, $base) = @_;
361 # calculate integer log of $x to base $base
362 # ref to array, ref to array - return ref to array
363 my ($class, $x, $base) = @_;
122364
123365 # X == 0 => NaN
124 return if _is_zero($c, $x);
125
126 $base = _new($c, 2) unless defined $base;
127 $base = _new($c, $base) unless ref $base;
366 return if $class -> _is_zero($x);
367
368 $base = $class -> _new(2) unless defined($base);
369 $base = $class -> _new($base) unless ref($base);
128370
129371 # BASE 0 or 1 => NaN
130 return if _is_zero($c, $base) || _is_one($c, $base);
372 return if $class -> _is_zero($base) || $class -> _is_one($base);
131373
132374 # X == 1 => 0 (is exact)
133 if (_is_one($c, $x)) {
134 _set($c, $x, 0);
135 return $x, 1;
136 }
137
138 my $cmp = _acmp($c, $x, $base);
375 if ($class -> _is_one($x)) {
376 return $class -> _zero(), 1;
377 }
378
379 my $cmp = $class -> _acmp($x, $base);
139380
140381 # X == BASE => 1 (is exact)
141382 if ($cmp == 0) {
142 _set($c, $x, 1);
143 return $x, 1;
383 return $class -> _one(), 1;
144384 }
145385
146386 # 1 < X < BASE => 0 (is truncated)
147387 if ($cmp < 0) {
148 _set($c, $x, 0);
149 return $x, 0;
150 }
151
152 my $x_org = _copy($c, $x);
153
154 # Alternative 1:
155
156 # Compute a guess for the result based on:
157 # $guess = int( length_in_base_10(X) / ( log(base) / log(10) ) )
158
159 my $len = _alen($c, $x);
160 my $log = log(_num($c, $base)) / log(10);
161
162 _set($c, $x, int($len / $log) - 1);
163
164 my $trial = _pow($c, _copy($c, $base), $x);
165 my $acmp = _acmp($c, $trial, $x_org);
166
167 # Exact result?
168
169 return $x, 1 if $acmp == 0;
388 return $class -> _zero(), 0;
389 }
390
391 my $y;
392
393 # log(x) / log(b) = log(xm * 10^xe) / log(bm * 10^be)
394 # = (log(xm) + xe*(log(10))) / (log(bm) + be*log(10))
395
396 {
397 my $x_str = $class -> _str($x);
398 my $b_str = $class -> _str($base);
399 my $xm = "." . $x_str;
400 my $bm = "." . $b_str;
401 my $xe = length($x_str);
402 my $be = length($b_str);
403 my $log10 = log(10);
404 my $guess = int((log($xm) + $xe * $log10) / (log($bm) + $be * $log10));
405 $y = $class -> _new($guess);
406 }
407
408 my $trial = $class -> _pow($class -> _copy($base), $y);
409 my $acmp = $class -> _acmp($trial, $x);
410
411 # Did we get the exact result?
412
413 return $y, 1 if $acmp == 0;
170414
171415 # Too small?
172416
173417 while ($acmp < 0) {
174 _mul($c, $trial, $base);
175 _inc($c, $x);
176 $acmp = _acmp($c, $trial, $x_org);
418 $trial = $class -> _mul($trial, $base);
419 $y = $class -> _inc($y);
420 $acmp = $class -> _acmp($trial, $x);
177421 }
178422
179423 # Too big?
180424
181425 while ($acmp > 0) {
182 _div($c, $trial, $base);
183 _dec($c, $x);
184 $acmp = _acmp($c, $trial, $x_org);
185 }
186
187 return $x, 1 if $acmp == 0; # result is exact
188 return $x, 0; # result is too small
189 }
426 $trial = $class -> _div($trial, $base);
427 $y = $class -> _dec($y);
428 $acmp = $class -> _acmp($trial, $x);
429 }
430
431 return $y, 1 if $acmp == 0; # result is exact
432 return $y, 0; # result is too small
433 }
434
190435 1;
191436
192437 __END__
+1
-1
t/mbi_ltm/bigintpm.inc less more
23842384 abc:abc:NaN
23852385 abc:+0:NaN
23862386 +0:abc:NaN
2387 +0:+0:NaN
2387 +0:+0:0
23882388 +1:+0:0
23892389 +0:+1:0
23902390 +27:+90:270
+3
-3
t/mbi_ltm_bigintg.t less more
478478
479479 my ($r, $exact) = $C->_log_int($x, $C->_new("3"));
480480 ok($C->_str($r), '4');
481 ok($C->_str($x), '4');
481 ok($C->_str($x) eq '81' || $C->_str($x) eq '4');
482482 ok($exact, 1);
483483
484484 $x = $C->_new("81");
485485
486486 ($r, $exact) = $C->_log_int($x, 3);
487487 ok($C->_str($r), '4');
488 ok($C->_str($x), '4');
488 ok($C->_str($x) eq '81' || $C->_str($x) eq '4');
489489 ok($exact, 1);
490490
491491 ###############################################################################
557557
558558 $x = $C->_new("123456789");
559559 ok($C->_check($x), 0);
560 ok($C->_check(123), '123 is not a reference to Math::BigInt::LTM');
560 ok($C->_check(123), '123 is not a reference');
561561
562562 # done
563563