File Coverage

blib/lib/Number/Fraction.pm
Criterion Covered Total %
statement 119 202 58.9
branch 63 104 60.5
condition 0 2 0.0
subroutine 25 43 58.1
pod 22 22 100.0
total 229 373 61.3


line stmt bran cond sub pod time code
1             =encoding utf8
2              
3             =head1 NAME
4              
5             Number::Fraction - Perl extension to model fractions
6              
7             =head1 SYNOPSIS
8              
9             use Number::Fraction;
10              
11             my $f1 = Number::Fraction->new(1, 2);
12             my $f2 = Number::Fraction->new('1/2');
13             my $f3 = Number::Fraction->new($f1); # clone
14             my $f4 = Number::Fraction->new; # 0/1
15              
16             or
17              
18             use Number::Fraction ':constants';
19              
20             my $f1 = '1/2';
21             my $f2 = $f1;
22              
23             my $one = $f1 + $f2;
24             my $half = $one - $f1;
25             print $half; # prints '1/2'
26              
27             or some famous examples from Ovid or the perldoc
28              
29             use Number::Fraction ':constants';
30              
31             print '0.1' + '0.2' - '0.3';
32             # except for perl6, this is the usual suspect 5.55111512312578e-17
33             # times the mass of the sun, this would be the size of Mount Everest
34             # just a small rounding difference
35              
36             my $f1 = Number::Fraction->new(-6.725);
37             my $f2 = Number::Fraction->new( 0.025);
38             print int $f1/$f2;
39             # the correct -269, no internal -268.99999999999994315658
40              
41             and as of the lates release with unicode support
42              
43             my $f1 = Number::Fraction->new('3½');
44             my $f2 = Number::Fraction->new(4.33);
45              
46             my $f0 = $f1 * $f2;
47              
48             print $f0->to_simple; # 15⅙
49              
50             and for those who love pie
51              
52             print '3.14159265359'->nearest(1 .. 10)->to_unicode_mixed # 3¹⁄₇
53              
54             print '3.14159265359'->nearest(1 .. 1000)->to_unicode_string # ³⁵⁵⁄₁₁₃
55              
56             =head1 ABSTRACT
57              
58             Number::Fraction is a Perl module which allows you to work with fractions
59             in your Perl programs.
60              
61             =head1 DESCRIPTION
62              
63             Number::Fraction allows you to work with fractions (i.e. rational
64             numbers) in your Perl programs in a very natural way.
65              
66             It was originally written as a demonstration of the techniques of
67             overloading.
68              
69             If you use the module in your program in the usual way
70              
71             use Number::Fraction;
72              
73             you can then create fraction objects using Cnew> in
74             a number of ways.
75              
76             my $f1 = Number::Fraction->new(1, 2);
77              
78             creates a fraction with a numerator of 1 and a denominator of 2.
79              
80             my $fm = Number::Fraction->new(1, 2, 3);
81              
82             creates a fraction from an integer of 1, a numerator of 2 and a denominator
83             of 3; which results in a fraction of 5/3 since fractions are normalised.
84              
85             my $f2 = Number::Fraction->new('1/2');
86              
87             does the same thing but from a string constant.
88              
89             my $f3 = Number::Fraction->new($f1);
90              
91             makes C<$f3> a copy of C<$f1>
92              
93             my $f4 = Number::Fraction->new; # 0/1
94              
95             creates a fraction with a denominator of 0 and a numerator of 1.
96              
97             If you use the alterative syntax of
98              
99             use Number::Fraction ':constants';
100              
101             then Number::Fraction will automatically create fraction objects from
102             string constants in your program. Any time your program contains a
103             string constant of the form C<\d+/\d+> then that will be automatically
104             replaced with the equivalent fraction object. For example
105              
106             my $f1 = '1/2';
107              
108             Having created fraction objects you can manipulate them using most of the
109             normal mathematical operations.
110              
111             my $one = $f1 + $f2;
112             my $half = $one - $f1;
113              
114             Additionally, whenever a fraction object is evaluated in a string
115             context, it will return a string in the format x/y. When a fraction
116             object is evaluated in a numerical context, it will return a floating
117             point representation of its value.
118              
119             Fraction objects will always "normalise" themselves. That is, if you
120             create a fraction of '2/4', it will silently be converted to '1/2'.
121              
122             =head2 Mixed Fractions and Unicode Support
123              
124             Since version 3.0 the interpretation of strings and constants has been
125             enriched with a few features for mixed fractions and Unicode characters.
126              
127             Number::Fraction now recognises a more Perlish way of entering mixed
128             fractions which consist of an integer-part and a fraction in the form of
129             C<\d+_\d+/\d+>. For example
130              
131             my $mixed = '2_3/4'; # two and three fourths, stored as 11/4
132              
133             or
134              
135             my $simple = '2½'; # two and a half, stored as 5/2
136              
137             Mixed fractions, either in Perl notation or with Unicode fractions can
138             be negative, prepending it with a minus-sign.
139              
140             my $negative = '-⅛'; # minus one eighth
141              
142             =head2 Experimental Support for Exponentiation
143              
144             Version 1.13 of Number::Fraction adds experimental support for exponentiation
145             operations. Version 3 has extended support and returns a Number::Fraction
146              
147             It does a lot of cheating, but can give very useful results. And for now will
148             try to make a real number into a Number::Fraction if that real does not have a
149             power of ten component (like 1.234e45, thes numbers will simply fail). Such that
150              
151             ('5⅞' ** '1¼') ** '⅘'
152              
153             will produce stil the right fraction!
154              
155             In a future version, I might use automatic rounding to a optional accuracy, so
156             that it also works for less forged examples as the above. One could still use
157             C to find the nearest fraction to the result of the previous
158             computation.
159              
160             For example:
161              
162             '1/2' ** 2 # Returns a Number::Fraction ('1/4')
163             '2/1' ** '2/1' Returns a Number::Fraction ('4/1')
164             '2/1' ** '1/2' Returns a real number (1.414213)
165             0.5 ** '2/1' Returns a Number::Fraction ('1/4')
166             0.25 ** '1/2' Returns a Number::Fraction ('1/2')
167              
168             =head2 Version 3: Now With Added Moo
169              
170             Version 3 of Number::Fraction has been reimplemented using Moo. You should
171             see very little difference in the way that the class works. The only difference
172             I can see is that C used to return C if it couldn't create a valid
173             object from its arguments, it now dies. If you aren't sure of the values that
174             are being passed into the constructor, then you'll want to call it within an
175             C block (or using something equivalent like L).
176              
177             =head1 METHODS
178              
179             =cut
180              
181             package Number::Fraction;
182              
183 14     14   921320 use 5.006;
  14         174  
184 14     14   101 use strict;
  14         27  
  14         300  
185 14     14   65 use warnings;
  14         27  
  14         365  
186              
187 14     14   78 use Carp;
  14         60  
  14         982  
188 14     14   8421 use Moo;
  14         165888  
  14         73  
189 14     14   29683 use MooX::Types::MooseLike::Base qw/Int/;
  14         96418  
  14         2066  
190              
191             our $VERSION = '3.0.2';
192              
193             my $_mixed = 0;
194              
195             our $MIXED_SEP = "\N{U+00A0}"; # NO-BREAK SPACE
196              
197             use overload
198 14         95 q("") => 'to_string',
199             '0+' => 'to_num',
200             '+' => 'add',
201             '*' => 'mult',
202             '-' => 'subtract',
203             '/' => 'div',
204             '**' => 'exp',
205             'abs' => 'abs',
206             '<' => '_frac_lt',
207             '>' => '_frac_gt',
208             '<=>' => '_frac_cmp',
209 14     14   16810 fallback => 1;
  14         13802  
210              
211             my %_const_handlers = (
212             q => sub {
213             my $f = eval { __PACKAGE__->new($_[0]) };
214             return $_[1] if $@;
215             return $f;
216             }
217             );
218              
219             =head2 import
220              
221             Called when module is Cd. Use to optionally install constant
222             handler.
223              
224             =cut
225              
226             sub import {
227 15     15   151 my %args = map { $_ => 1 } @_;
  26         115  
228 15         51 $_mixed = exists $args{':mixed'};
229 15 100       7048 overload::constant %_const_handlers if $args{':constants'};
230             }
231              
232             =head2 unimport
233              
234             Be a good citizen and uninstall constant handler when caller uses
235             C.
236              
237             =cut
238              
239             sub unimport {
240 1     1   16 overload::remove_constant(q => undef);
241 1         63 $_mixed = undef;
242             }
243              
244             has num => (
245             is => 'rw',
246             isa => Int,
247             );
248              
249             has den => (
250             is => 'rw',
251             isa => Int,
252             );
253              
254             =head2 BUILDARGS
255              
256             Parameter massager for Number::Fraction object. Takes the following kinds of
257             parameters:
258              
259             =over 4
260              
261             =item *
262              
263             A single Number::Fraction object which is cloned.
264              
265             =item *
266              
267             A string in the form 'x/y' where x and y are integers. x is used as the
268             numerator and y is used as the denominator of the new object.
269              
270             A string in the form 'a_b/c' where a,b and c are integers.
271             The numerator will be equal to a*c+b!
272             and c is used as the denominator of the new object.
273              
274             =item *
275              
276             Three integers which are used as the integer, numerator and denominator of the
277             new object.
278              
279             In order for this to work in version 2.x,
280             one needs to enable 'mixed' fractions:
281              
282             use Number::Fractions ':mixed';
283              
284             This will be the default behaviour in version 3.x;
285             when not enabled in version 2.x it will omit a warning to revise your code.
286              
287             =item *
288              
289             Two integers which are used as the numerator and denominator of the
290             new object.
291              
292             =item *
293              
294             A single integer which is used as the numerator of the the new object.
295             The denominator is set to 1.
296              
297             =item *
298              
299             No arguments, in which case a numerator of 0 and a denominator of 1
300             are used.
301              
302             =item *
303              
304             Note
305              
306             As of version 2.1 it no longer allows for an array of four or more integer.
307             Before then, it would simply pass in the first two integers. Version 2.1 allows
308             for three integers (when using C<:mixed>) and issues a warning when more then
309             two parameters are passed.
310             Starting with version 3, it will die as it is seen as an error to pass invalid
311             input.
312              
313             =back
314              
315             Dies if a Number::Fraction object can't be created.
316              
317             =cut
318              
319             our @_vulgar_fractions = (
320             {regexp=> qr|^(?-?)(?[0-9]+)?\N{U+00BC}\z|, num=>1, den=>4},
321             {regexp=> qr|^(?-?)(?[0-9]+)?\N{U+00BD}\z|, num=>1, den=>2},
322             {regexp=> qr|^(?-?)(?[0-9]+)?\N{U+00BE}\z|, num=>3, den=>4},
323             {regexp=> qr|^(?-?)(?[0-9]+)?\N{U+2153}\z|, num=>1, den=>3},
324             {regexp=> qr|^(?-?)(?[0-9]+)?\N{U+2154}\z|, num=>2, den=>3},
325             {regexp=> qr|^(?-?)(?[0-9]+)?\N{U+2155}\z|, num=>1, den=>5},
326             {regexp=> qr|^(?-?)(?[0-9]+)?\N{U+2156}\z|, num=>2, den=>5},
327             {regexp=> qr|^(?-?)(?[0-9]+)?\N{U+2157}\z|, num=>3, den=>5},
328             {regexp=> qr|^(?-?)(?[0-9]+)?\N{U+2158}\z|, num=>4, den=>5},
329             {regexp=> qr|^(?-?)(?[0-9]+)?\N{U+2159}\z|, num=>1, den=>6},
330             {regexp=> qr|^(?-?)(?[0-9]+)?\N{U+215A}\z|, num=>5, den=>6},
331             {regexp=> qr|^(?-?)(?[0-9]+)?\N{U+215B}\z|, num=>1, den=>8},
332             {regexp=> qr|^(?-?)(?[0-9]+)?\N{U+215C}\z|, num=>3, den=>8},
333             {regexp=> qr|^(?-?)(?[0-9]+)?\N{U+215D}\z|, num=>5, den=>8},
334             {regexp=> qr|^(?-?)(?[0-9]+)?\N{U+215E}\z|, num=>7, den=>8},
335             );
336              
337             our %_vulgar_codepoints = (
338             '1/4' => "\N{U+00BC}",
339             '1/2' => "\N{U+00BD}",
340             '3/4' => "\N{U+00BE}",
341             '1/3' => "\N{U+2153}",
342             '2/3' => "\N{U+2154}",
343             '1/5' => "\N{U+2155}",
344             '2/5' => "\N{U+2156}",
345             '3/5' => "\N{U+2157}",
346             '4/5' => "\N{U+2158}",
347             '1/6' => "\N{U+2159}",
348             '5/6' => "\N{U+215A}",
349             '1/8' => "\N{U+215B}",
350             '3/8' => "\N{U+215C}",
351             '5/8' => "\N{U+215D}",
352             '7/8' => "\N{U+215E}",
353             );
354              
355             around BUILDARGS => sub {
356             my $orig = shift;
357             my $class = shift;
358             if (@_ > 3) {
359             carp "Revise your code: too many arguments will raise an exception";
360             }
361             if (@_ == 3) {
362             if ( $_mixed ) {
363             die "integer, numerator and denominator need to be integers"
364             unless $_[0] =~ /^-?[0-9]+\z/
365             and $_[1] =~ /^-?[0-9]+\z/
366             and $_[2] =~ /^-?[0-9]+\z/;
367              
368             return $class->$orig({ num => $_[0] * $_[2] + $_[1], den => $_[2] });
369             }
370             else {
371             carp "Revise your code: 3 arguments will become mixed-fraction feature!";
372             }
373             }
374             if (@_ >= 2) {
375             die "numerator and denominator both need to be integers"
376             unless $_[0] =~ /^-?[0-9]+\z/ and $_[1] =~ /^-?[0-9]+\z/;
377             # fix: regex string representation and the real number can be different
378             my $num = sprintf( "%.0f", $_[0]);
379             my $den = sprintf( "%.0f", $_[1]);
380             return $class->$orig({ num => $num, den => $den });
381             } elsif (@_ == 1) {
382             if (ref $_[0]) {
383             if (UNIVERSAL::isa($_[0], $class)) {
384             return $class->$orig({ num => $_[0]->{num}, den => $_[0]->{den} });
385             } else {
386             die "Can't make a $class from a ", ref $_[0];
387             }
388             }
389              
390             for (@_vulgar_fractions) { # provides $_->{num} and $_->{den}
391             if ($_[0] =~ m/$_->{regexp}/ ) {
392             return $class->$orig({
393 14     14   28616 num => (defined $+{int} ? $+{int} : 0) * $_->{den} + $_->{num},
  14         6336  
  14         43517  
394             den => ($+{sign} eq '-') ? $_->{den} * -1 : $_->{den},
395             }
396             );
397             }
398             }
399              
400             # check for unicode mixed super/sub scripted strings
401             if ($_[0] =~ m|
402             ^
403             (?-?)
404             (?[0-9]+)?
405             (?[\N{U+2070}\N{U+00B9}\N{U+00B2}\N{U+00B3}\N{U+2074}-\N{U+207B}]+)
406             \N{U+2044} # FRACTION SLASH
407             (?[\N{U+2080}-\N{U+208B}]+)
408             \z
409             |x ) {
410             my $num = _sup_to_basic($+{num});
411             my $den = _sub_to_basic($+{den});
412             return $class->$orig({
413             num => (defined $+{int} ? $+{int} : 0) * $den + $num,
414             den => ($+{sign} eq '-') ? $den * -1 : $den,
415             }
416             );
417             }
418              
419             # check for floating point
420             elsif ($_[0] =~ m|
421             ^
422             (?-?)
423             (?[0-9]+)?
424             [.,] # yep, lets do bdecimal point or comma
425             (?[0-9]+)
426             \z
427             |x ) {
428             my $num = $+{num};
429             my $den = 10 ** length($+{num});
430             return $class->$orig({
431             num => (defined $+{int} ? $+{int} : 0) * $den + $num,
432             den => ($+{sign} eq '-') ? $den * -1 : $den,
433             }
434             );
435             }
436              
437             if ($_[0] =~ m|^(-?)([0-9]+)[_ \N{U+00A0}]([0-9]+)/([0-9]+)\z|) {
438             return $class->$orig({
439             num => $2 * $4 + $3,
440             den=> ($1 eq '-') ? $4 * -1 : $4}
441             );
442             } elsif ($_[0] =~ m|^(-?[0-9]+)(?:/(-?[0-9]+))?\z|) {
443             return $class->$orig({ num => $1, den => ( defined $2 ? $2 : 1) });
444             } else {
445             die "Can't make fraction out of $_[0]\n";
446             }
447             } else {
448             return $class->$orig({ num => 0, den => 1 });
449             }
450             };
451              
452             =head2 BUILD
453              
454             Object initialiser for Number::Fraction. Ensures that fractions are in a
455             normalised format.
456              
457             =cut
458              
459             sub BUILD {
460 210     210 1 22190 my $self = shift;
461 210 100       673 die "Denominator can't be equal to zero" if $self->{den} == 0;
462 208         516 $self->_normalise;
463             }
464              
465             sub _normalise {
466 208     208   294 my $self = shift;
467              
468 208         468 my $hcf = _hcf($self->{num}, $self->{den});
469              
470 208         526 for (qw/num den/) {
471 416         858 $self->{$_} /= $hcf;
472             }
473              
474 208 100       1189 if ($self->{den} < 0) {
475 5         17 for (qw/num den/) {
476 10         41 $self->{$_} *= -1;
477             }
478             }
479             }
480              
481             =head2 to_string
482              
483             Returns a string representation of the fraction in the form
484             "numerator/denominator".
485              
486             =cut
487              
488             sub to_string {
489 120     120 1 9637 my $self = shift;
490              
491 120 100       544 return $self->{num} if $self->{den} == 1;
492 97         2398 return $self->{num} . '/' . $self->{den};
493             }
494              
495              
496             =head2 to_mixed
497              
498             Returns a string representation of the fraction in the form
499             "integer numerator/denominator".
500              
501             =cut
502              
503             sub to_mixed {
504 0     0 1 0 my $self = shift;
505              
506 0 0       0 return $self->{num} if $self->{den} == 1;
507              
508 0 0       0 my $sgn = $self->{num} * $self->{den} < 0 ? '-' : '';
509 0         0 my $abs = $self->abs;
510 0         0 my $int = int($abs->{num} / $abs->{den});
511 0 0       0 $int = $int ? $int . $MIXED_SEP : '';
512              
513 0         0 return $sgn . $int . $abs->fract->to_string;
514             }
515              
516              
517             =head2 to_unicode_string
518              
519             Returns a string representation of the fraction in the form
520             "superscript numerator / subscript denominator".
521             A Unicode 'FRACTION SLASH' is used instead of a normal slash.
522              
523             =cut
524              
525             sub to_unicode_string {
526 0     0 1 0 return _to_unicode(shift->to_string);
527             }
528              
529              
530             =head2 to_unicode_mixed
531              
532             Returns a string representation of the fraction in the form
533             "integer superscript numerator / subscript denominator".
534             A Unicode 'FRACTION SLASH' is used instead of a normal slash.
535              
536             =cut
537              
538             sub to_unicode_mixed {
539 0     0 1 0 return _to_unicode(shift->to_mixed);
540             }
541              
542              
543             =head2 to_halfs
544              
545             =head2 to_quarters
546              
547             =head2 to_eights
548              
549             =head2 to_thirds
550              
551             =head2 to_sixths
552              
553             =head2 to_fifths
554              
555             Returns a string representation as a mixed fraction, rounded to the nearest
556             possible 'half', 'quarter' ... and so on.
557              
558             =cut
559              
560 0     0 1 0 sub to_halfs { return shift->to_simple(2) }
561              
562 0     0 1 0 sub to_thirds { return shift->to_simple(3) }
563              
564 0     0 1 0 sub to_quarters { return shift->to_simple(4) }
565              
566 0     0 1 0 sub to_fifths { return shift->to_simple(5) }
567              
568 0     0 1 0 sub to_sixths { return shift->to_simple(6) }
569              
570 0     0 1 0 sub to_eights { return shift->to_simple(8) }
571              
572             =head2 to_simple
573              
574             Returns a string representation as a mixed fraction, rounded to the nearest
575             possible to any of the above mentioned standard fractions. NB ⅐, ⅑ or ⅒ are not
576             being used.
577              
578             Optionally, one can pass in a list of well-known denominators (2, 3, 4, 5, 6, 8)
579             to choose wich fractions can be used.
580              
581             =cut
582              
583             sub to_simple {
584 0     0 1 0 my $self = shift;
585 0         0 my @denominators = @_;
586              
587 0 0       0 @denominators = ( 2, 3, 4, 5, 6, 8) unless @denominators;
588              
589 0         0 my $near = $self->nearest(@denominators);
590              
591 0 0       0 return $near->{num} if $near->{den} == 1;
592              
593 0 0       0 my $sgn = $near->{num} * $near->{den} < 0 ? '-' : '';
594 0         0 my $abs = $near->abs;
595 0         0 my $key = $abs->fract->to_string;
596 0         0 my $frc = $_vulgar_codepoints{$key};
597 0 0       0 unless ( $frc ) {
598 0         0 carp "not a recognize unicode fraction symbol [$key]\n";
599 0         0 return $near->to_unicode_mixed;
600             }
601 0   0     0 my $int = int($abs->{num} / $abs->{den}) || '';
602              
603 0         0 return $sgn . $int . $frc;
604             }
605              
606             =head2 to_num
607              
608             Returns a numeric representation of the fraction by calculating the sum
609             numerator/denominator. Normal caveats about the precision of floating
610             point numbers apply.
611              
612             =cut
613              
614             sub to_num {
615 21     21 1 41 my $self = shift;
616              
617 21         140 return $self->{num} / $self->{den};
618             }
619              
620             =head2 add
621              
622             Add a value to a fraction object and return a new object representing the
623             result of the calculation.
624              
625             The first parameter is a fraction object. The second parameter is either
626             another fraction object or a number.
627              
628             =cut
629              
630             sub add {
631 12     12 1 171 my ($l, $r, $rev) = @_;
632              
633 12 100       31 if (ref $r) {
634 10 100       45 if (UNIVERSAL::isa($r, ref $l)) {
635             return (ref $l)->new($l->{num} * $r->{den} + $r->{num} * $l->{den},
636 9         221 $r->{den} * $l->{den});
637             } else {
638 1         163 croak "Can't add a ", ref $l, " to a ", ref $l;
639             }
640             } else {
641 2 100       18 if ($r =~ /^[-+]?\d+$/) {
642 1         25 return $l + (ref $l)->new($r, 1);
643             } else {
644 1         4 return $l->to_num + $r;
645             }
646             }
647             }
648              
649             =head2 mult
650              
651             Multiply a fraction object by a value and return a new object representing
652             the result of the calculation.
653              
654             The first parameter is a fraction object. The second parameter is either
655             another fraction object or a number.
656              
657             =cut
658              
659             sub mult {
660 12     12 1 179 my ($l, $r, $rev) = @_;
661              
662 12 100       33 if (ref $r) {
663 10 100       40 if (UNIVERSAL::isa($r, ref $l)) {
664             return (ref $l)->new($l->{num} * $r->{num},
665 9         225 $l->{den} * $r->{den});
666             } else {
667 1         186 croak "Can't multiply a ", ref $l, " by a ", ref $l;
668             }
669             } else {
670 2 100       19 if ($r =~ /^[-+]?\d+$/) {
671 1         25 return $l * (ref $l)->new($r, 1);
672             } else {
673 1         5 return $l->to_num * $r;
674             }
675             }
676             }
677              
678             =head2 subtract
679              
680             Subtract a value from a fraction object and return a new object representing
681             the result of the calculation.
682              
683             The first parameter is a fraction object. The second parameter is either
684             another fraction object or a number.
685              
686             =cut
687              
688             sub subtract {
689 15     15 1 183 my ($l, $r, $rev) = @_;
690              
691 15 100       36 if (ref $r) {
692 11 100       46 if (UNIVERSAL::isa($r, ref $l)) {
693             return (ref $l)->new($l->{num} * $r->{den} - $r->{num} * $l->{den},
694 10         248 $r->{den} * $l->{den});
695             } else {
696 1         207 croak "Can't subtract a ", ref $l, " from a ", ref $l;
697             }
698             } else {
699 4 100       39 if ($r =~ /^[-+]?\d+$/) {
700 2         49 $r = (ref $l)->new($r, 1);
701 2 100       13 return $rev ? $r - $l : $l - $r;
702             } else {
703 2 100       10 return $rev ? $r - $l->to_num : $l->to_num - $r;
704             }
705             }
706             }
707              
708             =head2 div
709              
710             Divide a fraction object by a value and return a new object representing
711             the result of the calculation.
712              
713             The first parameter is a fraction object. The second parameter is either
714             another fraction object or a number.
715              
716             =cut
717              
718             sub div {
719 16     16 1 457 my ($l, $r, $rev) = @_;
720              
721 16 100       48 if (ref $r) {
722 12 100       49 if (UNIVERSAL::isa($r, ref $l)) {
723 11 100       43 die "FATAL ERROR: Division by zero" if $r->{num} == 0;
724             return (ref $l)->new($l->{num} * $r->{den},
725 10         249 $l->{den} * $r->{num});
726             } else {
727 1         180 croak "Can't divide a ", ref $l, " by a ", ref $l;
728             }
729             } else {
730 4 100       34 if ($r =~ /^[-+]?\d+$/) {
731 2         47 $r = (ref $l)->new($r, 1);
732 2 100       16 return $rev ? $r / $l : $l / $r;
733             } else {
734 2 100       11 return $rev ? $r / $l->to_num : $l->to_num / $r;
735             }
736             }
737             }
738              
739             =head2 exp
740              
741             Raise a Number::Fraction object to a power.
742              
743             The first argument is a number fraction object. The second argument is
744             another Number::Fraction object or a number. It will try to compute another new
745             Number::Fraction object. This may fail if either numerator or denominator of the
746             new one are getting too big. In such case the value returned is a real number.
747              
748             =cut
749              
750             sub exp {
751 10     10 1 178 my ($l, $r, $rev) = @_;
752              
753 10 100       25 if ($rev) {
754 2         5 my $f = eval {
755 2         44 (ref $l)->new($r)
756             };
757 2 50       14 return $f ** $l unless $@;
758 0         0 return $r ** $l->to_num;
759             }
760              
761 8 100       72 if (UNIVERSAL::isa($r, ref $l)) {
    50          
762 5 100       28 if ($r->{den} == 1) {
763 1         4 return $l ** $r->to_num;
764             } else {
765 4         19 return $l->to_num ** $r->to_num;
766             }
767             } elsif ($r =~ /^[-+]?\d+$/) {
768 3         82 return (ref $l)->new($l->{num} ** $r, $l->{den} ** $r);
769             } else {
770 0         0 croak "Can't raise $l to the power $r\n";
771             }
772              
773 0 0       0 my $expn = UNIVERSAL::isa($r, ref $l) ? $r->to_num : $r;
774 0         0 my $pure = eval {
775             # this is cheating, works when numerator and denominator look like integers
776 0         0 (ref $l)->new( $l->{num} ** $expn, $l->{den} ** $expn )
777             };
778 0 0       0 return $pure unless $@;
779 0         0 my $real = eval { $l->to_num ** $expn }; # real errors, like $expn is NaN
  0         0  
780 0 0       0 croak "Can't raise $l to the power $r\n" if $@;
781 0         0 my $fake = eval { (ref $l)->new($real) }; # overflow from int to float
  0         0  
782 0 0       0 return $fake unless $@;
783 0         0 return $real;
784             }
785              
786             =head2 abs
787              
788             Returns a copy of the given object with both the numerator and
789             denominator changed to positive values.
790              
791             =cut
792              
793             sub abs {
794 6     6 1 150 my $self = shift;
795              
796 6         160 return (ref $self)->new(abs($self->{num}), abs($self->{den}));
797             }
798              
799             =head2 fract
800              
801             Returns the fraction part of a Number::Fraction object as a new
802             Number::Fraction object.
803              
804             =cut
805              
806             sub fract {
807 0     0 1 0 my $self = shift;
808              
809 0         0 my $num = ($self->{num} <=> 0) * (CORE::abs($self->{num}) % $self->{den});
810 0         0 return (ref $self)->new($num, $self->{den});
811             }
812              
813              
814             =head2 int
815              
816             Returns the integer part of a Number::Fraction object as a new
817             Number::Fraction object.
818              
819             =cut
820              
821             sub int {
822 0     0 1 0 my $self = shift;
823              
824 0         0 return (ref $self)->new(CORE::int($self->{num}/$self->{den}), 1);
825             }
826              
827             # _frac_lt does the 'right thing' instead of numifying the fraction, it does
828             # what basic arithmetic dictates, make the denominators the same!
829             #
830             # one could forge fractions that would lead to bad floating points
831              
832             sub _frac_lt {
833 59     59   142 my ($l, $r, $rev ) = @_;
834 59         114 my ($l_cnt, $r_cnt);
835 59 100       292 if (UNIVERSAL::isa($r, ref $l)) {
836 18         57 $l_cnt = $l->{num} * CORE::abs $r->{den} * ($l->{den} <=> 0);
837 18         34 $r_cnt = $r->{num} * CORE::abs $l->{den} * ($r->{den} <=> 0);
838             } else {
839 41         121 $l_cnt = $l->{num} * 1 * ($l->{den} <=> 0);
840 41         135 $r_cnt = $r * CORE::abs $l->{den} * ($r <=> 0);
841             }
842 59 50       270 return ( $l_cnt < $r_cnt ) unless $rev;
843 0         0 return ( $l_cnt >= $r_cnt );
844             }
845              
846             sub _frac_gt {
847 61     61   270 my ($l, $r, $rev ) = @_;
848 61         97 my ($l_cnt, $r_cnt);
849 61 100       195 if (UNIVERSAL::isa($r, ref $l)) {
850 20         54 $l_cnt = $l->{num} * CORE::abs $r->{den} * ($l->{den} <=> 0);
851 20         37 $r_cnt = $r->{num} * CORE::abs $l->{den} * ($r->{den} <=> 0);
852             } else {
853 41         94 $l_cnt = $l->{num} * 1 * ($l->{den} <=> 0);
854 41         82 $r_cnt = $r * CORE::abs $l->{den} * ($r <=> 0);
855             }
856 61 50       391 return ( $l_cnt > $r_cnt ) unless $rev;
857 0         0 return ( $l_cnt <= $r_cnt );
858             }
859              
860             sub _frac_cmp {
861 55 50   55   6701 return -1 if _frac_lt(@_);
862 55 100       145 return +1 if _frac_gt(@_);
863 41         6819 return 0;
864             } # _frac_cmp
865              
866             =head2 nearest
867              
868             Takes a list of integers and creates a new Number::Fraction object nearest to
869             a fraction with a deniminator from that list.
870              
871             =cut
872              
873             sub nearest {
874 0     0 1 0 my $self = shift;
875 0 0       0 return $self if $self->{den} ==1;
876 0         0 my @denominators = @_;
877 0 0       0 die "Missing list of denominators" if not @denominators;
878              
879 0         0 my $frc = (ref $self)->new;
880 0         0 foreach my $den ( @denominators ) {
881 0         0 my $num = sprintf( "%.0f", $self->mult($den) );
882 0 0       0 if ( (
883             CORE::abs( $self->{num}*$frc->{den} - $frc->{num}*$self->{den} ) * $den
884             -
885             CORE::abs( $self->{num}*$den - $num*$self->{den} ) * $frc->{den}
886             ) > 0 ) {
887 0         0 $frc->{num} = $num;
888 0         0 $frc->{den} = $den;
889             }
890             }
891 0         0 return $frc;
892             }
893              
894             sub _hcf {
895 208     208   416 my ($x, $y) = @_;
896              
897 208 100       636 ($x, $y) = ($y, $x) if $y > $x;
898              
899 208 100       441 return $x if $x == $y;
900              
901 199         445 while ($y) {
902 218         577 ($x, $y) = ($y, $x % $y);
903             }
904              
905 199         540 return $x;
906             }
907              
908             # translating back and forth between basic digits and sup- or sub-script
909              
910             sub _sup_to_basic {
911 0     0     $_ = shift;
912 14     14   8997 tr/\N{U+2070}\N{U+00B9}\N{U+00B2}\N{U+00B3}\N{U+2074}-\N{U+207E}/0-9+\-=()/;
  14         221  
  14         318  
  0            
913 0           return $_;
914             }
915              
916             sub _sub_to_basic {
917 0     0     $_ = shift;
918 0           tr/\N{U+2080}-\N{U+208E}/0-9+\-=()/;
919 0           return $_;
920             }
921              
922             sub _basic_to_sup {
923 0     0     $_ = shift;
924 0           tr/0123456789+\-=()/\N{U+2070}\N{U+00B9}\N{U+00B2}\N{U+00B3}\N{U+2074}\N{U+2075}\N{U+2076}\N{U+2077}\N{U+2078}\N{U+2079}\N{U+207A}\N{U+207B}\N{U+207C}\N{U+207D}\N{U+207E}/;
925 0           return $_;
926             }
927              
928             sub _basic_to_sub {
929 0     0     $_ = shift;
930 0           tr/0123456789+\-=()/\N{U+2080}\N{U+2081}\N{U+2082}\N{U+2083}\N{U+2084}\N{U+2085}\N{U+2086}\N{U+2087}\N{U+2088}\N{U+2089}\N{U+208A}\N{U+208B}\N{U+208C}\N{U+208D}\N{U+208E}/;
931 0           return $_;
932             }
933              
934             # turn a basic string into one using sup- and sub-script characters
935             sub _to_unicode {
936 0 0   0     if ($_[0] =~ m|^(?-?)(?\d+)/(?\d+)$|) {
937 0           my $num = _basic_to_sup($+{num});
938 0           my $den = _basic_to_sub($+{den});
939 0 0         return ($+{sign} ? "\N{U+207B}" : '') . $num . "\N{U+2044}" . $den;
940             }
941 0 0         if ($_[0] =~ m|^(?-?)(?\d+)$MIXED_SEP(?\d+)/(?\d+)$|) {
942 0           my $num = _basic_to_sup($+{num});
943 0           my $den = _basic_to_sub($+{den});
944 0           return $+{sign} . $+{int} . $num . "\N{U+2044}" . $den;
945             }
946 0 0         if ($_[0] =~ m|^(?-?)(?\d+)$|) {
947 0           return $+{sign} . $+{int}; # Darn, this is just what we got!
948             }
949 0           return;
950             }
951              
952             1;
953             __END__