compute-scottish-stv: format output for slightly easier comparison

[appendix-a6.git] / stv

diff --git a/stv b/stv
index 03f16d8d0e418d2488e30a4011f1e92b9a6342b0..3c6160e979f27ffa7f026ed59d20a4b2dabf2710 100755 (executable)
--- a/stv
+++ b/stv
@@ -3,6 +3,19 @@
 # Does STV according to
 #  http://www.rosenstiel.co.uk/stvrules/av/index.htm
 
+# Usage:
+#  ./stv [TIEBREAK ...] PLACES [INPUT-FILES ...]
+#
+# PLACES is the number of seats to be filled
+#
+# INPUT-FILES are in the format:
+#    VOTER PQRST
+# where P, Q, R, etc. are candidates.  Candidates
+# must be single letters.
+#
+# Each TIEBREAK is
+#   P,Q,... 
+
 use strict;
 use utf8;
 use autodie;
@@ -20,6 +33,25 @@ use List::MoreUtils qw(nsort_by);
 our $stage=0;
 our @allvotes;
 
+our %tiebreak; # $tiebreak{ winningcand }{ losingcand } = 1
+
+while (@ARGV && $ARGV[0] =~ m/[<>]/) {
+    my ($losers, $winners) = ($? eq '<' ? ($`, $') : ($', $`));
+    my @losers = sort split /\,/, $losers;
+    my @winners = sort split /\,/, $winners;
+    die "@losers @winners" if @losers>1 && @winners>1;
+    my @all = sort @losers, @winners;
+    my $record = sub {
+       my ($how, $howers) = @_;
+       return unless @$howers == 1;
+       die "@all $how" if defined $tiebreak{$how}{"@all"};
+       $tiebreak{$how}{"@all"} = $howers->[0];
+    };
+    $record->('winner', \@winners);
+    $record->('loser',  \@losers);
+    shift @ARGV;
+}    
+
 our $places = shift @ARGV;
 die unless $places eq ($places + 0);
 
@@ -134,7 +166,17 @@ sub historically_prefer ($@) {
        $numequal++;
     }
 
-    die 'random choice unimplemented' if $numequal > 1;
+    if ($numequal > 1) {
+       my $how = $signum > 0 ? 'winner' : 'loser';
+        my @all = sort map { $_->{Cand} } @choices[ 0 .. $numequal-1 ];
+       my $hower = $tiebreak{$how}{"@all"};
+       if (defined $hower) {
+           printf "%7.7s %10s !!!!!!!!!!\n", "TIE".(uc $how), $hower;
+           return grep { $_->{Cand} eq $hower } @choices;
+       }
+       die "need tie break for $how between @all\n";
+    }
+
     return $choices[0];
 }
 
@@ -369,4 +411,14 @@ for (;;) {
     push @unsorted, @$votes;
 }
 
+open VL, ">.stv.votes" or die $!;
+foreach my $vote (@allvotes) {
+    print VL "----------------------------------------\n";
+    print VL "voter $vote->{Voter}\n";
+    print VL "prefs ". (join " ", @{ $vote->{Prefs} }). "\n";
+    print VL $_, "\n" foreach @{ $vote->{Log} };
+}
+print VL "========================================\n";
+close VL;
+
 print "done.\n";