#!/usr/bin/perl -w

# © 2009 Joost van Baal
#
# This file is free software; you can redistribute it and/or modify it under
# the terms of the GNU GPL version 3 or later; see <http://www.gnu.org/licenses/>.
# This file is distributed WITHOUT ANY WARRANTY.

# huisrekening - bepaal betalingen tussen leden aan de hand van bijdragen aan
#  gemeenschap
#
# huisrekening - a script to compute payment schemes for payback among people
#  who've all contributed (different) amounts of money to some common good.  (A
#  typical scenario for communities like student dorms.)
#
# voorbeeld:
#
# $ cat <<EOT | huisrekening
# piet 10
# jan 4
# marie 7
# klaas 0
# anne 1
# EOT

use strict;

my $maxsteps = 100;
my $rounding = 0.001;  # scheldt schulden kleiner dan rounding kwijt
my $debug = 0; # set to 1 for debugging output on stderr

my $mean = 0;
my $h = {};
my @betalingen = ();
my $stepsleft = $maxsteps; # force break of loop. FIXME: might be unneeded.
                           # or would rounding stuff be able to cause trouble?



# find key with min or max value
sub minmax {
    my $mode = shift;  # either "min" or "max"
    my $h = shift;
    my ($l, $max, $comp);
    while ((my $k, my $v) = each %$h) {
        defined $l or $l = $v;
        defined $max or $max = $k;
        $mode eq "max" ? ( $comp = ($v >= $l) ) : ( $comp = ($v <= $l) );
        if ($comp) {
            $debug and warn "changing $mode from $max to $k: comparing $v and $l\n";
            $max = $k;
            $l = $v;
        }
    }
    return $max;
}

while (<>) {
    chomp;
    (my $naam, my $bedrag) = split;
    $bedrag =~ /^-?(?:\d+(?:\.\d*)?|\.\d+)$/ or
        die "Fout in invoer: $bedrag is geen getal (gevonden op regel '$_').\n";
    $h->{$naam} = $bedrag;
    $mean += $bedrag;
}

$mean /= keys %$h;
$debug and warn "will lower all values with $mean\n";

# adjust hash: not amount contributed to community; but debt/credit to other members of community
for my $k (keys %$h) {
    $h->{$k} -= $mean;
    $debug and warn "value $k now " . $h->{$k} . "\n";
}

# calculate @betalingen
while (keys %$h and $stepsleft) {
    my $schuldenaar = &minmax("min", $h);
    my $schuld = $h->{$schuldenaar};
    my $vorderaar = &minmax("max", $h);
    my $vordering = $h->{$vorderaar};

    my $bedrag;
    $vordering + $schuld > 0 and $bedrag = $schuld or $bedrag = $vordering;

    $bedrag = abs($bedrag);

    $debug and warn "pushing $schuldenaar $vorderaar $bedrag\n";

    my $betaling = [ $schuldenaar, $vorderaar, $bedrag ];
    push @betalingen, ($betaling);

    $h->{$schuldenaar} += $bedrag;
    $h->{$vorderaar} -= $bedrag;

    for my $k ($schuldenaar, $vorderaar) {
        abs($h->{$k}) < $rounding and delete $h->{$k};
    }

    $stepsleft--;
}

unless ($stepsleft) {
    die "Kon geen betalingsschema bepalen binnen $maxsteps stappen.  Rapporteer
dit gedrag aub aan de auteur.  Vergeet niet instructies bij te leveren hoe
de bug te reproduceren.  Een patch met een fix wordt op prijs gesteld.\n";
}

for my $betaling (@betalingen) {
    printf "%s aan %s: %.2f\n", $betaling->[0], $betaling->[1], $betaling->[2];
}