File Coverage

blib/lib/Number/Fraction.pm
Criterion Covered Total %
statement 119 203 58.6
branch 63 104 60.5
condition 0 2 0.0
subroutine 25 44 56.8
pod 22 23 95.6
total 229 376 60.9


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 latest 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 still 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 forced 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   949630 use 5.010;
  14         163  
184 14     14   76 use strict;
  14         27  
  14         296  
185 14     14   63 use warnings;
  14         22  
  14         370  
186              
187 14     14   79 use Carp;
  14         58  
  14         1025  
188 14     14   8497 use Moo;
  14         169972  
  14         83  
189 14     14   30814 use MooX::Types::MooseLike::Base qw/Int/;
  14         97437  
  14         2215  
190              
191             our $VERSION = '3.0.4';
192              
193             my $_mixed = 0;
194              
195             our $MIXED_SEP = "\N{U+00A0}"; # NO-BREAK SPACE
196              
197             use overload
198 14         110 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   17580 fallback => 1;
  14         13729  
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   157 my %args = map { $_ => 1 } @_;
  26         109  
228 15         52 $_mixed = exists $args{':mixed'};
229 15 100       6896 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   12 overload::remove_constant(q => undef);
241 1         92 $_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             croak "Revise your code: too many arguments will raise an exception";
360             }
361             if (@_ == 3) {
362             if ( $_mixed ) {
363             croak "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             croak "Revise your code: 3 arguments is a mixed-fraction feature!";
372             }
373             }
374             if (@_ >= 2) {
375             croak "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             croak "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   29470 num => (defined $+{int} ? $+{int} : 0) * $_->{den} + $_->{num},
  14         6263  
  14         43369  
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             croak "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 22717 my $self = shift;
461 210 100       900 croak "Denominator can't be equal to zero" if $self->{den} == 0;
462 208         459 $self->_normalise;
463             }
464              
465             sub _normalise {
466 208     208   294 my $self = shift;
467              
468 208         514 my $hcf = _hcf($self->{num}, $self->{den});
469              
470 208         491 for (qw/num den/) {
471 416         848 $self->{$_} /= $hcf;
472             }
473              
474 208 100       1162 if ($self->{den} < 0) {
475 5         11 for (qw/num den/) {
476 10         43 $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 9696 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_eighths
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_eighths { return shift->to_simple(8) }
571              
572             # Typo retained for backwards compatibility
573 0     0 0 0 sub to_eights { return shift->to_eighths }
574              
575             =head2 to_simple
576              
577             Returns a string representation as a mixed fraction, rounded to the nearest
578             possible to any of the above mentioned standard fractions. NB ⅐, ⅑ or ⅒ are not
579             being used.
580              
581             Optionally, one can pass in a list of well-known denominators (2, 3, 4, 5, 6, 8)
582             to choose which fractions can be used.
583              
584             =cut
585              
586             sub to_simple {
587 0     0 1 0 my $self = shift;
588 0         0 my @denominators = @_;
589              
590 0 0       0 @denominators = ( 2, 3, 4, 5, 6, 8) unless @denominators;
591              
592 0         0 my $near = $self->nearest(@denominators);
593              
594 0 0       0 return $near->{num} if $near->{den} == 1;
595              
596 0 0       0 my $sgn = $near->{num} * $near->{den} < 0 ? '-' : '';
597 0         0 my $abs = $near->abs;
598 0         0 my $key = $abs->fract->to_string;
599 0         0 my $frc = $_vulgar_codepoints{$key};
600 0 0       0 unless ( $frc ) {
601 0         0 carp "not a recognised unicode fraction symbol [$key]\n";
602 0         0 return $near->to_unicode_mixed;
603             }
604 0   0     0 my $int = int($abs->{num} / $abs->{den}) || '';
605              
606 0         0 return $sgn . $int . $frc;
607             }
608              
609             =head2 to_num
610              
611             Returns a numeric representation of the fraction by calculating the sum
612             numerator/denominator. Normal caveats about the precision of floating
613             point numbers apply.
614              
615             =cut
616              
617             sub to_num {
618 21     21 1 42 my $self = shift;
619              
620 21         162 return $self->{num} / $self->{den};
621             }
622              
623             =head2 add
624              
625             Add a value to a fraction object and return a new object representing the
626             result of the calculation.
627              
628             The first parameter is a fraction object. The second parameter is either
629             another fraction object or a number.
630              
631             =cut
632              
633             sub add {
634 12     12 1 192 my ($l, $r, $rev) = @_;
635              
636 12 100       40 if (ref $r) {
637 10 100       58 if (UNIVERSAL::isa($r, ref $l)) {
638             return (ref $l)->new($l->{num} * $r->{den} + $r->{num} * $l->{den},
639 9         302 $r->{den} * $l->{den});
640             } else {
641 1         221 croak "Can't add a ", ref $l, " to a ", ref $l;
642             }
643             } else {
644 2 100       21 if ($r =~ /^[-+]?\d+$/) {
645 1         29 return $l + (ref $l)->new($r, 1);
646             } else {
647 1         6 return $l->to_num + $r;
648             }
649             }
650             }
651              
652             =head2 mult
653              
654             Multiply a fraction object by a value and return a new object representing
655             the result of the calculation.
656              
657             The first parameter is a fraction object. The second parameter is either
658             another fraction object or a number.
659              
660             =cut
661              
662             sub mult {
663 12     12 1 179 my ($l, $r, $rev) = @_;
664              
665 12 100       30 if (ref $r) {
666 10 100       43 if (UNIVERSAL::isa($r, ref $l)) {
667             return (ref $l)->new($l->{num} * $r->{num},
668 9         213 $l->{den} * $r->{den});
669             } else {
670 1         182 croak "Can't multiply a ", ref $l, " by a ", ref $l;
671             }
672             } else {
673 2 100       17 if ($r =~ /^[-+]?\d+$/) {
674 1         25 return $l * (ref $l)->new($r, 1);
675             } else {
676 1         5 return $l->to_num * $r;
677             }
678             }
679             }
680              
681             =head2 subtract
682              
683             Subtract a value from a fraction object and return a new object representing
684             the result of the calculation.
685              
686             The first parameter is a fraction object. The second parameter is either
687             another fraction object or a number.
688              
689             =cut
690              
691             sub subtract {
692 15     15 1 171 my ($l, $r, $rev) = @_;
693              
694 15 100       38 if (ref $r) {
695 11 100       46 if (UNIVERSAL::isa($r, ref $l)) {
696             return (ref $l)->new($l->{num} * $r->{den} - $r->{num} * $l->{den},
697 10         242 $r->{den} * $l->{den});
698             } else {
699 1         174 croak "Can't subtract a ", ref $l, " from a ", ref $l;
700             }
701             } else {
702 4 100       32 if ($r =~ /^[-+]?\d+$/) {
703 2         49 $r = (ref $l)->new($r, 1);
704 2 100       11 return $rev ? $r - $l : $l - $r;
705             } else {
706 2 100       24 return $rev ? $r - $l->to_num : $l->to_num - $r;
707             }
708             }
709             }
710              
711             =head2 div
712              
713             Divide a fraction object by a value and return a new object representing
714             the result of the calculation.
715              
716             The first parameter is a fraction object. The second parameter is either
717             another fraction object or a number.
718              
719             =cut
720              
721             sub div {
722 16     16 1 496 my ($l, $r, $rev) = @_;
723              
724 16 100       40 if (ref $r) {
725 12 100       49 if (UNIVERSAL::isa($r, ref $l)) {
726 11 100       46 die "FATAL ERROR: Division by zero" if $r->{num} == 0;
727             return (ref $l)->new($l->{num} * $r->{den},
728 10         228 $l->{den} * $r->{num});
729             } else {
730 1         165 croak "Can't divide a ", ref $l, " by a ", ref $l;
731             }
732             } else {
733 4 100       31 if ($r =~ /^[-+]?\d+$/) {
734 2         47 $r = (ref $l)->new($r, 1);
735 2 100       12 return $rev ? $r / $l : $l / $r;
736             } else {
737 2 100       11 return $rev ? $r / $l->to_num : $l->to_num / $r;
738             }
739             }
740             }
741              
742             =head2 exp
743              
744             Raise a Number::Fraction object to a power.
745              
746             The first argument is a number fraction object. The second argument is
747             another Number::Fraction object or a number. It will try to compute another new
748             Number::Fraction object. This may fail if either numerator or denominator of the
749             new one are getting too big. In such case the value returned is a real number.
750              
751             =cut
752              
753             sub exp {
754 10     10 1 252 my ($l, $r, $rev) = @_;
755              
756 10 100       25 if ($rev) {
757 2         4 my $f = eval {
758 2         44 (ref $l)->new($r)
759             };
760 2 50       16 return $f ** $l unless $@;
761 0         0 return $r ** $l->to_num;
762             }
763              
764 8 100       58 if (UNIVERSAL::isa($r, ref $l)) {
    50          
765 5 100       17 if ($r->{den} == 1) {
766 1         5 return $l ** $r->to_num;
767             } else {
768 4         27 return $l->to_num ** $r->to_num;
769             }
770             } elsif ($r =~ /^[-+]?\d+$/) {
771 3         89 return (ref $l)->new($l->{num} ** $r, $l->{den} ** $r);
772             } else {
773 0         0 croak "Can't raise $l to the power $r\n";
774             }
775              
776 0 0       0 my $expn = UNIVERSAL::isa($r, ref $l) ? $r->to_num : $r;
777 0         0 my $pure = eval {
778             # this is cheating, works when numerator and denominator look like integers
779 0         0 (ref $l)->new( $l->{num} ** $expn, $l->{den} ** $expn )
780             };
781 0 0       0 return $pure unless $@;
782 0         0 my $real = eval { $l->to_num ** $expn }; # real errors, like $expn is NaN
  0         0  
783 0 0       0 croak "Can't raise $l to the power $r\n" if $@;
784 0         0 my $fake = eval { (ref $l)->new($real) }; # overflow from int to float
  0         0  
785 0 0       0 return $fake unless $@;
786 0         0 return $real;
787             }
788              
789             =head2 abs
790              
791             Returns a copy of the given object with both the numerator and
792             denominator changed to positive values.
793              
794             =cut
795              
796             sub abs {
797 6     6 1 173 my $self = shift;
798              
799 6         163 return (ref $self)->new(abs($self->{num}), abs($self->{den}));
800             }
801              
802             =head2 fract
803              
804             Returns the fraction part of a Number::Fraction object as a new
805             Number::Fraction object.
806              
807             =cut
808              
809             sub fract {
810 0     0 1 0 my $self = shift;
811              
812 0         0 my $num = ($self->{num} <=> 0) * (CORE::abs($self->{num}) % $self->{den});
813 0         0 return (ref $self)->new($num, $self->{den});
814             }
815              
816              
817             =head2 int
818              
819             Returns the integer part of a Number::Fraction object as a new
820             Number::Fraction object.
821              
822             =cut
823              
824             sub int {
825 0     0 1 0 my $self = shift;
826              
827 0         0 return (ref $self)->new(CORE::int($self->{num}/$self->{den}), 1);
828             }
829              
830             # _frac_lt does the 'right thing' instead of numifying the fraction, it does
831             # what basic arithmetic dictates, make the denominators the same!
832             #
833             # one could forge fractions that would lead to bad floating points
834              
835             sub _frac_lt {
836 59     59   170 my ($l, $r, $rev ) = @_;
837 59         109 my ($l_cnt, $r_cnt);
838 59 100       247 if (UNIVERSAL::isa($r, ref $l)) {
839 18         51 $l_cnt = $l->{num} * CORE::abs $r->{den} * ($l->{den} <=> 0);
840 18         36 $r_cnt = $r->{num} * CORE::abs $l->{den} * ($r->{den} <=> 0);
841             } else {
842 41         137 $l_cnt = $l->{num} * 1 * ($l->{den} <=> 0);
843 41         125 $r_cnt = $r * CORE::abs $l->{den} * ($r <=> 0);
844             }
845 59 50       321 return ( $l_cnt < $r_cnt ) unless $rev;
846 0         0 return ( $l_cnt >= $r_cnt );
847             }
848              
849             sub _frac_gt {
850 61     61   264 my ($l, $r, $rev ) = @_;
851 61         98 my ($l_cnt, $r_cnt);
852 61 100       191 if (UNIVERSAL::isa($r, ref $l)) {
853 20         46 $l_cnt = $l->{num} * CORE::abs $r->{den} * ($l->{den} <=> 0);
854 20         35 $r_cnt = $r->{num} * CORE::abs $l->{den} * ($r->{den} <=> 0);
855             } else {
856 41         85 $l_cnt = $l->{num} * 1 * ($l->{den} <=> 0);
857 41         89 $r_cnt = $r * CORE::abs $l->{den} * ($r <=> 0);
858             }
859 61 50       392 return ( $l_cnt > $r_cnt ) unless $rev;
860 0         0 return ( $l_cnt <= $r_cnt );
861             }
862              
863             sub _frac_cmp {
864 55 50   55   6695 return -1 if _frac_lt(@_);
865 55 100       173 return +1 if _frac_gt(@_);
866 41         6985 return 0;
867             } # _frac_cmp
868              
869             =head2 nearest
870              
871             Takes a list of integers and creates a new Number::Fraction object nearest to
872             a fraction with a deniminator from that list.
873              
874             =cut
875              
876             sub nearest {
877 0     0 1 0 my $self = shift;
878 0 0       0 return $self if $self->{den} ==1;
879 0         0 my @denominators = @_;
880 0 0       0 die "Missing list of denominators" if not @denominators;
881              
882 0         0 my $frc = (ref $self)->new;
883 0         0 foreach my $den ( @denominators ) {
884 0         0 my $num = sprintf( "%.0f", $self->mult($den) );
885 0 0       0 if ( (
886             CORE::abs( $self->{num}*$frc->{den} - $frc->{num}*$self->{den} ) * $den
887             -
888             CORE::abs( $self->{num}*$den - $num*$self->{den} ) * $frc->{den}
889             ) > 0 ) {
890 0         0 $frc->{num} = $num;
891 0         0 $frc->{den} = $den;
892             }
893             }
894 0         0 return $frc;
895             }
896              
897             sub _hcf {
898 208     208   445 my ($x, $y) = @_;
899              
900 208 100       635 ($x, $y) = ($y, $x) if $y > $x;
901              
902 208 100       495 return $x if $x == $y;
903              
904 199         421 while ($y) {
905 218         598 ($x, $y) = ($y, $x % $y);
906             }
907              
908 199         574 return $x;
909             }
910              
911             # translating back and forth between basic digits and sup- or sub-script
912              
913             sub _sup_to_basic {
914 0     0     $_ = shift;
915 14     14   10151 tr/\N{U+2070}\N{U+00B9}\N{U+00B2}\N{U+00B3}\N{U+2074}-\N{U+207E}/0-9+\-=()/;
  14         275  
  14         233  
  0            
916 0           return $_;
917             }
918              
919             sub _sub_to_basic {
920 0     0     $_ = shift;
921 0           tr/\N{U+2080}-\N{U+208E}/0-9+\-=()/;
922 0           return $_;
923             }
924              
925             sub _basic_to_sup {
926 0     0     $_ = shift;
927 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}/;
928 0           return $_;
929             }
930              
931             sub _basic_to_sub {
932 0     0     $_ = shift;
933 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}/;
934 0           return $_;
935             }
936              
937             # turn a basic string into one using sup- and sub-script characters
938             sub _to_unicode {
939 0 0   0     if ($_[0] =~ m|^(?-?)(?\d+)/(?\d+)$|) {
940 0           my $num = _basic_to_sup($+{num});
941 0           my $den = _basic_to_sub($+{den});
942 0 0         return ($+{sign} ? "\N{U+207B}" : '') . $num . "\N{U+2044}" . $den;
943             }
944 0 0         if ($_[0] =~ m|^(?-?)(?\d+)$MIXED_SEP(?\d+)/(?\d+)$|) {
945 0           my $num = _basic_to_sup($+{num});
946 0           my $den = _basic_to_sub($+{den});
947 0           return $+{sign} . $+{int} . $num . "\N{U+2044}" . $den;
948             }
949 0 0         if ($_[0] =~ m|^(?-?)(?\d+)$|) {
950 0           return $+{sign} . $+{int}; # Darn, this is just what we got!
951             }
952 0           return;
953             }
954              
955             1;
956             __END__