File Coverage

blib/lib/Number/Fraction.pm
Criterion Covered Total %
statement 99 100 99.0
branch 63 64 98.4
condition 6 6 100.0
subroutine 18 18 100.0
pod 9 9 100.0
total 195 197 99.0


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3            
4             Number::Fraction - Perl extension to model fractions
5            
6             =head1 SYNOPSIS
7            
8             use Number::Fraction;
9            
10             my $f1 = Number::Fraction->new(1, 2);
11             my $f2 = Number::Fraction->new('1/2');
12             my $f3 = Number::Fraction->new($f1); # clone
13             my $f4 = Number::Fraction->new; # 0/1
14            
15             or
16            
17             use Number::Fraction ':constants';
18            
19             my $f1 = '1/2';
20             my $f2 = $f1;
21            
22             my $one = $f1 + $f2;
23             my $half = $one - $f1;
24             print $half; # prints '1/2'
25            
26             =head1 ABSTRACT
27            
28             Number::Fraction is a Perl module which allows you to work with fractions
29             in your Perl programs.
30            
31             =head1 DESCRIPTION
32            
33             Number::Fraction allows you to work with fractions (i.e. rational
34             numbers) in your Perl programs in a very natural way.
35            
36             It was originally written as a demonstration of the techniques of
37             overloading.
38            
39             If you use the module in your program in the usual way
40            
41             use Number::Fraction;
42            
43             you can then create fraction objects using C<Number::Fraction->new> in
44             a number of ways.
45            
46             my $f1 = Number::Fraction->new(1, 2);
47            
48             creates a fraction with a numerator of 1 and a denominator of 2.
49            
50             my $f2 = Number::Fraction->new('1/2');
51            
52             does the same thing but from a string constant.
53            
54             my $f3 = Number::Fraction->new($f1);
55            
56             makes C<$f3> a copy of C<$f1>
57            
58             my $f4 = Number::Fraction->new; # 0/1
59            
60             creates a fraction with a denominator of 0 and a numerator of 1.
61            
62             If you use the alterative syntax of
63            
64             use Number::Fraction ':constants';
65            
66             then Number::Fraction will automatically create fraction objects from
67             string constants in your program. Any time your program contains a
68             string constant of the form C<\d+/\d+> then that will be automatically
69             replaced with the equivalent fraction object. For example
70            
71             my $f1 = '1/2';
72            
73             Having created fraction objects you can manipulate them using most of the
74             normal mathematical operations.
75            
76             my $one = $f1 + $f2;
77             my $half = $one - $f1;
78            
79             Additionally, whenever a fraction object is evaluated in a string
80             context, it will return a string in the format x/y. When a fraction
81             object is evaluated in a numerical context, it will return a floating
82             point representation of its value.
83            
84             Fraction objects will always "normalise" themselves. That is, if you
85             create a fraction of '2/4', it will silently be converted to '1/2'.
86            
87             =head2 Experimental Support for Exponentiation
88            
89             Version 1.13 of Number::Fraction adds experimental support for exponentiation
90             operations. If a Number::Fraction object is used as the left hand operand of
91             an exponentiation expression then the value returned will be another
92             Number::Fraction object - if that makes sense. In all other cases, the
93             expression returns a real number.
94            
95             Currently this only works if the right hand operand is an integer (or
96             a Number::Fraction object that has a numerator of 1). Later I hope to
97             extend this so support so that a Number::Fraction object is returned
98             whenever the result of the expression is a rational number.
99            
100             For example:
101            
102             '1/2' ** 2 # Returns a Number::Fraction ('1/4')
103             '2/1' ** '2/1' Returns a Number::Fraction ('4/1')
104             '2/1' ** '1/2' Returns a real number (1.414213)
105             0.5 ** '2/1' Returns a real number (0.25)
106            
107             =head1 METHODS
108            
109             =cut
110              
111             package Number::Fraction;
112              
113 12     12   412583 use 5.006;
  12         38  
  12         200  
114 12     12   37 use strict;
  12         12  
  12         192  
115 12     12   35 use warnings;
  12         25  
  12         271  
116              
117 12     12   40 use Carp;
  12         12  
  12         986  
118              
119             our $VERSION = '1.13';
120              
121             use overload
122 12         12490   q("") => 'to_string',
123               '0+' => 'to_num',
124               '+' => 'add',
125               '*' => 'mult',
126               '-' => 'subtract',
127               '/' => 'div',
128               '**' => 'exp',
129 12     12   46   fallback => 1;
  12         15  
130              
131             my %_const_handlers =
132               (q => sub { return __PACKAGE__->new($_[0]) || $_[1] });
133              
134             =head2 import
135            
136             Called when module is C<use>d. Use to optionally install constant
137             handler.
138            
139             =cut
140              
141             sub import {
142 12 100 100 12   65717   overload::constant %_const_handlers if $_[1] and $_[1] eq ':constants';
143             }
144              
145             =head2 unimport
146            
147             Be a good citizen and uninstall constant handler when caller uses
148             C<no Number::Fraction>.
149            
150             =cut
151              
152             sub unimport {
153 1     1 1 45   overload::remove_constant(q => undef);
154             }
155              
156             =head2 new
157            
158             Constructor for Number::Fraction object. Takes the following kinds of
159             parameters:
160            
161             =over 4
162            
163             =item *
164            
165             A single Number::Fraction object which is cloned.
166            
167             =item *
168            
169             A string in the form 'x/y' where x and y are integers. x is used as the
170             numerator and y is used as the denominator of the new object.
171            
172             =item *
173            
174             Two integers which are used as the numerator and denominator of the
175             new object.
176            
177             =item *
178            
179             A single integer which is used as the numerator of the the new object.
180             The denominator is set to 1.
181            
182             =item *
183            
184             No arguments, in which case a numerator of 0 and a denominator of 1
185             are used.
186            
187             =back
188            
189             Returns C<undef> if a Number::Fraction object can't be created.
190            
191             =cut
192              
193             sub new {
194 193     193 1 138766   my $class = shift;
195              
196 193         160   my $self;
197 193 100       293   if (@_ >= 2) {
    100          
198 53 100 100     345     return unless $_[0] =~ /^-?[0-9]+\z/ and $_[1] =~ /^-?[0-9]+\z/;
199              
200 51         91     $self->{num} = $_[0];
201 51         74     $self->{den} = $_[1];
202               } elsif (@_ == 1) {
203 139 100       157     if (ref $_[0]) {
204 2 100       5       if (UNIVERSAL::isa($_[0], $class)) {
205 1         5         return $class->new($_[0]->{num},
206                                        $_[0]->{den});
207                   } else {
208 1         126         croak "Can't make a $class from a ",
209                       ref $_[0];
210             }
211                 } else {
212 137 100   1   21671       return unless $_[0] =~ m|^(-?[0-9]+)(?:/(-?[0-9]+))?\z|;
  1         325  
  1         9  
  1         12  
213              
214 124         281       $self->{num} = $1;
215 124 100       267       $self->{den} = defined $2 ? $2 : 1;
216                 }
217               } else {
218 1         1     $self->{num} = 0;
219 1         2     $self->{den} = 1;
220               }
221              
222 176         605   bless $self, $class;
223              
224 176         222   $self->_normalise;
225              
226 176         410   return $self;
227             }
228              
229             sub _normalise {
230 176     176   165   my $self = shift;
231              
232 176         250   my $hcf = _hcf($self->{num}, $self->{den});
233              
234 176         224   for (qw/num den/) {
235 352         483     $self->{$_} /= $hcf;
236               }
237              
238 176 100       441   if ($self->{den} < 0) {
239 4         5     for (qw/num den/) {
240 8         12       $self->{$_} *= -1;
241                 }
242               }
243             }
244              
245             =head2 to_string
246            
247             Returns a string representation of the fraction in the form
248             "numerator/denominator".
249            
250             =cut
251              
252             sub to_string {
253 103     103 1 70922   my $self = shift;
254              
255 103 100       151   if ($self->{den} == 1) {
256 14         106     return $self->{num};
257               } else {
258 89         21439     return "$self->{num}/$self->{den}";
259               }
260             }
261              
262             =head2 to_num
263            
264             Returns a numeric representation of the fraction by calculating the sum
265             numerator/denominator. Normal caveats about the precision of floating
266             point numbers apply.
267            
268             =cut
269              
270             sub to_num {
271 331     331 1 135667   my $self = shift;
272              
273 331         108103   return $self->{num} / $self->{den};
274             }
275              
276             =head2 add
277            
278             Add a value to a fraction object and return a new object representing the
279             result of the calculation.
280            
281             The first parameter is a fraction object. The second parameter is either
282             another fraction object or a number.
283            
284             =cut
285              
286             sub add {
287 12     12 1 68023   my ($l, $r, $rev) = @_;
288              
289 12 100       21   if (ref $r) {
290 10 100       17     if (UNIVERSAL::isa($r, ref $l)) {
291 9         35       return (ref $l)->new($l->{num} * $r->{den} + $r->{num} * $l->{den},
292             $r->{den} * $l->{den});
293                 } else {
294 1         128       croak "Can't add a ", ref $l, " to a ", ref $l;
295                 }
296               } else {
297 2 100       10     if ($r =~ /^[-+]?\d+$/) {
298 1         2       return $l + (ref $l)->new($r, 1);
299                 } else {
300 1         8       return $l->to_num + $r;
301                 }
302               }
303             }
304              
305             =head2 mult
306            
307             Multiply a fraction object by a value and return a new object representing
308             the result of the calculation.
309            
310             The first parameter is a fraction object. The second parameter is either
311             another fraction object or a number.
312            
313             =cut
314              
315             sub mult {
316 12     12 1 69397   my ($l, $r, $rev) = @_;
317              
318 12 100       19   if (ref $r) {
319 10 100       25     if (UNIVERSAL::isa($r, ref $l)) {
320 9         25       return (ref $l)->new($l->{num} * $r->{num},
321             $l->{den} * $r->{den});
322                 } else {
323 1         141       croak "Can't multiply a ", ref $l, " by a ", ref $l;
324                 }
325               } else {
326 2 100       10     if ($r =~ /^[-+]?\d+$/) {
327 1         2       return $l * (ref $l)->new($r, 1);
328                 } else {
329 1         8       return $l->to_num * $r;
330                 }
331               }
332             }
333              
334             =head2 subtract
335            
336             Subtract a value from a fraction object and return a new object representing
337             the result of the calculation.
338            
339             The first parameter is a fraction object. The second parameter is either
340             another fraction object or a number.
341            
342             =cut
343              
344             sub subtract {
345 15     15 1 68156   my ($l, $r, $rev) = @_;
346              
347 15 100       21   if (ref $r) {
348 11 100       21     if (UNIVERSAL::isa($r, ref $l)) {
349 10         33       return (ref $l)->new($l->{num} * $r->{den} - $r->{num} * $l->{den},
350             $r->{den} * $l->{den});
351                 } else {
352 1         133       croak "Can't subtract a ", ref $l, " from a ", ref $l;
353                 }
354               } else {
355 4 100       17     if ($r =~ /^[-+]?\d+$/) {
356 2         4       $r = (ref $l)->new($r, 1);
357 2 100       6       return $rev ? $r - $l : $l - $r;
358                 } else {
359 2 100       15       return $rev ? $r - $l->to_num : $l->to_num - $r;
360                 }
361               }
362             }
363              
364             =head2 div
365            
366             Divide a fraction object by a value and return a new object representing
367             the result of the calculation.
368            
369             The first parameter is a fraction object. The second parameter is either
370             another fraction object or a number.
371            
372             =cut
373              
374             sub div {
375 15     15 1 68458   my ($l, $r, $rev) = @_;
376              
377 15 100       20   if (ref $r) {
378 11 100       20     if (UNIVERSAL::isa($r, ref $l)) {
379 10         29       return (ref $l)->new($l->{num} * $r->{den},
380             $l->{den} * $r->{num});
381                 } else {
382 1         145       croak "Can't divide a ", ref $l, " by a ", ref $l;
383                 }
384               } else {
385 4 100       20     if ($r =~ /^[-+]?\d+$/) {
386 2         13       $r = (ref $l)->new($r, 1);
387 2 100       6       return $rev ? $r / $l : $l / $r;
388                 } else {
389 2 100       5       return $rev ? $r / $l->to_num : $l->to_num / $r;
390                 }
391               }
392             }
393              
394             =head2 exp
395            
396             Raise a Number::Fraction object to a power.
397            
398             The first argument is a number fraction object. The second argument is
399             another Number::Fraction object or a number. If the second argument is
400             an integer or a Number::Fraction object containing an integer then the
401             value returned is a Number::Fraction object, otherwise the value returned
402             is a real number.
403            
404             =cut
405              
406             sub exp {
407 6     6 1 68312   my ($l, $r, $rev) = @_;
408              
409 6 100       10   if ($rev) {
410 1         2     return $r ** $l->to_num;
411               }
412              
413 5 100       20   if (UNIVERSAL::isa($r, ref $l)) {
    50          
414 2 100       5     if ($r->{den} == 1) {
415 1         2       return $l ** $r->to_num;
416                 } else {
417 1         2       return $l->to_num ** $r->to_num;
418                 }
419               } elsif ($r =~ /^[-+]?\d+$/) {
420 3         10     return (ref $l)->new($l->{num} ** $r, $l->{den} ** $r);
421               } else {
422 0         0     croak "Can't raise $l to the power $r\n";
423               }
424             }
425              
426             sub _hcf {
427 176     176   200   my ($x, $y) = @_;
428              
429 176 100       361   ($x, $y) = ($y, $x) if $y > $x;
430              
431 176 100       266   return $x if $x == $y;
432              
433 167         192   while ($y) {
434 176         353     ($x, $y) = ($y, $x % $y);
435               }
436              
437 167         213   return $x;
438             }
439              
440             1;
441             __END__
442            
443             =head2 EXPORT
444            
445             None by default.
446            
447             =head1 SEE ALSO
448            
449             perldoc overload
450            
451             =head1 AUTHOR
452            
453             Dave Cross, E<lt>dave@mag-sol.comE<gt>
454            
455             =head1 COPYRIGHT AND LICENSE
456            
457             Copyright 2002-8 by Dave Cross
458            
459             This library is free software; you can redistribute it and/or modify
460             it under the same terms as Perl itself.
461            
462             =cut
463