File Coverage

blib/lib/Math/Round.pm
Criterion Covered Total %
statement 70 72 97.2
branch 38 44 86.3
condition n/a
subroutine 15 15 100.0
pod 10 10 100.0
total 133 141 94.3


line stmt bran cond sub pod time code
1             package Math::Round;
2            
3 1     1   8672 use strict;
  1         3  
  1         63  
4 1     1   1145 use POSIX;
  1         19776  
  1         11  
5 1     1   3466 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  1         13  
  1         1220  
6            
7             require Exporter;
8            
9             @ISA = qw(Exporter AutoLoader);
10             @EXPORT = qw(round nearest);
11             @EXPORT_OK = qw(round nearest round_even round_odd round_rand
12             nearest_ceil nearest_floor nearest_rand
13             nlowmult nhimult );
14             $VERSION = '0.06';
15            
16             %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
17            
18             #--- Default value for "one-half". This is the lowest value that
19             #--- gives acceptable results for test #6 in test.pl. See the pod
20             #--- for more information.
21            
22             $Math::Round::half = 0.50000000000008;
23            
24             sub round {
25 4     4 1 41 my $x;
26             my @res = map {
27 4 100       5 if ($_ >= 0) { POSIX::floor($_ + $Math::Round::half); }
  5         17  
  3         24  
28 2         8 else { POSIX::ceil($_ - $Math::Round::half); }
29             } @_;
30            
31 4 100       17 return (wantarray) ? @res : $res[0];
32             }
33            
34             sub round_even {
35 4         8 my @res = map {
36 3     3 1 31 my ($sign, $in, $fr) = _sepnum($_);
37 4 100       8 if ($fr == 0.5) {
38 2 100       18 $sign * (($in % 2 == 0) ? $in : $in + 1);
39             } else {
40 2         10 $sign * POSIX::floor(abs($_) + $Math::Round::half);
41             }
42             } @_;
43 3 100       11 return (wantarray) ? @res : $res[0];
44             }
45            
46             sub round_odd {
47 5         11 my @res = map {
48 4     4 1 25 my ($sign, $in, $fr) = _sepnum($_);
49 5 100       11 if ($fr == 0.5) {
50 2 100       8 $sign * (($in % 2 == 1) ? $in : $in + 1);
51             } else {
52 3         11 $sign * POSIX::floor(abs($_) + $Math::Round::half);
53             }
54             } @_;
55 4 100       14 return (wantarray) ? @res : $res[0];
56             }
57            
58             sub round_rand {
59 4         7 my @res = map {
60 3     3 1 22 my ($sign, $in, $fr) = _sepnum($_);
61 4 50       9 if ($fr == 0.5) {
62 0 0       0 $sign * ((rand(4096) < 2048) ? $in : $in + 1);
63             } else {
64 4         15 $sign * POSIX::floor(abs($_) + $Math::Round::half);
65             }
66             } @_;
67 3 100       10 return (wantarray) ? @res : $res[0];
68             }
69            
70             #--- Separate a number into sign, integer, and fractional parts.
71             #--- Return as a list.
72             sub _sepnum {
73 13     13   14 my $x = shift;
74 13 100       26 my $sign = ($x >= 0) ? 1 : -1;
75 13         13 $x = abs($x);
76 13         15 my $i = int($x);
77 13         27 return ($sign, $i, $x - $i);
78             }
79            
80             #------ "Nearest" routines (round to a multiple of any number)
81            
82             sub nearest {
83 5     5 1 27 my $targ = abs(shift);
84             my @res = map {
85 5 100       8 if ($_ >= 0) { $targ * int(($_ + $Math::Round::half * $targ) / $targ); }
  6         9  
  4         14  
86 2         8 else { $targ * POSIX::ceil(($_ - $Math::Round::half * $targ) / $targ); }
87             } @_;
88            
89 5 100       35 return (wantarray) ? @res : $res[0];
90             }
91            
92             # In the next two functions, the code for positive and negative numbers
93             # turns out to be the same. For negative numbers, the technique is not
94             # exactly obvious; instead of floor(x+0.5), we are in effect taking
95             # ceiling(x-0.5).
96            
97             sub nearest_ceil {
98 4     4 1 24 my $targ = abs(shift);
99 4         6 my @res = map { $targ * POSIX::floor(($_ + $Math::Round::half * $targ) / $targ) } @_;
  5         18  
100            
101 4 100       12 return wantarray ? @res : $res[0];
102             }
103            
104             sub nearest_floor {
105 4     4 1 26 my $targ = abs(shift);
106 4         5 my @res = map { $targ * POSIX::ceil(($_ - $Math::Round::half * $targ) / $targ) } @_;
  5         17  
107            
108 4 100       19 return wantarray ? @res : $res[0];
109             }
110            
111             sub nearest_rand {
112 3     3 1 22 my $targ = abs(shift);
113            
114 4         10 my @res = map {
115 3         4 my ($sign, $in, $fr) = _sepnear($_, $targ);
116 4 50       9 if ($fr == 0.5 * $targ) {
117 0 0       0 $sign * $targ * ((rand(4096) < 2048) ? $in : $in + 1);
118             } else {
119 4         12 $sign * $targ * int((abs($_) + $Math::Round::half * $targ) / $targ);
120             }
121             } @_;
122 3 100       11 return (wantarray) ? @res : $res[0];
123             }
124            
125             #--- Next lower multiple
126             sub nlowmult {
127 3     3 1 38 my $targ = abs(shift);
128 3         4 my @res = map { $targ * POSIX::floor($_ / $targ) } @_;
  4         13  
129            
130 3 100       14 return wantarray ? @res : $res[0];
131             }
132            
133             #--- Next higher multiple
134             sub nhimult {
135 3     3 1 22 my $targ = abs(shift);
136 3         4 my @res = map { $targ * POSIX::ceil($_ / $targ) } @_;
  4         14  
137            
138 3 100       9 return wantarray ? @res : $res[0];
139             }
140            
141             #--- Separate a number into sign, "integer", and "fractional" parts
142             #--- for the 'nearest' calculation. Return as a list.
143             sub _sepnear {
144 4     4   5 my ($x, $targ) = @_;
145 4 100       9 my $sign = ($x >= 0) ? 1 : -1;
146 4         4 $x = abs($x);
147 4         6 my $i = int($x / $targ);
148 4         8 return ($sign, $i, $x - $i*$targ);
149             }
150            
151             1;
152            
153             __END__