compute-scottish-stv: wip

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>

diff --git a/compute-scottish-stv b/compute-scottish-stv
index bb91c681db0c13c9e69ab23517a744686783e77d..78e62fb56bb7e4651f57b10d1d228a1030c429da 100644 (file)
--- a/compute-scottish-stv
+++ b/compute-scottish-stv
@@ -14,10 +14,11 @@ use bigrat;
 #     Weight => 1.0 }
 # We edit Prefs as we go
 
+# $cands{CAND}{Cand}
 # $cands{CAND}{Desc}
 # $cands{CAND}{Votes}
 # $cands{CAND}{Total}
-# $cands{CAND}{Continuing}
+# $cands{CAND}{NonCont} # undef, or Elected or Eliminated
 
 our $seats=0;
 
@@ -76,7 +77,7 @@ for (;;) {
     }
 }
 
-$_->{Continuing} = 1 foreach values %cands;
+$cands{$_}{Cand} = $_foreach keys %cands;
 
 sub sortballots (@) {
     # Takes each argument, which should be a ballot, sorts
@@ -106,8 +107,9 @@ sub sortballots (@) {
        }
        my $fp = $firstprefs[0];
        my $c = $cands{$fp};
-       if (!$c->{Continuing}) {
-           vlog $v, "dropping pref $fp, not a continuing candidate";
+       my $noncont = $c->{NonCont};
+       if ($noncont) {
+           vlog $v, "dropping pref $fp, $noncont";
            sortvallots $v;
            next;
        }
@@ -128,7 +130,7 @@ sub countballots () {
     }
     foreach my $cand (sort keys %cand) {
        $c = $cands{$cand};
-       next unless $c->{Continuing};
+       next if $c->{NonCont};
        prf "cand %s: %s votes\n", $stage, $cand, $c->{Total};
        $c->{History}[$stage-1] = $c->{Total};
     }
@@ -141,28 +143,46 @@ sub computequota () {
 }
 
 sub total_history_cmp () {
-    my $ha = $cands{a}{History};
-    my $hb = $cands{a}{History};
+    my $ha = $a->{History};
+    my $hb = $b->{History};
     foreach my $s (reverse 1 .. $stage) {
        my $d = $ha->[$s] <=> $hb->[$s];
        next unless $d;
-       print DEBUG "history cmp $a $b => $d (#$s $ha->[$s] $hb->[$s])\n";
+       print DEBUG "history cmp $a->{Cand} $b->[Cand}"
+           ." => $d (#$s $ha->[$s] $hb->[$s])\n";
        return $e;
     }
     return 0;
 }
 
+sub elect_core ($) {
+    my ($c) = @_;
+    prf "*** ELECT %s \`%s' ***\n", $c->{Cand}, $c->{Desc};
+    $c->{NonCont} = 'Elected';
+}
+
 sortballots @allvotes;
 
 for (;;) {
     $stage++;
+
+    my @continuing = grep { !$_->{NonCont} } values %cands;
+    my $seats_remain = $seats
+       - grep { $_->{NonCont} eq 'Elected' } values %cands;
+    if (@continuing <= $seats_remain) {
+       foreach my $c (@continuing) {
+           prf "electing %s to fill remaining place(s)\n", $c->{Cand};
+           elect_core $c;
+       }
+       last;
+    }
+
     countballots();
     
-    my @maybe_elect = reverse sort total_history_cmp keys %cands;
+    my @maybe_elect = reverse sort total_history_cmp @continuing;
     my $nelect=0;
     for (;;) {
-       my $nextcand = $maybe_elect[$nelect];
-       my $nextc = $cands{$nextcand};
+       my $nextc = $maybe_elect[$nelect];
 
        # We certainly only consider those who meet quota
        last unless $nextc->{Total} >= $quota;
@@ -171,7 +191,7 @@ for (;;) {
        # does not matter (SLGEO 49 talks about `two or more ... exceeds')
 
        last if $nelect &&
-           (total_history_cmp $maybe_elect[0], $nextcand) > 0;
+           (total_history_cmp $maybe_elect[0], $nextc) > 0;
        # ... only interested in those who compare equal
        # according ot the history (SLGEO 49(2)); NB our history
        # includes the current round.
@@ -180,24 +200,23 @@ for (;;) {
     }
 
     if ($nelect) {
-       my $elect;
+       my $electcand;
        if ($nelect > 1) {
-           my @all = @maybe_elect[0 .. $nelect-1];
+           my @all = map { $_->{Cand} } @maybe_elect[0 .. $nelect-1];
            my $elect = $tie{"@all"}{Win};
            die "need tie break, want winner from @all" unless defined $win;
            prf "electing %s due to tie break amongst %s\n",
-               $elect, "@all";
+               $electcand, "@all";
        } else {
-           $elect = $maybe_elect[0];
+           $electcand = $maybe_elect[0];
            prf "electing %s\n";
        }
 
-       prf "*** ELECT %s ***\n", $elect;
-       $c->{Continuing} = 0;
-       votelog $_, "helped elect $elect" foreach @{ $c->{Votes} };
+       my $c = $cands{$electcand};
+       elect_core $c;
+       votelog $_, "helped elect $electcand" foreach @{ $c->{Votes} };
        
        # SLGEO 48
-       my $c = $cands{$elect};
        my $surplus = $c->{Total} - $quota;
 
        if ($surplus <= 0) {
@@ -221,4 +240,4 @@ for (;;) {
        next;
     }
 
-    
+    # No-one to elect, must eliminate