File Coverage

blib/lib/Math/Base/Convert/CalcPP.pm
Criterion Covered Total %
statement 61 64 95.3
branch 13 16 81.2
condition 4 6 66.6
subroutine 8 8 100.0
pod 5 6 83.3
total 91 100 91.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package Math::Base::Convert::CalcPP;
4              
5 20     20   99 use strict;
  20         56  
  20         617  
6 20     20   85 use vars qw($VERSION);
  20         40  
  20         14195  
7              
8             $VERSION = do { my @r = (q$Revision: 0.03 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
9              
10             # test number < 2^32 is NOT power of 2
11             #
12             sub isnotp2 {
13 62     62 0 485 my $ref = ref $_[0];
14 62 50 33     137 shift if ref $_[0] || $_[0] =~ /\D/; # class?
15 62         116 $_[0] & $_[0] -1;
16             }
17              
18             # add a long n*32 bit number toa number < 65536
19             # add 'n' to array digits and propagate carry, return carry
20             #
21             sub addbaseno {
22 11483     11483 1 15684 my($ap,$n) = @_;
23 11483         18880 foreach (@$ap) {
24 11483         14076 $_ += $n;
25 11483 50       42866 return 0 unless $_ > 0xffffffff;
26 0         0 $n = 1;
27 0         0 $_ -= 4294967296;
28             }
29 0         0 1; # carry is one on exit, else would have taken return 0 branch
30             }
31              
32             # multiply a register of indeterminate length by a number < 65535
33             #
34             # ap pointer to multiplicand array
35             # multiplier
36             #
37             sub multiply {
38 11483     11483 1 15707 my($ap,$m) = @_;
39             # $m is always 2..65535
40             # $m &= 0xffff; # max value 65535 already done by VETTING
41             #
42             # perl uses doubles for arithmetic, $m << 65536 will fit
43 11483         14239 my $carry = 0;
44 11483         18563 foreach ( @$ap) {
45 41961         49335 $_ *= $m;
46 41961         47609 $_ += $carry;
47 41961 100       68491 if ($_ > 0xffffffff) {
48 26967         34541 $carry = int($_ / 4294967296);
49 26967         39630 $_ %= 4294967296;
50             } else {
51 14994         23924 $carry = 0;
52             }
53             }
54 11483 100       26124 push @$ap, $carry if $carry;
55             }
56              
57             sub dividebybase {
58 12780     12780 1 17479 my($np,$divisor) = @_;
59 12780         22104 my @dividend = @$np; # 3% improvement
60 12780         27281 while ($#dividend) { # 3% improvement
61 10466 100       22314 last if $dividend[0];
62 1108         2323 shift @dividend;
63             }
64 12780         15589 my $remainder = 0;
65 12780         14241 my @quotient;
66 12780         26004 while (@dividend) {
67 46200         63676 my $work = ($dividend[0] += ($remainder * 4294967296));
68 46200         70691 push @quotient, int($work / $divisor);
69 46200         52996 $remainder = $work % $divisor;
70 46200         102757 shift @dividend;
71             }
72 12780         28474 return (\@quotient,$remainder);
73             }
74              
75             # simple versions of conversion, works for N < ~2^49 or 10^16
76             #
77             #sub frombase {
78             # my($hsh,$base,$str) = @_;
79             # my $number = 0;
80             # for( $str =~ /./g ) {
81             # $number *= $base;
82             # $number += $hsh->{$_};
83             # }
84             # return $number;
85             #}
86              
87             #sub tobase {
88             #sub to_base
89             # my($bp,$base,$num) = @_;
90             # my $base = shift;
91             # return $bp->[0] if $num == 0;
92             # my $str = '';
93             # while( $num > 0 ) {
94             # $str = $bp->[$num % $base] . $str;
95             # $num = int( $num / $base );
96             # }
97             # return $str;
98             #}
99              
100             # convert a number from its base to 32*N bit representation
101             #
102             sub useFROMbaseto32wide {
103 559     559 1 2858 my $bc = shift;
104 559         778 my($ary,$hsh,$base,$str) = @{$bc}{qw(from fhsh fbase nstr)};
  559         1458  
105             # check if decimal and interger from within perl's 32bit double representation
106             # cutoff is 999,999,999,999,999 -- a bit less than 2^50
107             #
108             # convert directly to base 2^32 arrays
109             #
110 559         1162 my @result = (0);
111              
112 559 100 100     1789 if ($base == 10 && length($str) < 16) {
113             # unless ($str > 999999999999999) { # maximum 32 bit double float integer representation
114 35         73 $result[0] = $str % 4294967296;
115 35         68 my $quotient = int($str / 4294967296);
116 35 100       80 $result[1] = $quotient if $quotient;
117 35         69 $bc->{b32str} = \@result;
118             }
119             else {
120 524         6440 for ($str =~ /./g) {
121 11483         21661 multiply(\@result,$base);
122 11483 50       25348 push @result, 1 if addbaseno(\@result,$hsh->{$_}); # propagate carry
123             }
124             # my @rv = reverse @result;
125 524         2010 $bc->{b32str} = \@result;
126             }
127 559         1678 $bc;
128             }
129              
130             #my %used = map {$_,0}(0..255);
131              
132             # convert 32*N bit representation to any base < 65536
133             #
134              
135             sub use32wideTObase {
136 556     556 1 5195 my $bc = shift;
137 556         762 my($ary,$base,$rquot) = @{$bc}{qw(to tbase b32str)};
  556         1305  
138 556         1317 my @quotient = reverse(@$rquot);
139 556         776 my $quotient = \@quotient;
140 556         723 my @answer;
141             my $remainder;
142             do {
143 12780         23500 ($quotient,$remainder) = dividebybase($quotient,$base);
144             # these commented out print statements are for convert.t DO NOT REMOVE!
145             #$used{$remainder} = 1;
146             #print $remainder;
147             #print " *" if $remainder > 86;
148             #print "\n";
149 12780         35461 unshift @answer, $ary->[$remainder];
150 556         639 } while grep {$_} @$quotient;
  46200         75245  
151              
152             #foreach (sort {$b <=> $a} keys %used) {
153             #print " $_,\n" if $used{$_} && $_ > 85;
154             #print "\t$_\t=> \n" if !$used{$_} && $_ < 86;
155             #}
156 556         3672 join '', @answer;
157             }
158              
159             1;
160              
161             __END__