File Coverage

blib/lib/Vote/Count/IRV.pm
Criterion Covered Total %
statement 94 94 100.0
branch 23 24 95.8
condition n/a
subroutine 13 13 100.0
pod 2 2 100.0
total 132 133 99.2


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