# 
# On Mon, Dec 02, 2002 at 09:59:15AM +0000, csaba.raduly@sophos.com wrote:
# > 
# > No, I'm using the same definition of fudging :-)
# > The difference is that I'm truncating the percentages
# > instead of rounding (it seems to me that it is acceptable behaviour,
# > because it's within the "less than 1 of the last decimal place").
# 
# The problem statement specified rounding.
# 
# I was about to leave it at that - "obviously wrong".
# However, using truncation has some advantages.
# 
# - As you point out, the numbers are within 1 in
#   the last decimal place.
# 
# - Fudging will always be incrementing, never
#   decrementing.
# 
# Then a light bulb went on.  If you use the technique
# of applying the fudge to the elements that had the
# greatest error from the trucation, the fudging process
# will then minimise the final error and come to the
# same result as when you start with rounding.
# 
# And, because the fudging is always positive, the code
# is simpler.  I like that.  Here's my code revised to
# take advantage of this:
# 
#!/usr/bin/perl -w

use strict;

sub fudge_numbers {
    my( $prec ) = shift;
    my $sum = 0;
    $sum += $_ for @_;
    my( @display, @err, $totdisp );
    foreach ( @_ ) {
	my $exact = $_ / $sum * 100 * 10**$prec;
	my $trunc = int $exact;
	push( @display, $trunc );
	my $err = $exact - $trunc;
	push( @err, $err );
	$totdisp += $trunc;
    }
    # 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[$b] <=> $err[$a] } 0..$#_;
	while( $target > $totdisp ) {
	    ++$display[shift @ord];
	    ++$totdisp;
	}
    }
    # 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";
}
