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   135 use strict;
  20         45  
  20         882  
6 20     20   104 use vars qw($VERSION);
  20         35  
  20         18162  
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 622 my $ref = ref $_[0];
14 62 50 33     150 shift if ref $_[0] || $_[0] =~ /\D/; # class?
15 62         139 $_[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 16913 my($ap,$n) = @_;
23 11483         13989 foreach (@$ap) {
24 11483         12512 $_ += $n;
25 11483 50       25354 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 14413 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         13184 my $carry = 0;
44 11483         14694 foreach ( @$ap) {
45 41961         44431 $_ *= $m;
46 41961         43099 $_ += $carry;
47 41961 100       49670 if ($_ > 0xffffffff) {
48 26967         34231 $carry = int($_ / 4294967296);
49 26967         30833 $_ %= 4294967296;
50             } else {
51 14994         18927 $carry = 0;
52             }
53             }
54 11483 100       19686 push @$ap, $carry if $carry;
55             }
56              
57             sub dividebybase {
58 12780     12780 1 17390 my($np,$divisor) = @_;
59 12780         16845 my @dividend = @$np; # 3% improvement
60 12780         20482 while ($#dividend) { # 3% improvement
61 10466 100       16795 last if $dividend[0];
62 1108         1825 shift @dividend;
63             }
64 12780         14291 my $remainder = 0;
65 12780         13399 my @quotient;
66 12780         17599 while (@dividend) {
67 46200         51206 my $work = ($dividend[0] += ($remainder * 4294967296));
68 46200         60700 push @quotient, int($work / $divisor);
69 46200         48991 $remainder = $work % $divisor;
70 46200         66084 shift @dividend;
71             }
72 12780         20388 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 2692 my $bc = shift;
104 559         894 my($ary,$hsh,$base,$str) = @{$bc}{qw(from fhsh fbase nstr)};
  559         1527  
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         1409 my @result = (0);
111              
112 559 100 100     1692 if ($base == 10 && length($str) < 16) {
113             # unless ($str > 999999999999999) { # maximum 32 bit double float integer representation
114 35         258 $result[0] = $str % 4294967296;
115 35         85 my $quotient = int($str / 4294967296);
116 35 100       77 $result[1] = $quotient if $quotient;
117 35         91 $bc->{b32str} = \@result;
118             }
119             else {
120 524         7337 for ($str =~ /./g) {
121 11483         21389 multiply(\@result,$base);
122 11483 50       31416 push @result, 1 if addbaseno(\@result,$hsh->{$_}); # propagate carry
123             }
124             # my @rv = reverse @result;
125 524         2314 $bc->{b32str} = \@result;
126             }
127 559         1519 $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 8027 my $bc = shift;
137 556         852 my($ary,$base,$rquot) = @{$bc}{qw(to tbase b32str)};
  556         1430  
138 556         1939 my @quotient = reverse(@$rquot);
139 556         862 my $quotient = \@quotient;
140 556         903 my @answer;
141             my $remainder;
142             do {
143 12780         17032 ($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         25152 unshift @answer, $ary->[$remainder];
150 556         778 } while grep {$_} @$quotient;
  46200         58505  
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         4390 join '', @answer;
157             }
158              
159             1;
160              
161             __END__
162              
163             =head1 NAME
164              
165             Math::Base::Convert::CalcPP - standard methods used by Math::Base::Convert
166              
167             =head1 DESCRIPTION
168              
169             This module contains the standard methods used by B<Math::Base::Convert> to
170             convert from one base number to another base number.
171              
172             =over 4
173              
174             =item * $carry = addbaseno($reg32ptr,$int)
175              
176             This function adds an integer < 65536 to a long n*32 bit register and
177             returns the carry.
178              
179             =item * multiply($reg32ptr,$int)
180              
181             This function multiplies a long n*32 bit register by an integer < 65536
182              
183             =item * ($qptr,$remainder) = dividebybase($reg32ptr,$int)
184              
185             this function divides a long n*32 bit register by an integer < 65536 and
186             returns a pointer to a long n*32 bit quotient and an integer remainder.
187              
188             =item * $bc->useFROMbaseto32wide
189              
190             This method converts FROM an input base string to a long n*32 bit register using
191             an algorithim like:
192              
193             $longnum = 0;
194             for $char ( $in_str =~ /./g ) {
195             $longnum *= $base;
196             $longnum += $value{$char)
197             }
198             return $number;
199              
200             =item * $output = $bc->use32wideTObase
201              
202             This method converts a long n*32 bit register TO a base number using an
203             algorithim like:
204              
205             $output = '';
206             while( $longnum > 0 ) {
207             $output = ( $longnum % $base ) . $output;
208             $num = int( $longnum / $base );
209             }
210             return $output;
211              
212             =back
213              
214             =head1 AUTHOR
215            
216             Michael Robinton, michael@bizsystems.com
217              
218             =head1 COPYRIGHT
219              
220             Copyright 2012-15, Michael Robinton
221              
222             This program is free software; you may redistribute it and/or modify it
223             under the same terms as Perl itself.
224              
225             This program is distributed in the hope that it will be useful,
226             but WITHOUT ANY WARRANTY; without even the implied warranty of
227             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
228            
229             =cut
230              
231             1;