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