# 
# Ooops. I was applying all the adjustment the first element and had
# neglected to take into account that the percentage could be zero.
# Also changed the loop conditional to only continue as long as the
# magnitude of the difference was greater than the adjustment magnitude.
# 
# /me writes "I will write a test harness" on the blackboard
# 
# Garth
#
#!/opt/bin/perl -w
###############################################################################
# QOTW #7 - print fudged percentages so that they always add up to 100 given
# a data list
###############################################################################
use strict;

use constant FLOAT => 1; # size of difference (real-actual) allowable
                         # in final decimal place

my $precision = 1;
# my @data = (100, 100, 100, 100, 100, 100);
#my @data = (10, 20, 30, 30);
my @data = qw/1 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 1/;

my @percents = fudge_numbers($precision, @data);
print "(", join(" , ", @percents), ")\n";


sub fudge_numbers {
    my($precision, @data) = @_;

    my @percentages;

    die("Negative precision not allowed.\n") if ($precision < 0);

    # calculate the of sum of the data elements, negative values are an error
    my $sum = 0;
    foreach my $datum (@data) {
        die("Negative value for data element.\n") if($datum < 0);
        $sum += $datum;
    }

    # Calculate the percentage for each element, rounding to the desired
    # precision
    foreach my $datum (@data) {
        my $percent = sprintf("%." . $precision . "f", $datum/$sum*100);
        push(@percentages, $percent);
    }

    # Determine the sum of the percentages and get the difference from
    # 100%
    my $difference = 100;
    foreach my $p (@percentages) {
        $difference -= $p;
    }

    # round to the appropriate level of precision
    $difference = sprintf("%." . $precision . "f", $difference);
    print "diff is $difference\n";

    # If the difference is positive then FLOAT units have to be added to the
    # percentage, negative means FLOAT units have to be removed.
    # The amount that each percentage can be changed is:
    # FLOAT * 10^(-)$precision
    my $adjustment = sprintf("%." . $precision . "f", FLOAT * 10 ** (-1 * $precision));

    # Don't apply an adjustment if the percentage is zero or if the adjustment
    # would cause the percentage to become less than zero.
    # Only apply adjustments as long as the magnitude of the difference is
    # greater than the possible adjustment.
    if($difference > 0) {
        my $index = 0;
        while($difference >= $adjustment) {
            die("No more elements to adjust.\n") if ($index >= scalar(@percentages));
            if($percentages[$index] == 0) {
                $index++;
                next;
            }
            $percentages[$index] += $adjustment;
            $difference -= $adjustment;
            $index++;
        }
    } elsif ($difference < 0) {
        my $index = 0;
        while($difference <= (-1 * $adjustment)) {
            die("No more elements to adjust.\n") if ($index >= scalar(@percentages));
            if ($percentages[$index] == 0 || $percentages[$index] < $adjustment) {
                $index++;
                next;
            }
            $percentages[$index] -= $adjustment;
            $difference += $adjustment;
            $index++;
        }
    }

    return @percentages;
}


