File Coverage

blib/lib/Math/NoCarry.pm
Criterion Covered Total %
statement 57 57 100.0
branch 17 20 85.0
condition 5 9 55.5
subroutine 7 7 100.0
pod 3 3 100.0
total 89 96 92.7


line stmt bran cond sub pod time code
1             package Math::NoCarry;
2 4     4   2181 use strict;
  4         21  
  4         117  
3              
4 4     4   21 use warnings;
  4         6  
  4         155  
5 4     4   20 no warnings;
  4         9  
  4         135  
6              
7 4     4   21 use Exporter qw(import);
  4         5  
  4         3011  
8              
9             our @EXPORT_OK = qw(add subtract multiply);
10             our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
11              
12             our $VERSION = '1.114';
13              
14             =encoding utf8
15              
16             =head1 NAME
17              
18             Math::NoCarry - Perl extension for no-carry arithmetic
19              
20             =head1 SYNOPSIS
21              
22             use Math::NoCarry qw(:all);
23              
24             my $sum = add( 123, 456 );
25              
26             my $difference = subtract( 123, 456 );
27              
28             my $product = multiply( 123, 456 );
29              
30             =head1 DESCRIPTION
31              
32             No-carry arithmetic doesn't allow you to carry digits to the
33             next column. For example, if you add 8 and 4, you normally
34             expect the answer to be 12, but that 1 digit is a carry.
35             In no-carry arithmetic you can't do that, so the sum of
36             8 and 4 is just 2. In effect, this is addition modulo 10
37             in each column. I discard all of the carry digits in
38             this example:
39              
40             1234
41             + 5678
42             ------
43             6802
44              
45             For multiplication, the result of pair-wise multiplication
46             of digits is the modulo 10 value of their normal, everyday
47             multiplication.
48              
49             123
50             x 456
51             -----
52             8 6 x 3
53             2 6 x 2
54             6 6 x 1
55              
56             5 5 x 3
57             0 5 x 2
58             5 5 x 1
59              
60             2 4 x 3
61             8 4 x 2
62             + 4 4 x 1
63             -------
64             43878
65              
66             Since multiplication and subtraction are actually types of
67             additions, you can multiply and subtract like this as well.
68              
69             No carry arithmetic is both associative and commutative.
70              
71             =head2 Functions
72              
73             As of version 1.11, all of these functions are exportable on
74             demand, or with the tag C<:all> to get them all at once.
75              
76             =over 4
77              
78             =item multiply( A, B )
79              
80             Returns the no carry product of A and B.
81              
82             Return A if it is the only argument ( A x 1 );
83              
84             =cut
85              
86             sub multiply {
87 57 100   57 1 346 return $_[0] if $#_ < 1;
88              
89 14         29 @_ = map { $_ += 0 } @_;
  28         61  
90              
91 14   100     69 my $sign = ($_[0] > 0 and $_[1] < 0 ) ||
92             ($_[1] > 0 and $_[0] < 0 );
93              
94 14         40 my @p0 = reverse split //, abs $_[0];
95 14         30 my @p1 = reverse split //, abs $_[1];
96              
97 14         20 my @m;
98              
99 14         28 foreach my $i ( 0 .. $#p0 ) {
100 42         60 foreach my $j ( 0 .. $#p1 ) {
101 126         234 push @m, ( ( $p1[$j] * $p0[$i] ) % 10 ) * ( 10**($i+$j) );
102             }
103             }
104              
105 14         31 while( @m > 1 ) {
106 112         214 unshift @m, Math::NoCarry::add( shift @m, shift @m );
107             }
108              
109 14 100       30 $m[0] *= -1 if $sign;
110              
111 14         70 return $m[0];
112             }
113              
114             =item add( A, B )
115              
116             Returns the no carry sum of the positive numbers A and B.
117              
118             Returns A if it is the only argument ( A + 0 )
119              
120             Returns false if either number is negative.
121              
122             =cut
123              
124             sub add {
125 128 100   128 1 325 return $_[0] if $#_ < 1;
126              
127 118         181 @_ = map { local $^W; $_ += 0 } @_;
  236         427  
  236         548  
128              
129 118 50 33     364 return unless( $_[0] >= 0 and $_[1] >= 0 );
130              
131 118         327 my @addends = map scalar reverse, @_;
132              
133 118         164 my $string = '';
134              
135 118         153 my $max = length $addends[0];
136 118 100       193 $max = length $addends[1] if length $addends[1] > $max;
137              
138 118         222 for( my $i = 0; $i < $max ; $i++ ) {
139 380 100       524 my @digits = map { local $^W = 0; substr( $_, $i, 1) or 0 } @addends;
  760         1396  
  760         2290  
140              
141 380         671 my $sum = ( $digits[0] + $digits[1] ) % 10;
142              
143 380         801 $string .= $sum;
144             }
145              
146 118         433 $string =~ s/0*$//;
147              
148 118         193 $string = scalar reverse $string;
149              
150 118         367 return $string;
151             }
152              
153             =item subtract( A, B )
154              
155             Returns the no carry difference of the positive numbers A and B.
156              
157             Returns A if it is the only argument ( A - 0 )
158              
159             Returns false if either number is negative.
160              
161             =cut
162              
163             sub subtract {
164 16 100   16 1 114 return $_[0] if $#_ < 1;
165              
166 6 50 33     27 return unless( $_[0] >= 0 and $_[1] >= 0);
167              
168 6         19 my @addends = map scalar reverse, @_;
169              
170 6         10 my $string = '';
171              
172 6         9 my $max = length $addends[0];
173 6 50       12 $max = length $addends[1] if length $addends[1] > $max;
174              
175 6         14 for( my $i = 0; $i < $max ; $i++ ) {
176 18         25 my @digits = map { substr $_, $i, 1 } @addends;
  36         69  
177              
178 18 100       37 $digits[0] += 10 if $digits[0] < $digits[1];
179              
180 18         24 my $sum = ( $digits[0] - $digits[1] ) % 10;
181              
182 18         37 $string .= $sum;
183             }
184              
185 6         16 return scalar reverse $string;
186             }
187              
188             1;
189              
190             __END__