From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sat, 30 Jul 2016 19:16:25 +0000 (+0100)
Subject: stv: wip
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=appendix-a6.git;a=commitdiff_plain;h=e12fb06eb305bfb6bd29861f6edada00bab8eebe

stv: wip
---

diff --git a/stv b/stv
new file mode 100755
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";
+    }
+}