# Thanks to John Macdonald, Jamie McCarthy and Csaba Ráduly for your 
# helping me with my "how far off might we be" question. I've taken 
# that into account in this solution.
# 
# I wanted to fudge only those elements where I had rounded in the 
# direction of the error, and I wanted to stop fudging once the 
# 'error' had been removed.
# 
# My solution builds the full return array, then checks to see if the 
# percentages add to 100. If they don't, it rebuilds the array, 
# fudging as it goes until the "error" is compensated for. I don't 
# like that it builds the array twice - I'll be looking at other 
# solutions for more economical methods.
# 
# I adjusted for binary-to-decimal imprecision by introducing a 
# $tolerance variable inside the sub. This will break for very 
# high-precision calculations. Given the context of the problem, 
# though, I don't think that will be a problem. It is certainly a 
# *potential* problem, though, so I'll be looking at how others have 
# addressed that.

#!/usr/bin/perl -w
use strict;
use Math::Round;

my @one = fudge_numbers( 1, 30, 30, 10 );
print join ', ', @one;

sub fudge_numbers {
     my $precision = shift;
     my @in        = @_;
     my @out       = ();

     my $tolerance = 0.000_000_001;    # 1 one-billionth should suffice.

     my $sum       = 0;                # sum, for determining percentages.
     my $sum_total = 0;   # what you get when you add up all rounded percentages.
     my $off_by    = 0;   # difference between sum_total and 100.

     # this sub gets $precision as the number of digits after the decimal.
     # Math::Round::nearest wants to see precision as a decimal number, instead.
     if ( $precision == 0 ) {
         $precision = 1;
     }
     else {
         $precision = '.' . '0' x ( $precision - 1 ) . '1';
     }

     $sum += $_ for @in;

     foreach my $this (@in) {
         my $out = $this / $sum;
         $out *= 100;
         $out = nearest( $precision, $out );
         push @out, $out;
     }

     $sum_total += $_ for @out;

     $off_by = $sum_total - 100;

     if ( ( abs($off_by) > $tolerance ) ) {

         # rebuild the @out array, fudging elements as we go...
         @out = ();
         foreach my $this (@in) {
             my $out = $this / $sum;
             $out *= 100;
             $out = nearest( $precision, $out );

             if ( $off_by > 0 && ( abs($off_by) > $tolerance ) ) {
                 # if the overall difference is positive & we're still off...
                 if ( $out > ( ( $this / $sum ) * 100 ) ) {
                     # and if we rounded this one up
                     $out -= $precision;
                     $off_by -= $precision;
                     #round it down instead. update how much we're still off
                 }
             } ## end  if ( $off_by > 0 && ( abs($off_by...
             elsif ( $off_by < 0 && ( abs($off_by) > $tolerance ) ) {
                 if ( $out < ( $this / $sum ) * 100 ) {
                     $out    += $precision;
                     $off_by += $precision;
                 }
             }
             push @out, $out;
         } ## end  foreach my $this (@in)
     } ## end  if ( ( abs($off_by) > $tolerance...
   return @out;
} ## end  sub fudge_numbers

