Profile of Math/Round.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For xt/tapper-mcp-scheduler-with-db-longrun.t
Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:10 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Math/Round.pm
Statements | Executed 17 statements in 727µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 11µs | 13µs | Math::Round::::BEGIN@3Math::Round::BEGIN@3
1 | 1 | 1 | 11µs | 76µs | Math::Round::::BEGIN@5Math::Round::BEGIN@5
1 | 1 | 1 | 10µs | 2.95ms | Math::Round::::BEGIN@4Math::Round::BEGIN@4
0 | 0 | 0 | 0s | 0s | Math::Round::::_sepnearMath::Round::_sepnear
0 | 0 | 0 | 0s | 0s | Math::Round::::_sepnumMath::Round::_sepnum
0 | 0 | 0 | 0s | 0s | Math::Round::::nearestMath::Round::nearest
0 | 0 | 0 | 0s | 0s | Math::Round::::nearest_ceilMath::Round::nearest_ceil
0 | 0 | 0 | 0s | 0s | Math::Round::::nearest_floorMath::Round::nearest_floor
0 | 0 | 0 | 0s | 0s | Math::Round::::nearest_randMath::Round::nearest_rand
0 | 0 | 0 | 0s | 0s | Math::Round::::nhimultMath::Round::nhimult
0 | 0 | 0 | 0s | 0s | Math::Round::::nlowmultMath::Round::nlowmult
0 | 0 | 0 | 0s | 0s | Math::Round::::roundMath::Round::round
0 | 0 | 0 | 0s | 0s | Math::Round::::round_evenMath::Round::round_even
0 | 0 | 0 | 0s | 0s | Math::Round::::round_oddMath::Round::round_odd
0 | 0 | 0 | 0s | 0s | Math::Round::::round_randMath::Round::round_rand

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Math::Round;
2 |  |  |  |  |
3 | 3 | 16µs | 2 | 15µs | # spent 13µs (11+2) within Math::Round::BEGIN@3 which was called: # once (11µs+2µs) by DateTime::BEGIN@13 at line 3 use strict; # spent 13µs making 1 call to Math::Round::BEGIN@3 # spent 2µs making 1 call to strict::import
4 | 3 | 42µs | 2 | 5.89ms | # spent 2.95ms (10µs+2.94) within Math::Round::BEGIN@4 which was called: # once (10µs+2.94ms) by DateTime::BEGIN@13 at line 4 use POSIX; # spent 2.95ms making 1 call to Math::Round::BEGIN@4 # spent 2.94ms making 1 call to POSIX::import
5 | 3 | 640µs | 2 | 141µs | # spent 76µs (11+65) within Math::Round::BEGIN@5 which was called: # once (11µs+65µs) by DateTime::BEGIN@13 at line 5 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); # spent 76µs making 1 call to Math::Round::BEGIN@5 # spent 65µs making 1 call to vars::import
6 |  |  |  |  |
7 | 1 | 700ns |  |  | require Exporter;
8 |  |  |  |  |
9 | 1 | 14µs |  |  | @ISA = qw(Exporter AutoLoader);
10 | 1 | 700ns |  |  | @EXPORT = qw(round nearest);
11 | 1 | 2µs |  |  | @EXPORT_OK = qw(round nearest round_even round_odd round_rand
12 |  |  |  |  | nearest_ceil nearest_floor nearest_rand
13 |  |  |  |  | nlowmult nhimult );
14 | 1 | 400ns |  |  | $VERSION = '0.06';
15 |  |  |  |  |
16 | 1 | 3µs |  |  | %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 | 1 | 400ns |  |  | $Math::Round::half = 0.50000000000008;
23 |  |  |  |  |
24 |  |  |  |  | sub round {
25 |  |  |  |  | my $x;
26 |  |  |  |  | my @res = map {
27 |  |  |  |  | if ($_ >= 0) { POSIX::floor($_ + $Math::Round::half); }
28 |  |  |  |  | else { POSIX::ceil($_ - $Math::Round::half); }
29 |  |  |  |  | } @_;
30 |  |  |  |  |
31 |  |  |  |  | return (wantarray) ? @res : $res[0];
32 |  |  |  |  | }
33 |  |  |  |  |
34 |  |  |  |  | sub round_even {
35 |  |  |  |  | my @res = map {
36 |  |  |  |  | my ($sign, $in, $fr) = _sepnum($_);
37 |  |  |  |  | if ($fr == 0.5) {
38 |  |  |  |  | $sign * (($in % 2 == 0) ? $in : $in + 1);
39 |  |  |  |  | } else {
40 |  |  |  |  | $sign * POSIX::floor(abs($_) + $Math::Round::half);
41 |  |  |  |  | }
42 |  |  |  |  | } @_;
43 |  |  |  |  | return (wantarray) ? @res : $res[0];
44 |  |  |  |  | }
45 |  |  |  |  |
46 |  |  |  |  | sub round_odd {
47 |  |  |  |  | my @res = map {
48 |  |  |  |  | my ($sign, $in, $fr) = _sepnum($_);
49 |  |  |  |  | if ($fr == 0.5) {
50 |  |  |  |  | $sign * (($in % 2 == 1) ? $in : $in + 1);
51 |  |  |  |  | } else {
52 |  |  |  |  | $sign * POSIX::floor(abs($_) + $Math::Round::half);
53 |  |  |  |  | }
54 |  |  |  |  | } @_;
55 |  |  |  |  | return (wantarray) ? @res : $res[0];
56 |  |  |  |  | }
57 |  |  |  |  |
58 |  |  |  |  | sub round_rand {
59 |  |  |  |  | my @res = map {
60 |  |  |  |  | my ($sign, $in, $fr) = _sepnum($_);
61 |  |  |  |  | if ($fr == 0.5) {
62 |  |  |  |  | $sign * ((rand(4096) < 2048) ? $in : $in + 1);
63 |  |  |  |  | } else {
64 |  |  |  |  | $sign * POSIX::floor(abs($_) + $Math::Round::half);
65 |  |  |  |  | }
66 |  |  |  |  | } @_;
67 |  |  |  |  | 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 |  |  |  |  | my $x = shift;
74 |  |  |  |  | my $sign = ($x >= 0) ? 1 : -1;
75 |  |  |  |  | $x = abs($x);
76 |  |  |  |  | my $i = int($x);
77 |  |  |  |  | return ($sign, $i, $x - $i);
78 |  |  |  |  | }
79 |  |  |  |  |
80 |  |  |  |  | #------ "Nearest" routines (round to a multiple of any number)
81 |  |  |  |  |
82 |  |  |  |  | sub nearest {
83 |  |  |  |  | my $targ = abs(shift);
84 |  |  |  |  | my @res = map {
85 |  |  |  |  | if ($_ >= 0) { $targ * int(($_ + $Math::Round::half * $targ) / $targ); }
86 |  |  |  |  | else { $targ * POSIX::ceil(($_ - $Math::Round::half * $targ) / $targ); }
87 |  |  |  |  | } @_;
88 |  |  |  |  |
89 |  |  |  |  | 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 |  |  |  |  | my $targ = abs(shift);
99 |  |  |  |  | my @res = map { $targ * POSIX::floor(($_ + $Math::Round::half * $targ) / $targ) } @_;
100 |  |  |  |  |
101 |  |  |  |  | return wantarray ? @res : $res[0];
102 |  |  |  |  | }
103 |  |  |  |  |
104 |  |  |  |  | sub nearest_floor {
105 |  |  |  |  | my $targ = abs(shift);
106 |  |  |  |  | my @res = map { $targ * POSIX::ceil(($_ - $Math::Round::half * $targ) / $targ) } @_;
107 |  |  |  |  |
108 |  |  |  |  | return wantarray ? @res : $res[0];
109 |  |  |  |  | }
110 |  |  |  |  |
111 |  |  |  |  | sub nearest_rand {
112 |  |  |  |  | my $targ = abs(shift);
113 |  |  |  |  |
114 |  |  |  |  | my @res = map {
115 |  |  |  |  | my ($sign, $in, $fr) = _sepnear($_, $targ);
116 |  |  |  |  | if ($fr == 0.5 * $targ) {
117 |  |  |  |  | $sign * $targ * ((rand(4096) < 2048) ? $in : $in + 1);
118 |  |  |  |  | } else {
119 |  |  |  |  | $sign * $targ * int((abs($_) + $Math::Round::half * $targ) / $targ);
120 |  |  |  |  | }
121 |  |  |  |  | } @_;
122 |  |  |  |  | return (wantarray) ? @res : $res[0];
123 |  |  |  |  | }
124 |  |  |  |  |
125 |  |  |  |  | #--- Next lower multiple
126 |  |  |  |  | sub nlowmult {
127 |  |  |  |  | my $targ = abs(shift);
128 |  |  |  |  | my @res = map { $targ * POSIX::floor($_ / $targ) } @_;
129 |  |  |  |  |
130 |  |  |  |  | return wantarray ? @res : $res[0];
131 |  |  |  |  | }
132 |  |  |  |  |
133 |  |  |  |  | #--- Next higher multiple
134 |  |  |  |  | sub nhimult {
135 |  |  |  |  | my $targ = abs(shift);
136 |  |  |  |  | my @res = map { $targ * POSIX::ceil($_ / $targ) } @_;
137 |  |  |  |  |
138 |  |  |  |  | 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 |  |  |  |  | my ($x, $targ) = @_;
145 |  |  |  |  | my $sign = ($x >= 0) ? 1 : -1;
146 |  |  |  |  | $x = abs($x);
147 |  |  |  |  | my $i = int($x / $targ);
148 |  |  |  |  | return ($sign, $i, $x - $i*$targ);
149 |  |  |  |  | }
150 |  |  |  |  |
151 | 1 | 7µs |  |  | 1;
152 |  |  |  |  |
153 |  |  |  |  | __END__