-#!/usr/bin/en perl
+#!/usr/bin/env perl
# The MIT License (MIT)
#
# Copyright (c) 2011-2015 Ismaël Bouya http://www.normalesup.org/~bouya/
my @transactions = ();
my @descriptions = ();
my $evenement_def;
-my $remboursements = "";
-
-if($#ARGV==0) {
- open FILE, $ARGV[0] || die "Impossible de lire le fichier";
- $evenement_def = <FILE>;
- chomp($evenement_def);
- while(my $noms = <FILE>) {
- if($noms eq "\n") { last; }
- my ($numero,$nom) = split(/ /,$noms,2);
- chomp($nom);
- $participants{$nom} = $numero;
+my @remboursements = ();
+my %initiales = ();
+
+if($#ARGV == 0) {
+ open FILE, $ARGV[0] || die "Impossible de lire le fichier";
+ $evenement_def = <FILE>;
+ chomp($evenement_def);
+ while(my $noms = <FILE>) {
+ if($noms eq "\n") { last; }
+ my ($numero,$nom) = split(/ /,$noms,2);
+ chomp($nom);
+ $participants{$nom} = $numero;
+ }
+ while(my $transaction = <FILE>) {
+ if($transaction eq "\n") { last; }
+ chomp($transaction);
+ push(@transactions,$transaction);
+ my $description = <FILE>;
+ chomp($description);
+ push(@descriptions,$description);
+ }
+ while(my $remboursement = <FILE>) {
+ if($remboursement eq "\n") { last; }
+ chomp($remboursement);
+ my @remb = split(/ /, $remboursement);
+ push(@remboursements,\@remb);
+ }
+ $file = $ARGV[0];
+}
+
+sub choose_action {
+ my @actions = ('Ajouter un participant');
+ my $action;
+
+ if (keys(%participants) > 0) {
+ $actions[1] = "Ajouter une dépense";
+ $actions[2] = "Enregistrer";
+ }
+ if(scalar(@transactions) > 0) {
+ $actions[2] = "Enregistrer";
+ $actions[3] = "Voir les frais de quelqu'un (dépenses - dettes)";
+ $actions[4] = "Voir les frais de tout le monde";
+ $actions[5] = "Equilibrage";
+ $actions[6] = "Voir une transaction";
+ }
+ if(scalar(@remboursements) > 0) {
+ $actions[7] = "Afficher les remboursements";
+ }
+
+ while(1) {
+ my $i = 1;
+ my $var;
+ my @vart = ( @actions, 'Sortir' );
+ my $message = '';
+ foreach $var ( @vart ) {
+ $message .= $i++.') '.$var."\n";
+ }
+ print $message;
+ $var = <STDIN>;
+ chop($var);
+ if(/\D/ || $var < 1 || $var > $i) {
+ print "Mauvaise entrée\n";
+ next;
+ }
+ $action = $vart[$var-1];
+ last;
+ }
+
+ return $action;
+}
+
+sub pp {
+ my ($price, $noteur) = @_;
+
+ if (!$noteur) {
+ return sprintf("%.2f", $price)." EUR";
+ } else {
+ return sprintf("%.2f", $price);
+ }
+}
+
+sub compute_initiales {
+ %initiales = ();
+}
+
+sub add_participant {
+ print "Nom du participant ?\n";
+ my $participant = <STDIN>;
+ chomp($participant);
+ $participant =~ s/\s/_/g;
+ $participants{$participant} = keys(%participants)+1;
+ compute_initiales();
+}
+
+sub select_menu {
+ my (@vart) = @_;
+ while(1) {
+ my $i = 1;
+ my $var;
+ foreach $var ( @vart ) {
+ print $i++.') '.$var."\n";
+ }
+ $var = <STDIN>;
+ chop($var);
+ if(/\D/ || $var < 1 || $var > scalar @vart) {
+ print "Mauvaise entrée\n";
+ next;
}
- while(my $transaction = <FILE>) {
- if($transaction eq "\n") { last; }
- chomp($transaction);
- push(@transactions,$transaction);
- my $description = <FILE>;
- chomp($description);
- push(@descriptions,$description);
+ return $vart[$var-1];
+ }
+}
+
+sub select_participant {
+ my ($annuler, @supplementaires) = @_;
+ while(1) {
+ my $i = 1;
+ my $var;
+ my @vart = ( keys(%participants), @supplementaires, ($annuler) );
+ foreach $var ( @vart ) {
+ print $i++.') '.$var."\n";
}
- $file = $ARGV[0];
+ $var = <STDIN>;
+ chop($var);
+ if(/\D/ || $var < 1 || $var > scalar @vart) {
+ print "Mauvaise entrée\n";
+ next;
+ }
+ if ($var != scalar @vart) {
+ return $vart[$var-1];
+ } else {
+ return;
+ }
+ }
+}
+
+sub select_transaction {
+ my $transaction;
+ while(1) {
+ my $i = 1;
+ my $var;
+ my @vart = ( @descriptions, "Annuler" );
+ foreach $var ( @vart ) {
+ print $i++.') '.$var."\n";
+ }
+ $var = <STDIN>;
+ chop($var);
+ if(/\D/ || $var < 1 || $var > $i) {
+ print "Mauvaise entrée\n";
+ next;
+ }
+ $transaction = $var-1;
+ last;
+ }
+
+ my ($payeur, $prix, $total_parts, $split, $parts) = &parse_transaction($transactions[$transaction]);
+ return ($descriptions[$transaction], $payeur, $prix, $total_parts, $split, $parts);
+}
+
+sub add_transaction {
+ print "Qui a payé ?\n";
+ my $paye = select_participant("Annuler");
+ if(!$paye) {
+ print "Annulé";
+ return;
+ }
+ print "Quoi ?\n";
+ my $description = <STDIN>;
+ chomp($description);
+ print "Combien ?\n";
+ my $prix = <STDIN>;
+ chomp($prix);
+ print "Pour qui ?\n";
+ my $repartition = "";
+ my $total_parts = 0;
+ DESTS: while(1) {
+ my $dest = select_participant("Fini", "Ajouter à tous");
+ switch($dest) {
+ case undef {
+ if($repartition eq "") {
+ print "Annulé\n";
+ return;
+ }
+ elsif($total_parts == 0) {
+ print "Le nombre total de parts est nul, il faut en ajouter !\n";
+ next DESTS;
+ }
+ else {
+ push(@transactions, $participants{$paye}.' '.$prix.$repartition);
+ push(@descriptions, $description);
+ return;
+ }
+ }
+ case "Ajouter à tous" {
+ print "Nombre de parts ?\n";
+ my $parts = <STDIN>;
+ chomp($parts);
+ if(!($parts == 0)) {
+ foreach my $participant (keys(%participants)) {
+ $repartition .= ' '.$participants{$participant}.':'.scalar($parts);
+ $total_parts += scalar($parts);
+ }
+ }
+ }
+ else {
+ print "Nombre de parts ?\n";
+ my $parts = <STDIN>;
+ chomp($parts);
+ if(!($parts == 0)) {
+ $repartition .= ' '.$participants{$dest}.':'.scalar($parts);
+ $total_parts += scalar($parts);
+ }
+ }
+ }
+ }
+}
+
+sub find_participant {
+ my ($participant_number) = @_;
+
+ foreach my $name (keys(%participants)) {
+ if ($participant_number == $participants{$name}) {
+ return $name;
+ }
+ }
+}
+
+sub parse_transaction {
+ my ($transaction) = @_;
+ my @table_trans = split(/ /,$transaction);
+
+ my $payeur = shift(@table_trans);
+ $payeur = find_participant($payeur);
+ my $prix = shift(@table_trans);
+ my %parts;
+ my %split;
+ my $total_parts = 0;
+ foreach my $repartition (@table_trans) {
+ my ($participant, $part) = split(/:/, $repartition);
+ $participant = find_participant($participant);
+ $parts{$participant} ||= 0;
+ $parts{$participant} += $part;
+ $total_parts += $part;
+ }
+ if (!$parts{$payeur}) {
+ $parts{$payeur} = 0;
+ }
+ foreach my $participant (keys(%parts)) {
+ $split{$participant} = - ($parts{$participant} * $prix) / $total_parts;
+ if ($participant eq $payeur) {
+ $split{$participant} += $prix;
+ }
+ }
+
+ return ($payeur, $prix, $total_parts, \%split, \%parts);
+}
+
+sub max_length {
+ my (@strings) = @_;
+ my @string_lengths = sort { length($a) <=> length($b) } @strings;
+ return length($string_lengths[-1]);
+}
+
+sub list_transactions_for_participants {
+ my (@participants) = @_;
+ my $one_participant = 0;
+ if (scalar @participants == 0) {
+ @participants = keys(%participants);
+ }
+ if (scalar @participants == 1) {
+ $one_participant = 1;
+ }
+
+ my %depenses;
+ my %solde;
+
+ my @zipped = map {($transactions[$_], $descriptions[$_])} (0 .. $#descriptions);
+ while (scalar(@zipped) > 0) {
+ my $transaction = shift @zipped;
+ my $description = shift @zipped;
+ my ($payeur, $prix, $total_parts, $parsed_transaction, $parts) = &parse_transaction($transaction);
+ $depenses{$payeur} ||= 0;
+ $depenses{$payeur} += $prix;
+
+ my @intersection = grep( $parsed_transaction->{$_}, @participants);
+ if (scalar @intersection) {
+ my $phantom = " " x length($description.":");
+ my $max_participant_length = max_length(@intersection);
+
+ print $description.":";
+ foreach my $participant (@intersection) {
+ $solde{$participant} ||= 0;
+ $solde{$participant} += $parsed_transaction->{$participant};
+
+ if ($one_participant) {
+ print " ".pp($parsed_transaction->{$participant});
+ if ($payeur eq $participant) {
+ print " (a payé, ".pp($prix).")";
+ }
+ print "\n";
+ } else {
+ my $participant_padding = " " x ($max_participant_length - length($participant));
+ print " ".$participant.$participant_padding." ".pp($parsed_transaction->{$participant});
+ if ($payeur eq $participant) {
+ print " (a payé, ".pp($prix).")";
+ }
+ print "\n".$phantom;
+ }
+ }
+ if (!$one_participant) {
+ print "\n";
+ }
+ }
+ }
+
+ foreach my $personne (@participants) {
+ my $d = $depenses{$personne} || 0;
+ my $s = $solde{$personne} || 0;
+ if ($d) {
+ print $personne." a payé ".pp($d);
+ } else {
+ print $personne." n'a rien payé";
+ }
+ if ($s) {
+ print " et a pour ".pp($d - $s)." de frais au total.\n";
+ } else {
+ print " et n'a pas eu de frais.\n";
+ }
+ print $personne." a donc un solde de ".pp($s)."\n";
+ }
+}
+
+sub compute_equity {
+ my %depenses;
+ my %frais;
+ my %soldes;
+ foreach my $transaction (@transactions) {
+ my ($payeur, $prix, $total_parts, $split, $parts) = &parse_transaction($transaction);
+ $depenses{$payeur} += $prix;
+
+ foreach my $personne (keys(%{$split})) {
+ $soldes{$personne} += $split->{$personne};
+ }
+ }
+ foreach my $personne (keys(%soldes)) {
+ $frais{$personne} = $depenses{$personne} - $soldes{$personne};
+ }
+
+ return (\%depenses, \%frais, \%soldes);
+}
+
+sub delete_zeros {
+ my ($soldes, @participants) = @_;
+
+ foreach my $participant (@participants) {
+ delete $soldes->{$participant} if pp($soldes->{$participant}, 1) == 0;
+ }
+}
+
+sub compute_reimbursment {
+ my ($a, $b, $soldes) = @_;
+ my $s_a = $soldes->{$a};
+ my $s_b = $soldes->{$b};
+
+ return if (pp($s_a, 1) * pp($s_b, 1) >= 0);
+ my $debtor = pp($s_a, 1) < 0 ? $a : $b;
+ my $creditor = pp($s_a, 1) > 0 ? $a : $b;
+ my $exchange = (abs($s_a) < abs($s_b)) ? abs($s_a) : abs($s_b);
+
+ my @remboursement = ($debtor, $creditor, $exchange);
+ push @remboursements, \@remboursement;
+ $soldes->{$creditor} -= $exchange;
+ $soldes->{$debtor} += $exchange;
+ delete_zeros($soldes, $a, $b);
+}
+
+sub select_exchange_couple {
+ my ($soldes) = @_;
+ my $bd; # biggest debtor
+ my $sc; # smallest creditor
+
+ foreach my $p (keys(%{$soldes})) {
+ $bd = $p if $soldes->{$p} < 0 && (!$bd || $soldes->{$p} < $soldes->{$bd});
+ $sc = $p if $soldes->{$p} > 0 && (!$sc || $soldes->{$p} < $soldes->{$sc});
+ }
+
+ return ($bd, $sc);
+}
+
+sub print_remboursements {
+ foreach my $remboursement (@remboursements) {
+ my ($debtor, $creditor, $exchange) = (@{$remboursement});
+ print $debtor." doit ".pp($exchange)." à ".$creditor."\n";
+ }
+ my $pause = <STDIN>;
}
GLOBALE: while(1) {
- if(keys(%participants)>0) {
- $actions[1]="Ajouter une dépense";
- $actions[2]="Enregistrer";
+ my $action = choose_action();
+ switch ($action) {
+ case "Ajouter un participant" {
+ add_participant();
+ }
+ case "Ajouter une dépense" {
+ add_transaction();
+ }
+ case "Voir les frais de quelqu'un (dépenses - dettes)" {
+ my $personne = select_participant("Annuler");
+ if(!$personne) {
+ next GLOBALE;
+ }
+ list_transactions_for_participants(($personne));
+ my $pause = <STDIN>;
+ }
+ case "Voir les frais de tout le monde" {
+ list_transactions_for_participants(keys(%participants));
+ my $pause = <STDIN>;
}
- if(scalar(@transactions)>0) {
- $actions[3]="Voir les dépenses de quelqu'un";
- $actions[2]="Enregistrer";
- $actions[4]="Equilibrage";
- $actions[5]="Voir une transaction";
+ case "Voir une transaction" {
+ my ($description, $payeur, $prix, $total_parts, $split, $parts) = select_transaction();
+ print $description." (payé par ".$payeur."), ".pp($prix)."\n";
+ foreach my $pers (keys(%{$split})) {
+ print $pers.", ".$parts->{$pers}." part(s), soit ". pp($split->{$pers});
+ if ($pers eq $payeur) {
+ print " (".pp($prix)." - ".pp($prix - $split->{$pers}).")";
+ }
+ print "\n";
+ }
}
+ case "Enregistrer" {
+ print "Nom de l'événement ?";
+ if(!($evenement_def eq "")) {
+ print " [".$evenement_def."]";
+ }
+ print "\n";
+ my $evenement = <STDIN>;
+ chomp($evenement);
+ if($evenement eq "") {
+ $evenement = $evenement_def;
+ }
+ open FILE, ">".$file;
+ print FILE $evenement."\n";
+ my $key;
+ foreach $key (keys(%participants)) {
+ print FILE $participants{$key}." ".$key."\n";
+ }
+ print FILE "\n";
+ for(my $i=0;$i<scalar(@transactions);$i++) {
+ print FILE $transactions[$i]."\n";
+ print FILE $descriptions[$i]."\n";
+ }
+ print FILE "\n";
+ foreach my $remboursement (@remboursements) {
+ print FILE join(" ", @{$remboursement})."\n";
+ }
+ close FILE;
+ }
+ case "Equilibrage" {
+ my ($depenses, $frais, $soldes) = compute_equity();
+ @remboursements = ();
+
+ foreach my $personne (keys(%participants)) {
+ print $personne." a un solde de ".pp($soldes->{$personne})." (+" . pp($depenses->{$personne}). " / -". pp($frais->{$personne}) . ")\n";
+ }
+ my $pause = <STDIN>;
+ print "Y-a-t-il des remboursements plus aisés ?\n";
+ my $ouinon = select_menu("Oui", "Non");
- my $action;
- while(1) {
- my $i = 1;
- my $var;
- my @vart = ( @actions, 'Sortir' );
- my $message = '';
- foreach $var ( @vart ) {
- $message .= $i++.') '.$var."\n";
- }
- print $message;
- $var = <STDIN>;
- chop($var);
- if(/\D/ || $var < 1 || $var > $i) {
- print "Mauvaise entrée\n";
- next;
- }
- $action = $vart[$var-1];
- last;
+ AISE: while($ouinon eq "Oui") {
+ print "Qui ?\n";
+ my $personnea = select_participant("Fini");
+ if(!$personnea) { last AISE; }
+ print "Avec qui ?\n";
+ my $personneb = select_participant("Annuler");
+ if(!$personneb) { next AISE; }
+ compute_reimbursment($personnea, $personneb, $soldes);
+ }
+ # Une boucle pour détecter si on a des couples qui s'annulent mutuellement
+ delete_zeros($soldes, keys(%{$soldes}));
+ COUPLE: foreach my $personnea (keys(%participants)) {
+ next if(pp($soldes->{$personnea}, 1) == 0);
+ foreach my $personneb (keys(%participants)) {
+ next if (pp($soldes->{$personneb} + $soldes->{$personnea}, 1) != 0);
+ compute_reimbursment($personnea, $personneb, $soldes);
+ next COUPLE;
+ }
+ }
+ REMB: while(1) {
+ last REMB if(keys(%{$soldes}) == 0);
+
+ my ($biggest_debtor, $smallest_creditor) = select_exchange_couple($soldes);
+ compute_reimbursment($biggest_debtor, $smallest_creditor, $soldes);
+ }
+ print_remboursements();
+ }
+ case "Afficher les remboursements" {
+ print_remboursements();
}
- switch ($action) {
- case "Ajouter un participant" {
- print "Nom du participant\n";
- my $participant = <STDIN>;
- chomp($participant);
- $participants{$participant} = keys(%participants)+1;
- }
- case "Ajouter une dépense" {
- print "Qui a payé ?\n";
- my $paye;
- while(1) {
- my $i = 1;
- my $var;
- my @vart = ( keys(%participants), "Annuler" );
- foreach $var ( @vart ) {
- print $i++.') '.$var."\n";
- }
- $var = <STDIN>;
- chop($var);
- if(/\D/ || $var < 1 || $var > $i) {
- print "Mauvaise entrée\n";
- next;
- }
- $paye = $vart[$var-1];
- last;
- }
- if($paye eq "Annuler") {
- next GLOBALE;
- }
- print "Quoi ?\n";
- my $description = <STDIN>;
- chomp($description);
- print "Combien ?\n";
- my $prix = <STDIN>;
- chomp($prix);
- print "Pour qui ?\n";
- my $repartition = "";
- my $total_parts = 0;
- DESTS: while(1) {
- my $dest;
- while(1) {
- my $i = 1;
- my $var;
- my @vart = ( keys(%participants), "Ajouter à tous", "Fini" );
- foreach $var ( @vart ) {
- print $i++.') '.$var."\n";
- }
- $var = <STDIN>;
- chop($var);
- if(/\D/ || $var < 1 || $var > $i) {
- print "Mauvaise entrée\n";
- next;
- }
- $dest = $vart[$var-1];
- last;
- }
- switch($dest) {
- case "Fini" {
- if($repartition eq "") { print "Annulé\n"; }
- elsif($total_parts == 0) {
- print "Le nombre total de parts est nul, il faut en ajouter !\n";
- next DESTS;
- }
- else {
- push(@transactions, $participants{$paye}.' '.$prix.$repartition);
- push(@descriptions, $description);
- }
- last DESTS;
- }
- case "Ajouter à tous" {
- print "Nombre de parts ?\n";
- my $parts = <STDIN>;
- chomp($parts);
- if(!($parts == 0)) {
- foreach my $participant (keys(%participants)) {
- $repartition .= ' '.$participants{$participant}.':'.scalar($parts);
- $total_parts += scalar($parts);
- }
- }
- }
- else {
- print "Nombre de parts ?\n";
- my $parts = <STDIN>;
- chomp($parts);
- if(!($parts == 0)) {
- $repartition .= ' '.$participants{$dest}.':'.scalar($parts);
- $total_parts += scalar($parts);
- }
- }
- }
- }
- }
- case "Voir les dépenses de quelqu'un" {
- my $personne;
- while(1) {
- my $i = 1;
- my $var;
- my @vart = ( keys(%participants), "Annuler" );
- foreach $var ( @vart ) {
- print $i++.') '.$var."\n";
- }
- $var = <STDIN>;
- chop($var);
- if(/\D/ || $var < 1 || $var > $i) {
- print "Mauvaise entrée\n";
- next;
- }
- $personne = $vart[$var-1];
- last;
- }
- if($personne eq "Annuler") {
- next GLOBALE;
- }
- my $depenses = 0;
- my $frais = 0;
- foreach my $transaction (@transactions) {
- my @table_trans = split(/ /,$transaction);
- my $payeur = shift(@table_trans);
- my $prix = shift(@table_trans);
- if($payeur == $participants{$personne}) {
- $depenses += $prix;
- }
- my $parts = 0;
- my $frac = 0;
- my $repartition;
- foreach $repartition (@table_trans) {
- my ($pers,$part) = split(/:/,$repartition);
- if($pers == $participants{$personne}) {
- $frac += $part;
- }
- $parts += $part;
- }
- $frais += $prix*$frac/$parts;
- }
- print $personne." a payé ".$depenses." EUR\n";
- print "et a pour ".sprintf("%.2f",$frais)." EUR de frais au total.\n";
- print "Il a donc un solde de ".sprintf("%.2f",$depenses-$frais)." EUR\n";
- my $pause = <STDIN>;
- }
- case "Voir une transaction" {
- my $transaction;
- while(1) {
- my $i = 1;
- my $var;
- my @vart = ( @descriptions, "Annuler" );
- foreach $var ( @vart ) {
- print $i++.') '.$var."\n";
- }
- $var = <STDIN>;
- chop($var);
- if(/\D/ || $var < 1 || $var > $i) {
- print "Mauvaise entrée\n";
- next;
- }
- $transaction = $var-1;
- last;
- }
- my @table_trans = split(/ /,$transactions[$transaction]);
- my $payeur = shift(@table_trans);
- my $prix = shift(@table_trans);
- my $Tparts = 0;
- my $repartition;
- my %parts;
- foreach my $pers (keys(%participants)) {
- if($payeur == $participants{$pers}) {
- print $descriptions[$transaction]." (payé par ".$pers."), ".$prix." EUR\n";
- last
- }
- }
- foreach $repartition (@table_trans) {
- my ($pers,$part) = split(/:/,$repartition);
- $Tparts += $part;
- $parts{$pers} += $part;
- }
- foreach my $pers (keys(%participants)) {
- if(!exists $parts{$participants{$pers}}) {
- next;
- }
- print $pers.", ".$parts{$participants{$pers}}." part(s), soit ". $prix*$parts{$participants{$pers}}/$Tparts." EUR\n";
- }
- my $pause = <STDIN>;
- }
- case "Enregistrer" {
- print "Nom de l'événement ?";
- if(!($evenement_def eq "")) {
- print " [".$evenement_def."]";
- }
- print "\n";
- my $evenement = <STDIN>;
- chomp($evenement);
- if($evenement eq "") {
- $evenement = $evenement_def;
- }
- open FILE, ">".$file;
- print FILE $evenement."\n";
- my $key;
- foreach $key (keys(%participants)) {
- print FILE $participants{$key}." ".$key."\n";
- }
- print FILE "\n";
- for(my $i=0;$i<scalar(@transactions);$i++) {
- print FILE $transactions[$i]."\n";
- print FILE $descriptions[$i]."\n";
- }
- print FILE "\n";
- print FILE $remboursements;
- close FILE;
- }
- case "Equilibrage" {
- my %Tdepenses = ();
- my %Tfrais = ();
- my %Tsolde = ();
- $remboursements = "";
- foreach my $Ttransaction (@transactions) {
- my @Ttable_trans = split(/ /,$Ttransaction);
- my $Tpayeur = shift(@Ttable_trans);
- my $Tprix = shift(@Ttable_trans);
- $Tdepenses{$Tpayeur} = $Tdepenses{$Tpayeur} + $Tprix;
- my $Tparts = 0;
- my $Tfrac = 0;
- my $Trepartition;
- foreach $Trepartition (@Ttable_trans) {
- my ($Tpers,$Tpart) = split(/:/,$Trepartition);
- $Tparts += $Tpart;
- }
- foreach $Trepartition (@Ttable_trans) {
- my ($Tpers,$Tpart) = split(/:/,$Trepartition);
- $Tfrais{$Tpers} = $Tfrais{$Tpers} + $Tprix*$Tpart/$Tparts;
- }
- }
- foreach my $Tpersonne (keys(%participants)) {
- my $numero = $participants{$Tpersonne};
- $Tsolde{$Tpersonne} = sprintf("%.2f",$Tdepenses{$numero}-$Tfrais{$numero});
- print $Tpersonne." a un solde de ".$Tsolde{$Tpersonne}." EUR\n";
- }
- my $pause = <STDIN>;
- print "Y-a-t-il des remboursements plus aisés ?\n";
- my $ouinon;
- while(1) {
- my $i = 1;
- my $var;
- my @vart = ( "Oui", "Non" );
- foreach $var ( @vart ) {
- print $i++.') '.$var."\n";
- }
- $var = <STDIN>;
- chop($var);
- if(/\D/ || $var < 1 || $var > $i) {
- print "Mauvaise entrée\n";
- next;
- }
- $ouinon = $vart[$var-1];
- last;
- }
- AISE: while($ouinon eq "Oui") {
- print "Qui ?\n";
- my $personne;
- while(1) {
- my $i = 1;
- my $var;
- my @vart = ( keys(%participants), "Fini" );
- foreach $var ( @vart ) {
- print $i++.') '.$var."\n";
- }
- $var = <STDIN>;
- chop($var);
- if(/\D/ || $var < 1 || $var > $i) {
- print "Mauvaise entrée\n";
- next;
- }
- $personne = $vart[$var-1];
- last;
- }
- if($personne eq "Fini") { last AISE; }
- print "Avec qui ?\n";
- my $personneb;
- while(1) {
- my $i = 1;
- my $var;
- my @vart = ( keys(%participants), "Annuler" );
- foreach $var ( @vart ) {
- print $i++.') '.$var."\n";
- }
- $var = <STDIN>;
- chop($var);
- if(/\D/ || $var < 1 || $var > $i) {
- print "Mauvaise entrée\n";
- next;
- }
- $personneb = $vart[$var-1];
- last;
- }
- if($personneb eq "Annuler") { next AISE; }
- if($Tsolde{$personne}*$Tsolde{$personneb}<0) {
- my $pers_inf = ($Tsolde{$personne}<0)?$personne:$personneb;
- my $pers_sup = ($Tsolde{$personne}>0)?$personne:$personneb;
- my $inf = (abs($Tsolde{$personne})<abs($Tsolde{$personneb}))?abs($Tsolde{$personne}):abs($Tsolde{$personneb});
- $remboursements .= $pers_inf." doit ".$inf." EUR à ".$pers_sup."\n";
- $Tsolde{$pers_inf} += $inf;
- $Tsolde{$pers_sup} -= $inf;
- }
- }
- # Une boucle pour détecter si on a des couples qui s'annulent mutuellement
- COUPLE: foreach my $personne (keys(%participants)) {
- if($Tsolde{$personne} == 0) { next; }
- foreach my $personneb (keys(%participants)) {
- if($Tsolde{$personneb} + $Tsolde{$personne} != 0) { next; }
- my $pers_inf = ($Tsolde{$personne}<0)?$personne:$personneb;
- my $pers_sup = ($Tsolde{$personne}>0)?$personne:$personneb;
- my $val = abs($Tsolde{$personne});
- $remboursements .= $pers_inf." doit ".$val." EUR à ".$pers_sup."\n";
- $Tsolde{$pers_inf} += $val;
- $Tsolde{$pers_sup} -= $val;
- next COUPLE;
- }
- }
- REMB: while(1) {
- # On supprime les 0, et on fait deux hashs
- my %Tneg = ();
- my %Tpos = ();
- foreach my $personne (keys(%Tsolde)) {
- if($Tsolde{$personne} == 0) { delete $Tsolde{$personne}; }
- elsif($Tsolde{$personne} < 0) { $Tneg{$personne} = $Tsolde{$personne}; }
- elsif($Tsolde{$personne} > 0) { $Tpos{$personne} = $Tsolde{$personne}; }
- }
- if(keys(%Tneg) == 0) {
- last REMB;
- }
- foreach my $neg (sort { $Tneg{$a} cmp $Tneg{$b} } keys %Tneg) {
- my $max = 0;
- my $positif = 0;
- foreach my $pos (sort { $Tpos{$a} cmp $Tpos{$b} } keys %Tpos) {
- if($Tpos{$pos} + $Tneg{$neg}>0) {
- $positif = $pos;
- last;
- }
- $max = $pos;
- }
- if(!($max eq 0)) {
- $remboursements .= $neg." doit ".$Tsolde{$max}." EUR à ".$max."\n";
- $Tsolde{$neg} += $Tsolde{$max};
- delete $Tsolde{$max};
- }
- else {
- $remboursements .= $neg." doit ".-$Tsolde{$neg}." EUR à ".$positif."\n";
- $Tsolde{$positif} += $Tsolde{$neg};
- delete $Tsolde{$neg};
- }
- next REMB;
- }
- }
- print $remboursements;
- my $pause = <STDIN>;
- }
- case "Sortir" {
- last GLOBALE;
- }
+ case "Sortir" {
+ last GLOBALE;
}
+ }
}
projects / perso / Immae / Projets / Scripts / Public.git / commitdiff
