File Coverage

blib/lib/Math/FractionManip.pm
Criterion Covered Total %
statement 421 523 80.5
branch 161 264 60.9
condition 54 101 53.4
subroutine 38 49 77.5
pod 32 32 100.0
total 706 969 72.8


line stmt bran cond sub pod time code
1             package Math::FractionManip;
2             our $AUTHORITY = 'cpan:GENE';
3              
4             # ABSTRACT: Manipulate fractions
5              
6 1     1   724 use strict;
  1         2  
  1         36  
7             #use warnings;
8              
9             our $VERSION = '0.5504';
10              
11 1     1   5 use Carp qw(croak);
  1         2  
  1         38  
12 1     1   981 use Math::BigInt ();
  1         22328  
  1         36  
13 1     1   970 use Math::BigFloat ();
  1         24451  
  1         53  
14             use overload
15 1         7 '+' => 'add',
16             '-' => 'sub',
17             '*' => 'mul',
18             '/' => 'div',
19             'abs' => 'abs',
20             '**' => 'pow',
21             'sqrt' => 'sqrt',
22             '<=>' => 'cmp',
23             '""' => 'string',
24             '0+' => 'decimal',
25 1     1   11 fallback => 1;
  1         2  
26              
27             my %DEF = (
28             CURRENT => { TAGS => [qw/ NORMAL REDUCE SMALL AUTO /], DIGITS => undef, SYSTEM => 1, NAME => 'DEFAULT' },
29             DEFAULT => { TAGS => [qw/ NORMAL REDUCE SMALL AUTO /], DIGITS => undef, READONLY => 1, SYSTEM => 1 },
30             BLANK => { TAGS => ['', '', ''], DIGITS => '', READONLY => 1, SYSTEM => 1 },
31             );
32              
33             my ($OUTFORMAT, $REDUCE, $SIZE, $AUTO, $INTERNAL, $RED_STATE) = (0 .. 5);
34             my $TAG_END = 3; #Last index of tags meant to be kept.
35              
36             my %TAGS = (
37             NORMAL => [$OUTFORMAT, 'NORMAL'],
38             MIXED => [$OUTFORMAT, 'MIXED'],
39             MIXED_RAW => [$OUTFORMAT, 'MIXED_RAW'],
40             RAW => [$OUTFORMAT, 'RAW'],
41             DEF_MIXED => [$OUTFORMAT, undef],
42             REDUCE => [$REDUCE, 'REDUCE'],
43             NO_REDUCE => [$REDUCE, 'NO_REDUCE'],
44             DEF_REDUCE => [$REDUCE, undef],
45             SMALL => [$SIZE, 'SMALL'],
46             BIG => [$SIZE, 'BIG'],
47             DEF_BIG => [$SIZE, undef],
48             AUTO => [$AUTO, 'AUTO'],
49             NO_AUTO => [$AUTO, 'NO_AUTO'],
50             DEF_AUTO => [$AUTO, undef],
51             CONVERTED => [$INTERNAL, 'CONVERTED'],
52             IS_REDUCED => [$RED_STATE, 'IS_REDUCED'],
53             );
54              
55             my @DEF_TAG = qw(DEF_MIXED DEF_REDUCE DEF_BIG DEF_AUTO);
56              
57             my $ID = 01;
58              
59             sub new {
60 64     64 1 5065 my $proto = shift;
61 64   33     247 my $class = ref($proto) || $proto;
62 64         118 my ($self, @frac, @tags, $tag, $decimal, $p1, $p2, $p3);
63 64 100 100     107 if (_is_decimal($_[0]) and _is_decimal($_[1]) and _is_decimal($_[2])) {
    100 100        
    100 100        
    100          
    50          
64 2         6 my $sign = $_[0] / abs($_[0]);
65 2         6 @tags = _tags(@_[3 .. $#_]);
66 2         6 ($decimal, $p1, $p2, $p3) = _fix_num(\@tags, @_[0 .. 2]);
67 2         6 ($p1, $p2, $p3) = (abs($p1), abs($p2), abs($p3));
68 2         5 @frac = ($p1 * $p3 + $p2, $sign * $p3);
69 2 50       5 @frac = _de_decimal(@frac, \@tags) if $decimal;
70             }
71             elsif (_is_decimal($_[0]) and _is_decimal($_[1])) {
72 50         119 @tags = _tags(@_[2 .. $#_]);
73 50         129 ($decimal, @frac) = _fix_num(\@tags, @_[0 .. 1]);
74 50 100       80 @frac = _de_decimal(@frac, \@tags) if $decimal;
75 50         82 @frac = _simplify_sign(@frac);
76             }
77             elsif (_is_decimal($_[0])) {
78             {
79 5         7 @tags = _tags(@_[1 .. $#_]);
  5         13  
80 5         12 ($decimal, $p1) = _fix_num(\@tags, $_[0]);
81 5 100       11 @frac = ($p1, 1), last if not $decimal;
82 3         6 (@frac[0 .. 1], $tag) = _from_decimal($p1);
83 3         7 @tags = _tags(@tags, $tag);
84 3         8 ($decimal, @frac) = _fix_num(\@tags, @frac);
85 3 50       7 @frac = _de_decimal(@frac, \@tags) if $decimal;
86             }
87             }
88             elsif ($_[0] =~ /\s*([\+\-]?)\s*([0-9e\.\+\-]+)\s+([0-9e\.\+\-]+)\s*\/\s*([0-9e\.\+\-]+)/) {
89 2         7 my $sign = $1 . '1';
90 2         6 @tags = _tags(@_[1 .. $#_]);
91 2         6 ($decimal, $p1, $p2, $p3) = _fix_num(\@tags, $2, $3, $4);
92 2         5 ($p1, $p2, $p3) = (abs($p1), abs($p2), abs($p3));
93 2         5 @frac = ($p1 * $p3 + $p2, $sign * $p3);
94 2 50       5 @frac = _de_decimal($p1 * $p3 + $p2, $sign * $p3, \@tags) if $decimal;
95             }
96             elsif ($_[0] =~ /\s*([0-9e\.\+\-]+)\s*\/\s*([0-9e\.\+\-]+)/) {
97 5         16 @tags = _tags(@_[1 .. $#_]);
98 5         15 ($decimal, @frac) = _fix_num(\@tags, $1, $2);
99 5 50       12 @frac = _de_decimal(@frac, \@tags) if $decimal;
100 5         11 @frac = _simplify_sign(@frac);
101             }
102             else {
103 0         0 croak("\"$_[0]\" is of unknown format");
104             }
105 64 50       135 croak("Can not have 0 as the denominator") if $frac[1] == 0;
106 64 100 100     477 if (_tag($REDUCE, \@tags) ne 'NO_REDUCE' and _tag($RED_STATE, \@tags) ne 'IS_REDUCED') {
107 33         110 my $not_reduced;
108 33         46 ($not_reduced, @frac) = _reduce(@frac);
109 33 100 66     150 @frac = _fix_auto('DOWN', \@tags, @frac) if $not_reduced and _tag($AUTO, \@tags) eq 'AUTO';
110             }
111 64 100       97 @tags[$RED_STATE] = undef if _tag($RED_STATE, \@tags) eq 'IS_REDUCED';
112 64         156 $self->{frac} = \@frac;
113 64         87 $self->{tags} = \@tags;
114 64         105 bless($self, $class);
115 64         237 return $self;
116             }
117              
118             sub string {
119 40     40 1 19810 my $self = shift;
120 40         50 my @frac;
121 40         100 my $mixed = _tag($OUTFORMAT, [$_[0]], $self->{tags});
122 40 100       111 if ($mixed eq 'MIXED') {
    50          
    50          
123 14         29 @frac = $self->list('MIXED');
124 14         21 my $string = "";
125 14 100       27 $string .= "$frac[0]" if $frac[0] != 0;
126 14 100 100     312 $string .= " " if $frac[0] != 0 and $frac[1] != 0;
127 14 100       273 $string .= "$frac[1]/$frac[2]" if $frac[1] != 0;
128 14 50       418 $string = "0" if $string eq '';
129 14         150 return $string;
130             }
131             elsif ($mixed eq 'MIXED_RAW') {
132 0         0 @frac = $self->list('MIXED');
133 0         0 return "$frac[0] $frac[1]/$frac[2]";
134             }
135             elsif ($mixed eq 'RAW') {
136 0         0 @frac = $self->list;
137 0 0       0 return ($frac[0] >= 0 ? '+' : '') . "$frac[0]/$frac[1]";
138             }
139             else {
140 26         50 @frac = $self->list;
141 26         230 return "$frac[0]/$frac[1]";
142             }
143             }
144              
145             sub list {
146 40     40 1 50 my $self = shift;
147 40         44 my @frac = @{ $self->{frac} };
  40         79  
148 40 100       74 if ($_[0] eq "MIXED") {
149 14         25 my $whole = $frac[0] / $frac[1];
150 14 100       266 $whole = int($whole) if not ref($frac[0]);
151 14         23 $frac[0] = abs($frac[0] - $frac[1] * $whole);
152 14         280 @frac = ($whole, @frac);
153             }
154 40         57 foreach (@frac) { s/^\+//; }
  94         366  
155 40         171 return @frac;
156             }
157              
158             sub reduce {
159 0     0 1 0 my $self = shift;
160 0         0 my ($undef, @frac) = _reduce(@{ $self->{frac} });
  0         0  
161 0         0 return Math::FractionManip->new(@frac, @{ $self->{tags} });
  0         0  
162             }
163              
164              
165             sub decimal {
166 2     2 1 2 my $self = shift;
167 2         3 my @frac = @{ $self->{frac} };
  2         4  
168 2 50       17 return $frac[0] / $frac[1] if not ref($frac[0]);
169 0 0       0 return Math::BigFloat->new(Math::BigFloat::bdiv($frac[0], $frac[1], $DEF{CURRENT}{DIGITS})) if ref($frac[0]);
170             }
171              
172             sub num {
173 1     1 1 955 my $self = shift;
174 1         2 my @frac = @{ $self->{frac} };
  1         3  
175 1 50       23 return $frac[0] / $frac[1] if not ref $frac[0];
176 0 0       0 return Math::BigFloat->new(Math::BigFloat::bdiv($frac[0], $frac[1], $DEF{CURRENT}{DIGITS})) if ref($frac[0]);
177             }
178              
179             ## For the next three methods:
180             # If used on the object use the tags of the object
181             # If given a class use the dafault tags,
182             # .... if a default set is specified then return for that set.
183              
184             sub is_tag {
185 6     6 1 1226 my $self = shift;
186 6         9 my $tag = shift;
187 6 50       20 my $default = 1 if $_[0] eq 'INC_DEF';
188 6         8 my $is_tag = 0;
189 6         8 my @tags;
190             {
191 6 50       8 $is_tag = 0, last if not $TAGS{$tag}; #if there is no such tag ret=0
  6         16  
192 6         7 my ($num, $tag) = @{ $TAGS{$tag} };
  6         14  
193 6 50       13 if (ref($self) eq "Math::FractionManip") {
194 6         8 @tags = @{ $self->{tags} };
  6         14  
195 6 100       14 $is_tag = 1, last if $tags[$num] eq $tag;
196 3 50 33     9 $is_tag = undef, last if $tags[$num] eq undef and not $default;
197 3 0 33     10 $is_tag = -1, last if $DEF{CURRENT}{TAGS}[$num] eq $tag
      33        
198             and $tags[$num] eq undef and $default;
199 3         4 $is_tag = 0;
200             }
201             else {
202 0         0 my $set;
203 0 0       0 $set = 'CURRENT' unless $set = $_[0];
204 0 0       0 $set = 'BLANK' unless exists $DEF{$set};
205 0 0       0 $is_tag = 1, last if $DEF{$set}{TAGS}[$num] eq $tag;
206 0         0 $is_tag = 0;
207             }
208             }
209 6         24 return $is_tag;
210             }
211              
212             sub tags {
213 5     5 1 9 my $self = shift;
214 5         6 my @tags;
215 5 50       16 if (ref($self) eq "Math::FractionManip") {
    50          
216 0 0       0 my $inc_def = 1 if $_[0] eq 'INC_DEF';
217 0         0 @tags = @{ $self->{tags} }[0 .. $TAG_END];
  0         0  
218 0         0 my $num;
219 0         0 foreach $num (0 .. $#tags) {
220 0 0 0     0 $tags[$num] = $DEF_TAG[$num] if $tags[$num] eq undef and not $inc_def;
221 0 0 0     0 $tags[$num] = $DEF{CURRENT}{TAGS}[$num] if $tags[$num] eq undef and $inc_def;
222             }
223             }
224             elsif (ref($self) ne "Math::FractionManip") {
225 5         8 my $set;
226 5 100       12 $set = 'CURRENT' unless $set = $_[0];
227 5 50       9 $set = 'BLANK' unless exists $DEF{$set};
228 5         6 @tags = @{ $DEF{$set}{TAGS} };
  5         42  
229             }
230 5         32 return @tags;
231             }
232              
233             sub digits {
234 5     5 1 9 my $self = shift;
235 5         6 my $set;
236 5 100       12 $set = 'CURRENT' unless $set = $_[0];
237 5 50       11 $set = 'BLANK' unless exists $DEF{$set};
238 5         18 return $DEF{$set}{DIGITS};
239             }
240              
241             ###############################
242             # These methods are used for managing default sets.
243              
244             sub sets {
245 0     0 1 0 my $self = shift;
246 0         0 return keys %DEF;
247             }
248              
249             sub name_set {
250 1     1 1 3 shift;
251 1 50       3 return $DEF{CURRENT}{NAME} if not $_[0];
252 1 50       4 $DEF{CURRENT}{NAME} = $_[0] if $_[0];
253             }
254              
255             sub exists_set {
256 0     0 1 0 return exists $DEF{ $_[1] };
257             }
258              
259             sub use_set {
260 1     1 1 3 my $self = shift;
261 1         2 my $name = shift;
262 1 50 33     6 if (exists $DEF{$name} and not $DEF{$name}{READONLY}) {
263 1         3 $DEF{CURRENT} = $DEF{$name};
264 1         2 return $name;
265             }
266             else {
267 0         0 return undef;
268             }
269             }
270              
271             sub temp_set {
272 0     0 1 0 my $self = shift;
273 0         0 my $name = shift;
274 0 0       0 if (not $name) {
275 0         0 $ID++;
276 0         0 $name = "\cI\cD$ID";
277 0         0 $self->copy_set('CURRENT', $name);
278 0         0 $self->copy_set('DEFAULT', 'CURRENT');
279 0         0 return $name;
280             }
281             else { #if $name;
282 0         0 my $return = $self->copy_set($name, 'CURRENT');
283 0         0 $self->del_set($name);
284 0         0 return $return;
285             }
286             }
287              
288             sub load_set {
289 2     2 1 10 my $self = shift;
290 2 50       6 if (exists $DEF{ $_[0] }) {
291 2 50       14 $self->copy_set($_[0], 'CURRENT') if exists $DEF{ $_[0] };
292 2         4 return $_[0];
293             }
294             else {
295 0         0 return undef;
296             }
297             }
298              
299             sub save_set {
300 1     1 1 2 my $self = shift;
301 1         2 my $name;
302 1 50       4 $name = $DEF{CURRENT}{NAME} unless $name = shift;
303 1 50 33     7 ++$ID, $name = "\cI\cD:$ID" if not $name or $name eq 'RAND';
304 1   50     22 return $self->copy_set('CURRENT', $name) && $name;
305             }
306              
307             sub copy_set {
308 3     3 1 5 shift;
309 3         7 my ($name1, $name2) = @_;
310 3 50 33     17 if ($DEF{$name2}{READONLY} or $name2 eq 'BLANK' or not exists $DEF{$name1}) {
      33        
311 0         0 return 0;
312             }
313             else {
314 3         9 $DEF{$name2} = {}; # kill any links from use;
315 3         4 $DEF{$name2}{TAGS} = [@{ $DEF{$name1}{TAGS} }];
  3         10  
316 3         6 $DEF{$name2}{DIGITS} = $DEF{$name1}{DIGITS};
317 3 100       8 $DEF{$name2}{NAME} = $name2 unless $name2 eq 'CURRENT';
318 3 100       20 $DEF{$name2}{NAME} = $name1 if $name2 eq 'CURRENT';
319 3         7 return 1;
320             }
321             }
322              
323             sub del_set {
324 0 0 0 0 1 0 if (exists $DEF{ $_[1] } and not $DEF{ $_[1] }{SYSTEM}) {
325 0         0 delete $DEF{ $_[1] };
326 0         0 return $_[1];
327             }
328             }
329              
330             ###############################
331             # All of the modify methods are not meant to return anything, they modify
332             # the object being referenced.
333              
334             # This method works almost like the new method except that it takes an
335             # object as an argement and will modify it instead of creating a new
336             # object, also any tags associated with the object are left in tact
337             # unless a new tag is given to override the old.
338             sub modify {
339 0     0 1 0 my $me = shift;
340 0         0 my $self;
341 0         0 my @tags = @{ $me->{tags} };
  0         0  
342 0         0 $self = Math::FractionManip->new(@_, @tags, @_); # The extra @_ is there to override tags
343 0         0 $me->{frac} = $self->{frac};
344 0         0 $me->{tags} = $self->{tags};
345             }
346              
347             # XXX This method appears to break things? -GB
348             sub modify_digits {
349 1     1 1 3 my $self = shift;
350 1         3 $DEF{CURRENT}{DIGITS} = shift;
351             }
352              
353             sub modify_reduce {
354 0     0 1 0 my $me = shift;
355 0         0 my $self = $me->reduce;
356 0         0 $me->{frac} = $self->{frac};
357 0         0 $me->{tags} = $self->{tags};
358             }
359              
360             sub modify_num {
361 0     0 1 0 my $self = shift;
362 0         0 $self->[0] = $_[0];
363             }
364              
365             sub modify_den {
366 0     0 1 0 my $self = shift;
367 0         0 $self->[1] = $_[0];
368             }
369              
370             sub modify_tag {
371 5     5 1 676 my $self = shift;
372 5         11 my ($return, @return);
373 5         0 my $newtag;
374 5         8 foreach $newtag (@_) {
375 7         13 my $tagnum = _tagnum($newtag);
376 7 50       21 if ($tagnum == -1) {
    100          
377 0         0 push @return, undef;
378             }
379             elsif (ref($self) eq "Math::FractionManip") {
380 3         6 my @frac = @{ $self->{frac} };
  3         7  
381 3         4 my @tags = @{ $self->{tags} };
  3         6  
382 3         6 my @newtags = _tags(@tags, $newtag);
383              
384             # Now transform the Fraction based on the new tag.
385 3 100       8 if ($tagnum == $SIZE) {
    50          
386 1         3 my $newtag = _tag($SIZE, \@newtags);
387 1 50       3 @frac = map { "$_" + 0 } @frac if $newtag eq 'SMALL';
  0         0  
388 1 50       4 @frac = map { Math::BigInt->new($_) } @frac if $newtag eq 'BIG';
  2         82  
389             }
390             elsif ($tagnum == $REDUCE) {
391 0 0       0 (undef, @frac) = _reduce(@frac) if _tag($REDUCE, \@newtags) eq 'REDUCE';
392             }
393              
394             # Finally Modify the Fraction
395 3         45 $self->{frac} = \@frac;
396 3         8 $self->{tags} = \@newtags;
397             }
398             else {
399 4         6 $DEF{CURRENT}{TAGS}[$tagnum] = $newtag;
400             }
401 7         15 push @return, $newtag;
402             }
403 5         9 return @return;
404             }
405              
406             ###############################
407             # These methods are meant to be called with the overload operators.
408              
409             sub add {
410 16     16 1 22 my @frac1 = @{ $_[0]->{frac} };
  16         30  
411 16         22 my @tags1 = @{ $_[0]->{tags} };
  16         28  
412 16         25 my (@frac2, @frac, @tags2, $frac);
413 16         16 my $skipauto = 0;
414 16 100       47 @frac2 = @{ $_[1]->{frac} }, @tags2 = @{ $_[1]->{tags} } if ref($_[1]) eq "Math::FractionManip";
  10         19  
  10         16  
415 16 100       46 @frac2 = _from_decimal($_[1]), $tags2[$INTERNAL] = 'CONVERTED' if ref($_[1]) ne "Math::FractionManip";
416 16         42 my @tags = _tags_preserve([@tags1], [@tags2]);
417              
418             LOOP: {
419 16 100       34 if (_tag($REDUCE, \@tags) eq 'NO_REDUCE') {
  17         34  
420 4         13 @frac = ($frac1[0] * $frac2[1] + $frac2[0] * $frac1[1], $frac1[1] * $frac2[1]);
421             }
422             else {
423              
424             # Taken from Knuth v2 (rev 2), p313.
425             # It will always return a reduced fraction.
426 13         23 my $gcd1 = _gcd($frac1[1], $frac2[1]);
427 13         29 my $tmp = $frac1[0] * ($frac2[1] / $gcd1) + $frac2[0] * ($frac1[1] / $gcd1);
428 13         18 my $gcd2 = _gcd($tmp, $gcd1);
429 13         27 @frac = ($tmp / $gcd2, ($frac1[1] / $gcd1) * ($frac2[1] / $gcd2));
430 13         19 $tags[$RED_STATE] = 'IS_REDUCED';
431             }
432 17 100 66     502 if ((_tag($AUTO, \@tags) eq 'AUTO') and (not $skipauto) and
      66        
      66        
      66        
433             ($tags[$SIZE] eq 'SMALL') and ($frac[0] =~ /[eE]/ or $frac[1] =~ /[eE]/))
434             {
435 1         3 (@frac1[0 .. 1], @frac2[0 .. 1]) = map { Math::BigInt->new($_) } (@frac1, @frac2);
  4         19390  
436 1         39 $tags[$SIZE] = 'BIG';
437 1         2 $skipauto = 1;
438 1         3 redo LOOP;
439             }
440             }
441 16         55 return Math::FractionManip->new(@frac, @tags);
442             }
443              
444             sub sub {
445 1     1 1 7 my ($frac1, $frac2) = ($_[$_[2]], $_[not $_[2]]); # swap if needed
446 1 50       3 $frac1 = Math::FractionManip->new($frac1, 'CONVERTED') if ref($frac1) ne "Math::FractionManip";
447 1 50       3 $frac2 = Math::FractionManip->new($frac2, 'CONVERTED') if ref($frac2) ne "Math::FractionManip";
448              
449 1         3 $frac2 = Math::FractionManip->new($frac2->{frac}[0], -$frac2->{frac}[1], @{ $frac2->{tags} });
  1         3  
450              
451 1         3 return $frac1 + $frac2;
452             }
453              
454             sub mul {
455 7     7 1 9 my @frac1 = @{ $_[0]{frac} };
  7         16  
456 7         7 my @tags1 = @{ $_[0]{tags} };
  7         15  
457 7         10 my (@frac2, @frac, @tags2);
458 7 100       14 @frac2 = @{ $_[1]->{frac} }, @tags2 = @{ $_[1]->{tags} } if ref($_[1]) eq "Math::FractionManip";
  3         7  
  3         5  
459 7 100       18 @frac2 = (_from_decimal($_[1])), $tags2[$INTERNAL] = 'CONVERTED' if ref($_[1]) ne "Math::FractionManip";
460 7         21 my @tags = _tags_preserve([@tags1], [@tags2]);
461 7         16 my $skipauto = 0;
462             LOOP: {
463 7 100       7 if (_tag($REDUCE, \@tags) eq 'NO_REDUCE') {
  8         41  
464 2         6 @frac = ($frac1[0] * $frac2[0], $frac1[1] * $frac2[1]);
465             }
466             else {
467 6         10 my ($gcd1, $gcd2) = (_gcd($frac1[0], $frac2[1]), _gcd($frac2[0], $frac1[1]));
468 6         13 $frac[0] = ($frac1[0] / $gcd1) * ($frac2[0] / $gcd2);
469 6         11 $frac[1] = ($frac1[1] / $gcd2) * ($frac2[1] / $gcd1);
470 6         8 $tags[$RED_STATE] = 'IS_REDUCED';
471             }
472 8 100 66     217 if ((_tag($AUTO, \@tags) eq 'AUTO') and (not $skipauto) and
      66        
      66        
      66        
473             ($tags[$SIZE] eq 'SMALL') and ($frac[0] =~ /[eE]/ or $frac[1] =~ /[eE]/))
474             {
475 1         3 (@frac1[0 .. 1], @frac2[0 .. 1]) = map { Math::BigInt->new($_) } (@frac1, @frac2);
  4         125  
476 1         36 $tags[$SIZE] = 'BIG';
477 1         2 $skipauto = 1;
478 1         3 redo LOOP;
479             }
480             }
481 7         20 return Math::FractionManip->new(@frac, @tags);
482             }
483              
484             sub div {
485 1     1 1 4 my ($frac1, $frac2) = ($_[$_[2]], $_[not $_[2]]); # swap if needed
486 1 50       4 $frac1 = Math::FractionManip->new($frac1, 'CONVERTED') if ref($frac1) ne "Math::FractionManip";
487 1 50       3 $frac2 = Math::FractionManip->new($frac2, 'CONVERTED') if ref($frac2) ne "Math::FractionManip";
488              
489 1         2 $frac2 = Math::FractionManip->new($frac2->{frac}[1], $frac2->{frac}[0], @{ $frac2->{tags} });
  1         4  
490              
491             #Makes a copy of the fraction with the num and den switched.
492              
493 1         4 return $frac1 * $frac2;
494             }
495              
496             sub pow {
497 2     2 1 5 my (@frac, @frac1, @tags1);
498 2 50       7 @frac1 = @{ $_[$_[2]]->{frac} }, @tags1 = @{ $_[$_[2]]->{tags} } if ref($_[$_[2]]) eq "Math::FractionManip";
  2         5  
  2         5  
499 2 50       7 @frac1 = _from_decimal($_[$_[2]]) if ref($_[$_[2]]) ne "Math::FractionManip";
500 2         3 my $frac2;
501 2 50       4 $frac2 = $_[not $_[2]]->decimal if ref($_[not $_[2]]) eq "Math::FractionManip";
502 2 50       5 $frac2 = $_[not $_[2]] if ref($_[not $_[2]]) ne "Math::FractionManip";
503 2         4 my @tags = @tags1;
504 2         3 my $skipauto = 0;
505              
506             LOOP: {
507 2         4 @frac = ($frac1[0] ** $frac2, $frac1[1] ** $frac2);
  2         8  
508              
509 2 50 33     5 if ((_tag($AUTO, \@tags) eq 'AUTO') and (not $skipauto) and
      33        
      33        
      33        
510             ($tags[$SIZE] eq 'SMALL') and ($frac[0] =~ /[eE]/ or $frac[1] =~ /[eE]/))
511             {
512 0         0 @frac1 = map { Math::BigInt->new($_) } @frac1;
  0         0  
513 0         0 $tags[$SIZE] = 'BIG';
514 0         0 $skipauto = 1;
515 0         0 redo LOOP;
516             }
517             }
518              
519 2         7 return Math::FractionManip->new(@frac, @tags);
520             }
521              
522             sub sqrt {
523 1     1 1 910 my $self = shift;
524 1         2 my @frac = @{ $self->{frac} };
  1         3  
525 1         2 my @tags = @{ $self->{tags} };
  1         3  
526 1         2 my $ans;
527 1 50       3 if (ref($frac[0])) {
528 0         0 $frac[0] = Math::BigFloat->new(Math::BigFloat::fsqrt($frac[0], $DEF{CURRENT}{DIGITS}));
529 0         0 $frac[1] = Math::BigFloat->new(Math::BigFloat::fsqrt($frac[1], $DEF{CURRENT}{DIGITS}));
530             }
531             else {
532 1         4 @frac = (sqrt($frac[0]), sqrt($frac[1]));
533             }
534 1         4 return Math::FractionManip->new(@frac, @tags);
535             }
536              
537             sub abs {
538 0     0 1 0 my $self = shift;
539 0         0 my @frac = @{ $self->{frac} };
  0         0  
540 0         0 my @tags = @{ $self->{tags} };
  0         0  
541 0         0 return Math::FractionManip->new(abs($frac[0]), abs($frac[1]), @tags, 'IS_REDUCED');
542             }
543              
544             sub cmp {
545 0     0 1 0 my @frac1 = @{ $_[0]->{frac} };
  0         0  
546 0         0 my @tags1 = @{ $_[0]->{tags} };
  0         0  
547 0         0 my (@frac2, @frac, @tags2, $x, $y);
548 0 0       0 @frac2 = @{ $_[1]->{frac} }, @tags2 = @{ $_[1]->{tags} } if ref($_[1]) eq "Math::FractionManip";
  0         0  
  0         0  
549 0 0       0 @frac2 = _from_decimal($_[1]), @tags2 = qw(CONVERTED) if ref($_[1]) ne "Math::FractionManip";
550 0         0 my @tags = _tags_preserve([@tags1], [@tags2]);
551 0 0       0 if (_tag($REDUCE, \@tags) == 'NO_REDUCE') {
552 0         0 $x = $frac1[0] * $frac2[1];
553 0         0 $y = $frac2[0] * $frac1[1];
554             }
555             else {
556 0         0 my $gcd1 = _gcd($frac1[1], $frac2[1]);
557 0         0 $x = $frac1[0] * ($frac2[1] / $gcd1);
558 0         0 $y = $frac2[0] * ($frac1[1] / $gcd1);
559             }
560 0         0 return $x <=> $y;
561             }
562              
563             ################################
564             # These functions are internal
565              
566             sub _fix_num {
567 67     67   88 my $tagsref = shift;
568 67         114 my @return = @_;
569 67         99 my $auto = _tag($AUTO, $tagsref) eq 'AUTO';
570 67         128 $tagsref->[$SIZE] = _tag($SIZE, $tagsref);
571 67 50       106 $tagsref->[$SIZE] = 'SMALL' if $auto;
572 67         80 my $num;
573 67         75 my $decimal = 0;
574 67         86 foreach $num (@return) {
575 133 50       378 if (ref($num) eq "Math::BigFloat") {
    100          
    50          
    100          
576 0 0       0 $tagsref->[$SIZE] = 'BIG' unless $auto;
577 0         0 $decimal = 1;
578             }
579             elsif (ref($num) eq "Math::BigInt") {
580 4 50       7 $tagsref->[$SIZE] = 'BIG' unless $auto;
581             }
582             elsif (ref($num)) {
583              
584             # do nothing
585             }
586             elsif ($num =~ /[\.\e]/) {
587 9         12 $decimal = 1;
588             }
589 133 50       212 if ($auto) {
590 133         313 $num =~ /[\+\-]?\s*0*([0-9]*)\s*\.?\s*([0-9]*)0*/;
591 133         363 my $length = length($1) + length($2);
592 133 100       243 $tagsref->[$SIZE] = 'BIG' if $length > 15;
593             }
594             }
595 67 100       109 if ($tagsref->[$SIZE] eq 'BIG') {
596 2 50       6 @return = map { Math::BigInt->new("$_") } @return if not $decimal;
  4         132  
597 2 50       127 @return = map { Math::BigFloat->new("$_") } @return if $decimal;
  0         0  
598             }
599 67 100 66     178 if ($tagsref->[$SIZE] eq 'SMALL' and $auto) {
600 65         97 @return = map { "$_" + 0 } @return;
  129         352  
601             }
602 67         157 return ($decimal, @return);
603             }
604              
605             sub _fix_auto {
606 6     6   9 my $direction = shift;
607 6         6 my $tagsref = shift;
608 6         10 my @return = @_;
609 6         9 $tagsref->[$SIZE] = 'SMALL';
610 6         6 my $num;
611 6         10 foreach $num (@return) {
612 12         54 $num =~ /[\+\-]?\s*0*([0-9]*)\s*\.?\s*([0-9]*)0*/;
613 12         24 my $length = length($1) + length($2);
614 12 50       22 $tagsref->[$SIZE] = 'BIG' if $length > 15;
615             }
616 6 50 33     29 if ($tagsref->[$SIZE] eq 'BIG' and $direction eq 'BOTH') {
    50          
617 0         0 @return = map { Math::BigInt->new("$_") } @return;
  0         0  
618             }
619             elsif ($tagsref->[$SIZE] eq 'SMALL') {
620 6         8 @return = map { "$_" + 0 } @return;
  12         38  
621             }
622 6         13 return (@return);
623             }
624              
625             sub _is_decimal {
626 302 100   302   547 return undef unless defined $_[0];
627 254         729 my $return = $_[0] =~ /^\s*[\+\-0-9eE\.]+\s*$/;
628 254         997 return $return;
629             }
630              
631             sub _reduce {
632 33     33   49 my @frac = @_;
633 33         50 my $gcd = _gcd(@frac);
634 33 100       58 if ($gcd == 1) {
635 27         58 return (0, @frac);
636             }
637             else {
638 6         16 return (1, $frac[0] / $gcd, $frac[1] / $gcd);
639             }
640             }
641              
642             sub _simplify_sign {
643 55     55   77 my @frac = @_;
644 55         68 my $sign = 1;
645 55 100       116 $sign = ($frac[0] / CORE::abs($frac[0])) * ($frac[1] / CORE::abs($frac[1])) if $frac[0];
646 55         847 @frac = ($sign * CORE::abs($frac[0]), CORE::abs($frac[1]));
647 55         735 return @frac;
648             }
649              
650             sub _tags {
651 70     70   112 my @return = (undef, undef);
652 70         92 my ($NUM, $VALUE) = (0, 1);
653              
654 70         182 foreach (@_) {
655 194 100       331 next if not $TAGS{$_};
656 81         99 my ($num, $value) = @{ $TAGS{$_} };
  81         132  
657 81         137 $return[$num] = $value;
658             }
659              
660 70         145 return @return;
661             }
662              
663             sub _tag {
664 416     416   511 my $item = shift;
665 416         457 my $return;
666             my $ref;
667 416         652 foreach $ref (@_, $DEF{CURRENT}{TAGS}) {
668 769 100       783 last if $return = ${$ref}[$item];
  769         1449  
669             }
670 416         1159 return $return;
671             }
672              
673             sub _tagnum {
674 7     7   8 my $item = shift;
675 7 50       16 if (exists $TAGS{$item}) {
676 7         14 return $TAGS{$item}[0];
677             }
678             else {
679 0         0 return -1;
680             }
681             }
682              
683             sub _tags_preserve {
684 23     23   26 my @tags1 = @{ $_[0] };
  23         36  
685 23         29 my @tags2 = @{ $_[1] };
  23         42  
686 23         28 my @tags;
687 23 50       52 if ($tags1[$INTERNAL] eq 'CONVERTED') {
    100          
688 0         0 @tags = @tags2;
689             }
690             elsif ($tags2[$INTERNAL] eq 'CONVERTED') {
691 10         41 @tags = @tags1;
692             }
693             else {
694 13 50       24 @tags = map { $tags1[$_] eq $tags2[$_] and $tags1[$_] } (0 .. $#tags1);
  51         144  
695             }
696 23         50 return @tags;
697             }
698              
699             sub _gcd {
700 71     71   113 my ($x, $y) = (CORE::abs($_[0]), CORE::abs($_[1]));
701 71 50       95 if (ref($x)) {
702 0         0 $x = Math::BigInt->new($x->bgcd($y));
703             }
704             else {
705             {
706 71 50       77 $x = 1, last if $y > 1e17; # If this is so % will thinks its a zero so if
  71         117  
707             # $y>1e17 will simply will basicly give up and
708             # have it return 1 as the GCD.
709 71         115 my ($x0);
710 71         114 while ($y != 0) {
711 179         189 $x0 = $x;
712 179         233 ($x, $y) = ($y, $x % $y);
713              
714             # Note $x0 = $x, $x = $y, $y= $x % $y Before the Swith
715 179 100 66     508 $x = 1, last if ($x0 > 99999999 or $x > 999999999) and int($x0 / $x) * $x + $y != $x0;
      100        
716              
717             # This is to see if the mod operater through up on us when dealing with
718             # large numbers. If it did set the gcd = 1 and quit.
719             }
720             }
721             }
722 71         110 return $x;
723             }
724              
725             sub _de_decimal {
726 3     3   5 my @frac = @_;
727 3         5 my @return;
728 3         5 my $big = _tag($SIZE, $_[2]);
729 3         3 my (@int_part, @decimal_part);
730 3         18 ($int_part[0], $decimal_part[0]) = $frac[0] =~ /(\d+)\.(\d+)/;
731 3         14 ($int_part[1], $decimal_part[1]) = $frac[1] =~ /(\d+)\.(\d+)/;
732 3         11 @decimal_part = sort { $a <=> $b } (length($decimal_part[0]), length($decimal_part[1]));
  3         10  
733 3         6 my $factor = 10 ** $decimal_part[1];
734 3         7 @frac = ($_[0] * $factor, $_[1] * $factor);
735 3         7 return @frac;
736             }
737              
738             sub _from_decimal {
739 13     13   19 my $decimal = shift; # the decimal (1.312671267127)
740 13 50       22 my $big = 'BIG' if ref($decimal);
741 13         95 my ($repeat); # flag to keep track if it is repeating or not
742             my ($sign);
743 13         0 my ($factor, $int_factor);
744 13         0 my ($factor2);
745 13         0 my ($whole_num, $whole_num_len);
746 13         0 my ($int_part); # integer part (1)
747 13         0 my ($decimal_part, $decimal_part_len); # decimal part (312671267127)
748 13         0 my ($decimal_part2); # decimal part - last bit \/ (312671267)
749 13         0 my ($pat, $pat_len); # repeating pat (1267)
750 13         0 my ($pat_lastb); # last bit of repeating pat (127)
751 13         0 my ($beg_part, $beg_part_len); # non-repeating part (3)
752 13         0 my ($other_part, $other_part_len); # repeating part (1267126712127)
753 13         0 my ($frac1, $frac2, $frac3);
754              
755 13         48 my $rnd_mode = $Math::BigFloat::rnd_mode; # to avoid problems with incon.
756 13         57 $Math::BigFloat::rnd_mode = 'trunc'; # rounding
757              
758 13         218 $decimal = "$decimal";
759 13         24 $decimal =~ s/\s//g;
760 13         30 ($sign, $int_part, $decimal_part) = $decimal =~ /([\+\-]?)\s*(\d*)\.(\d+)$/;
761 13         19 $sign .= '1';
762 13         14 $decimal_part_len = length($decimal_part);
763 13 100       24 $int_part = "" unless $int_part;
764 13         24 $factor = '1' . '0' x (length($decimal_part));
765 13 50       20 $factor = Math::BigFloat->new($factor) if $big;
766              
767             # Make it a BigFloat now to simplfy latter
768 13         16 $int_factor = '1' . '0' x (length($int_part));
769 13         17 $beg_part_len = 0;
770             OuterBlock:
771 13         26 while ($beg_part_len < $decimal_part_len) {
772 4         8 $beg_part = substr($decimal_part, 0, $beg_part_len);
773 4         5 $other_part = substr($decimal_part, $beg_part_len);
774 4         5 $other_part_len = length($other_part);
775 4         4 my $i;
776 4         21 for ($i = 1; $i < ($other_part_len / 2 + 1); $i++) {
777 4         7 $pat = substr($other_part, 0, $i);
778 4         5 $pat_len = $i;
779 4         7 local $_ = $other_part;
780 4         5 $repeat = undef;
781 4         4 while (1) {
782 21         231 ($_) = /^$pat(.*)/;
783 21         36 my $length = length($_);
784              
785 21 100       36 if ($length <= $pat_len) {
786 4 50       7 last unless $length;
787 4         7 $pat_lastb = substr($pat, 0, $length);
788 4 100       10 $repeat = 1, last OuterBlock if $pat_lastb eq $_;
789 2 50       7 if ($pat_lastb eq $_ - 1) {
790              
791             # this is needed to see if it really is the repeating fracton
792             # we intented it to be. If we don't do this 1.1212 would become
793             # 1120/999 = 1.1211211211.
794             # The first three lines converts it to a fraction and the
795             # rests tests it to the actual repeating decimal/
796             # The NO_REDUCE flag is their to save time as reducing large
797             # fraction can take a bit of time which is unnecessary as we will
798             # be converting it to a decimal.
799 2         20 $decimal_part2 = substr($decimal_part, 0, $decimal_part_len - length($pat_lastb));
800 2         6 $factor2 = '1' . '0' x (length($decimal_part2));
801 2         20 $frac1 = Math::FractionManip->new('0' . $beg_part, 1 . 0 x $beg_part_len, 'NO_REDUCE', $big);
802 2         9 $frac2 = Math::FractionManip->new('0' . $pat, 9 x $pat_len . 0 x $beg_part_len, 'NO_REDUCE', $big);
803 2         9 $frac3 = $frac1 + $frac2;
804 2         6 my $what_i_get = $frac3->decimal;
805 2         10 my $places = length($what_i_get);
806 2 50       9 my $decimal_p_tmp = $decimal_part2 if not $big;
807 2 50       4 $decimal_p_tmp = Math::BigFloat->new($decimal_part2) if $big;
808 2         10 my $what_i_should_get = (($decimal_p_tmp) / $factor2) . "$pat" x ($places);
809              
810             # The rest of this is doing nothing more but trying to compare
811             # the what_i_get and what_i_should_get but becuse the stupid
812             # BigFloat module is so pragmentic all this hopla is nessary
813 2 50       10 $what_i_should_get = Math::BigFloat->new($what_i_should_get) if $big;
814 2 50       5 $what_i_should_get = $what_i_should_get->fround(length($what_i_get) - 1) if $big;
815 2 50       13 $what_i_should_get = Math::BigFloat->new($what_i_should_get) if $big;
816             # ^^ Needed because the fround method does not return a BigFloat object!
817              
818 2 50       5 my $pass = "$what_i_get" eq "$what_i_should_get" if $big;
819 2 50       7 $pass = $what_i_get == $what_i_should_get if not $big;
820 2 50       9 $repeat = 1, last OuterBlock if ($pass);
821             }
822             }
823             }
824             }
825 0         0 $beg_part_len++;
826             }
827 13 100       22 if ($repeat) {
828 4         15 $frac1 = Math::FractionManip->new('0' . $beg_part, 1 . 0 x $beg_part_len, $big);
829 4         13 $frac2 = Math::FractionManip->new('0' . $pat, 9 x $pat_len . 0 x $beg_part_len, $big);
830 4 50       9 $int_part = Math::FractionManip->new('0' . $int_part, 1, 'BIG') if $big;
831 4         9 $frac3 = $sign * ($int_part + $frac1 + $frac2);
832 4         9 return @{ $frac3->{frac} };
  4         19  
833             }
834             else {
835 9         33 return ($decimal * $factor, $factor, $big);
836             }
837 0           $Math::BigFloat::rnd_mode = $rnd_mode; # set it back to what it was.
838             }
839              
840             1;
841              
842             __END__