Math-Round-Fair

 view release on metacpan or  search on metacpan

t/11-random.t  view on Meta::CPAN

#!perl -w

use strict;
$^W=1;

use lib 't/lib';

my ($seed, $cases, $iterations);
BEGIN {
	$seed = $ARGV[0] || 0;
	srand($seed);
	$cases = $ARGV[1] || 10;
	die unless $cases >= 1;
	$iterations = $ARGV[2] || 1000;
	die unless $iterations >= 10;
}

use Test;

BEGIN {
	plan tests => $cases, todo => [];
}

BEGIN { $ENV{MATH_ROUND_FAIR_DEBUG} = 0 }
use Check_FairRound;

t/11-random.t  view on Meta::CPAN

	# Generate all the cases first, so that the cases are the same even
	# if the runs use a different number of random numbers when the
	# implementation changes.
	my @in = gen_test_case;
	push @cases, \@in;
}
my $result = 0;
for my $case (1..$cases) {
	my $in = shift @cases;
	print "@$in\n" if 0;
	eval { Check_FairRound::run_case($in, $iterations, 1e-7/$cases) };
	if($@) {
		$result = 1 if @ARGV;
		chomp($@);
		ok(undef, 1, "$@ in case number $case (@$in) with seed=$seed");
	}
	else {
		ok(1);
	}
}
exit($result);

t/12-random_big.t  view on Meta::CPAN

#!perl -w

use strict;
$^W=1;

use lib 't/lib';

my ($seed, $cases, $iterations);
BEGIN {
	$seed = $ARGV[0] || 0;
	srand($seed);
	$cases = $ARGV[1] || 5;
	die unless $cases >= 1;
	$iterations = $ARGV[2] || 200;
	die unless $iterations >= 10;
}

use Test;

BEGIN {
	plan tests => $cases, todo => [];
}

BEGIN { $ENV{MATH_ROUND_FAIR_DEBUG} = 1 }
use Check_FairRound;

t/12-random_big.t  view on Meta::CPAN

	# Generate all the cases first, so that the cases are the same even
	# if the runs use a different number of random numbers when the
	# implementation changes.
	my @in = gen_test_case;
	push @cases, \@in;
}
my $result = 0;
for my $case (1..$cases) {
	my $in = shift @cases;
	print "@$in\n" if 0;
	eval { Check_FairRound::run_case($in, $iterations, 1e-7/$cases) };
	if($@) {
		$result = 1 if @ARGV;
		chomp($@);
		ok(undef, 1, "$@ in case number $case (@$in) with seed=$seed");
	}
	else {
		ok(1);
	}
}
exit($result);

t/lib/Check_FairRound.pm  view on Meta::CPAN

                # elected not to do so.
		$verify_stats = 0;
		warn "Not checking statistical properties because Math::CDF " .
		  "could not be loaded: $@";
        }
}

use Math::Round::Fair qw(round_adjacent);

sub run_case {
	my ($in, $iterations, $how_unlikely) = @_;
	die "Total loss of precision" if 1.0 - $how_unlikely/4.0 == 1.0;
	my @in = @$in;

	my $sum=0.0;
	$sum += $_ for(@in);

	my @accums = map { 0.0 } (@in, 'SUM');
	for my $iteration (1..$iterations) {
		eval {
			my @out = round_adjacent(@in);
			die "wrong number of results" unless @out==@in;
			my $round_sum=0;
			$round_sum += $_ for(@out);

			for(
			  (map { [$in[$_], $out[$_]] } ($[..$#in)),
			  [$sum, $round_sum]
			) {

t/lib/Check_FairRound.pm  view on Meta::CPAN

			for($[..$#in) {
				$accums[$_] += $out[$_];
			}
			$accums[-1] += $round_sum;
		};
		chomp($@) and die "$@ on iteration number $iteration" if $@;
	}

	if($verify_stats) {
		# Check that each average meets its expectation.
		my @avgs = map { $_/$iterations } @accums;
		for(
		  (map { [$in[$_], $avgs[$_]] } ($[..$#in)), [$sum, $avgs[-1]]
		) {
			my ($expect, $average) = @$_;
			my $n = $iterations;
			my $base = int($expect);
			my $p = abs($expect - $base);

			my $x = int($n * abs($average - $base) + 0.5);
			my $prob = pbinom($x, $n, $p);
			$prob = 1.0 - pbinom($x-1, $n, $p) if $x && $prob > 0.5;
			if($prob < $how_unlikely) {
				die
 "$expect rounded on average to $average (almost certainly a bug - prob=$prob)";
			}