line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
39
|
|
|
39
|
|
25197
|
use strict; |
|
39
|
|
|
|
|
106
|
|
|
39
|
|
|
|
|
1520
|
|
2
|
39
|
|
|
39
|
|
238
|
use warnings; |
|
39
|
|
|
|
|
86
|
|
|
39
|
|
|
|
|
1278
|
|
3
|
39
|
|
|
39
|
|
990
|
use 5.024; |
|
39
|
|
|
|
|
147
|
|
4
|
39
|
|
|
39
|
|
247
|
use feature qw /postderef signatures/; |
|
39
|
|
|
|
|
94
|
|
|
39
|
|
|
|
|
5196
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
use namespace::autoclean; |
8
|
39
|
|
|
39
|
|
318
|
use Moose::Role; |
|
39
|
|
|
|
|
95
|
|
|
39
|
|
|
|
|
392
|
|
9
|
39
|
|
|
39
|
|
4311
|
|
|
39
|
|
|
|
|
139
|
|
|
39
|
|
|
|
|
422
|
|
10
|
|
|
|
|
|
|
with 'Vote::Count::TopCount'; |
11
|
|
|
|
|
|
|
with 'Vote::Count::TieBreaker'; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
use Storable 3.15 'dclone'; |
14
|
39
|
|
|
39
|
|
231573
|
|
|
39
|
|
|
|
|
745
|
|
|
39
|
|
|
|
|
2955
|
|
15
|
|
|
|
|
|
|
our $VERSION='2.02'; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 NAME |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
Vote::Count::IRV |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 VERSION 2.02 |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=cut |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# ABSTRACT: IRV Method for Vote::Count |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
no warnings 'experimental'; |
28
|
39
|
|
|
39
|
|
258
|
use List::Util qw( min max ); |
|
39
|
|
|
|
|
100
|
|
|
39
|
|
|
|
|
2112
|
|
29
|
39
|
|
|
39
|
|
298
|
#use Data::Dumper; |
|
39
|
|
|
|
|
94
|
|
|
39
|
|
|
|
|
44959
|
|
30
|
|
|
|
|
|
|
# use Data::Printer; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
return @tiedchoices if @tiedchoices == 1; |
33
|
179
|
|
|
179
|
|
254
|
my %high = |
|
179
|
|
|
|
|
250
|
|
|
179
|
|
|
|
|
241
|
|
|
179
|
|
|
|
|
293
|
|
|
179
|
|
|
|
|
312
|
|
|
179
|
|
|
|
|
236
|
|
34
|
179
|
100
|
|
|
|
567
|
map { $_ => 1 } $self->TieBreaker( $tiebreaker, $active, @tiedchoices ); |
35
|
|
|
|
|
|
|
if ( defined $self->{'last_tiebreaker'} ) { |
36
|
44
|
|
|
|
|
200
|
$self->logt( $self->{'last_tiebreaker'}{'terse'} ); |
|
56
|
|
|
|
|
146
|
|
37
|
44
|
100
|
|
|
|
144
|
$self->logv( $self->{'last_tiebreaker'}{'verbose'} ); |
38
|
5
|
|
|
|
|
22
|
$self->{'last_tiebreaker'} = undef; |
39
|
5
|
|
|
|
|
20
|
} |
40
|
5
|
|
|
|
|
14
|
if ( @tiedchoices == scalar( keys %high ) ) { return @tiedchoices } |
41
|
|
|
|
|
|
|
# tiebreaker returns winner, we want losers! |
42
|
44
|
100
|
|
|
|
147
|
# use map to remove winner(s) from @tiedchoices. |
|
11
|
|
|
|
|
55
|
|
43
|
|
|
|
|
|
|
# warning about sort interpreted as function fixed |
44
|
|
|
|
|
|
|
my @low = sort map { |
45
|
|
|
|
|
|
|
if ( $high{$_} ) { } |
46
|
|
|
|
|
|
|
else { $_ } |
47
|
33
|
100
|
|
|
|
72
|
} @tiedchoices; |
|
88
|
|
|
|
|
176
|
|
48
|
70
|
|
|
|
|
183
|
return @low; |
49
|
|
|
|
|
|
|
} |
50
|
33
|
|
|
|
|
115
|
|
51
|
|
|
|
|
|
|
$self->_IRVDO( active => $active, tiebreaker => $tiebreaker ); |
52
|
|
|
|
|
|
|
} |
53
|
48
|
|
|
48
|
1
|
16265
|
|
|
48
|
|
|
|
|
100
|
|
|
48
|
|
|
|
|
98
|
|
|
48
|
|
|
|
|
92
|
|
|
48
|
|
|
|
|
88
|
|
54
|
48
|
|
|
|
|
203
|
my $ranking2 = $args{'ranking2'} ? $args{'ranking2'} : 'precedence'; |
55
|
|
|
|
|
|
|
$self->_IRVDO( 'btr' => 1, ranking2 => $ranking2 ); |
56
|
|
|
|
|
|
|
} |
57
|
4
|
|
|
4
|
1
|
35
|
|
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
5
|
|
58
|
4
|
100
|
|
|
|
21
|
# RunIRV needed a new argument and was a long established method, |
59
|
4
|
|
|
|
|
21
|
# so now it hands everything off to this private method that uses |
60
|
|
|
|
|
|
|
# named arguments. |
61
|
|
|
|
|
|
|
local $" = ', '; |
62
|
|
|
|
|
|
|
my $active = defined $args{'active'} ? dclone $args{'active'} : dclone $self->Active() ; |
63
|
|
|
|
|
|
|
my $tiebreaker = do { |
64
|
|
|
|
|
|
|
if ( defined $args{'tiebreaker'} ) { $args{'tiebreaker'} } |
65
|
52
|
|
|
52
|
|
86
|
elsif ( defined $self->TieBreakMethod() ) { $self->TieBreakMethod() } |
|
52
|
|
|
|
|
90
|
|
|
52
|
|
|
|
|
203
|
|
|
52
|
|
|
|
|
68
|
|
66
|
52
|
|
|
|
|
112
|
else { 'all' } |
67
|
52
|
100
|
|
|
|
2984
|
}; |
68
|
52
|
|
|
|
|
162
|
my $roundctr = 0; |
69
|
52
|
100
|
|
|
|
569
|
my $maxround = scalar( keys %{$active} ); |
|
39
|
100
|
|
|
|
123
|
|
70
|
5
|
|
|
|
|
132
|
$self->logt( "Instant Runoff Voting", |
71
|
8
|
|
|
|
|
23
|
'Choices: ', join( ', ', ( sort keys %{$active} ) ) ); |
72
|
|
|
|
|
|
|
# forever loop normally ends with return from $majority |
73
|
52
|
|
|
|
|
111
|
# a tie should be detected and also generate a |
74
|
52
|
|
|
|
|
80
|
# return from the else loop. |
|
52
|
|
|
|
|
161
|
|
75
|
|
|
|
|
|
|
# if something goes wrong roundcountr/maxround |
76
|
52
|
|
|
|
|
126
|
# will generate exception. |
|
52
|
|
|
|
|
542
|
|
77
|
|
|
|
|
|
|
IRVLOOP: |
78
|
|
|
|
|
|
|
until (0) { |
79
|
|
|
|
|
|
|
$roundctr++; |
80
|
|
|
|
|
|
|
die "IRVLOOP infinite stopped at $roundctr" if $roundctr > $maxround; |
81
|
|
|
|
|
|
|
my $round = $self->TopCount($active); |
82
|
|
|
|
|
|
|
$self->logv( '---', "IRV Round $roundctr", $round->RankTable() ); |
83
|
52
|
|
|
|
|
159
|
my $majority = $self->EvaluateTopCountMajority($round); |
84
|
251
|
|
|
|
|
425
|
if ( defined $majority->{'winner'} ) { |
85
|
251
|
50
|
|
|
|
542
|
return $majority; |
86
|
251
|
|
|
|
|
867
|
} |
87
|
251
|
|
|
|
|
973
|
elsif ( $args{'btr'}) { |
88
|
251
|
|
|
|
|
1566
|
my $br = $self->BottomRunOff( |
89
|
251
|
100
|
|
|
|
823
|
'active' => $active, 'ranking2' => $args{'ranking2'} ); |
|
|
100
|
|
|
|
|
|
90
|
44
|
|
|
|
|
504
|
$self->logv( $br->{'runoff'}); |
91
|
|
|
|
|
|
|
$self->logt( "Eliminating: ${\ $br->{'eliminate'} }" ); |
92
|
|
|
|
|
|
|
delete $active->{ $br->{'eliminate'} }; |
93
|
|
|
|
|
|
|
} |
94
|
28
|
|
|
|
|
107
|
else { #-- |
95
|
28
|
|
|
|
|
116
|
my @bottom = $self->_ResolveTie( $active, $tiebreaker, $round->ArrayBottom()->@* ); |
96
|
28
|
|
|
|
|
50
|
if ( scalar(@bottom) == scalar( keys %{$active} ) ) { |
|
28
|
|
|
|
|
129
|
|
97
|
28
|
|
|
|
|
255
|
# if there is a tie at the end, the finalists should |
98
|
|
|
|
|
|
|
# be both top and bottom and the active set. |
99
|
|
|
|
|
|
|
$self->logt( "Tied: @bottom" ); |
100
|
179
|
|
|
|
|
506
|
return { tie => 1, tied => \@bottom, winner => 0 }; |
101
|
179
|
100
|
|
|
|
327
|
} |
|
179
|
|
|
|
|
511
|
|
102
|
|
|
|
|
|
|
$self->logt( "Eliminating: @bottom" ); |
103
|
|
|
|
|
|
|
for my $b (@bottom) { |
104
|
8
|
|
|
|
|
56
|
delete $active->{$b}; |
105
|
8
|
|
|
|
|
95
|
} |
106
|
|
|
|
|
|
|
} #-- |
107
|
171
|
|
|
|
|
882
|
} |
108
|
171
|
|
|
|
|
407
|
} |
109
|
227
|
|
|
|
|
1356
|
|
110
|
|
|
|
|
|
|
1; |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=pod |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=head1 IRV |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
Implements Instant Runoff Voting for Vote::Count. |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=head1 SYNOPSIS |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
use Vote::Count::Method; |
121
|
|
|
|
|
|
|
use Vote::Count::ReadBallots 'read_ballots'; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
my $Election = Vote::Count::->new( |
124
|
|
|
|
|
|
|
BallotSet => read_ballots('%path_to_my_ballots'), |
125
|
|
|
|
|
|
|
TieBreakMethod => 'grandjunction'); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
my $result = $Election->RunIRV(); |
128
|
|
|
|
|
|
|
my $winner = $result->{'winner'}; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
say $Election->logv(); # Print the full Log. |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=head1 Method Summary |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
Instant Runoff Voting Looks for a Majority Winner. If one isn't present the choice with the lowest Top Count is removed. |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
Instant Runoff Voting is easy to count by hand and meets the Later Harm and Condorcet Loser Criteria. It, unfortunately, fails a large number of consistency criteria; the order of candidate dropping matters and small changes to the votes of non-winning choices that result in changes to the dropping order can change the outcome. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
Instant Runoff Voting is also known as Alternative Vote and as the Hare Method. |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=head2 Tie Handling |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
There is no standard accepted method for IRV tie resolution, Eliminate All is a common one and the default. |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
Returns a tie when all of the remaining choices are in a tie. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
An optional value to RunIRV is to specify tiebreaker, see L<Vote::Count::TieBreaker>. |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=head2 RunIRV |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
$Election->RunIRV(); |
151
|
|
|
|
|
|
|
$Election->RunIRV( $active ) |
152
|
|
|
|
|
|
|
$Election->RunIRV( $active, 'approval' ) |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
Runs IRV on the provided Ballot Set. Takes an optional parameter of $active which is a hashref for which the keys are the currently active choices. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
Returns results in a hashref which will be the results of Vote::Count::TopCount->EvaluateTopCountMajority, if there is no winner hash will instead be: |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
tie => [true or false], |
159
|
|
|
|
|
|
|
tied => [ array of tied choices ], |
160
|
|
|
|
|
|
|
winner => a false value |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
Supports the Vote::Count logt, logv, and logd methods for providing details of the method. |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=head1 Bottom Two Runoff IRV |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
B<Bottom Two Runoff IRV> is the simplest modification to IRV which meets the Condorcet Winner Criteria. Instead of eliminating the low choice, the lowest two choices enter a virtual runoff, eliminating the loser. This is the easiest possible Hand Count Condorcet method, there will always be fewer pairings than choices. As a Condorcet method it fails Later No Harm. |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
BTR IRV will only eliminate a member of the Smith Set when both members of the runoff are in it, so it can never eliminate the final member of the Smith Set, and is thus Smith compliant. |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=head2 RunBTRIRV |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
my $result = $Election->RunBTRIRV(); |
173
|
|
|
|
|
|
|
my $result = $Election->RunBTRIRV( 'ranking2' => 'Approval'); |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
Choices are ordered by TopCount, ties for position are decided by Precedence. It is mandatory that either the TieBreakMethod is Precedence or TieBreakerFallBackPrecedence is True. The optional ranking2 option will use a second method before Precedence, see UnTieList in L<Vote::Count::TieBreaker|Vote::Count::TieBreaker/UnTieList>. |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
The returned values and logging are the same as for RunIRV. |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=cut |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
#FOOTER |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=pod |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
BUG TRACKER |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
L<https://github.com/brainbuz/Vote-Count/issues> |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
AUTHOR |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
John Karr (BRAINBUZ) brainbuz@cpan.org |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
CONTRIBUTORS |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
Copyright 2019-2021 by John Karr (BRAINBUZ) brainbuz@cpan.org. |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
LICENSE |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
This module is released under the GNU Public License Version 3. See license file for details. For more information on this license visit L<http://fsf.org>. |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
SUPPORT |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
This software is provided as is, per the terms of the GNU Public License. Professional support and customisation services are available from the author. |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=cut |
206
|
|
|
|
|
|
|
|