stv: wip

diff --git a/stv b/stv
new file mode 100755 (executable)
index 0000000..b2ae674
--- /dev/null
+++ b/stv
@@ -0,0 +1,106 @@
+#!/usr/bin/perl -w
+#
+# Does STV according to
+#  http://www.rosenstiel.co.uk/stvrules/av/index.htm
+
+use strict;
+use utf8;
+use autodie;
+use bigrat;
+
+# vote is
+#  { Voter => opaque,
+#    Prefs => [ list ],
+#    Weight => 1.0 }
+
+our $stage=0;
+our @allvotes;
+
+our $places = shift @ARGV;
+die unless $places eq ($places + 0);
+
+while (<>) {
+    m/^(\w+) ([A-Z]+)$/ or die;
+    my $prefs = $1;
+    my $vote = {
+        Voter => $1,
+       Weight => 1.0,
+       Prefs => (split //, $prefs),
+    };
+    push @allvotes, $vote;
+}
+
+sub pr ($) {
+    my ($f) = @_;
+    return sprintf "%10.6f=%-10s", $f, $f;
+}
+
+sub votelog ($$) {
+    my ($vote,$m) = @_;
+    push @{ $vote->{Log} }, "stage $stage: $m";
+}
+
+sub filterout ($$) {
+    my ($cand, $why) = @_;
+    foreach my $vote (@allvotes) {
+       my $oldprefs = $vote->{Prefs};
+       my @prefs = grep { $_ ne $cand } $oldprefs;
+       next if @prefs == @$oldprefs;
+       votelog $vote, "crossed out candidate $cand: $why";
+    }
+}
+
+for (;;) {
+    $stage++;
+
+    my %sorted;
+    # $sorted{firstpref}{Votes} = [ $vote, ... ]
+    # $sorted{firstpref}{Total} = [ $vote, ... ]
+    for my $vote (@allvotes) {
+       next unless @{ $vote->{Prefs} };
+       my $firstpref = $vote->{Prefs}[0];
+       push @{ $sorted{$firstpref}{Votes} }, $vote;
+    }
+    foreach my $firstpref (sort keys %sorted) {
+       foreach my $vote (@{ $sorted{$firstpref}{Votes} }) {
+           votelog $vote, "counted $vote->{Weight] for $firstpref";
+           $sorted{$firstpref}{Total} += $vote->{Weight};
+       }
+    }
+    my @sorted = sort {
+       $sorted{$b}{Total} <=> $sorted{$a}{Total};
+    } keys %sorted;
+
+    my $totalvalid = 0;
+    foreach my $firstpref (@sorted) {
+       $sorted{$firstpref}{Total} += $_->{Weight}
+           foreach @{ $sorted{$firstpref}{Votes} };
+       printf "%10s %s\n", $firstpref, pr $sorted{$firstpref}{Total};
+       $totalvalid += $sorted{$firstpref}{Total};
+    }
+    printf "%10s %s\n", 'TOTAL', pr $totalvalid;
+
+    last unless $totalvalid > 0;
+
+    my $quota = $totalvalid / ($places + 1);
+    printf "\nquota = %10s\n", pr $quota;
+
+    my $topfirst = $sorted[0];
+    my $topvoters = $sorted{  }{Weight};
+    my $surplus = $topvoters - $quota;
+    if ($surplus >= 0) {
+       printf "%10s ELECTED\n", $sorted[0];
+
+       # transfer the surplus
+       my $weightmult = $surplus / $topvoters;
+       foreach my $vote (@{ $sorted{$topfirst}{Votes} }) {
+           votelog $vote, "part of surplus of weight $weightmult";
+           $vote->{Weight} *= $weightmult;
+       }
+       filterout $topfirst, "candidate was elected";
+    } else {
+       my $elim = $sorted{ $#sorted };
+       printf "%10s eliminated\n", $elim;
+       filterout $elim, "candidate was eliminated";
+    }
+}