File Coverage

blib/lib/Vote/Count/TopCount.pm
Criterion Covered Total %
statement 120 120 100.0
branch 25 26 96.1
condition 3 3 100.0
subroutine 18 18 100.0
pod 4 5 80.0
total 170 172 98.8


line stmt bran cond sub pod time code
1 39     39   27219 use strict;
  39         233  
  39         1300  
2 39     39   1808 use warnings;
  39         133  
  39         1019  
3 39     39   681 use 5.024;
  39         145  
4              
5 39     39   225 use feature qw /postderef signatures/;
  39         97  
  39         3603  
6              
7             use Moose::Role;
8 39     39   254  
  39         103  
  39         265  
9             no warnings 'experimental';
10 39     39   210324 use List::Util qw( min max );
  39         108  
  39         1970  
11 39     39   278 use Vote::Count::RankCount;
  39         141  
  39         3519  
12 39     39   1720 use Vote::Count::TextTableTiny 'generate_table';
  39         111  
  39         1227  
13 39     39   286  
  39         82  
  39         2321  
14             use Math::BigRat try => 'GMP';
15 39     39   30630 use Storable 'dclone';
  39         4351642  
  39         1586  
16 39     39   22490  
  39         96  
  39         58125  
17             # ABSTRACT: TopCount and related methods for Vote::Count. Toolkit for vote counting.
18              
19             our $VERSION='2.02';
20              
21             =head1 NAME
22              
23             Vote::Count::TopCount
24              
25             =head1 VERSION 2.02
26              
27             =head1 Synopsis
28              
29             This Role is consumed by Vote::Count it provides TopCount and related Methods to Vote::Count objects.
30              
31             =head1 Definition of Top Count
32              
33             Top Count is tabulation of the Top Choice vote on each ballot. As choices are eliminated the first choice on some ballots will be removed, the next highest remaining choice becomes the Top Choice for that ballot. When all choices on a ballot are eliminated it becomes exhausted and is no longer counted.
34              
35             =head1 TopCount Methods
36              
37             =head2 TopCount
38              
39             Takes a hashref of active choices as an optional parameter, if one is not provided it uses the internal active list accessible via the ->Active() method, which itself defaults to the BallotSet's Choices list.
40              
41             Returns a L<RankCount|Vote::Count::RankCount> object containing the TopCount.
42              
43             TopCount supports both Ranked and Range Ballot Types.
44              
45             For RCV, TopCount respects weighting, 'votevalue' is defaulted to 1 by readballots. Integers or Floating point values may be used.
46              
47             =head2 LastTopCountUnWeighted
48              
49             Returns a hashref of the unweighted raw count from the last TopCount operation.
50              
51             =cut
52              
53             has 'LastTopCountUnWeighted' => (
54             is => 'rw',
55             isa => 'HashRef',
56             required => 0,
57             );
58              
59             $active = $self->Active() unless defined $active;
60 14     14   22 my %topcount = ( map { $_ => Math::BigRat->new(0) } keys( $active->%* ) );
  14         24  
  14         22  
  14         19  
61 14 100       79 TOPCOUNTRANGEBALLOTS:
62 14         48 for my $b ( $self->BallotSet()->{'ballots'}->@* ) {
  66         41990  
63             my $vv = dclone $b->{'votes'};
64 14         11234 my %votes = $vv->%*;
65 64         9239 for my $v ( keys %votes ) {
66 64         314 delete $votes{$v} unless defined $active->{$v};
67 64         188 }
68 236 100       578 next TOPCOUNTRANGEBALLOTS unless keys %votes;
69             my $max = max( values %votes );
70 64 100       170 my @top = ();
71 61         175 for my $c ( keys %votes ) {
72 61         103 if ( $votes{$c} == $max ) { push @top, $c }
73 61         120 }
74 182 100       353 my $topvalue = Math::BigRat->new( $b->{'count'} / scalar(@top) );
  64         140  
75             for (@top) { $topcount{$_} += $topvalue }
76 61         263 }
77 61         44512 for my $k ( keys %topcount ) {
  64         980  
78             $topcount{$k} = $topcount{$k}->as_float(5)->numify();
79 14         2253 }
80 66         24828 return Vote::Count::RankCount->Rank( \%topcount );
81             }
82 14         6437  
83             my %ballotset = $self->BallotSet()->%*;
84             my %ballots = ( $ballotset{'ballots'}->%* );
85 429     429   719 $active = $self->Active() unless defined $active;
  429         664  
  429         708  
  429         634  
86 429         10128 my %topcount = ( map { $_ => 0 } keys( $active->%* ) );
87 429         21749 my %lasttopcount = ( map { $_ => 0 } keys( $active->%* ) );
88 429 100       4531 TOPCOUNTBALLOTS:
89 429         1410 for my $b ( keys %ballots ) {
  2370         4680  
90 429         1424 # reset topchoice so that if there is none the value will be false.
  2370         3989  
91             $ballots{$b}{'topchoice'} = 'NONE';
92 429         5441 my @votes = $ballots{$b}->{'votes'}->@*;
93             for my $v (@votes) {
94 45426         75243 if ( defined $topcount{$v} ) {
95 45426         101653 $topcount{$v} += $ballots{$b}{'count'} * $ballots{$b}{'votevalue'};
96 45426         61007 $lasttopcount{$v} += $ballots{$b}{'count'};
97 65582 100       113874 $ballots{$b}{'topchoice'} = $v;
98 43839         73269 next TOPCOUNTBALLOTS;
99 43839         60601 }
100 43839         61507 }
101 43839         73578 }
102             $self->LastTopCountUnWeighted( \%lasttopcount );
103             return Vote::Count::RankCount->Rank( \%topcount );
104             }
105 429         16629  
106 429         2337 # An STV method was performing a TopCount to reset the topchoices
107             # after elimination. Decided it was better to check here.
108             unless( keys( $self->Active()->%* ) or defined( $active) ) {
109 444     444 1 7987 return { 'error' => 'no active choices'};
  444         759  
  444         720  
  444         641  
110             }
111             if ( $self->BallotSet()->{'options'}{'rcv'} == 1 ) {
112 444 100 100     11660 return $self->_RCVTopCount($active);
113 1         11 }
114             elsif ( $self->BallotSet()->{'options'}{'range'} == 1 ) {
115 443 100       10967 return $self->_RangeTopCount($active);
    50          
116 429         1433 }
117             }
118              
119 14         51  
120             =head2 TopChoice
121              
122             Returns the Top Choice on a specific ballot from the last TopCount operation. The ballot is identified by it's key in the ballotset.
123 4     4 0 50  
124             $Election->TopCount();
125             my $top = $Election->TopChoice( 'FOO:BAZ:BAR:ZAB');
126              
127             =cut
128              
129             return $self->BallotSet()->{ballots}{$ballot}{topchoice};
130             }
131              
132             =head2 TopCountMajority
133              
134 11822     11822 1 15265 $self->TopCountMajority( $round_topcount )
  11822         15154  
  11822         15679  
  11822         13719  
135 11822         268534 or
136             $self->TopCountMajority( undef, $active_choices )
137              
138             Will find the majority winner from the results of a topcount, or alternately may be given undef and a hashref of active choices and will topcount the ballotset for just those choices and then find the majority winner.
139              
140             Returns a hashref of results. It will always include the votes in the round and the threshold for majority. If there is a winner it will also include the winner and winvotes.
141              
142             =cut
143              
144             $active = $self->Active() unless defined $active;
145             unless ( defined $topcount ) { $topcount = $self->TopCount($active) }
146             my $topc = $topcount->RawCount();
147             my $numvotes = $topcount->CountVotes();
148             my @choices = keys $topc->%*;
149             my $threshold = 1 + int( $numvotes / 2 );
150 308     308 1 2774 for my $t (@choices) {
  308         499  
  308         447  
  308         427  
  308         414  
151 308 100       8208 if ( $topc->{$t} >= $threshold ) {
152 308 100       768 return (
  26         92  
153 308         1008 {
154 308         823 votes => $numvotes,
155 308         909 threshold => $threshold,
156 308         955 winner => $t,
157 308         639 winvotes => $topc->{$t}
158 1494 100       2905 }
159             );
160             }
161             }
162             # No winner
163             return (
164 56         435 {
165             votes => $numvotes,
166             threshold => $threshold,
167             }
168             );
169             }
170              
171             =head2 EvaluateTopCountMajority
172 252         1314  
173             This method wraps TopCountMajority adding logging, the logging of which would be a lot of boiler plate in round oriented methods. It takes the same parameters and returns the same hashref.
174              
175             =cut
176              
177             my $majority = $self->TopCountMajority( $topcount, $active );
178             if ( $majority->{'winner'} ) {
179             my $winner = $majority->{'winner'};
180             my $rows = [
181             [ 'Winner', $winner ],
182             [ 'Votes in Final Round', $majority->{'votes'} ],
183             [ 'Votes Needed for Majority', $majority->{'threshold'} ],
184 298     298 1 550 [ 'Winning Votes', $majority->{'winvotes'} ],
  298         497  
  298         460  
  298         467  
  298         410  
185 298         1033 ];
186 298 100       811 $self->logt(
187 52         146 '---',
188             generate_table(
189             rows => $rows,
190             header_row => 0,
191             )
192 52         290 );
193             }
194 52         235 return $majority;
195             }
196              
197             =pod
198              
199             =head1 Top Counting Range Ballots
200              
201             Since Range Ballots often allow ranking choices equally, those equal votes need to be split. The other option is to have a rule that assigns an order among the tied choices in a conversion to Ranked Ballots. To prevent Rounding errors in the addition on large sets the fractions are added as Rational Numbers. The totals are converted to floating point numbers with a precision of 5 places for display.
202 298         869  
203             It is recommended to install Math::BigInt::GMP to improve performance on the Rational Number math used for Top Count on Range Ballots.
204              
205             =cut
206              
207             1;
208              
209             #FOOTER
210              
211             =pod
212              
213             BUG TRACKER
214              
215             L<https://github.com/brainbuz/Vote-Count/issues>
216              
217             AUTHOR
218              
219             John Karr (BRAINBUZ) brainbuz@cpan.org
220              
221             CONTRIBUTORS
222              
223             Copyright 2019-2021 by John Karr (BRAINBUZ) brainbuz@cpan.org.
224              
225             LICENSE
226              
227             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>.
228              
229             SUPPORT
230              
231             This software is provided as is, per the terms of the GNU Public License. Professional support and customisation services are available from the author.
232              
233             =cut
234