--- /dev/null
+#!/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 (;;) {
+