File Coverage

blib/lib/Math/BigInt/LTM.pm
Criterion Covered Total %
statement 73 468 15.6
branch 17 244 6.9
condition 1 18 5.5
subroutine 15 53 28.3
pod n/a
total 106 783 13.5


line stmt bran cond sub pod time code
1             package Math::BigInt::LTM;
2              
3 8     8   476716 use strict;
  8         47  
  8         199  
4 8     8   34 use warnings;
  8         15  
  8         298  
5             our $VERSION = '0.080';
6              
7 8     8   2179 use CryptX;
  8         19  
  8         210  
8 8     8   42 use Carp;
  8         13  
  8         12713  
9              
10 0     0   0 sub CLONE_SKIP { 1 } # prevent cloning
11              
12             sub api_version() { 2 } # compatible with Math::BigInt v1.83+
13              
14       10     sub import { }
15              
16             ### the following functions are implemented in XS
17             # _1ex()
18             # _acmp()
19             # _add()
20             # _alen()
21             # _alen()
22             # _and()
23             # _as_bytes()
24             # _copy()
25             # _dec()
26             # _div()
27             # _from_base()
28             # _from_bin()
29             # _from_bytes()
30             # _from_hex()
31             # _from_oct()
32             # _gcd()
33             # _inc()
34             # _is_even()
35             # _is_odd()
36             # _is_one()
37             # _is_ten()
38             # _is_two()
39             # _is_zero()
40             # _lcm()
41             # _len()
42             # _lsft()
43             # _mod()
44             # _modinv()
45             # _modpow()
46             # _mul()
47             # _new()
48             # _one()
49             # _or()
50             # _pow()
51             # _root()
52             # _rsft()
53             # _set()
54             # _sqrt()
55             # _str()
56             # _sub()
57             # _ten()
58             # _to_base()
59             # _to_bin()
60             # _to_bytes()
61             # _to_hex()
62             # _to_oct()
63             # _two()
64             # _xor()
65             # _zero()
66             # _zeros()
67              
68              
69             ### same as overloading in Math::BigInt::Lib
70             use overload
71              
72             # overload key: with_assign
73              
74             '+' => sub {
75 0     0   0 my $class = ref $_[0];
76 0         0 my $x = $class -> _copy($_[0]);
77 0 0       0 my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
78 0         0 return $class -> _add($x, $y);
79             },
80              
81             '-' => sub {
82 0     0   0 my $class = ref $_[0];
83 0         0 my ($x, $y);
84 0 0       0 if ($_[2]) { # if swapped
85 0         0 $y = $_[0];
86 0 0       0 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
87             } else {
88 0         0 $x = $class -> _copy($_[0]);
89 0 0       0 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
90             }
91 0         0 return $class -> _sub($x, $y);
92             },
93              
94             '*' => sub {
95 0     0   0 my $class = ref $_[0];
96 0         0 my $x = $class -> _copy($_[0]);
97 0 0       0 my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
98 0         0 return $class -> _mul($x, $y);
99             },
100              
101             '/' => sub {
102 0     0   0 my $class = ref $_[0];
103 0         0 my ($x, $y);
104 0 0       0 if ($_[2]) { # if swapped
105 0         0 $y = $_[0];
106 0 0       0 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
107             } else {
108 0         0 $x = $class -> _copy($_[0]);
109 0 0       0 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
110             }
111 0         0 return $class -> _div($x, $y);
112             },
113              
114             '%' => sub {
115 0     0   0 my $class = ref $_[0];
116 0         0 my ($x, $y);
117 0 0       0 if ($_[2]) { # if swapped
118 0         0 $y = $_[0];
119 0 0       0 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
120             } else {
121 0         0 $x = $class -> _copy($_[0]);
122 0 0       0 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
123             }
124 0         0 return $class -> _mod($x, $y);
125             },
126              
127             '**' => sub {
128 0     0   0 my $class = ref $_[0];
129 0         0 my ($x, $y);
130 0 0       0 if ($_[2]) { # if swapped
131 0         0 $y = $_[0];
132 0 0       0 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
133             } else {
134 0         0 $x = $class -> _copy($_[0]);
135 0 0       0 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
136             }
137 0         0 return $class -> _pow($x, $y);
138             },
139              
140             '<<' => sub {
141 0     0   0 my $class = ref $_[0];
142 0         0 my ($x, $y);
143 0 0       0 if ($_[2]) { # if swapped
144 0         0 $y = $class -> _num($_[0]);
145 0 0       0 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
146             } else {
147 0         0 $x = $_[0];
148 0 0       0 $y = ref($_[1]) ? $class -> _num($_[1]) : $_[1];
149             }
150 0         0 return $class -> _lsft($x, $y);
151             },
152              
153             '>>' => sub {
154 0     0   0 my $class = ref $_[0];
155 0         0 my ($x, $y);
156 0 0       0 if ($_[2]) { # if swapped
157 0         0 $y = $_[0];
158 0 0       0 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
159             } else {
160 0         0 $x = $class -> _copy($_[0]);
161 0 0       0 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
162             }
163 0         0 return $class -> _rsft($x, $y);
164             },
165              
166             # overload key: num_comparison
167              
168             '<' => sub {
169 0     0   0 my $class = ref $_[0];
170 0         0 my ($x, $y);
171 0 0       0 if ($_[2]) { # if swapped
172 0         0 $y = $_[0];
173 0 0       0 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
174             } else {
175 0         0 $x = $class -> _copy($_[0]);
176 0 0       0 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
177             }
178 0         0 return $class -> _acmp($x, $y) < 0;
179             },
180              
181             '<=' => sub {
182 0     0   0 my $class = ref $_[0];
183 0         0 my ($x, $y);
184 0 0       0 if ($_[2]) { # if swapped
185 0         0 $y = $_[0];
186 0 0       0 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
187             } else {
188 0         0 $x = $class -> _copy($_[0]);
189 0 0       0 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
190             }
191 0         0 return $class -> _acmp($x, $y) <= 0;
192             },
193              
194             '>' => sub {
195 0     0   0 my $class = ref $_[0];
196 0         0 my ($x, $y);
197 0 0       0 if ($_[2]) { # if swapped
198 0         0 $y = $_[0];
199 0 0       0 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
200             } else {
201 0         0 $x = $class -> _copy($_[0]);
202 0 0       0 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
203             }
204 0         0 return $class -> _acmp($x, $y) > 0;
205             },
206              
207             '>=' => sub {
208 0     0   0 my $class = ref $_[0];
209 0         0 my ($x, $y);
210 0 0       0 if ($_[2]) { # if swapped
211 0         0 $y = $_[0];
212 0 0       0 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
213             } else {
214 0         0 $x = $class -> _copy($_[0]);
215 0 0       0 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
216             }
217 0         0 return $class -> _acmp($x, $y) >= 0;
218             },
219              
220             '==' => sub {
221 0     0   0 my $class = ref $_[0];
222 0         0 my $x = $class -> _copy($_[0]);
223 0 0       0 my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
224 0         0 return $class -> _acmp($x, $y) == 0;
225             },
226              
227             '!=' => sub {
228 0     0   0 my $class = ref $_[0];
229 0         0 my $x = $class -> _copy($_[0]);
230 0 0       0 my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
231 0         0 return $class -> _acmp($x, $y) != 0;
232             },
233              
234             # overload key: 3way_comparison
235              
236             '<=>' => sub {
237 0     0   0 my $class = ref $_[0];
238 0         0 my ($x, $y);
239 0 0       0 if ($_[2]) { # if swapped
240 0         0 $y = $_[0];
241 0 0       0 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
242             } else {
243 0         0 $x = $class -> _copy($_[0]);
244 0 0       0 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
245             }
246 0         0 return $class -> _acmp($x, $y);
247             },
248              
249             # overload key: binary
250              
251             '&' => sub {
252 0     0   0 my $class = ref $_[0];
253 0         0 my ($x, $y);
254 0 0       0 if ($_[2]) { # if swapped
255 0         0 $y = $_[0];
256 0 0       0 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
257             } else {
258 0         0 $x = $class -> _copy($_[0]);
259 0 0       0 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
260             }
261 0         0 return $class -> _and($x, $y);
262             },
263              
264             '|' => sub {
265 0     0   0 my $class = ref $_[0];
266 0         0 my ($x, $y);
267 0 0       0 if ($_[2]) { # if swapped
268 0         0 $y = $_[0];
269 0 0       0 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
270             } else {
271 0         0 $x = $class -> _copy($_[0]);
272 0 0       0 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
273             }
274 0         0 return $class -> _or($x, $y);
275             },
276              
277             '^' => sub {
278 0     0   0 my $class = ref $_[0];
279 0         0 my ($x, $y);
280 0 0       0 if ($_[2]) { # if swapped
281 0         0 $y = $_[0];
282 0 0       0 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
283             } else {
284 0         0 $x = $class -> _copy($_[0]);
285 0 0       0 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
286             }
287 0         0 return $class -> _xor($x, $y);
288             },
289              
290             # overload key: func
291              
292 0     0   0 'abs' => sub { $_[0] },
293              
294             'sqrt' => sub {
295 0     0   0 my $class = ref $_[0];
296 0         0 return $class -> _sqrt($class -> _copy($_[0]));
297             },
298              
299 0     0   0 'int' => sub { $_[0] },
300              
301             # overload key: conversion
302              
303 0 0   0   0 'bool' => sub { ref($_[0]) -> _is_zero($_[0]) ? '' : 1; },
304              
305 4     4   2976 '""' => sub { ref($_[0]) -> _str($_[0]); },
306              
307 0     0   0 '0+' => sub { ref($_[0]) -> _num($_[0]); },
308              
309 0     0   0 '=' => sub { ref($_[0]) -> _copy($_[0]); },
310              
311 8     8   3887 ;
  8         3894  
  8         310  
312              
313             ### same as _from_base_num() in Math::BigInt::Lib
314             sub _from_base_num {
315             # Convert an array in the given base to a number.
316 0     0   0 my ($class, $in, $base) = @_;
317              
318             # Make sure the base is an object and >= 2.
319 0 0       0 $base = $class -> _new($base) unless ref($base);
320 0         0 my $two = $class -> _two();
321 0 0       0 croak "base must be >= 2" unless $class -> _acmp($base, $two) >= 0;
322              
323             # @$in = map { ref($_) ? $_ : $class -> _new($_) } @$in;
324              
325 0         0 my $ele = $in -> [0];
326              
327 0 0       0 $ele = $class -> _new($ele) unless ref($ele);
328 0         0 my $x = $class -> _copy($ele);
329              
330 0         0 for my $i (1 .. $#$in) {
331 0         0 $x = $class -> _mul($x, $base);
332 0         0 $ele = $in -> [$i];
333 0 0       0 $ele = $class -> _new($ele) unless ref($ele);
334 0         0 $x = $class -> _add($x, $ele);
335             }
336              
337 0         0 return $x;
338             }
339              
340             ### same as _to_base_num() in Math::BigInt::Lib
341             sub _to_base_num {
342             # Convert the number to an array of integers in any base.
343 0     0   0 my ($class, $x, $base) = @_;
344              
345             # Make sure the base is an object and >= 2.
346 0 0       0 $base = $class -> _new($base) unless ref($base);
347 0         0 my $two = $class -> _two();
348 0 0       0 croak "base must be >= 2" unless $class -> _acmp($base, $two) >= 0;
349              
350 0         0 my $out = [];
351 0         0 my $xcopy = $class -> _copy($x);
352 0         0 my $rem;
353              
354             # Do all except the last (most significant) element.
355 0         0 until ($class -> _acmp($xcopy, $base) < 0) {
356 0         0 ($xcopy, $rem) = $class -> _div($xcopy, $base);
357 0         0 unshift @$out, $rem;
358             }
359              
360             # Do the last (most significant element).
361 0 0       0 unless ($class -> _is_zero($xcopy)) {
362 0         0 unshift @$out, $xcopy;
363             }
364              
365             # $out is empty if $x is zero.
366 0 0       0 unshift @$out, $class -> _zero() unless @$out;
367              
368 0         0 return $out;
369             }
370              
371             ### same as _check() in Math::BigInt::Lib
372             sub _check {
373             # used by the test suite
374 2     2   6 my ($class, $x) = @_;
375 2 50       5 return "Input is undefined" unless defined $x;
376 2 100       11 return "$x is not a reference" unless ref($x);
377 1         4 return 0;
378             }
379              
380             ### same as _digit() in Math::BigInt::Lib
381             sub _digit {
382 6     6   13 my ($class, $x, $n) = @_;
383 6         67 substr($class ->_str($x), -($n+1), 1);
384             }
385              
386             ### same as _digitsum() in Math::BigInt::Lib
387             sub _digitsum {
388 0     0   0 my ($class, $x) = @_;
389              
390 0         0 my $len = $class -> _len($x);
391 0         0 my $sum = $class -> _zero();
392 0         0 for (my $i = 0 ; $i < $len ; ++$i) {
393 0         0 my $digit = $class -> _digit($x, $i);
394 0         0 $digit = $class -> _new($digit);
395 0         0 $sum = $class -> _add($sum, $digit);
396             }
397              
398 0         0 return $sum;
399             }
400              
401             ### same as _num() in Math::BigInt::Lib
402             sub _num {
403 3477     3477   2421456 my ($class, $x) = @_;
404 3477         15243 0 + $class -> _str($x);
405             }
406              
407             ### PATCHED/OLDER _fac() from Math::BigInt::Lib
408             sub _fac {
409             # factorial
410 15     15   354940 my ($class, $x) = @_;
411              
412 15         56 my $two = $class -> _two();
413              
414 15 100       64 if ($class -> _acmp($x, $two) < 0) {
415             ###HACK: needed for MBI 1.999715 compatibility
416             ###return $class -> _one();
417 2         9 $class->_set($x, 1); return $x
  2         15  
418             }
419              
420 13         36 my $i = $class -> _copy($x);
421 13         41 while ($class -> _acmp($i, $two) > 0) {
422 252         364 $i = $class -> _dec($i);
423 252         607 $x = $class -> _mul($x, $i);
424             }
425              
426 13         91 return $x;
427             }
428              
429             ### PATCHED _dfac() from Math::BigInt::Lib
430             sub _dfac {
431             # double factorial
432 0     0   0 my ($class, $x) = @_;
433              
434 0         0 my $two = $class -> _two();
435              
436 0 0       0 if ($class -> _acmp($x, $two) < 0) {
437             ###HACK: needed for MBI 1.999715 compatibility
438             ###return $class -> _one();
439 0         0 $class->_set($x, 1); return $x
  0         0  
440             }
441              
442 0         0 my $i = $class -> _copy($x);
443 0         0 while ($class -> _acmp($i, $two) > 0) {
444 0         0 $i = $class -> _sub($i, $two);
445 0         0 $x = $class -> _mul($x, $i);
446             }
447              
448 0         0 return $x;
449             }
450              
451             ### same as _nok() in Math::BigInt::Lib
452             sub _nok {
453             # Return binomial coefficient (n over k).
454 0     0   0 my ($class, $n, $k) = @_;
455              
456             # If k > n/2, or, equivalently, 2*k > n, compute nok(n, k) as
457             # nok(n, n-k), to minimize the number if iterations in the loop.
458              
459             {
460 0         0 my $twok = $class -> _mul($class -> _two(), $class -> _copy($k));
  0         0  
461 0 0       0 if ($class -> _acmp($twok, $n) > 0) {
462 0         0 $k = $class -> _sub($class -> _copy($n), $k);
463             }
464             }
465              
466             # Example:
467             #
468             # / 7 \ 7! 1*2*3*4 * 5*6*7 5 * 6 * 7
469             # | | = --------- = --------------- = --------- = ((5 * 6) / 2 * 7) / 3
470             # \ 3 / (7-3)! 3! 1*2*3*4 * 1*2*3 1 * 2 * 3
471             #
472             # Equivalently, _nok(11, 5) is computed as
473             #
474             # (((((((7 * 8) / 2) * 9) / 3) * 10) / 4) * 11) / 5
475              
476 0 0       0 if ($class -> _is_zero($k)) {
477 0         0 return $class -> _one();
478             }
479              
480             # Make a copy of the original n, in case the subclass modifies n in-place.
481              
482 0         0 my $n_orig = $class -> _copy($n);
483              
484             # n = 5, f = 6, d = 2 (cf. example above)
485              
486 0         0 $n = $class -> _sub($n, $k);
487 0         0 $n = $class -> _inc($n);
488              
489 0         0 my $f = $class -> _copy($n);
490 0         0 $f = $class -> _inc($f);
491              
492 0         0 my $d = $class -> _two();
493              
494             # while f <= n (the original n, that is) ...
495              
496 0         0 while ($class -> _acmp($f, $n_orig) <= 0) {
497 0         0 $n = $class -> _mul($n, $f);
498 0         0 $n = $class -> _div($n, $d);
499 0         0 $f = $class -> _inc($f);
500 0         0 $d = $class -> _inc($d);
501             }
502              
503 0         0 return $n;
504             }
505              
506             ### same as _sadd() in Math::BigInt::Lib
507             # Signed addition. If the flag is false, $xa might be modified, but not $ya. If
508             # the false is true, $ya might be modified, but not $xa.
509             sub _sadd {
510 0     0   0 my $class = shift;
511 0         0 my ($xa, $xs, $ya, $ys, $flag) = @_;
512 0         0 my ($za, $zs);
513              
514             # If the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8)
515              
516 0 0       0 if ($xs eq $ys) {
517 0 0       0 if ($flag) {
518 0         0 $za = $class -> _add($ya, $xa);
519             } else {
520 0         0 $za = $class -> _add($xa, $ya);
521             }
522 0 0       0 $zs = $class -> _is_zero($za) ? '+' : $xs;
523 0         0 return $za, $zs;
524             }
525              
526 0         0 my $acmp = $class -> _acmp($xa, $ya); # abs(x) = abs(y)
527              
528 0 0       0 if ($acmp == 0) { # x = -y or -x = y
529 0         0 $za = $class -> _zero();
530 0         0 $zs = '+';
531 0         0 return $za, $zs;
532             }
533              
534 0 0       0 if ($acmp > 0) { # abs(x) > abs(y)
535 0         0 $za = $class -> _sub($xa, $ya, $flag);
536 0         0 $zs = $xs;
537             } else { # abs(x) < abs(y)
538 0         0 $za = $class -> _sub($ya, $xa, !$flag);
539 0         0 $zs = $ys;
540             }
541 0         0 return $za, $zs;
542             }
543              
544             ### same as _ssub() in Math::BigInt::Lib
545             # Signed subtraction. If the flag is false, $xa might be modified, but not $ya.
546             # If the false is true, $ya might be modified, but not $xa.
547             sub _ssub {
548 0     0   0 my $class = shift;
549 0         0 my ($xa, $xs, $ya, $ys, $flag) = @_;
550              
551             # Swap sign of second operand and let _sadd() do the job.
552 0 0       0 $ys = $ys eq '+' ? '-' : '+';
553 0         0 $class -> _sadd($xa, $xs, $ya, $ys, $flag);
554             }
555              
556             ### same as _log_int() in Math::BigInt::Lib
557             sub _log_int {
558             # calculate integer log of $x to base $base
559             # ref to array, ref to array - return ref to array
560 11     11   14937 my ($class, $x, $base) = @_;
561              
562             # X == 0 => NaN
563 11 50       55 return if $class -> _is_zero($x);
564              
565 11 50       29 $base = $class -> _new(2) unless defined($base);
566 11 100       28 $base = $class -> _new($base) unless ref($base);
567              
568             # BASE 0 or 1 => NaN
569 11 50 33     63 return if $class -> _is_zero($base) || $class -> _is_one($base);
570              
571             # X == 1 => 0 (is exact)
572 11 50       315 if ($class -> _is_one($x)) {
573 0         0 return $class -> _zero(), 1;
574             }
575              
576 11         33 my $cmp = $class -> _acmp($x, $base);
577              
578             # X == BASE => 1 (is exact)
579 11 50       24 if ($cmp == 0) {
580 0         0 return $class -> _one(), 1;
581             }
582              
583             # 1 < X < BASE => 0 (is truncated)
584 11 50       26 if ($cmp < 0) {
585 0         0 return $class -> _zero(), 0;
586             }
587              
588 11         14 my $y;
589              
590             # log(x) / log(b) = log(xm * 10^xe) / log(bm * 10^be)
591             # = (log(xm) + xe*(log(10))) / (log(bm) + be*log(10))
592              
593             {
594 11         15 my $x_str = $class -> _str($x);
  11         4264  
595 11         49 my $b_str = $class -> _str($base);
596 11         29 my $xm = "." . $x_str;
597 11         16 my $bm = "." . $b_str;
598 11         23 my $xe = length($x_str);
599 11         16 my $be = length($b_str);
600 11         11 my $log10 = log(10);
601 11         98 my $guess = int((log($xm) + $xe * $log10) / (log($bm) + $be * $log10));
602 11         38 $y = $class -> _new($guess);
603             }
604              
605 11         100 my $trial = $class -> _pow($class -> _copy($base), $y);
606 11         31 my $acmp = $class -> _acmp($trial, $x);
607              
608             # Did we get the exact result?
609              
610 11 100       45 return $y, 1 if $acmp == 0;
611              
612             # Too small?
613              
614 6         13 while ($acmp < 0) {
615 6         29 $trial = $class -> _mul($trial, $base);
616 6         16 $y = $class -> _inc($y);
617 6         24 $acmp = $class -> _acmp($trial, $x);
618             }
619              
620             # Too big?
621              
622 6         13 while ($acmp > 0) {
623 1         19 $trial = $class -> _div($trial, $base);
624 1         5 $y = $class -> _dec($y);
625 1         4 $acmp = $class -> _acmp($trial, $x);
626             }
627              
628 6 100       28 return $y, 1 if $acmp == 0; # result is exact
629 1         6 return $y, 0; # result is too small
630             }
631              
632             ### same as _lucas() in Math::BigInt::Lib
633             sub _lucas {
634 0     0   0 my ($class, $n) = @_;
635              
636 0 0       0 $n = $class -> _num($n) if ref $n;
637              
638             # In list context, use lucas(n) = lucas(n-1) + lucas(n-2)
639              
640 0 0       0 if (wantarray) {
641 0         0 my @y;
642              
643 0         0 push @y, $class -> _two();
644 0 0       0 return @y if $n == 0;
645              
646 0         0 push @y, $class -> _one();
647 0 0       0 return @y if $n == 1;
648              
649 0         0 for (my $i = 2 ; $i <= $n ; ++ $i) {
650 0         0 $y[$i] = $class -> _add($class -> _copy($y[$i - 1]), $y[$i - 2]);
651             }
652              
653 0         0 return @y;
654             }
655              
656             # In scalar context use that lucas(n) = fib(n-1) + fib(n+1).
657             #
658             # Remember that _fib() behaves differently in scalar context and list
659             # context, so we must add scalar() to get the desired behaviour.
660              
661 0 0       0 return $class -> _two() if $n == 0;
662              
663 0         0 return $class -> _add(scalar($class -> _fib($n - 1)),
664             scalar($class -> _fib($n + 1)));
665             }
666              
667             ### same as _fib() in Math::BigInt::Lib
668             sub _fib {
669 0     0   0 my ($class, $n) = @_;
670              
671 0 0       0 $n = $class -> _num($n) if ref $n;
672              
673             # In list context, use fib(n) = fib(n-1) + fib(n-2)
674              
675 0 0       0 if (wantarray) {
676 0         0 my @y;
677              
678 0         0 push @y, $class -> _zero();
679 0 0       0 return @y if $n == 0;
680              
681 0         0 push @y, $class -> _one();
682 0 0       0 return @y if $n == 1;
683              
684 0         0 for (my $i = 2 ; $i <= $n ; ++ $i) {
685 0         0 $y[$i] = $class -> _add($class -> _copy($y[$i - 1]), $y[$i - 2]);
686             }
687              
688 0         0 return @y;
689             }
690              
691             # In scalar context use a fast algorithm that is much faster than the
692             # recursive algorith used in list context.
693              
694 0         0 my $cache = {};
695 0         0 my $two = $class -> _two();
696 0         0 my $fib;
697              
698             $fib = sub {
699 0     0   0 my $n = shift;
700 0 0       0 return $class -> _zero() if $n <= 0;
701 0 0       0 return $class -> _one() if $n <= 2;
702 0 0       0 return $cache -> {$n} if exists $cache -> {$n};
703              
704 0         0 my $k = int($n / 2);
705 0         0 my $a = $fib -> ($k + 1);
706 0         0 my $b = $fib -> ($k);
707 0         0 my $y;
708              
709 0 0       0 if ($n % 2 == 1) {
710             # a*a + b*b
711 0         0 $y = $class -> _add($class -> _mul($class -> _copy($a), $a),
712             $class -> _mul($class -> _copy($b), $b));
713             } else {
714             # (2*a - b)*b
715 0         0 $y = $class -> _mul($class -> _sub($class -> _mul(
716             $class -> _copy($two), $a), $b), $b);
717             }
718              
719 0         0 $cache -> {$n} = $y;
720 0         0 return $y;
721 0         0 };
722              
723 0         0 return $fib -> ($n);
724             }
725              
726             ### same as _sand() in Math::BigInt::Lib
727             sub _sand {
728 0     0   0 my ($class, $x, $sx, $y, $sy) = @_;
729              
730 0 0 0     0 return ($class -> _zero(), '+')
731             if $class -> _is_zero($x) || $class -> _is_zero($y);
732              
733 0 0 0     0 my $sign = $sx eq '-' && $sy eq '-' ? '-' : '+';
734              
735 0         0 my ($bx, $by);
736              
737 0 0       0 if ($sx eq '-') { # if x is negative
738             # two's complement: inc (dec unsigned value) and flip all "bits" in $bx
739 0         0 $bx = $class -> _copy($x);
740 0         0 $bx = $class -> _dec($bx);
741 0         0 $bx = $class -> _as_hex($bx);
742 0         0 $bx =~ s/^-?0x//;
743 0         0 $bx =~ tr<0123456789abcdef>
744             <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
745             } else { # if x is positive
746 0         0 $bx = $class -> _as_hex($x); # get binary representation
747 0         0 $bx =~ s/^-?0x//;
748 0         0 $bx =~ tr
749             <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
750             }
751              
752 0 0       0 if ($sy eq '-') { # if y is negative
753             # two's complement: inc (dec unsigned value) and flip all "bits" in $by
754 0         0 $by = $class -> _copy($y);
755 0         0 $by = $class -> _dec($by);
756 0         0 $by = $class -> _as_hex($by);
757 0         0 $by =~ s/^-?0x//;
758 0         0 $by =~ tr<0123456789abcdef>
759             <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
760             } else {
761 0         0 $by = $class -> _as_hex($y); # get binary representation
762 0         0 $by =~ s/^-?0x//;
763 0         0 $by =~ tr
764             <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
765             }
766              
767             # now we have bit-strings from X and Y, reverse them for padding
768 0         0 $bx = reverse $bx;
769 0         0 $by = reverse $by;
770              
771             # padd the shorter string
772 0 0       0 my $xx = "\x00"; $xx = "\x0f" if $sx eq '-';
  0         0  
773 0 0       0 my $yy = "\x00"; $yy = "\x0f" if $sy eq '-';
  0         0  
774 0         0 my $diff = CORE::length($bx) - CORE::length($by);
775 0 0       0 if ($diff > 0) {
    0          
776             # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by
777 0         0 $by .= $yy x $diff;
778             } elsif ($diff < 0) {
779             # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx
780 0         0 $bx .= $xx x abs($diff);
781             }
782              
783             # and the strings together
784 0         0 my $r = $bx & $by;
785              
786             # and reverse the result again
787 0         0 $bx = reverse $r;
788              
789             # One of $bx or $by was negative, so need to flip bits in the result. In both
790             # cases (one or two of them negative, or both positive) we need to get the
791             # characters back.
792 0 0       0 if ($sign eq '-') {
793 0         0 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
794             <0123456789abcdef>;
795             } else {
796 0         0 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
797             ;
798             }
799              
800             # leading zeros will be stripped by _from_hex()
801 0         0 $bx = '0x' . $bx;
802 0         0 $bx = $class -> _from_hex($bx);
803              
804 0 0       0 $bx = $class -> _inc($bx) if $sign eq '-';
805              
806             # avoid negative zero
807 0 0       0 $sign = '+' if $class -> _is_zero($bx);
808              
809 0         0 return $bx, $sign;
810             }
811              
812             ### same as _sxor() in Math::BigInt::Lib
813             sub _sxor {
814 0     0   0 my ($class, $x, $sx, $y, $sy) = @_;
815              
816 0 0 0     0 return ($class -> _zero(), '+')
817             if $class -> _is_zero($x) && $class -> _is_zero($y);
818              
819 0 0       0 my $sign = $sx ne $sy ? '-' : '+';
820              
821 0         0 my ($bx, $by);
822              
823 0 0       0 if ($sx eq '-') { # if x is negative
824             # two's complement: inc (dec unsigned value) and flip all "bits" in $bx
825 0         0 $bx = $class -> _copy($x);
826 0         0 $bx = $class -> _dec($bx);
827 0         0 $bx = $class -> _as_hex($bx);
828 0         0 $bx =~ s/^-?0x//;
829 0         0 $bx =~ tr<0123456789abcdef>
830             <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
831             } else { # if x is positive
832 0         0 $bx = $class -> _as_hex($x); # get binary representation
833 0         0 $bx =~ s/^-?0x//;
834 0         0 $bx =~ tr
835             <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
836             }
837              
838 0 0       0 if ($sy eq '-') { # if y is negative
839             # two's complement: inc (dec unsigned value) and flip all "bits" in $by
840 0         0 $by = $class -> _copy($y);
841 0         0 $by = $class -> _dec($by);
842 0         0 $by = $class -> _as_hex($by);
843 0         0 $by =~ s/^-?0x//;
844 0         0 $by =~ tr<0123456789abcdef>
845             <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
846             } else {
847 0         0 $by = $class -> _as_hex($y); # get binary representation
848 0         0 $by =~ s/^-?0x//;
849 0         0 $by =~ tr
850             <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
851             }
852              
853             # now we have bit-strings from X and Y, reverse them for padding
854 0         0 $bx = reverse $bx;
855 0         0 $by = reverse $by;
856              
857             # padd the shorter string
858 0 0       0 my $xx = "\x00"; $xx = "\x0f" if $sx eq '-';
  0         0  
859 0 0       0 my $yy = "\x00"; $yy = "\x0f" if $sy eq '-';
  0         0  
860 0         0 my $diff = CORE::length($bx) - CORE::length($by);
861 0 0       0 if ($diff > 0) {
    0          
862             # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by
863 0         0 $by .= $yy x $diff;
864             } elsif ($diff < 0) {
865             # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx
866 0         0 $bx .= $xx x abs($diff);
867             }
868              
869             # xor the strings together
870 0         0 my $r = $bx ^ $by;
871              
872             # and reverse the result again
873 0         0 $bx = reverse $r;
874              
875             # One of $bx or $by was negative, so need to flip bits in the result. In both
876             # cases (one or two of them negative, or both positive) we need to get the
877             # characters back.
878 0 0       0 if ($sign eq '-') {
879 0         0 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
880             <0123456789abcdef>;
881             } else {
882 0         0 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
883             ;
884             }
885              
886             # leading zeros will be stripped by _from_hex()
887 0         0 $bx = '0x' . $bx;
888 0         0 $bx = $class -> _from_hex($bx);
889              
890 0 0       0 $bx = $class -> _inc($bx) if $sign eq '-';
891              
892             # avoid negative zero
893 0 0       0 $sign = '+' if $class -> _is_zero($bx);
894              
895 0         0 return $bx, $sign;
896             }
897              
898             ### same as _sor() in Math::BigInt::Lib
899             sub _sor {
900 0     0   0 my ($class, $x, $sx, $y, $sy) = @_;
901              
902 0 0 0     0 return ($class -> _zero(), '+')
903             if $class -> _is_zero($x) && $class -> _is_zero($y);
904              
905 0 0 0     0 my $sign = $sx eq '-' || $sy eq '-' ? '-' : '+';
906              
907 0         0 my ($bx, $by);
908              
909 0 0       0 if ($sx eq '-') { # if x is negative
910             # two's complement: inc (dec unsigned value) and flip all "bits" in $bx
911 0         0 $bx = $class -> _copy($x);
912 0         0 $bx = $class -> _dec($bx);
913 0         0 $bx = $class -> _as_hex($bx);
914 0         0 $bx =~ s/^-?0x//;
915 0         0 $bx =~ tr<0123456789abcdef>
916             <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
917             } else { # if x is positive
918 0         0 $bx = $class -> _as_hex($x); # get binary representation
919 0         0 $bx =~ s/^-?0x//;
920 0         0 $bx =~ tr
921             <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
922             }
923              
924 0 0       0 if ($sy eq '-') { # if y is negative
925             # two's complement: inc (dec unsigned value) and flip all "bits" in $by
926 0         0 $by = $class -> _copy($y);
927 0         0 $by = $class -> _dec($by);
928 0         0 $by = $class -> _as_hex($by);
929 0         0 $by =~ s/^-?0x//;
930 0         0 $by =~ tr<0123456789abcdef>
931             <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
932             } else {
933 0         0 $by = $class -> _as_hex($y); # get binary representation
934 0         0 $by =~ s/^-?0x//;
935 0         0 $by =~ tr
936             <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
937             }
938              
939             # now we have bit-strings from X and Y, reverse them for padding
940 0         0 $bx = reverse $bx;
941 0         0 $by = reverse $by;
942              
943             # padd the shorter string
944 0 0       0 my $xx = "\x00"; $xx = "\x0f" if $sx eq '-';
  0         0  
945 0 0       0 my $yy = "\x00"; $yy = "\x0f" if $sy eq '-';
  0         0  
946 0         0 my $diff = CORE::length($bx) - CORE::length($by);
947 0 0       0 if ($diff > 0) {
    0          
948             # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by
949 0         0 $by .= $yy x $diff;
950             } elsif ($diff < 0) {
951             # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx
952 0         0 $bx .= $xx x abs($diff);
953             }
954              
955             # or the strings together
956 0         0 my $r = $bx | $by;
957              
958             # and reverse the result again
959 0         0 $bx = reverse $r;
960              
961             # One of $bx or $by was negative, so need to flip bits in the result. In both
962             # cases (one or two of them negative, or both positive) we need to get the
963             # characters back.
964 0 0       0 if ($sign eq '-') {
965 0         0 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
966             <0123456789abcdef>;
967             } else {
968 0         0 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
969             ;
970             }
971              
972             # leading zeros will be stripped by _from_hex()
973 0         0 $bx = '0x' . $bx;
974 0         0 $bx = $class -> _from_hex($bx);
975              
976 0 0       0 $bx = $class -> _inc($bx) if $sign eq '-';
977              
978             # avoid negative zero
979 0 0       0 $sign = '+' if $class -> _is_zero($bx);
980              
981 0         0 return $bx, $sign;
982             }
983              
984             ### same as _as_bin() in Math::BigInt::Lib
985             sub _as_bin {
986             # convert the number to a string of binary digits with prefix
987 4     4   11 my ($class, $x) = @_;
988 4         33 return '0b' . $class -> _to_bin($x);
989             }
990              
991             ### same as _as_oct() in Math::BigInt::Lib
992             sub _as_oct {
993             # convert the number to a string of octal digits with prefix
994 3     3   7 my ($class, $x) = @_;
995 3         22 return '0' . $class -> _to_oct($x); # yes, 0 becomes "00"
996             }
997              
998             ### same as _as_hex() in Math::BigInt::Lib
999             sub _as_hex {
1000             # convert the number to a string of hexadecimal digits with prefix
1001 4     4   1500 my ($class, $x) = @_;
1002 4         36 return '0x' . $class -> _to_hex($x);
1003             }
1004              
1005             1;
1006              
1007             =pod
1008              
1009             =head1 NAME
1010              
1011             Math::BigInt::LTM - Use the libtommath library for Math::BigInt routines
1012              
1013             =head1 SYNOPSIS
1014              
1015             use Math::BigInt lib => 'LTM';
1016              
1017             ## See Math::BigInt docs for usage.
1018              
1019             =head1 DESCRIPTION
1020              
1021             Provides support for big integer calculations by means of the libtommath c-library.
1022              
1023             I
1024              
1025             =head1 SEE ALSO
1026              
1027             L, L
1028              
1029             =cut