+ };
+ votelog $v, "split for $fpref";
+ }
+ next;
+ }
+ my $fp = $firstprefs->[0];
+ my $c = $cands{$fp};
+ my $noncont = $c->{NonCont};
+ if ($noncont) {
+ votelog $v, "dropping pref $fp, $noncont";
+ sortballots $v;
+ next;
+ }
+ votelog $v, "sorted into pile for candidate $fp weight $w";
+ push @{ $c->{Votes} }, $v;
+ }
+}
+
+sub floor ($) {
+ my ($v) = @_;
+ $v = new Math::BigRat $v; # we need a copy
+ return $v->bfloor();
+}
+
+sub sv ($) {
+ my ($in) = @_;
+ my $v = new Math::BigRat $in; # just in case
+ my $intpart = floor($v);
+ my $frac = $v - $intpart;
+ my $good = floor($frac * $F);
+ my $bad = $frac * $F - $good;
+ my $s = sprintf "%7d", $intpart;
+ if ($frac) {
+ $s .= sprintf ".%0${DIGS}d", $good;
+ $s .= sprintf "%-4s", ($bad ? "+$bad" : "");
+ } else {
+ $s .= sprintf " %${DIGS}s%4s", '', '';
+ }
+#print STDERR "# $in => $s # (intpart=$intpart frac=$frac)\n";
+ return $s;
+}
+
+sub prf {
+ my $fmt = shift;
+ printf " ".$fmt, @_;
+}
+
+sub countballots () {
+ my @pr;
+
+ foreach my $c (values %cands) {
+ next if $c->{NonCont};
+ $c->{Total} = 0/1;
+ $c->{Total} += $_->{Weight} foreach @{ $c->{Votes} };
+ print DEBUG "counted $c->{Cand} $c->{Total}\n";
+ $c->{History}[$stage-1] = $c->{Total};
+ push @pr, $c;
+ }
+
+ foreach my $c (reverse sort $display_cmp @pr) {
+ prf "candidate %-10s: %s votes\n", $c->{Cand}, sv $c->{Total};
+ }
+}
+
+sub computequota () {
+ my $totalvalid = 0/1;
+ $totalvalid += $_->{Total} foreach values %cands;
+ $quota = floor($totalvalid / (1 + $seats) + 1);
+ prf "total valid %s\n", sv $totalvalid;
+ prf "quota %s\n", sv $quota;
+}
+
+sub total_history_cmp () {
+ my $ha = $a->{History};
+ my $hb = $b->{History};
+ my $m = "stage $stage history cmp $a->{Cand} $b->{Cand}";
+ print DEBUG "$m...\n";
+ foreach my $s (reverse 0 .. $stage-1) {
+ my $d = $ha->[$s] <=> $hb->[$s];
+ next unless $d;
+ print DEBUG "$m => $d (#$s $ha->[$s] $hb->[$s])\n";
+ return $d;
+ }
+ print DEBUG "$m => 0\n";
+ 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];
+ last unless $nextc;
+
+ # Only interested in those who compare equal according to the
+ # history (SLGEO 49(2)); NB our history includes the current
+ # round.
+
+ last if $signum*($a = $maybe[0], $b = $nextc, total_history_cmp) > 0;
+ $nequal++;
+ }
+
+ 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[0 .. $nequal-1];
+ my $tiekey = $signum > 0 ? 'Win' : 'Lose';
+ $selectcand = $tie{"@all"}{$tiekey};
+ die "need tie break, want $tiekey from @all"
+ unless defined $selectcand;
+ prf "$what %s due to tie break amongst %s\n",
+ $selectcand, "@all";
+ } else {
+ $selectcand = $maybe[0]{Cand};
+ prf "$what %s\n", $selectcand;
+ }
+
+ return $cands{$selectcand};
+}
+
+sub elect_core ($) {
+ my ($c) = @_;
+ prf "*** ELECT %s \`%s' ***\n", $c->{Cand}, $c->{Desc};
+ $c->{NonCont} = 'Elected';
+ push @elected, $c;
+}
+
+$stage = 0;