From 2ca665096a98105791c0d59b9bb0fae765c909b4 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sun, 21 Aug 2016 17:23:57 +0100
Subject: [PATCH] compute-scottish-stv: wip

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---
 compute-scottish-stv | 61 +++++++++++++++++++++++++++++---------------
 1 file changed, 40 insertions(+), 21 deletions(-)

diff --git a/compute-scottish-stv b/compute-scottish-stv
index bb91c68..78e62fb 100644
--- 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
-- 
2.30.2