From 440eafd9205a4cbee5ab4ee0b0cf9c4e41b25bf1 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sun, 21 Aug 2016 13:29:28 +0100
Subject: [PATCH] compute-scottish-stv: wip

---
 compute-scottish-stv | 102 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 102 insertions(+)
 create mode 100644 compute-scottish-stv

diff --git a/compute-scottish-stv b/compute-scottish-stv
new file mode 100644
index 0000000..77e00da
--- /dev/null
+++ b/compute-scottish-stv
@@ -0,0 +1,102 @@
+#!/usr/bin/perl -w
+
+# Reference:
+# The Scottish Local Government Elections Order 2007
+
+use strict;
+
+# Data structures:
+#
+# vote is
+#   { Voter => opaque,
+#     Prefs => [ list ],
+#     Weight => 1.0 }
+# We edit Prefs as we go
+
+# $cands{CAND}{Desc}
+# $cands{CAND}{Votes}
+
+our $stage=0;
+
+our $seats=0;
+
+sub unkopt ($$) {
+    my ($what,$opt) = @_;
+    if ($opt =~ m/^[A-Z]/) {
+	die "unknown option $_ for $what";
+    } elsif ($opt =~ m/^[a-z]/) {
+	print STDERR "warning (line $.): unknown option $_ for $what\n";
+    }
+}
+
+for (;;) {
+    $_ = <>;
+    if (m/^\| /) {
+	foreach $_ (split / /, $') {
+	    if (m/^_?[Ss]eats=(\d+)/) {
+		$seats = $1;
+	    } else {
+		unkopt "election", $_;
+	    }
+	}
+    } elsif (m/^(\w+) = (\S*) \|/) {
+	my ($cand,$desc) = @_;
+	unkopt "candidate $cand", $_ foreach split / /, $';
+	$cands{$cand}{Desc} = $desc;
+    } elsif (m/^(\w*) :\s*(.*)\s*\|(.*)/) {
+	my ($voter,$prefs,$opts) = ($1,$2,$3);
+	$v = { Voter => $voter };
+	push @{ $v->{Prefs} }, [ $_ =~ m/\w+/g ]
+	    foreach split /\s+/, $prefs;
+	foreach $_ (split / /, $opts) {
+	    if (m/^_?[Ww]eight=(\d+)/(\d+)$/) {
+		$v->{Weight} = $1 / $2;
+	    } elsif (m/^_?[Ww]eight=([0-9.]+)$/) {
+		$v->{Weight} = new Math::BigRat $1;
+	    } else {
+		unkopt "voter $v->{Voter}", $_;
+	    }
+	}
+	push @allvotes, $v;
+    } elsif (m/^\.$/) {
+	last;
+    } else {
+	die "$_ ?";
+    }
+}
+
+sub sortballots (@) {
+    # Takes each argument, which should be a ballot, sorts
+    # it into $cand{CAND}{Votes} according to first preference.
+    # Strips that first preference from the ballot.
+    # If the first preference has been eliminated, strips it
+    # and looks for further preferences.
+    foreach my $v (@_) {
+	my $firstprefs = shift @{ $v->{Prefs} };
+	if (!$firstprefs || !@$firstprefs) {
+	    vlog $v, "no more preferences, non transferable";
+	    push @non_transferable, $v;
+	    next;
+	}
+	if (@$firstprefs > 1) {
+	    vlog $v, "splitting due to several equal first preferences";
+	    foreach my $fpref (@$firstprefs) {
+		my $v2 = {
+		    %$v,
+		    Weight => $v->{Weight} / @$firstprefs,
+		    Prefs => [ [ $fpref ], @{ $v->{Prefs} } ],
+			 };
+		vlog $v, "split for $fpref";
+		
+			
+		    Voter => $
+	    
+	my @prefs 
+	my $nprefs = scalar @{ $v->{Prefs}
+    my @input = @_;
+    
+
+# $cands
+
+for (;;) {
+    
-- 
2.30.2