File Coverage

blib/lib/Math/Round/Var.pm
Criterion Covered Total %
statement 63 77 81.8
branch 15 26 57.6
condition 2 9 22.2
subroutine 12 14 85.7
pod 2 2 100.0
total 94 128 73.4


line stmt bran cond sub pod time code
1             package Math::Round::Var;
2             $VERSION=v1.0.0;
3              
4 2     2   71055 use 5.006;
  2         8  
  2         105  
5 2     2   13 use strict;
  2         4  
  2         132  
6 2     2   11 use warnings;
  2         8  
  2         88  
7 2     2   12 use Carp;
  2         4  
  2         1135  
8              
9             =head1 NAME
10              
11             Math::Round::Var - Variations on rounding.
12              
13             =head1 SYNOPSIS
14              
15             Simple decimal rounding:
16              
17             use Math::Round::Var;
18             my $rnd = Math::Round::Var->new(0.01);
19             # rounds to two decimal places:
20             my $num = 399886.758673;
21             $num = $rnd->round($num);
22             print "$num\n"; # 399886.76
23              
24             Now it all makes sense.
25              
26             #!/usr/bin/perl
27             use Math::Round::Var;
28             my $scheme = shift; # let user specify the rounding
29             my $num1 = shift;
30             my $rnd = Math::Round::Var->new($scheme);
31             my $num2 = $rnd->round($num1);
32             print "$num1 rounds to $num2 according to scheme: $scheme\n";
33              
34             =head1 DESCRIPTION
35              
36             This module gives you the ability to round numbers to either decimal or
37             fractional precision while encapsulating the rounding precision in an
38             object. This allows scripts and modules to maintain multiple precision
39             values as objects.
40              
41             It also implements flexible scheme parsing, so that your programs and
42             modules can offload the how-to-round decisions to this module.
43              
44             =head1 AUTHOR
45              
46             Eric L. Wilhelm @
47              
48             http://scratchcomputing.com
49              
50             =head1 COPYRIGHT
51              
52             This module is copyright (C) 2003-2008 by Eric L. Wilhelm.
53              
54             =head1 LICENSE
55              
56             This module is distributed under the same terms as Perl. See the Perl
57             source package for details.
58              
59             You may use this software under one of the following licenses:
60              
61             (1) GNU General Public License
62             (found at http://www.gnu.org/copyleft/gpl.html)
63             (2) Artistic License
64             (found at http://www.perl.com/pub/language/misc/Artistic.html)
65              
66             =cut
67             ########################################################################
68              
69             =head1 Front-End Constructor
70              
71             The Math::Round::Var->new() constructor only decides between the
72             sub-packages based on the format of your precision argument.
73              
74             This is the extent of the purpose of the Math::Round::Var class.
75              
76             =head2 new
77              
78             Math::Round::Var->new($precision);
79              
80             =cut
81             sub new {
82 4     4 1 1678 my $caller = shift;
83 4         7 my $precision = shift;
84             # decide which to use
85 4         10 my ($type, $count) = format_of($precision);
86 4 100       18 if($type eq "fraction") {
    50          
    0          
87 1         7 return(Math::Round::Var::Fraction->new(round_to => $precision));
88             }
89             elsif($type eq "decimal") {
90 3         12 return(Math::Round::Var::Float->new(precision => $count));
91             }
92             elsif($type eq "fake") {
93 0         0 return(Math::Round::Var::Fake->new());
94             }
95             else {
96 0         0 die("$type is not a valid rounding type");
97             }
98             } # end subroutine new definition
99             ########################################################################
100              
101             =head2 format_of
102              
103             Returns "decimal" or "fraction" for $type based on the format of
104             $precision. If $type is "decimal", then $count will be the number of
105             digits to use.
106              
107             my ($type, $count) = format_of($precision);
108              
109             Valid formats should be any of the number formats which are used by
110             Perl. Basically, the 'fraction' methods will work for anything (as long
111             as Perl can divide by it), but we would be wasting time if we only want
112             to round to a certain decimal place.
113              
114             Fractional Formats:
115              
116             Anything which does not reduce to a 'multiple of 10'.
117              
118             0.125
119             0.00007
120             2
121             2.885
122              
123             Decimal Formats:
124              
125             Anything which can be expressed as 1.0e.
126              
127             0.0000001
128             1.0e-10
129              
130             Number-of-Digits (Decimal) Format:
131              
132             Anything which matches the /^d\d+$/ pattern will be used as a 'digit
133             count'.
134              
135             d0
136             d5
137             d60 # bad idea, but valid
138              
139             Fake Format:
140              
141             Anything less than zero.
142              
143             -1
144             -0.001
145              
146             =cut
147             sub format_of {
148 4     4 1 7 my ($prec) = @_;
149 4         4 my $frac = "fraction";
150 4         8 my $dec = "decimal";
151             # short-circuit decimal:
152 4 50       26 if($prec =~ m/^d(\d+)$/) {
153 0         0 my $count = $1;
154 0         0 return($dec, $count);
155             }
156             # we may want to round off like %0.0f
157 4 100       12 unless($prec) {
158 1 50       8 defined($prec) or carp("assuming round-to-integer");
159 1         4 return($dec, 0);
160             }
161 3 50       9 if($prec < 0) {
162 0         0 return('fake');
163             }
164             # if we want to round by numbers which are larger than 1, we must
165             # use the fractional methods:
166 3 50       15 if($prec >= 1) {
167 0         0 return($frac, $prec);
168             }
169             # seems that the easiest way is to divide by a big number so that it
170             # is guaranteed to be in exponential notation, then we simply have
171             # to look at what comes before the 'e'
172 3         4 my $num = $prec;
173             # assumption is that this accomplishes the transform:
174 3         6 $num /= 1e+4;
175 3 50       25 if($num =~ m/^(.*?)e-(\d+)$/) {
176 3         10 my ($n, $d) = ($1, $2);
177             # print "number: $n\n", "digits: $d\n";
178 3 100       8 if($n == 1) {
179 2         8 return($dec, $d - 4);
180             }
181             else {
182 1         3 return($frac, 0);
183             }
184             }
185             else {
186 0         0 croak("$prec tricks me ($num)");
187             }
188              
189             } # end subroutine format_of definition
190             ########################################################################
191              
192             package Math::Round::Var::Float;
193              
194 2     2   13 use Carp;
  2         7  
  2         534  
195              
196             =head1 Decimal-based rounding
197              
198             =head2 new
199              
200             Creates a new decimal-based rounding object.
201              
202             Math::Round::Var::Float->new(precision => 7);
203              
204             The argument to precision is the number of digits to use in rounding.
205             This is used as part of a sprintf() format.
206              
207             =cut
208             sub new {
209 3     3   6 my $caller = shift;
210 3   33     19 my $class = ref($caller) || $caller;
211 3         9 my $self = {@_};
212 3         6 my $p = $self->{precision};
213 3 50       19 defined($p) or croak("must define 'precision'");
214 3 50       17 ($p =~ m/^\d+$/) or croak("precision must be an integer");
215 3         10 bless($self, $class);
216 3         10 return($self);
217             } # end subroutine new definition
218             ########################################################################
219              
220             =head2 round
221              
222             $number = $rounder->round($number);
223              
224             =cut
225             sub round {
226 3     3   864 my $self = shift;
227 3         12 my $rnd = $self->{precision};
228 3         6 my $number = shift;
229 3         45 return(sprintf("%0.${rnd}f", $number));
230             } # end subroutine round definition
231             ########################################################################
232              
233             package Math::Round::Var::Fraction;
234              
235 2     2   12 use Carp;
  2         4  
  2         598  
236              
237             =head1 Fraction-based rounding.
238              
239             =head2 new
240              
241             Math::Round::Var::Fraction->new();
242              
243             =cut
244             sub new {
245 1     1   2 my $caller = shift;
246 1   33     29 my $class = ref($caller) || $caller;
247 1         3 my $self = {@_};
248 1         3 my $r = $self->{round_to};
249 1 50       3 defined($r) or croak("must define 'round_to'");
250 1         2 bless($self, $class);
251 1         4 return($self);
252             } # end subroutine new definition
253             ########################################################################
254              
255             =head2 round
256              
257             $number = $rounder->round($number);
258              
259             =cut
260             sub round {
261 1     1   363 my $self = shift;
262 1         6 my $rnd = $self->{round_to};
263 1         1 my $number = shift;
264 1         10 return(sprintf("%0.0f", $number / $rnd) * $rnd);
265             } # end subroutine round definition
266             ########################################################################
267              
268             package Math::Round::Var::Fake;
269              
270              
271             =head1 Fake rounding
272              
273             This mode doesn't round at all. This is useful when you need user-input
274             to be able to disable rounding without rewriting a lot of code.
275              
276             =head2 new
277              
278             Math::Round::Var::Fake->new();
279              
280             =cut
281             sub new {
282 0     0     my $caller = shift;
283 0   0       my $class = ref($caller) || $caller;
284 0           my $self = {@_};
285 0           bless($self, $class);
286 0           return($self);
287             } # end subroutine new definition
288             ########################################################################
289              
290             =head2 round
291              
292             $fake->round();
293              
294             =cut
295             sub round {
296 0     0     my $self = shift;
297 0           return(shift);
298             } # end subroutine round definition
299             ########################################################################
300             1;
301