X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;f=compute-scottish-stv;h=98ec3082bd92de269a79af720f4ba8472c8f163a;hb=4f9a31eb456993ad9c8931e2ce036ebbad2df835;hp=528cc5f0891a1556a26ed89c96547406122e1dba;hpb=6f5838e665e31aa6d3e1216eb6e29884254b0f5a;p=appendix-a6.git diff --git a/compute-scottish-stv b/compute-scottish-stv index 528cc5f..98ec308 100755 --- a/compute-scottish-stv +++ b/compute-scottish-stv @@ -58,6 +58,8 @@ $SIG{__DIE__} = sub { die $_[0]; }; +sub total_history_cmp (); + sub unkopt ($$) { my ($what,$opt) = @_; if ($opt =~ m/^[A-Z]/) { @@ -67,6 +69,23 @@ sub unkopt ($$) { } } +my $display_cmp = \&total_history_cmp; +my $for_compare = 0; + +while (@ARGV && $ARGV[0] =~ m/^\-/) { + $_ = shift @ARGV; + if (m/^--$/) { + last; + } elsif (m/^--sort=alpha$/) { + $display_cmp = sub { $b->{Cand} cmp $a->{Cand} }; + } elsif (m/^--for-compare$/) { + $for_compare = 1; + unshift @ARGV, '--sort=alpha'; + } else { + die; + } +} + for (;;) { $_ = <>; if (m/^\| /) { @@ -186,20 +205,31 @@ sub sv ($) { sub prf { my $fmt = shift; - printf "stage %d: ".$fmt, $stage, @_; + printf " ".$fmt, @_; +} +sub prfm { + prf @_ unless $for_compare; } 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; + } + + if ($for_compare) { + # for comparison with OpenSTV, which always prints + # the quota for every elected candidate + push @pr, { %$_, Total => $quota } foreach @elected; } - foreach my $c (reverse sort total_history_cmp - grep { !$_->{NonCont} } values %cands) { + foreach my $c (reverse sort $display_cmp @pr) { prf "candidate %-10s: %s votes\n", $c->{Cand}, sv $c->{Total}; } } @@ -207,8 +237,9 @@ sub countballots () { sub computequota () { my $totalvalid = 0/1; $totalvalid += $_->{Total} foreach values %cands; - $quota = floor($totalvalid / (1 + $seats)); - prf "quota %s\n", sv $quota; + $quota = floor($totalvalid / (1 + $seats) + 1); + prfm "total valid %s\n", sv $totalvalid; + prf "quota %s\n", sv $quota; } sub total_history_cmp () { @@ -279,7 +310,7 @@ sub select_best_worst ($$$$) { $selectcand, "@all"; } else { $selectcand = $maybe[0]{Cand}; - prf "$what %s\n", $selectcand; + prfm "$what %s\n", $selectcand; } return $cands{$selectcand}; @@ -287,7 +318,7 @@ sub select_best_worst ($$$$) { sub elect_core ($) { my ($c) = @_; - prf "*** ELECT %s \`%s' ***\n", $c->{Cand}, $c->{Desc}; + prfm "*** ELECT %s \`%s' ***\n", $c->{Cand}, $c->{Desc}; $c->{NonCont} = 'Elected'; push @elected, $c; } @@ -296,12 +327,13 @@ $stage = 0; for (;;) { $stage++; + printf "stage %3d:\n", $stage; sortballots @allvotes if $stage == 1; my $seats_remain = $seats - @elected; - prf "seats remaining %d\n", $seats_remain; + prfm "seats remaining %d\n", $seats_remain; last unless $seats_remain; @@ -310,6 +342,7 @@ for (;;) { prf "electing %s to fill remaining place(s)\n", $c->{Cand}; elect_core $c; } + countballots() if $for_compare; last; } @@ -334,6 +367,8 @@ for (;;) { next; } + last if $seats_remain == 1; # don't bother doing more transfers + my $B = $c->{Total}; my %tspr; @@ -354,7 +389,7 @@ for (;;) { die unless $tspr{"@$previously"} == $xfervalue; } else { $tspr{"@$previously"} = $xfervalue; - prf "transfer value of ballots %s: %s\n", + prfm "transfer value of ballots %20s: %s\n", "@$previously", sv $xfervalue; } } @@ -371,7 +406,7 @@ for (;;) { -1, 'eliminating'; if ($c) { - prf "=== eliminating %s \`%s' ===\n", $c->{Cand}, $c->{Desc}; + prfm "=== eliminating %s \`%s' ===\n", $c->{Cand}, $c->{Desc}; $c->{NonCont} = 'Eliminated'; sortballots @{ $c->{Votes} }; @@ -383,9 +418,15 @@ for (;;) { print "Winners:\n"; -foreach my $i (0..$#elected) { - my $c = $elected[$i]; - printf " %3d. %-10s %s\n", $i+1, $c->{Cand}, $c->{Desc}; +if ($for_compare) { + foreach my $c (sort { $a->{Cand} cmp $b->{Cand} } @elected) { + printf " %s\n", $c->{Cand}; + } +} else { + foreach my $i (0..$#elected) { + my $c = $elected[$i]; + printf " %3d. %-10s %s\n", $i+1, $c->{Cand}, $c->{Desc}; + } } print "done.\n";