r4501 - in /packages/libmath-round-perl: ./ branches/
branches/upstream/ branches/upstream/current/ tags/
segre at users.alioth.debian.org
segre at users.alioth.debian.org
Sat Dec 2 16:56:32 CET 2006
Author: segre
Date: Sat Dec 2 16:56:31 2006
New Revision: 4501
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=4501
Log:
[svn-inject] Installing original source of libmath-round-perl
Added:
packages/libmath-round-perl/
packages/libmath-round-perl/branches/
packages/libmath-round-perl/branches/upstream/
packages/libmath-round-perl/branches/upstream/current/
packages/libmath-round-perl/branches/upstream/current/Changes
packages/libmath-round-perl/branches/upstream/current/MANIFEST
packages/libmath-round-perl/branches/upstream/current/Makefile.PL
packages/libmath-round-perl/branches/upstream/current/README
packages/libmath-round-perl/branches/upstream/current/Round.pm
packages/libmath-round-perl/branches/upstream/current/test.pl
packages/libmath-round-perl/tags/
Added: packages/libmath-round-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmath-round-perl/branches/upstream/current/Changes?rev=4501&op=file
==============================================================================
--- packages/libmath-round-perl/branches/upstream/current/Changes (added)
+++ packages/libmath-round-perl/branches/upstream/current/Changes Sat Dec 2 16:56:31 2006
@@ -1,0 +1,20 @@
+Revision history for Perl extension Math::Round.
+
+0.01 Wed Oct 25 10:32:06 2000
+ - original version; created by h2xs 1.18
+
+0.02 Thu Mar 8 14:16:16 2001
+ - Small cosmetic changes (e-mail address and such).
+
+0.03 Mon Sep 17 10:34:40 2001
+ - Now using a value for one-half that is slightly larger than
+ 0.5, to thwart the floating-point units. Thanks to Paul
+ Rohwer (pauldrohwer at yahoo.com) for pointing this out.
+
+0.04 Mon Mar 4 11:33:15 2002
+ - Added nearest_ceil and nearest_floor at the suggestion of
+ Charlie Kim (cckim at stanford.edu).
+
+0.05 Mon Apr 22 10:07:09 2002
+ - Added nlowmult and nhimult at the suggestion of Tielman
+ de Villiers (tjdevil at bondnet.co.za).
Added: packages/libmath-round-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmath-round-perl/branches/upstream/current/MANIFEST?rev=4501&op=file
==============================================================================
--- packages/libmath-round-perl/branches/upstream/current/MANIFEST (added)
+++ packages/libmath-round-perl/branches/upstream/current/MANIFEST Sat Dec 2 16:56:31 2006
@@ -1,0 +1,6 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+Round.pm
+test.pl
Added: packages/libmath-round-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmath-round-perl/branches/upstream/current/Makefile.PL?rev=4501&op=file
==============================================================================
--- packages/libmath-round-perl/branches/upstream/current/Makefile.PL (added)
+++ packages/libmath-round-perl/branches/upstream/current/Makefile.PL Sat Dec 2 16:56:31 2006
@@ -1,0 +1,7 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'Math::Round',
+ 'VERSION_FROM' => 'Round.pm', # finds $VERSION
+);
Added: packages/libmath-round-perl/branches/upstream/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmath-round-perl/branches/upstream/current/README?rev=4501&op=file
==============================================================================
--- packages/libmath-round-perl/branches/upstream/current/README (added)
+++ packages/libmath-round-perl/branches/upstream/current/README Sat Dec 2 16:56:31 2006
@@ -1,0 +1,48 @@
+Math::Round -- Perl extension for rounding numbers
+
+Math::Round is a Perl module. It supplies functions to round numbers,
+both positive and negative, in various ways. This may seem like an
+odd thing to write a whole module for, but rounding can sometimes be
+a little tricky, so I thought some people might find this useful.
+
+round: round to the nearest integer; numbers ending in .5 go
+ "to infinity" (3.5 becomes 4, -3.5 becomes -4)
+round_even: round; numbers ending in .5 go to the even number
+round_odd: round; numbers ending in .5 go to the odd number
+round_rand: round; numbers ending in .5 go up or down randomly
+
+nearest: round to the nearest multiple of any number
+nearest_ceil: like nearest; numbers halfway between two multiples
+ go up
+nearest_floor: like nearest; numbers halfway between two multiples
+ go down
+nearest_rand: like nearest; numbers halfway between two multiples
+ go up or down randomly
+
+nlowmult: next lower multiple of a number
+nhimult: next higher multiple of a number
+
+Recent Changes
+==============
+Version 0.04: Added nearest_ceil and nearest_floor.
+Version 0.05: Added nlowmult and nhimult.
+
+How to Install
+==============
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+
+Copyright © 2002 Geoffrey Rommel. All rights reserved.
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+Geoffrey Rommel
+DBA Tech Consultant
+Sears, Roebuck and Co.
+GROMMEL at cpan.org
+
+October 2000
Added: packages/libmath-round-perl/branches/upstream/current/Round.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmath-round-perl/branches/upstream/current/Round.pm?rev=4501&op=file
==============================================================================
--- packages/libmath-round-perl/branches/upstream/current/Round.pm (added)
+++ packages/libmath-round-perl/branches/upstream/current/Round.pm Sat Dec 2 16:56:31 2006
@@ -1,0 +1,365 @@
+package Math::Round;
+
+use strict;
+use POSIX;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+require Exporter;
+
+ at ISA = qw(Exporter AutoLoader);
+ at EXPORT = qw(round nearest);
+ at EXPORT_OK = qw(round nearest round_even round_odd round_rand
+ nearest_ceil nearest_floor nearest_rand
+ nlowmult nhimult );
+$VERSION = '0.05';
+
+%EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
+
+#--- Determine what value to use for "one-half". Because of the
+#--- perversities of floating-point hardware, we must use a value
+#--- slightly larger than 1/2. We accomplish this by determining
+#--- the bit value of 0.5 and increasing it by a small amount in a
+#--- lower-order byte. Since the lowest-order bits are still zero,
+#--- the number is mathematically exact.
+
+my $halfhex = unpack('H*', pack('d', 0.5));
+if (substr($halfhex,0,2) ne '00' && substr($halfhex, -2) eq '00') {
+ #--- It's big-endian.
+ substr($halfhex, -4) = '1000';
+} else {
+ #--- It's little-endian.
+ substr($halfhex, 0,4) = '0010';
+}
+
+my $half = unpack('d',pack('H*', $halfhex));
+
+sub round {
+ my $x;
+ my @res = ();
+ foreach $x (@_) {
+ if ($x >= 0) {
+ push @res, POSIX::floor($x + $half);
+ } else {
+ push @res, POSIX::ceil($x - $half);
+ }
+ }
+ return (wantarray) ? @res : $res[0];
+}
+
+sub round_even {
+ my $x;
+ my @res = ();
+ foreach $x (@_) {
+ my ($sign, $in, $fr) = _sepnum($x);
+ if ($fr == 0.5) {
+ push @res, $sign * (($in % 2 == 0) ? $in : $in + 1);
+ } else {
+ push @res, $sign * POSIX::floor(abs($x) + $half);
+ }
+ }
+ return (wantarray) ? @res : $res[0];
+}
+
+sub round_odd {
+ my $x;
+ my @res = ();
+ foreach $x (@_) {
+ my ($sign, $in, $fr) = _sepnum($x);
+ if ($fr == 0.5) {
+ push @res, $sign * (($in % 2 == 1) ? $in : $in + 1);
+ } else {
+ push @res, $sign * POSIX::floor(abs($x) + $half);
+ }
+ }
+ return (wantarray) ? @res : $res[0];
+}
+
+sub round_rand {
+ my $x;
+ my @res = ();
+ foreach $x (@_) {
+ my ($sign, $in, $fr) = _sepnum($x);
+ if ($fr == 0.5) {
+ push @res, $sign * ((rand(4096) < 2048) ? $in : $in + 1);
+ } else {
+ push @res, $sign * POSIX::floor(abs($x) + $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, $i);
+ $sign = ($x >= 0) ? 1 : -1;
+ $x = abs($x);
+ $i = int($x);
+ return ($sign, $i, $x - $i);
+}
+
+#------ "Nearest" routines (round to a multiple of any number)
+
+sub nearest {
+ my ($targ, @inputs) = @_;
+ my @res = ();
+ my $x;
+
+ $targ = abs($targ) if $targ < 0;
+ foreach $x (@inputs) {
+ if ($x >= 0) {
+ push @res, $targ * int(($x + $half * $targ) / $targ);
+ } else {
+ push @res, $targ * POSIX::ceil(($x - $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, @inputs) = @_;
+ my @res = ();
+ my $x;
+
+ $targ = abs($targ) if $targ < 0;
+ foreach $x (@inputs) {
+ push @res, $targ * POSIX::floor(($x + $half * $targ) / $targ);
+ }
+ return (wantarray) ? @res : $res[0];
+}
+
+sub nearest_floor {
+ my ($targ, @inputs) = @_;
+ my @res = ();
+ my $x;
+
+ $targ = abs($targ) if $targ < 0;
+ foreach $x (@inputs) {
+ push @res, $targ * POSIX::ceil(($x - $half * $targ) / $targ);
+ }
+ return (wantarray) ? @res : $res[0];
+}
+
+sub nearest_rand {
+ my ($targ, @inputs) = @_;
+ my @res = ();
+ my $x;
+
+ $targ = abs($targ) if $targ < 0;
+ foreach $x (@inputs) {
+ my ($sign, $in, $fr) = _sepnear($x, $targ);
+ if ($fr == 0.5 * $targ) {
+ push @res, $sign * $targ * ((rand(4096) < 2048) ? $in : $in + 1);
+ } else {
+ push @res, $sign * $targ * int((abs($x) + $half * $targ) / $targ);
+ }
+ }
+ return (wantarray) ? @res : $res[0];
+}
+
+#--- Next lower multiple
+sub nlowmult {
+ my ($targ, @inputs) = @_;
+ my @res = ();
+ my $x;
+
+ $targ = abs($targ) if $targ < 0;
+ foreach $x (@inputs) {
+ push @res, $targ * POSIX::floor($x / $targ);
+ }
+ return (wantarray) ? @res : $res[0];
+}
+
+#--- Next higher multiple
+sub nhimult {
+ my ($targ, @inputs) = @_;
+ my @res = ();
+ my $x;
+
+ $targ = abs($targ) if $targ < 0;
+ foreach $x (@inputs) {
+ push @res, $targ * POSIX::ceil($x / $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, $i);
+ $sign = ($x >= 0) ? 1 : -1;
+ $x = abs($x);
+ $i = int($x / $targ);
+ return ($sign, $i, $x - $i*$targ);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Math::Round - Perl extension for rounding numbers
+
+=head1 SYNOPSIS
+
+ use Math::Round qw(...those desired... or :all);
+
+ $rounded = round($scalar);
+ @rounded = round(LIST...);
+ $rounded = nearest($target, $scalar);
+ @rounded = nearest($target, LIST...);
+
+ # and other functions as described below
+
+=head1 DESCRIPTION
+
+B<Math::Round> supplies functions that will round numbers in different
+ways. The functions B<round> and B<nearest> are exported by
+default; others are available as described below. "use ... qw(:all)"
+exports all functions.
+
+=head1 FUNCTIONS
+
+=over 2
+
+=item B<round> LIST
+
+Rounds the number(s) to the nearest integer. In scalar context,
+returns a single value; in list context, returns a list of values.
+Numbers that are halfway between two integers are rounded
+"to infinity"; i.e., positive values are rounded up (e.g., 2.5
+becomes 3) and negative values down (e.g., -2.5 becomes -3).
+
+=item B<round_even> LIST
+
+Rounds the number(s) to the nearest integer. In scalar context,
+returns a single value; in list context, returns a list of values.
+Numbers that are halfway between two integers are rounded to the
+nearest even number; e.g., 2.5 becomes 2, 3.5 becomes 4, and -2.5
+becomes -2.
+
+=item B<round_odd> LIST
+
+Rounds the number(s) to the nearest integer. In scalar context,
+returns a single value; in list context, returns a list of values.
+Numbers that are halfway between two integers are rounded to the
+nearest odd number; e.g., 3.5 becomes 3, 4.5 becomes 5, and -3.5
+becomes -3.
+
+=item B<round_rand> LIST
+
+Rounds the number(s) to the nearest integer. In scalar context,
+returns a single value; in list context, returns a list of values.
+Numbers that are halfway between two integers are rounded up or
+down in a random fashion. For example, in a large number of trials,
+2.5 will become 2 half the time and 3 half the time.
+
+=item B<nearest> TARGET, LIST
+
+Rounds the number(s) to the nearest multiple of the target value.
+TARGET must be positive.
+In scalar context, returns a single value; in list context, returns
+a list of values. Numbers that are halfway between two multiples
+of the target will be rounded to infinity. For example:
+
+ nearest(10, 44) yields 40
+ nearest(10, 46) 50
+ nearest(10, 45) 50
+ nearest(25, 328) 325
+ nearest(.1, 4.567) 4.6
+ nearest(10, -45) -50
+
+=item B<nearest_ceil> TARGET, LIST
+
+Rounds the number(s) to the nearest multiple of the target value.
+TARGET must be positive.
+In scalar context, returns a single value; in list context, returns
+a list of values. Numbers that are halfway between two multiples
+of the target will be rounded to the ceiling, i.e. the next
+algebraically higher multiple. For example:
+
+ nearest_ceil(10, 44) yields 40
+ nearest_ceil(10, 45) 50
+ nearest_ceil(10, -45) -40
+
+=item B<nearest_floor> TARGET, LIST
+
+Rounds the number(s) to the nearest multiple of the target value.
+TARGET must be positive.
+In scalar context, returns a single value; in list context, returns
+a list of values. Numbers that are halfway between two multiples
+of the target will be rounded to the floor, i.e. the next
+algebraically lower multiple. For example:
+
+ nearest_floor(10, 44) yields 40
+ nearest_floor(10, 45) 40
+ nearest_floor(10, -45) -50
+
+=item B<nearest_rand> TARGET, LIST
+
+Rounds the number(s) to the nearest multiple of the target value.
+TARGET must be positive.
+In scalar context, returns a single value; in list context, returns
+a list of values. Numbers that are halfway between two multiples
+of the target will be rounded up or down in a random fashion.
+For example, in a large number of trials, C<nearest(10, 45)> will
+yield 40 half the time and 50 half the time.
+
+=item B<nlowmult> TARGET, LIST
+
+Returns the next lower multiple of the number(s) in LIST.
+TARGET must be positive.
+In scalar context, returns a single value; in list context, returns
+a list of values. Numbers that are between two multiples of the
+target will be adjusted to the nearest multiples of LIST that are
+algebraically lower. For example:
+
+ nlowmult(10, 44) yields 40
+ nlowmult(10, 46) 40
+ nlowmult(25, 328) 325
+ nlowmult(.1, 4.567) 4.5
+ nlowmult(10, -41) -50
+
+=item B<nhimult> TARGET, LIST
+
+Returns the next higher multiple of the number(s) in LIST.
+TARGET must be positive.
+In scalar context, returns a single value; in list context, returns
+a list of values. Numbers that are between two multiples of the
+target will be adjusted to the nearest multiples of LIST that are
+algebraically higher. For example:
+
+ nhimult(10, 44) yields 50
+ nhimult(10, 46) 50
+ nhimult(25, 328) 350
+ nhimult(.1, 4.512) 4.6
+ nhimult(10, -49) -40
+
+=back
+
+=head1 STANDARD FLOATING-POINT DISCLAIMER
+
+Floating-point numbers are, of course, a rational subset of the real
+numbers, so calculations with them are not always exact. In order to
+avoid surprises because of this, these routines use a value for
+one-half that is very slightly larger than 0.5. Nevertheless,
+if the numbers to be rounded are stored as floating-point, they will
+be subject, as usual, to the mercies of your hardware, your C
+compiler, etc. Thus, numbers that are supposed to be halfway between
+two others may be stored in a slightly different way and thus behave
+surprisingly.
+
+=head1 AUTHOR
+
+Math::Round was written by Geoffrey Rommel E<lt>GROMMEL at cpan.orgE<gt>
+in October 2000.
+
+=cut
Added: packages/libmath-round-perl/branches/upstream/current/test.pl
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmath-round-perl/branches/upstream/current/test.pl?rev=4501&op=file
==============================================================================
--- packages/libmath-round-perl/branches/upstream/current/test.pl (added)
+++ packages/libmath-round-perl/branches/upstream/current/test.pl Sat Dec 2 16:56:31 2006
@@ -1,0 +1,90 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+################## We start with some black magic to print on failure.
+
+BEGIN { $| = 1; print "1..11\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Math::Round qw(:all);
+$loaded = 1;
+print "ok 1\n";
+
+################## End of black magic.
+
+my $failed = 0;
+
+#--- Both scalar and list contexts are tested.
+print "round............";
+was_it_ok(2, round(2.4) == 2 &&
+ round(2.5) == 3 &&
+ round(2.6) == 3 &&
+ eq2(round(-3.9, -2.5), -4, -3) );
+
+print "round_even.......";
+was_it_ok(3, round_even(2.4) == 2 &&
+ round_even(2.5) == 2 &&
+ eq2(round_even(-2.6, 3.5), -3, 4) );
+
+print "round_odd........";
+was_it_ok(4, round_odd(16.4) == 16 &&
+ round_odd(16.5) == 17 &&
+ round_odd(16.6) == 17 &&
+ eq2(round_odd(-16.7, 17.5), -17, 17) );
+
+print "round_rand.......";
+was_it_ok(5, round_rand(16.4) == 16 &&
+ round_rand(16.6) == 17 &&
+ eq2(round_rand(-17.8, -29.2), -18, -29) );
+
+print "nearest..........";
+was_it_ok(6, nearest(20, 9) == 0 &&
+ nearest(20, 10) == 20 &&
+ nearest(20, 11) == 20 &&
+ sprintf("%.2f", nearest(0.01, 16.575)) eq "16.58" &&
+ eq2(nearest(20, -98, -110), -100, -120) );
+
+print "nearest_ceil.....";
+was_it_ok(7, nearest_ceil(20, 9) == 0 &&
+ nearest_ceil(20, 10) == 20 &&
+ nearest_ceil(20, 11) == 20 &&
+ eq2(nearest_ceil(20, -98, -110), -100, -100) );
+
+print "nearest_floor....";
+was_it_ok(8, nearest_floor(20, 9) == 0 &&
+ nearest_floor(20, 10) == 0 &&
+ nearest_floor(20, 11) == 20 &&
+ eq2(nearest_floor(20, -98, -110), -100, -120) );
+
+print "nearest_rand.....";
+was_it_ok(9, nearest_rand(30, 44) == 30 &&
+ nearest_rand(30, 46) == 60 &&
+ eq2(nearest_rand(30, -76, -112), -90, -120) );
+
+print "nlowmult.........";
+was_it_ok(10, nlowmult(10, 44) == 40 &&
+ nlowmult(10, 46) == 40 &&
+ eq2(nlowmult(30, -76, -91), -90, -120) );
+
+print "nhimult..........";
+was_it_ok(11, nhimult(10, 41) == 50 &&
+ nhimult(10, 49) == 50 &&
+ eq2(nhimult(30, -74, -119), -60, -90) );
+
+if ($failed == 0) { print "All tests successful.\n"; }
+else {
+ $tt = ($failed == 1) ? "1 test" : "$failed tests";
+ print "$tt failed! There is no joy in Mudville.\n";
+}
+
+
+#--- Compare two lists with 2 elements each for equality.
+sub eq2 {
+ my ($a0, $a1, $b0, $b1) = @_;
+ return ($a0 == $b0 && $a1 == $b1) ? 1 : 0;
+}
+
+sub was_it_ok {
+ my ($num, $test) = @_;
+ if ($test) { print "ok $num\n"; }
+ else { print "not ok $num\n"; $failed++; }
+}
More information about the Pkg-perl-cvs-commits
mailing list