unkopt "candidate $cand", $_ foreach split / /, $';
$cands{$cand}{Desc} = $desc;
} elsif (m/^(\w*) :\s*(.*)\s*\|(.*)/) {
my ($voter,$prefs,$opts) = ($1,$2,$3);
unkopt "candidate $cand", $_ foreach split / /, $';
$cands{$cand}{Desc} = $desc;
} elsif (m/^(\w*) :\s*(.*)\s*\|(.*)/) {
my ($voter,$prefs,$opts) = ($1,$2,$3);
push @{ $v->{Prefs} }, [ $_ =~ m/\w+/g ]
foreach split /\s+/, $prefs;
foreach $_ (split / /, $opts) {
push @{ $v->{Prefs} }, [ $_ =~ m/\w+/g ]
foreach split /\s+/, $prefs;
foreach $_ (split / /, $opts) {
-$cands{$_}{Cand} = $_foreach keys %cands;
+$cands{$_}{Cand} = $_ foreach keys %cands;
+$_->{Weight} //= 1/1 foreach @allvotes;
+$_->{TransferredSurplus} //= [ ] foreach @allvotes;
+$_->{OrigPrefs} //= [ @{ $_->{Prefs} } ] foreach @allvotes;
+
+sub votelog ($$) {
+ my ($vote,$m) = @_;
+ push @{ $vote->{Log} }, "stage $stage: $m";
+}
sub sortballots (@) {
# Takes each argument, which should be a ballot, sorts
# it into $cand{CAND}{Votes} according to first preference.
# Strips that first preference from the ballot.
# If the first preference has been eliminated, strips it
# and looks for further preferences.
sub sortballots (@) {
# Takes each argument, which should be a ballot, sorts
# it into $cand{CAND}{Votes} according to first preference.
# Strips that first preference from the ballot.
# If the first preference has been eliminated, strips it
# and looks for further preferences.
foreach my $fpref (@$firstprefs) {
my $v2 = {
%$v,
Weight => $w / @$firstprefs,
Prefs => [ [ $fpref ], @{ $v->{Prefs} } ],
};
foreach my $fpref (@$firstprefs) {
my $v2 = {
%$v,
Weight => $w / @$firstprefs,
Prefs => [ [ $fpref ], @{ $v->{Prefs} } ],
};
- prf "cand %s: %s votes\n", $stage, $cand, $c->{Total};
+ $c->{Total} = 0/1;
+ $c->{Total} += $_->{Weight} foreach @{ $c->{Votes} };
+ print DEBUG "counted $c->{Cand} $c->{Total}\n";
- my $totalvalid = 0;
- $totalvalid += $_->{Total} foreach keys %cands;
- $quota = floor($totalvalid / (1 + $seats));
+ my $totalvalid = 0/1;
+ $totalvalid += $_->{Total} foreach values %cands;
+ $quota = ($totalvalid / (1 + $seats)) -> bfloor();
+ prf "quota %10s\n", $quota;
# Only interested in those who compare equal according to the
# history (SLGEO 49(2)); NB our history includes the current
# round.
# Only interested in those who compare equal according to the
# history (SLGEO 49(2)); NB our history includes the current
# round.
- my $win = $tie{"@all"}{$tiekey};
- die "need tie break, want $tiekey from @all" unless defined $win;
+ $selectcand = $tie{"@all"}{$tiekey};
+ die "need tie break, want $tiekey from @all"
+ unless defined $selectcand;
if (continuing() <= $seats_remain) {
foreach my $c (continuing()) {
prf "electing %s to fill remaining place(s)\n", $c->{Cand};
if (continuing() <= $seats_remain) {
foreach my $c (continuing()) {
prf "electing %s to fill remaining place(s)\n", $c->{Cand};
my $c = select_best_worst
sub { $_->{Total} >= $quota },
sub { $_ > $quota },
my $c = select_best_worst
sub { $_->{Total} >= $quota },
sub { $_ > $quota },
# SLGEO 48(3): we do arithmetic to 5 d3ecimal places,
# but always rounding down
votelog $v, "transferring with value $xfervalue (A=$A B=$B)";
$v->{Weight} = $xfervalue;
# SLGEO 48(3): we do arithmetic to 5 d3ecimal places,
# but always rounding down
votelog $v, "transferring with value $xfervalue (A=$A B=$B)";
$v->{Weight} = $xfervalue;
+
+ if (defined $tspr{"@$previously"}) {
+ die unless $tspr{"@$previously"} == $xfervalue;
+ } else {
+ $tspr{"@$previously"} = $xfervalue;
+ prf "transfer value of ballots %s: %10s\n",
+ "@$previously", $xfervalue;
+ }
$c->{Votes} = { }; # will crash if we access it again
next;
}
# No-one to elect, must eliminate
$c->{Votes} = { }; # will crash if we access it again
next;
}
# No-one to elect, must eliminate