compute-scottish-stv: wip, before test

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

diff --git a/compute-scottish-stv b/compute-scottish-stv
old mode 100644 (file)
new mode 100755 (executable)
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";