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

package Math::Round;

use strict;
use POSIX;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

require Exporter;

@ISA = qw(Exporter AutoLoader);
@EXPORT = qw(round nearest);
@EXPORT_OK = qw(round nearest round_even round_odd round_rand
   nearest_ceil nearest_floor nearest_rand
   nlowmult nhimult );
$VERSION = '0.06';

%EXPORT_TAGS = ( all => [ @EXPORT_OK ] );

#--- Default value for "one-half". This is the lowest value that
#--- gives acceptable results for test #6 in test.pl. See the pod
#--- for more information.

$Math::Round::half = 0.50000000000008;

sub round {
 my $x;
 my @res  = map {
  if ($_ >= 0) { POSIX::floor($_ + $Math::Round::half); }
     else { POSIX::ceil($_ - $Math::Round::half); }
 } @_;

 return (wantarray) ? @res : $res[0];
}

sub round_even {
 my @res  = map {
   my ($sign, $in, $fr) = _sepnum($_);
   if ($fr == 0.5) {
      $sign * (($in % 2 == 0) ? $in : $in + 1);
   } else {
      $sign * POSIX::floor(abs($_) + $Math::Round::half);
   }
 } @_;
 return (wantarray) ? @res : $res[0];
}

sub round_odd {
 my @res  = map {
   my ($sign, $in, $fr) = _sepnum($_);
   if ($fr == 0.5) {
      $sign * (($in % 2 == 1) ? $in : $in + 1);
   } else {
      $sign * POSIX::floor(abs($_) + $Math::Round::half);
   }
 } @_;
 return (wantarray) ? @res : $res[0];
}

sub round_rand {
 my @res  = map {
   my ($sign, $in, $fr) = _sepnum($_);
   if ($fr == 0.5) {
      $sign * ((rand(4096) < 2048) ? $in : $in + 1);
   } else {
      $sign * POSIX::floor(abs($_) + $Math::Round::half);
   }
 } @_;
 return (wantarray) ? @res : $res[0];
}

#--- Separate a number into sign, integer, and fractional parts.
#--- Return as a list.
sub _sepnum {
 my $x = shift;
 my $sign = ($x >= 0) ? 1 : -1;
 $x = abs($x);
 my $i = int($x);
 return ($sign, $i, $x - $i);
}

#------ "Nearest" routines (round to a multiple of any number)

sub nearest {
 my $targ = abs(shift);
 my @res  = map {
  if ($_ >= 0) { $targ * int(($_ + $Math::Round::half * $targ) / $targ); }
     else { $targ * POSIX::ceil(($_ - $Math::Round::half * $targ) / $targ); }
 } @_;

 return (wantarray) ? @res : $res[0];
}

# In the next two functions, the code for positive and negative numbers
# turns out to be the same.  For negative numbers, the technique is not
# exactly obvious; instead of floor(x+0.5), we are in effect taking
# ceiling(x-0.5).

sub nearest_ceil {
    my $targ = abs(shift);
    my @res  = map { $targ * POSIX::floor(($_ + $Math::Round::half * $targ) / $targ) } @_;

    return wantarray ? @res : $res[0];
}

sub nearest_floor {
    my $targ = abs(shift);
    my @res  = map { $targ * POSIX::ceil(($_ - $Math::Round::half * $targ) / $targ) } @_;

    return wantarray ? @res : $res[0];
}

sub nearest_rand {
 my $targ = abs(shift);

 my @res = map {
   my ($sign, $in, $fr) = _sepnear($_, $targ);
   if ($fr == 0.5 * $targ) {
      $sign * $targ * ((rand(4096) < 2048) ? $in : $in + 1);
   } else {
      $sign * $targ * int((abs($_) + $Math::Round::half * $targ) / $targ);
   }
 } @_;
 return (wantarray) ? @res : $res[0];
}

#--- Next lower multiple
sub nlowmult {
    my $targ = abs(shift);
    my @res  = map { $targ * POSIX::floor($_ / $targ) } @_;

    return wantarray ? @res : $res[0];
}

#--- Next higher multiple
sub nhimult {
    my $targ = abs(shift);
    my @res  = map { $targ * POSIX::ceil($_ / $targ) } @_;

    return wantarray ? @res : $res[0];
}

#--- Separate a number into sign, "integer", and "fractional" parts
#--- for the 'nearest' calculation.  Return as a list.
sub _sepnear {
 my ($x, $targ) = @_;
 my $sign = ($x >= 0) ? 1 : -1;
 $x = abs($x);
 my $i = int($x / $targ);
 return ($sign, $i, $x - $i*$targ);
}

1;

__END__