File Coverage

blib/lib/Vote/Count/Method/MinMax.pm
Criterion Covered Total %
statement 125 125 100.0
branch 24 24 100.0
condition n/a
subroutine 15 15 100.0
pod 3 3 100.0
total 167 167 100.0


line stmt bran cond sub pod time code
1 1     1   845 use strict;
  1         2  
  1         41  
2 1     1   8 use warnings;
  1         3  
  1         43  
3 1     1   34 use 5.024;
  1         5  
4 1     1   7 use feature qw /postderef signatures/;
  1         2  
  1         143  
5              
6             package Vote::Count::Method::MinMax;
7              
8 1     1   8 use namespace::autoclean;
  1         2  
  1         12  
9 1     1   107 use Moose;
  1         2  
  1         9  
10             extends 'Vote::Count';
11              
12             our $VERSION='2.00';
13              
14             =head1 NAME
15              
16             Vote::Count::Method::MinMax
17              
18             =head1 VERSION 2.00
19              
20             =cut
21              
22             # ABSTRACT: Methods in the MinMax Family.
23              
24             =pod
25              
26             =head1 SYNOPSIS
27              
28             my $MinMaxElection =
29             Vote::Count::Method::MinMax->new( 'BallotSet' => $ballotset );
30              
31             # $method is one of: winning margin opposition
32             my $Winner = $MinMaxElection->MinMax( $method )->{'winner'};
33             say $MinMaxElection->logv();
34              
35             =head1 The MinMax Methods
36              
37             MinMax (also known as Minimax and Simpson-Kramer) uses a Pairwise comparison Matrix. Instead of looking at wins and losses as with Condorcet Methods, it scores each pairing, the choice with the lowest worst pairing score wins.
38              
39             =head2 The Three MinMax Scoring Rules
40              
41             =head3 Winning Votes ('winning')
42              
43             When the choice being scored loses, the votes for the winner in the pairing are scored. When the choice wins or ties the pairing is scored as 0.
44              
45             This scoring method meets the Condorcet Winner, but not the Smith, Condorcet Loser or Later Harm Criteria.
46              
47             =head3 Margin ('margin')
48              
49             When the choice being scored loses, the votes for the winner minus the votes for that choice in the pairing are scored. When the choice wins or ties the pairing is scored as 0.
50              
51             This scoring method meets the Condorcet Winner, but not the Smith, Condorcet Loser or Later Harm Criteria.
52              
53             =head3 Opposition ('opposition')
54              
55             The votes for the other choice in the pairing are scored regardless of whether the choice won or lost.
56              
57             This scoring method is claimed to meet the Later Harm Criteria, but fails Condorcet Winner and Smith.
58              
59             =head2 Tie Breaker
60              
61             As a Tie Breaker it is recommended to use the next worst pairing score. Because it follows the method and should resolve well, this Tie Breaker is implemented by Vote::Count within the MinMax method itself. If it returns a tie your implementation can apply another method like Modified Grand-Junction.
62              
63             =cut
64              
65 1     1   7709 no warnings 'experimental';
  1         2  
  1         75  
66              
67 1     1   19 use Vote::Count::TextTableTiny qw/generate_table/;
  1         3  
  1         104  
68 1     1   11 use Carp;
  1         2  
  1         65  
69 1     1   14 use Try::Tiny;
  1         5  
  1         1647  
70             # use Data::Dumper;
71              
72             =pod
73              
74             =head2 ScoreMinMax
75              
76             Generate hashref scoring according the requested $method which is one of three scoring rules: 'winning', 'margin', 'opposition'.
77              
78             my $scores = $MinMaxElection->ScoreMinMax( $method );
79              
80             =cut
81              
82 16     16 1 35515 sub ScoreMinMax ( $self, $method ) {
  16         32  
  16         27  
  16         25  
83 16         30 my $scores = {};
84             # Always grab the matrix by calling PairMatrix,
85             # build is lazy.
86 16         546 my $Matrix = $self->PairMatrix()->{'Matrix'};
87 16         408 my @choices = sort ( keys $self->Active()->%* );
88 16         51 for my $Choice (@choices) {
89 97         171 my @ChoiceLoss = ();
90 97         154 LOOPMMMO: for my $Opponent (@choices) {
91 643 100       1102 next LOOPMMMO if $Opponent eq $Choice;
92 546         807 my $M = $Matrix->{$Choice}{$Opponent};
93 546         697 my $S = undef;
94 546 100       941 if ( $method eq 'opposition' ) {
    100          
95 274         386 $S = $M->{$Opponent};
96             }
97             elsif ( $M->{'winner'} eq $Opponent ) {
98 136 100       224 $S = $M->{$Opponent} if $method eq 'winning';
99 136 100       240 $S = $M->{$Opponent} - $M->{$Choice} if $method eq 'margin';
100             }
101             else {
102 136         169 $S = 0;
103             }
104 546         897 $scores->{$Choice}{$Opponent} = $S;
105             # there was a bug where sometimes @ChoiceLoss was sorted
106             # alphanumerically. resolution force the sort to be numeric.
107 546         865 push @ChoiceLoss, ( $S );
108             } # LOOPMMMO:
109             $scores->{$Choice}{score}
110 97         218 = [ reverse sort { $a <=> $b } @ChoiceLoss ];
  952         1486  
111             }
112 16         66 return $scores;
113             }
114              
115 8     8   13 sub _pairmatrixtable1 ( $I, $scores ) {
  8         17  
  8         13  
  8         13  
116 8         33 my @rows = ( [qw/Choice Choice Votes Opponent Votes Score/] );
117 8         243 my @choices = sort ( keys $I->Active()->%* );
118 8         194 my $Matrix = $I->PairMatrix()->{'Matrix'};
119 8         20 for my $Choice (@choices) {
120 47         89 push @rows, [$Choice];
121 47         73 for my $Opponent (@choices) {
122 305         426 my $Cstr = $Choice;
123 305         525 my $Ostr = $Opponent;
124 305 100       495 next if $Opponent eq $Choice;
125 258         396 my $CVote = $Matrix->{$Choice}{$Opponent}{$Choice};
126 258         389 my $OVote = $Matrix->{$Choice}{$Opponent}{$Opponent};
127 258 100       458 if ( $Matrix->{$Choice}{$Opponent}{'winner'} eq $Choice ) {
128 127         210 $Cstr = "**$Cstr**";
129             }
130 258 100       478 if ( $Matrix->{$Choice}{$Opponent}{'winner'} eq $Opponent ) {
131 127         226 $Ostr = "**$Ostr**";
132             }
133 258         355 my $Score = $scores->{$Choice}{$Opponent};
134 258         768 push @rows, [ ' ', $Cstr, $CVote, $Ostr, $OVote, $Score ];
135             }
136             }
137 8         36 return generate_table( rows => \@rows );
138             }
139              
140 8     8   17 sub _pairmatrixtable2 ( $I, $scores ) {
  8         107  
  8         20  
  8         13  
141 8         37 my @rows = ( [qw/Choice Scores/] );
142 8         350 my @choices = sort ( keys $I->Active()->%* );
143 8         33 for my $Choice (@choices) {
144 47         180 my $scores = join ', ', ( $scores->{$Choice}{'score'}->@* );
145 47         122 push @rows, [ $Choice, $scores ];
146             }
147 8         37 return generate_table( rows => \@rows );
148             }
149              
150             =pod
151              
152             =head2 MinMaxPairingVotesTable
153              
154             Generate a formatted table of the Pairing Matrix from a set of scores generated by ScoreMinMax.
155              
156             say $MinMaxElection->MinMaxPairingVotesTable( $scores );
157              
158             =cut
159              
160 8     8 1 20 sub MinMaxPairingVotesTable ( $I, $scores ) {
  8         14  
  8         14  
  8         13  
161 8         26 my $table1 = $I->_pairmatrixtable1($scores);
162 8         159 my $table2 = $I->_pairmatrixtable2($scores);
163 8         154 return "\n$table1\n\n$table2\n";
164             }
165              
166             =pod
167              
168             =head2 MinMax
169              
170             Run and log the election with MinMax according to scoring $method: 'winning', 'margin', 'opposition'.
171              
172             my $result = $MinMaxElection->MinMax( $method );
173              
174             The returned value is a HashRef:
175              
176             { 'tie' => true or false value,
177             'winner' => will be false if tie is true --
178             otherwise the winning choice.
179             # tied is only present when tie is true.
180             'tied' => [ array ref of tied choices ],
181             }
182              
183             =cut
184              
185 7     7 1 5177 sub MinMax ( $self, $method ) {
  7         15  
  7         15  
  7         10  
186 7         23 my $score = $self->ScoreMinMax($method);
187 7         42 my @active = $self->GetActiveList();
188 7         65 $self->logt( "MinMax $method Choices: ", join( ', ', @active ) );
189 7         26 $self->logv( $self->MinMaxPairingVotesTable($score) );
190 7         20 my $winner = '';
191 7         24 my @tied = ();
192 7         16 my $round = 0;
193             # round inited to 0. The 7th round is 6. round increments at
194             # end of the loop. this sets correct number of rounds.
195 7         29 my $roundlimit = scalar(@active) -1;
196 7         28 LOOPMINMAX: while ( $round < $roundlimit ) {
197             # start with $bestscore larger than any possible score
198 10         58 my $bestscore = $self->VotesCast() + 1;
199 10         23 my @hasbest = ();
200 10         32 for my $a (@active) {
201 49         95 my $this = $score->{$a}{'score'}[$round];
202 49 100       121 if ( $this == $bestscore ) { push @hasbest, $a }
  4 100       12  
203             elsif ( $this < $bestscore ) {
204 22         33 $bestscore = $this;
205 22         54 @hasbest = ($a);
206             }
207             }
208 10 100       36 if ( scalar(@hasbest) == 1 ) {
209 6         13 $winner = shift @hasbest;
210 6         60 $self->logt("Winner is $winner.");
211 6         137 return { 'tie' => 0, 'winner' => $winner };
212             }
213             # only choices that are tied continue to tie breaking.
214 4         10 @active = @hasbest;
215             # if this is the last round @tied must be set.
216 4         12 @tied = @hasbest;
217 4 100       11 if( $bestscore == 0 ) {
218 1         15 $self->logt(
219             "Tie between @tied. Best Score is 0. No more Tiebreakers available." );
220 1         4 last LOOPMINMAX;
221             }
222 3         7 $round++;
223 3         26 $self->logt(
224             "Tie between @tied. Best Score is $bestscore. Going to Tiebreaker Round $round."
225             );
226             }
227 1         7 $self->logt( "Tied: " . join( ', ', @tied ) );
228 1         28 return { 'tie' => 1, 'tied' => \@tied, 'winner' => 0 };
229             }
230              
231             =pod
232              
233             =head2 Floor Rules
234              
235             It is recommended to use a low Floor.
236              
237             This method specifies that the scores from less worst pairings be used as the tie breaker, removing inconsequential choices can affect the resolveability of the tie breaker. Unlike IRV where the presence of inconsequential choices can be seen as a randomizing factor, and their bulk removal as improving the consistency of the method, this method does not benefit from that.
238              
239             =cut
240              
241             1;
242              
243             #FOOTER
244              
245             =pod
246              
247             BUG TRACKER
248              
249             L<https://github.com/brainbuz/Vote-Count/issues>
250              
251             AUTHOR
252              
253             John Karr (BRAINBUZ) brainbuz@cpan.org
254              
255             CONTRIBUTORS
256              
257             Copyright 2019-2021 by John Karr (BRAINBUZ) brainbuz@cpan.org.
258              
259             LICENSE
260              
261             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>.
262              
263             SUPPORT
264              
265             This software is provided as is, per the terms of the GNU Public License. Professional support and customisation services are available from the author.
266              
267             =cut
268