#!/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 .
# 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 <= $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];
}