# On Mon, Dec 02, 2002 at 11:51:15AM +0100, Andreas J. Koenig wrote:
# > >>>>> On Sun, 1 Dec 2002 23:40:16 -0500, John Macdonald <jmm@perlwolf.com> said:
# > 
# >   > If one number had a .45 rounded down to 0, while
# >   > another had .11 rounded down to zero; it is less
# >   > erroneous to fudge up the first than the second
# >   > (the default rounding gives an error vector of
# >   > [-0.45,-0.11], fudging the first gives an error vector
# >   > of [0.55,-0.11], while fudging the second gives an
# >   > error vector of [-0.45,0.89] which is less balanced).
# > 
# > Excellent idea!
# > 
# > But somewhere is a bug. When I feed
# > 
# > 3 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 1
# > 
# > to your function, I get surprisingly:
# > 
# > 9.090 9.090 9.090 9.090 9.090 9.090 9.090 9.090 9.090 9.090 9.090 10
# 
# Ouch.  Converting to integer is useful to maintain precision,
# but there isn't always a large enough number to have a position
# to insert the decimal point back in when I convert back to a
# decimal fraction.
# 
# Here's the fix:
# 
#       if( $prec ) {
#   	my $pat = '.' x $prec;
#   	$pat = "($pat)\$";
# - 	s/$pat/.$1/ for @display;
# + 	for( @display ) {
# + 	    s/^/0/ until s/$pat/.$1/;
# + 	}
#       }
#       return @display;
#   }
# 
# After the fix, the module looks like:
# 
#!/usr/bin/perl -w

use strict;

sub fudge_numbers {
    my( $prec ) = shift;
    my $fmt = "%.${prec}f";
    my $sum = 0;
    $sum += $_ for @_;
    my( @display, @err, $totdisp );
    foreach ( @_ ) {
	my $exact = $_ / $sum * 100;
	my $round = sprintf $fmt, $exact;
	# copy the string before it gets used as a number
	my $display = $round;
	# remove the decimal point from the display value (for now)
	$display =~ s/\.//;
	push( @display, $display );
	my $err = $exact - $round;
	push( @err, $err );
	$totdisp += $display;
    }
    # without the decimal point, the target total is 100 x extra digits
    my $target = 10 ** (2+$prec);
    if( $target != $totdisp ) {
	# fudging is required
	# find the values that will be least incorrect when fudged
	my( @ord ) = sort { $err[$a] <=> $err[$b] } 0..$#_;
	my $incr = -1;
	if( $target > $totdisp ) {
	    $incr = 1;
	    @ord = reverse @ord;
	}
	while( $target != $totdisp ) {
	    $display[shift @ord] += $incr;
	    $totdisp += $incr;
	}
    }
    # reinsert the decimal point
    if( $prec ) {
	my $pat = '.' x $prec;
	$pat = "($pat)\$";
	for( @display ) {
	    s/^/0/ until s/$pat/.$1/;
	}
    }
    return @display;
}

__END__

my $test;
for $test (
	[ 3, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1 ],
	[ 0, 1, 4, 7 ],
	[ 0, 7, 7, 3, 3, 1 ],
	[ 1, 30, 30, 10 ],
	[ 0, 7, 7, 7 ],
	[ 1, 7, 7, 7 ],
	[ 2, 10, 10, 30 ],
	) {
    print "Testing: @$test\n";
    print "Result: ", join( ' ', fudge_numbers( @$test ) ), "\n";
}
