From efd3b265330b58c683d8fa4c9fddcde05f5e7981 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sun, 21 Aug 2016 17:43:48 +0100
Subject: [PATCH] compute-scottish-stv: wip, before test

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---
 compute-scottish-stv | 116 +++++++++++++++++++++++++++++--------------
 1 file changed, 79 insertions(+), 37 deletions(-)
 mode change 100644 => 100755 compute-scottish-stv

diff --git a/compute-scottish-stv b/compute-scottish-stv
old mode 100644
new mode 100755
index 78e62fb..1684103
--- a/compute-scottish-stv
+++ b/compute-scottish-stv
@@ -155,6 +155,62 @@ sub total_history_cmp () {
     return 0;
 }
 
+sub continuing () {
+    grep { !$_->{NonCont} } values %cands;
+}
+
+sub select_best_worst ($$$$) {
+    my ($wantcand, $wanttiebreak, $signum, $what) = @_;
+    # $wantcand->($c) = boolish
+    # $wanttiebreak->($total) = boolish
+    # Firstly candidates not meeting $wantcand are ignored
+    # Then we pick the best (worst) candiate by Total (or vote history).
+    # (SLGEO 49(2) and 51(2).
+    # If this does not help then totals are equal and we call wanttiebreak.
+    # If it returns 0 we return alphabetically first CAND.  Otherwise
+    # we tie break.
+
+    my @maybe = grep { $wantcand->($_) } @continuing;
+    @maybe = sort total_history_cmp @maybe;
+    @maybe = reverse @maybe if $signum > 0;
+
+    return undef unless @maybe;
+
+    my $nequal = 1;
+
+    for (;;) {
+	my $nextc = $maybe[$nequal];
+
+	# Only interested in those who compare equal according to the
+	# history (SLGEO 49(2)); NB our history includes the current
+	# round.
+	last if $signum*(total_history_cmp $maybe[0], $nextc) > 0;
+	$nextc++;
+    }
+
+    if ($nequal > 1 && !$wanttiebreak->($maybe[0]{Total})) {
+	# ... if equal for election we can do them one by one, since
+	# order does not matter (SLGEO 49 talks about `two or more
+	# ... exceeds').
+	$nequal = 1;
+    }
+
+    my $selectcand;
+    if ($nequal > 1) {
+	my @all = map { $_->{Cand} } @maybe_elect[0 .. $nelect-1];
+	my $tiekey = $signum > 0 ? 'Win' : 'Lose';
+	my $win = $tie{"@all"}{$tiekey};
+	die "need tie break, want $tiekey from @all" unless defined $win;
+	prf "$what %s due to tie break amongst %s\n",
+	    $eslectcand, "@all";
+    } else {
+	$selectcand = $maybe[0];
+	prf "$what %s\n";
+    }
+
+    return $cands{$electcand};
+}
+
 sub elect_core ($) {
     my ($c) = @_;
     prf "*** ELECT %s \`%s' ***\n", $c->{Cand}, $c->{Desc};
@@ -166,11 +222,10 @@ 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) {
+    if (continuing() <= $seats_remain) {
+	foreach my $c (continuing()) {
 	    prf "electing %s to fill remaining place(s)\n", $c->{Cand};
 	    elect_core $c;
 	}
@@ -178,43 +233,15 @@ for (;;) {
     }
 
     countballots();
-    
-    my @maybe_elect = reverse sort total_history_cmp @continuing;
-    my $nelect=0;
-    for (;;) {
-	my $nextc = $maybe_elect[$nelect];
-
-	# We certainly only consider those who meet quota
-	last unless $nextc->{Total} >= $quota;
-	last unless $nextc->{Total} > $quota && $nextel;
-	# ... if equal we can do them one by one, since order
-	# does not matter (SLGEO 49 talks about `two or more ... exceeds')
-
-	last if $nelect &&
-	    (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.
-
-	$nelect++;
-    }
 
-    if ($nelect) {
-	my $electcand;
-	if ($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",
-		$electcand, "@all";
-	} else {
-	    $electcand = $maybe_elect[0];
-	    prf "electing %s\n";
-	}
+    my $c = select_best_worst
+	sub { $_->{Total} >= $quota },
+	sub { $_ > $quota },
+	+1, 'electing';
 
-	my $c = $cands{$electcand};
+    if ($c) {
 	elect_core $c;
-	votelog $_, "helped elect $electcand" foreach @{ $c->{Votes} };
+	votelog $_, "helped elect $c->{Cand}" foreach @{ $c->{Votes} };
 	
 	# SLGEO 48
 	my $surplus = $c->{Total} - $quota;
@@ -241,3 +268,18 @@ for (;;) {
     }
 
     # No-one to elect, must eliminate
+    my $c = select_best_worst
+	sub { 1; },
+	sub { 1; },
+	-1, 'eliminating';
+
+    if ($c) {
+	prf "=== eliminating %s (%s) ===\n", $c->{Cand}, $c->{Desc};
+	$c->{NonCont} = 'Eliminated';
+	next;
+    }
+
+    die;
+}
+
+print "done.\n"; 
-- 
2.30.2