4 # The Scottish Local Government Elections Order 2007
13 # Prefs => [ [ CAND, ...], ... ],
15 # We edit Prefs as we go
20 # $cands{CAND}{Continuing}
30 if ($opt =~ m/^[A-Z]/) {
31 die "unknown option $_ for $what";
32 } elsif ($opt =~ m/^[a-z]/) {
33 print STDERR "warning (line $.): unknown option $_ for $what\n";
40 foreach $_ (split / /, $') {
41 if (m/^_?[Ss]eats=(\d+)/) {
43 } elsif (m/^_?[Tt]ie=(.*)\>(.*)$/) {
44 my @more = split /\,/, $1;
45 my @less = split /\,/, $2;
46 my @all = join ',', sort (@more, @less);
47 $tie{"@all"}{Win} = $more[0] if @more == 1;
48 $tie{"@all"}{Lose} = $less[0] if @less == 1;
50 unkopt "election", $_;
53 } elsif (m/^(\w+) = (\S*) \|/) {
54 my ($cand,$desc) = @_;
55 unkopt "candidate $cand", $_ foreach split / /, $';
56 $cands{$cand}{Desc} = $desc;
57 } elsif (m/^(\w*) :\s*(.*)\s*\|(.*)/) {
58 my ($voter,$prefs,$opts) = ($1,$2,$3);
59 $v = { Voter => $voter };
60 push @{ $v->{Prefs} }, [ $_ =~ m/\w+/g ]
61 foreach split /\s+/, $prefs;
62 foreach $_ (split / /, $opts) {
63 if (m/^_?[Ww]eight=(\d+)/(\d+)$/) {
64 $v->{Weight} = $1 / $2;
65 } elsif (m/^_?[Ww]eight=([0-9.]+)$/) {
66 $v->{Weight} = new Math::BigRat $1;
68 unkopt "voter $v->{Voter}", $_;
79 $_->{Continuing} = 1 foreach values %cands;
82 # Takes each argument, which should be a ballot, sorts
83 # it into $cand{CAND}{Votes} according to first preference.
84 # Strips that first preference from the ballot.
85 # If the first preference has been eliminated, strips it
86 # and looks for further preferences.
88 my $firstprefs = shift @{ $v->{Prefs} };
90 if (!$firstprefs || !@$firstprefs) {
91 vlog $v, "no more preferences, non transferable";
92 push @non_transferable, $v;
95 if (@$firstprefs > 1) {
96 vlog $v, "splitting due to several equal first preferences";
97 foreach my $fpref (@$firstprefs) {
100 Weight => $w / @$firstprefs,
101 Prefs => [ [ $fpref ], @{ $v->{Prefs} } ],
103 vlog $v, "split for $fpref";
107 my $fp = $firstprefs[0];
109 if (!$c->{Continuing}) {
110 vlog $v, "dropping pref $fp, not a continuing candidate";
114 vlog $v, "sorted into pile for candidate $fp weight $w";
115 push @{ $c->{Votes} }, $v;
121 printf "stage %d: ".$_, $stage, @_;
124 sub countballots () {
125 foreach my $c (values %cand) {
127 $c->{Total} += $_->{Weight} foreach @{ $c->{Voters} };
129 foreach my $cand (sort keys %cand) {
131 next unless $c->{Continuing};
132 prf "cand %s: %s votes\n", $stage, $cand, $c->{Total};
133 $c->{History}[$stage-1] = $c->{Total};
137 sub computequota () {
139 $totalvalid += $_->{Total} foreach keys %cands;
140 $quota = floor($totalvalid / (1 + $seats));
143 sub total_history_cmp () {
144 my $ha = $cands{a}{History};
145 my $hb = $cands{a}{History};
146 foreach my $s (reverse 1 .. $stage) {
147 my $d = $ha->[$s] <=> $hb->[$s];
149 print DEBUG "history cmp $a $b => $d (#$s $ha->[$s] $hb->[$s])\n";
155 sortballots @allvotes;
161 my @maybe_elect = reverse sort total_history_cmp keys %cands;
164 my $nextcand = $maybe_elect[$nelect];
165 my $nextc = $cands{$nextcand};
167 # We certainly only consider those who meet quota
168 last unless $nextc->{Total} >= $quota;
169 last unless $nextc->{Total} > $quota && $nextel;
170 # ... if equal we can do them one by one, since order
171 # does not matter (SLGEO 49 talks about `two or more ... exceeds')
174 (total_history_cmp $maybe_elect[0], $nextcand) > 0;
175 # ... only interested in those who compare equal
176 # according ot the history (SLGEO 49(2)); NB our history
177 # includes the current round.
185 my @all = @maybe_elect[0 .. $nelect-1];
186 my $elect = $tie{"@all"}{Win};
187 die "need tie break, want winner from @all" unless defined $win;
188 prf "electing %s due to tie break amongst %s\n",
191 $elect = $maybe_elect[0];
195 prf "*** ELECT %s ***\n", $elect;
196 $c->{Continuing} = 0;
197 votelog $_, "helped elect $elect" foreach @{ $c->{Votes} };
200 my $c = $cands{$elect};
201 my $surplus = $c->{Total} - $quota;
208 my $B = $c->{Weight};
210 foreach my $v (@{ $c->{Votes} }) {
211 my $A = $surplus * $v->{Weight};
213 my $xfervalue = floor(($A * $F) / $B) / $f;
214 # SLGEO 48(3): we do arithmetic to 5 d3ecimal places,
215 # but always rounding down
216 votelog $v, "transferring with value $xfervalue (A=$A B=$B)";
217 $v->{Weight} = $xfervalue;
220 $c->{Votes} = { }; # will crash if we access it again