Question

We have a cost C which must be assigned to departments 1..n. Another computation produces the share for each department, it is a number from 0 to 1, with more than 5 decimal places. The sum of all department shares is exactly 1, but they are not necessarily equal.

The goal is to compute the exact dollars and cents to bill to each department. The sum of the bill must EXACTLY match the cost C, it cannot be a few pennies under or over. Furthermore, each department’s share must be not require fractional pennies. Additionally, although it is not fair to just dump the remainder onto the last department, it is not necessary to look back to previous timeframes. Note that simply rounding each department’s share to the penny almost always results in an over/under of a few pennies.

Grossly oversimplified example: C = 33.34 , 4 departments each with exactly 0.2500 share. Because 33.34 * 0.25 = 8.335 so you can see that two departments must pay 8.33 and two must pay 8.34. One correct assignment would be: d1=8.33, d2=8.34, d3=8.33, d4=8.34. If you round, every department pays 8.34 which results in an overage of $0.02. If you multiply this by many more departments and many more costs, you end up with hundred dollar discrepancies.

I want to do this in 1 pass, that is, I don’t want to loop through, find out I am off by 0.02, then loop again and tweak values until it is correct. I want to do this in 1 pass. I would also like to know if this algorithm has a name.

Answer 1

In Perl:

#!/usr/bin/perl

use strict;
use warnings;

use Data::Dumper;

use List::AllUtils qw( sum );

print Dumper allocate(10_000, .23, .37, .4);
print Dumper allocate(33.34, .25, .25, .25, .25);
print Dumper allocate(100, 1/3, 1/3, 1/3);

sub allocate {
    my ($C, @shares) = @_;

    my @alloc;

    while ( my $share = shift @shares ) {
        push @alloc, sprintf '%.2f', $C * $share;
        $C -= $alloc[-1];
        my $denom = sum @shares;
        $_ /= $denom for @shares;
    }

    return \@alloc;
}

Output:

$VAR1 = [
          '2300.00',
          '3700.00',
          '4000.00'
        ];
$VAR1 = [
          '8.34',
          '8.33',
          '8.34',
          '8.33'
        ];
$VAR1 = [
          '33.33',
          '33.34',
          '33.33'
        ];