# 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;
}
}
-$_->{Continuing} = 1 foreach values %cands;
+$cands{$_}{Cand} = $_foreach keys %cands;
sub sortballots (@) {
# Takes each argument, which should be a ballot, sorts
}
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;
}
}
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};
}
}
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;
# 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.
}
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) {
next;
}
-
+ # No-one to elect, must eliminate