File Coverage

blib/lib/Vote/Count/Method/STAR.pm
Criterion Covered Total %
statement 67 67 100.0
branch 10 10 100.0
condition n/a
subroutine 12 12 100.0
pod 1 1 100.0
total 90 90 100.0


line stmt bran cond sub pod time code
1 1     1   490 use strict;
  1         2  
  1         31  
2 1     1   6 use warnings;
  1         2  
  1         27  
3 1     1   15 use 5.024;
  1         4  
4 1     1   6 use feature qw /postderef signatures/;
  1         2  
  1         127  
5              
6             use namespace::autoclean;
7 1     1   447 use Moose;
  1         17441  
  1         4  
8 1     1   619 extends 'Vote::Count';
  1         474326  
  1         7  
9              
10             our $VERSION='2.02';
11              
12             =head1 NAME
13              
14             Vote::Count::Method::STAR
15              
16             =head1 VERSION 2.02
17              
18             =cut
19              
20             # ABSTRACT: STAR Voting.
21              
22             =pod
23              
24             =head1 SYNOPSIS
25              
26             use Vote::Count::Method::STAR;
27              
28             my $tennessee = Vote::Count::Method::STAR->new(
29             BallotSet => read_range_ballots('t/data/tennessee.range.json'), );
30             my $winner = $tennessee->STAR() ;
31              
32             say $Election->logv();
33              
34             =head1 Description
35              
36             Implements the STAR method for resolving Range Ballots.
37              
38             =head1 Method Common Name: STAR (Score Then Automatic Runoff)
39              
40             Scores the Range Ballots, then holds a runoff between the two highest scored choices. The method is named for the acronym for Score Then Automatic Runoff.
41              
42             =head2 Function Name: STAR
43              
44             Conducts and Logs STAR.
45              
46             Beginning with version 1.08 the STAR() method returns a Hash Ref similar to other Vote::Count Methods. The key 'tie' is true for a tie false otherwise, the key 'winner' contains the winning choice or 0 if there is a tie. When there is a tie an additional key 'tied' contains an Array Ref of the tied choices.
47              
48             When more than 2 choices are in a tie for the automatic runoff STAR() returns them as a tie.
49              
50             =head2 Criteria
51              
52             =head3 Simplicity
53              
54             The Range Ballot is more complex for voters than the Ranked Choice Ballot. The scoring and runoff are both very simple.
55              
56             =head3 Later Harm
57              
58             By ranking the preferred choice with the maximum score, and alternate choices very low, the voter is able to minimuze the later harm impact of those later choices. With 10 choices in regular Borda, the second choice would recieve 90% of the first choice's score, by ranking later choices at the bottom of the scale the impact is much lower.
59              
60             =head3 Condorcet Criteria
61              
62             STAR only meets the Condorcet Loser Criteria. The runoff prevents a Condorcet Loser from winning.
63              
64             STAR does not meet the Smith and Condorcet Winner Criteria.
65              
66             =head3 Consistency
67              
68             STAR should meet Monotonacity. Adding a non-winning choice will have no impact on the outcome unless they can score high enough to reach and lose the runoff phase. Clone handling is dependent on the behavior of the clone group supporters, if they rank the clones far apart, the clone that attracts later support from non-clone supporters is likely to not reach the runoff.
69              
70             =head3 Strategic Voting
71              
72             STAR creates strong incentive for strategic voting. The voter must decide to either mitigate later harm, or to show strong support for their secondary choices. Even when the voter decides to rate the choices accurately, it is a greater effort than ranking them.
73              
74             =cut
75              
76             no warnings 'experimental';
77 1     1   7735 # use YAML::XS;
  1         2  
  1         48  
78              
79             use Carp;
80 1     1   6 use List::Util qw( min max sum );
  1         26  
  1         105  
81 1     1   8 # use Data::Dumper;
  1         2  
  1         69  
82             use Sort::Hash;
83 1     1   573  
  1         888  
  1         637  
84             # Similar needs will arise elsewhere. this method should be generalized
85             # and put in a shared role. the aability to resolve ties internally will
86             # also be desired.
87              
88             my %sv = $scores->RawCount()->%*;
89 10     10   17 my @order = sort_hash( 'desc', \%sv );
  10         15  
  10         14  
  10         13  
90 10         34 my @toptwo = ( shift @order, shift @order );
91 10         36 my %tied = ( map { $_ => $sv{$_} } @toptwo );
92 10         1678 my $lastval = $sv{ $toptwo[1] };
93 10         19 while ( $sv{ $order[0] } == $lastval ) {
  20         48  
94 10         21 my $tieit = shift @order;
95 10         29 $tied{$tieit} = $sv{tieit};
96 3         7 }
97 3         10 if ( scalar( keys %tied ) > 2 ) {
98             $I->logt(
99 10 100       28 "Unhandled Situation, there is a tie in determining the top two for Automatic Runoff."
100 3         15 );
101             $I->logt( join( ', ', ( sort keys %tied ) ) );
102             $I->logd( $scores->RankTable() );
103 3         22 # $I->logd( Dumper $I );
104 3         15 return ( keys %tied );
105             }
106 3         37 return @toptwo;
107             }
108 7         47  
109             $active = $self->Active() unless defined $active;
110             my $scores = $self->Score($active);
111 8     8 1 3441 $self->logv( $scores->RankTable() );
  8         15  
  8         18  
  8         9  
112 8 100       173 my @best_two = $self->_best_two($scores);
113 8         30 if ( scalar( @best_two ) > 2 ) {
114 8         26 return { 'tie' => 1, 'winner' => 0, 'tied' => \@best_two };
115 8         81 }
116 8 100       25 my ( $A, $B ) = @best_two;
117 2         51 my ( $countA, $countB ) = $self->RangeBallotPair( $A, $B );
118             if ( $countA > $countB ) {
119 6         15 $self->logt("Automatic Runoff Winner: $A [ $A: $countA -- $B: $countB ]");
120 6         26 return { 'tie' => 0, 'winner' => $A };
121 6 100       24 }
    100          
122 4         28 elsif ( $countA < $countB ) {
123 4         66 $self->logt("Automatic Runoff Winner: $B [ $B: $countB -- $A: $countA ]");
124             return { 'tie' => 0, 'winner' => $B };
125             }
126 1         13 else {
127 1         18 $self->logt("Automatic Runoff TIE: [ $A: $countA -- $B: $countB ]");
128             return { 'tie' => 1, 'winner' => 0, 'tied' => [ $A, $B ] };
129             }
130 1         13 }
131 1         16  
132             1;
133              
134             #FOOTER
135              
136             =pod
137              
138             BUG TRACKER
139              
140             L<https://github.com/brainbuz/Vote-Count/issues>
141              
142             AUTHOR
143              
144             John Karr (BRAINBUZ) brainbuz@cpan.org
145              
146             CONTRIBUTORS
147              
148             Copyright 2019-2021 by John Karr (BRAINBUZ) brainbuz@cpan.org.
149              
150             LICENSE
151              
152             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>.
153              
154             SUPPORT
155              
156             This software is provided as is, per the terms of the GNU Public License. Professional support and customisation services are available from the author.
157              
158             =cut
159