File Coverage

blib/lib/Math/BigInt/BitVect.pm
Criterion Covered Total %
statement 240 260 92.3
branch 97 126 76.9
condition 3 3 100.0
subroutine 44 49 89.8
pod 1 1 100.0
total 385 439 87.7


line stmt bran cond sub pod time code
1             package Math::BigInt::BitVect;
2              
3 8     8   848117 use 5.006;
  8         108  
4 8     8   44 use strict;
  8         21  
  8         176  
5 8     8   51 use warnings;
  8         13  
  8         268  
6              
7 8     8   5805 use Math::BigInt::Lib 1.999801;
  8         96344  
  8         77  
8              
9             our @ISA = qw< Math::BigInt::Lib >;
10              
11             our $VERSION = '1.20';
12              
13 8     8   3789 use Bit::Vector;
  8         8674  
  8         25053  
14              
15             ##############################################################################
16             # global constants, flags and accessory
17              
18             my $bits = 32; # make new numbers this wide
19             my $chunk = 32; # keep size a multiple of this
20              
21             # for is_* functions
22             my $zero = Bit::Vector->new_Dec($bits, 0);
23             my $one = Bit::Vector->new_Dec($bits, 1);
24             my $two = Bit::Vector->new_Dec($bits, 2);
25             my $ten = Bit::Vector->new_Dec($bits, 10);
26              
27 0     0 1 0 sub api_version { 2; }
28              
29       2     sub import { }
30              
31             sub __dump {
32 0     0   0 my ($class, $x) = @_;
33 0         0 my $str = $class -> _as_bin($x);
34              
35             # number of bits allocated
36              
37 0         0 my $nbits_alloc = $x -> Size();
38 0         0 my $imax = $x -> Max();
39              
40             # minimum number of bits needed
41              
42 0 0       0 my $nbits_min = $imax < 0 ? 1 : $imax + 2;
43              
44             # expected number of bits
45              
46 0         0 my $nbits_exp = $chunk * __ceil($nbits_min / $chunk);
47              
48 0         0 return "$str ($nbits_min/$nbits_exp/$nbits_alloc)";
49             }
50              
51             ##############################################################################
52             # create objects from various representations
53              
54             sub _new {
55 70221     70221   3347603 my ($class, $str) = @_;
56              
57             # $nbin is the maximum number of bits required to represent any $ndec digit
58             # number in base two. log(10)/log(2) = 3.32192809488736
59              
60 70221         113525 my $ndec = length($str);
61 70221         149551 my $nbin = 1 + __ceil(3.32192809488736 * $ndec);
62              
63 70221         133971 $nbin = $chunk * __ceil($nbin / $chunk); # chunked
64              
65 70221         823134 my $u = Bit::Vector->new_Dec($nbin, $str);
66 70221 100       172049 $class->__reduce($u) if $nbin > $bits;
67 70221         144514 $u;
68             }
69              
70             sub _from_hex {
71 319     319   4563 my ($class, $str) = @_;
72              
73 319         1139 $str =~ s/^0[xX]//;
74 319         674 my $bits = 1 + 4 * length($str);
75 319         674 $bits = $chunk * __ceil($bits / $chunk);
76 319         1117 my $x = Bit::Vector->new_Hex($bits, $str);
77 319         770 $class->__reduce($x);
78             }
79              
80             sub _from_bin {
81 50     50   641 my $str = $_[1];
82              
83 50         179 $str =~ s/^0[bB]//;
84 50         94 my $bits = 1 + length($str);
85 50         108 $bits = $chunk * __ceil($bits / $chunk);
86 50         195 Bit::Vector->new_Bin($bits, $str);
87             }
88              
89             sub _zero {
90 12224     12224   1048691 Bit::Vector->new_Dec($bits, 0);
91             }
92              
93             sub _one {
94 1867     1867   57994 Bit::Vector->new_Dec($bits, 1);
95             }
96              
97             sub _two {
98 294     294   2526 Bit::Vector->new_Dec($bits, 2);
99             }
100              
101             sub _ten {
102 0     0   0 Bit::Vector->new_Dec($bits, 10);
103             }
104              
105             sub _copy {
106 30501     30501   804257 $_[1]->Clone();
107             }
108              
109             ##############################################################################
110             # convert back to string and number
111              
112             sub _str {
113             # make string
114 52771     52771   109292924 my $x = $_[1]->to_Dec();
115 52771         135720 $x;
116             }
117              
118             sub _num {
119             # make a number
120 10440     10440   101145 0 + $_[1]->to_Dec();
121             }
122              
123             sub _as_hex {
124 70     70   936 my $x = lc $_[1]->to_Hex();
125 70         401 $x =~ s/^0*([\da-f])/0x$1/;
126 70         228 $x;
127             }
128              
129             sub _as_bin {
130 95     95   1021 my $x = $_[1]->to_Bin();
131 95         664 $x =~ s/^0*(\d)/0b$1/;
132 95         332 $x;
133             }
134              
135             ##############################################################################
136             # actual math code
137              
138             sub _add {
139 23717     23717   290557 my ($class, $x, $y) = @_;
140              
141             # sizes must match!
142 23717         44997 my $xs = $x->Size();
143 23717         41090 my $ys = $y->Size();
144 23717         39454 my $ns = __max($xs, $ys) + 2; # 2 extra bits, to avoid overflow
145 23717         46023 $ns = $chunk * __ceil($ns / $chunk);
146 23717 50       75172 $x->Resize($ns) if $xs != $ns;
147 23717 50       62822 $y->Resize($ns) if $ys != $ns;
148 23717         69498 $x->add($x, $y, 0);
149              
150             # then reduce again
151 23717 50       69300 $class->__reduce($x) if $ns != $xs;
152 23717 50       60575 $class->__reduce($y) if $ns != $ys;
153              
154 23717         51797 $x;
155             }
156              
157             sub _sub {
158             # $x is always larger than $y! So overflow/underflow can not happen here
159 24152     24152   125785 my ($class, $x, $y, $z) = @_;
160              
161             # sizes must match!
162 24152         46033 my $xs = $x->Size();
163 24152         42472 my $ys = $y->Size();
164 24152         44032 my $ns = __max($xs, $ys); # no reserve, since no overflow
165 24152         48364 $ns = $chunk * __ceil($ns / $chunk);
166 24152 50       51570 $x->Resize($ns) if $xs != $ns;
167 24152 100       44492 $y->Resize($ns) if $ys != $ns;
168              
169 24152 100       40159 if ($z) {
170 2632         8087 $y->subtract($x, $y, 0);
171 2632         6028 $class->__reduce($y);
172 2632 50       5094 $class->__reduce($x) if $ns != $xs;
173             } else {
174 21520         67365 $x->subtract($x, $y, 0);
175 21520 100       40645 $class->__reduce($y) if $ns != $ys;
176 21520         41814 $class->__reduce($x);
177             }
178              
179 24152 100       65501 return $x unless $z;
180 2632         5569 $y;
181             }
182              
183             sub _mul {
184 22582     22582   340222 my ($class, $x, $y) = @_;
185              
186             # sizes must match!
187 22582         43101 my $xs = $x->Size();
188 22582         39337 my $ys = $y->Size();
189             # reserve some bits (and +2), so we never overflow
190 22582         34740 my $ns = $xs + $ys + 2; # 2^12 * 2^8 = 2^20 (so we take 22)
191 22582         42125 $ns = $chunk * __ceil($ns / $chunk);
192 22582 50       82562 $x->Resize($ns) if $xs != $ns;
193 22582 50       62650 $y->Resize($ns) if $ys != $ns;
194              
195             # then mul
196 22582         345295 $x->Multiply($x, $y);
197             # then reduce again
198 22582 50       65884 $class->__reduce($y) if $ns != $ys;
199 22582 50       63456 $class->__reduce($x) if $ns != $xs;
200 22582         43123 $x;
201             }
202              
203             sub _div {
204 19331     19331   78651 my ($class, $x, $y) = @_;
205              
206             # sizes must match!
207              
208 19331         37836 my $xs = $x->Max();
209 19331         35802 my $ys = $y->Max();
210              
211             # if $ys > $xs, quotient is zero
212              
213 19331 100 100     73096 if ($xs < 0 || $xs < $ys) {
214 498         1393 my $r = $x->Clone();
215 498         1507 $x = Bit::Vector->new_Hex($chunk, 0);
216 498 100       2671 return wantarray ? ($x, $r) : $x;
217             } else {
218 18833         35336 my $ns = $x->Size(); # common size
219 18833         31178 my $ys = $y->Size();
220 18833 100       56375 $y->Resize($ns) if $ys < $ns;
221 18833         51105 my $r = Bit::Vector->new_Hex($ns, 0);
222 18833         1517708 $x->Divide($x, $y, $r);
223 18833 100       56766 $class->__reduce($y) if $ys < $ns;
224 18833         41800 $class->__reduce($x);
225 18833 100       78143 return wantarray ? ($x, $class->__reduce($r)) : $x;
226             }
227             }
228              
229             sub _inc {
230 2444     2444   15107 my ($class, $x) = @_;
231              
232             # an overflow can occur if the leftmost bit and the rightmost bit are
233             # both 1 (we don't bother to look at the other bits)
234              
235 2444         5119 my $xs = $x->Size();
236 2444 50       9119 if ($x->bit_test($xs-2) & $x->bit_test(0)) {
237 0         0 $x->Resize($xs + $chunk); # make one bigger
238 0         0 $x->increment();
239 0         0 $class->__reduce($x); # in case no overflow occured
240             } else {
241 2444         5332 $x->increment(); # can't overflow, so no resize/reduce necc.
242             }
243 2444         5587 $x;
244             }
245              
246             sub _dec {
247             # input is >= 1
248 836     836   2605 my ($class, $x) = @_;
249              
250 836         2072 $x->decrement(); # will only get smaller, so reduce afterwards
251 836         1503 $class->__reduce($x);
252             }
253              
254             sub _and {
255             # bit-wise AND of two numbers
256 36     36   1378 my ($class, $x, $y) = @_;
257              
258             # sizes must match!
259 36         93 my $xs = $x->Size();
260 36         70 my $ys = $y->Size();
261 36         79 my $ns = __max($xs, $ys); # highest bits in $x, $y are zero
262 36         92 $ns = $chunk * __ceil($ns / $chunk);
263 36 50       101 $x->Resize($ns) if $xs != $ns;
264 36 100       86 $y->Resize($ns) if $ys != $ns;
265              
266 36         127 $x->And($x, $y);
267 36 50       82 $class->__reduce($y) if $ns != $xs;
268 36         100 $class->__reduce($x);
269 36         91 $x;
270             }
271              
272             sub _xor {
273             # bit-wise XOR of two numbers
274 53     53   1852 my ($class, $x, $y) = @_;
275              
276             # sizes must match!
277 53         142 my $xs = $x->Size();
278 53         114 my $ys = $y->Size();
279 53         122 my $ns = __max($xs, $ys); # highest bits in $x, $y are zero
280 53         164 $ns = $chunk * __ceil($ns / $chunk);
281 53 100       146 $x->Resize($ns) if $xs != $ns;
282 53 100       127 $y->Resize($ns) if $ys != $ns;
283              
284 53         192 $x->Xor($x, $y);
285 53 100       118 $class->__reduce($y) if $ns != $xs;
286 53         144 $class->__reduce($x);
287 53         143 $x;
288             }
289              
290             sub _or {
291             # bit-wise OR of two numbers
292 51     51   1608 my ($class, $x, $y) = @_;
293              
294             # sizes must match!
295 51         141 my $xs = $x->Size();
296 51         120 my $ys = $y->Size();
297 51         117 my $ns = __max($xs, $ys); # highest bits in $x, $y are zero
298 51         150 $ns = $chunk * __ceil($ns / $chunk);
299 51 100       142 $x->Resize($ns) if $xs != $ns;
300 51 100       138 $y->Resize($ns) if $ys != $ns;
301              
302 51         180 $x->Or($x, $y);
303 51 100       111 $class->__reduce($y) if $ns != $xs;
304 51 100       101 $class->__reduce($x) if $ns != $xs;
305 51         129 $x;
306             }
307              
308             sub _gcd {
309             # Greatest Common Divisor
310 33     33   457 my ($class, $x, $y) = @_;
311              
312             # Original, Bit::Vectors Euklid algorithmn
313             # sizes must match!
314 33         80 my $xs = $x->Size();
315 33         95 my $ys = $y->Size();
316 33         78 my $ns = __max($xs, $ys);
317 33 50       77 $x->Resize($ns) if $xs != $ns;
318 33 50       74 $y->Resize($ns) if $ys != $ns;
319 33         179 $x->GCD($x, $y);
320 33 50       58 $class->__reduce($y) if $ys != $ns;
321 33         92 $class->__reduce($x);
322 33         82 $x;
323             }
324              
325             ##############################################################################
326             # testing
327              
328             sub _acmp {
329 28497     28497   350500 my ($class, $x, $y) = @_;
330              
331 28497         58001 my $xm = $x->Size();
332 28497         48909 my $ym = $y->Size();
333 28497         42032 my $diff = ($xm - $ym);
334              
335 28497 100       55399 return $diff <=> 0 if $diff != 0;
336              
337             # used sizes are the same, so no need for Resizing/reducing
338 28092         84945 $x->Lexicompare($y);
339             }
340              
341             sub _len {
342             # return length, aka digits in decmial, costly!!
343 47266     47266   70899793 length($_[1]->to_Dec());
344             }
345              
346             sub _alen {
347 0     0   0 my $nb = $_[1] -> Max(); # index (zero-based)
348 0 0       0 return 1 if $nb < 0; # $nb is negative if $_[1] is zero
349 0         0 int(0.5 + 3.32192809488736 * ($nb + 1));
350             }
351              
352             sub _digit {
353             # return the nth digit, negative values count backward; this is costly!
354 27     27   214 my ($class, $x, $n) = @_;
355              
356 27         295 substr($x->to_Dec(), -($n+1), 1);
357             }
358              
359             sub _fac {
360             # factorial of $x
361 44     44   1372 my ($class, $x) = @_;
362              
363 44 100       158 if ($class->_is_zero($x)) {
364 1         4 $x = $class->_one(); # not $one since we need a copy/or new object!
365 1         5 return $x;
366             }
367 43         139 my $n = $class->_copy($x);
368 43         133 $x = $class->_one(); # not $one since we need a copy/or new object!
369 43         117 while (!$class->_is_one($n)) {
370 641         1516 $class->_mul($x, $n);
371 641         1086 $class->_dec($n);
372             }
373 43         233 $x; # no __reduce() since only getting bigger
374             }
375              
376             sub _pow {
377             # return power
378 24008     24008   49450 my ($class, $x, $y) = @_;
379              
380             # x**0 = 1
381              
382 24008 100       44464 return $class -> _one() if $class -> _is_zero($y);
383              
384             # 0**y = 0 if $y != 0 (y = 0 is taken care of above).
385              
386 22958 50       45290 return $class -> _zero() if $class -> _is_zero($x);
387              
388 22958         101289 my $ns = 1 + ($x -> Max() + 1) * $y -> to_Dec();
389 22958         51962 $ns = $chunk * __ceil($ns / $chunk);
390              
391 22958         61518 my $z = Bit::Vector -> new($ns);
392              
393 22958         813357 $z -> Power($x, $y);
394 22958         46871 return $class->__reduce($z);
395             }
396              
397             ###############################################################################
398             # shifting
399              
400             sub _rsft {
401 14002     14002   63314 my ($class, $x, $n, $b) = @_;
402              
403 14002 100       27574 if ($b == 2) {
404 29         71 $x->Move_Right($class->_num($n)); # must be scalar - ugh
405             } else {
406 13973 50       35725 $b = $class->_new($b) unless ref($b);
407 13973         32501 $x = $class->_div($x, $class->_pow($b, $n));
408             }
409 14002         40963 $class->__reduce($x);
410             }
411              
412             sub _lsft {
413 9736     9736   49532 my ($class, $x, $n, $b) = @_;
414              
415 9736 100       18642 if ($b == 2) {
416 15         38 $n = $class->_num($n); # need scalar for Resize/Move_Left - ugh
417 15         52 my $size = $x->Size() + 1 + $n; # y and one more
418 15         47 my $ns = (int($size / $chunk)+1)*$chunk;
419 15         47 $x->Resize($ns);
420 15         60 $x->Move_Left($n);
421 15         34 $class->__reduce($x); # to minimum size
422             } else {
423 9721         18988 $b = $class->_new($b);
424 9721         22573 $class->_mul($x, $class->_pow($b, $n));
425             }
426 9736         47877 return $x;
427             }
428              
429             ##############################################################################
430             # _is_* routines
431              
432             sub _is_zero {
433             # return true if arg is zero
434 171568     171568   3342049 my $x = $_[1];
435              
436 171568 100       469394 return $x -> is_empty() ? 1 : 0;
437             }
438              
439             sub _is_one {
440             # return true if arg is one
441 2958     2958   22673 my $x = $_[1];
442              
443 2958 100       8548 return 0 if $x->Size() != $bits; # if size mismatch
444 2616         8562 $x->equal($one);
445             }
446              
447             sub _is_two {
448             # return true if arg is two
449 58     58   2231 my $x = $_[1];
450              
451 58 100       214 return 0 if $x->Size() != $bits; # if size mismatch
452 50         165 $x->equal($two);
453             }
454              
455             sub _is_ten {
456             # return true if arg is ten
457 0     0   0 my $x = $_[1];
458              
459 0 0       0 return 0 if $x->Size() != $bits; # if size mismatch
460 0         0 $_[1]->equal($ten);
461             }
462              
463             sub _is_even {
464             # return true if arg is even
465              
466 23 100   23   1488 $_[1]->bit_test(0) ? 0 : 1;
467             }
468              
469             sub _is_odd {
470             # return true if arg is odd
471              
472 196 100   196   4190 $_[1]->bit_test(0) ? 1 : 0;
473             }
474              
475             ###############################################################################
476             # check routine to test internal state of corruptions
477              
478             sub _check {
479             # no checks yet, pull it out from the test suite
480 1830     1830   748197 my $x = $_[1];
481 1830 50       4910 return "Undefined" unless defined $x;
482 1830 100       4725 return "$x is not a reference to Bit::Vector" if ref($x) ne 'Bit::Vector';
483              
484 1829 50       6742 return "$x is negative" if $x->Sign() < 0;
485              
486             # Get the size.
487              
488 1829         4420 my $xs = $x -> Size();
489              
490             # The size must be a multiple of the chunk size.
491              
492 1829         4729 my $ns = $chunk * int($xs / $chunk);
493 1829 50       3780 if ($xs != $ns) {
494 0         0 return "Size($x) is $x bits, expected a multiple of $chunk.";
495             }
496              
497             # The size must not be larger than necessary.
498              
499 1829         4415 my $imax = $x -> Max(); # index of highest non-zero bit
500 1829 100       4063 my $nmin = $imax < 0 ? 1 : $imax + 2; # minimum number of bits required
501 1829         4135 $ns = $chunk * __ceil($nmin / $chunk); # minimum size in whole chunks
502 1829 50       4046 if ($xs != $ns) {
503 0         0 return "Size($x) is $xs bits, but only $ns bits are needed.";
504             }
505              
506 1829         4174 0;
507             }
508              
509             sub _mod {
510 766     766   6045 my ($class, $x, $y) = @_;
511              
512             # Get current sizes.
513              
514 766         1467 my $xs = $x -> Size();
515 766         1332 my $ys = $y -> Size();
516              
517             # Resize to a common size.
518              
519 766         1295 my $ns = __max($xs, $ys);
520 766 50       1601 $x -> Resize($ns) if $xs < $ns;
521 766 100       1778 $y -> Resize($ns) if $ys < $ns;
522 766         1885 my $quo = Bit::Vector -> new($ns);
523 766         1587 my $rem = Bit::Vector -> new($ns);
524              
525             # Get the quotient.
526              
527 766         19239 $quo -> Divide($x, $y, $rem);
528              
529             # Resize $y back to its original size, if necessary.
530              
531 766 100       1751 $y -> Resize($ys) if $ys < $ns;
532              
533 766         1454 $class -> __reduce($rem);
534             }
535              
536             # The following methods are not implemented (yet):
537              
538             #sub _1ex { }
539              
540             #sub _as_bytes { }
541              
542             #sub _as_oct { }
543              
544             #sub _from_bytes { }
545              
546             #sub _from_oct { }
547              
548             #sub _lcm { }
549              
550             #sub _log_int { }
551              
552             #sub _modinv { }
553              
554             #sub _modpow { }
555              
556             #sub _nok { }
557              
558             #sub _root { }
559              
560             #sub _sqrt { }
561              
562             #sub _zeros { }
563              
564             sub __reduce {
565             # internal reduction to make minimum size
566 206217     206217   340328 my ($class, $x) = @_;
567              
568 206217         363768 my $bits_allocated = $x->Size();
569 206217 100       389844 return $x if $bits_allocated <= $chunk;
570              
571             # The number of bits we use is always a positive multiple of $chunk. Add
572             # two extra bits to $imax; one because $imax is zero-based, and one to
573             # avoid that the highest bit is one, which signifies a negative number.
574              
575 171782         313659 my $imax = $x->Max();
576 171782 100       302041 my $bits_needed = $imax < 0 ? 1 : 2 + $imax;
577 171782         285331 $bits_needed = $chunk * __ceil($bits_needed / $chunk);
578              
579 171782 100       323750 if ($bits_allocated > $bits_needed) {
580 138435         252256 $x->Resize($bits_needed);
581             }
582              
583 171782         300580 $x;
584             }
585              
586             ###############################################################################
587             # helper/utility functions
588              
589             # maximum of 2 values
590              
591             sub __max {
592 48808     48808   77510 my ($m, $n) = @_;
593 48808 100       99675 $m > $n ? $m : $n;
594             }
595              
596             # ceiling function
597              
598             sub __ceil {
599 407971     407971   549731 my $x = shift;
600 407971         584050 my $ix = int $x;
601 407971 100       770426 ($ix >= $x) ? $ix : $ix + 1;
602             }
603              
604             1;
605              
606             __END__