# While the quiz explicitly specified that the fudge
# could be applied to *any* of the values (but a maximum
# fudge of 1 in the last digit) I chose to apply the
# fudge so that the minimum error would occur.
# 
# 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).
# 
# So, I determined the error that came from the
# rounding, and then when some fudging was required,
# I sorted the values by the error and chose the one(s)
# that would stay closest to 0 after the fudging.
# 
# I also took some care to ensure that the rounded
# values were never permitted to lose their roundedness
# by floating point arithmetic.  So, I copied the
# value so that I could do arithmetic with it (possibly
# introducing some additional floating point skew below
# the desired precision) while separately retaining
# the rounded value as a string, converting it to an
# integer until any fudging was complete (and converting
# it back by string insertion of a period rather than by
# dividing by 10**n).
# 
# 
# #!/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)\$";
	s/$pat/.$1/ for @display;
    }
    return @display;
}

__END__

my $test;
for $test (
	[ 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";
}
