File Coverage

blib/lib/Vote/Count/Start.pm
Criterion Covered Total %
statement 119 132 90.1
branch 14 22 63.6
condition n/a
subroutine 21 22 95.4
pod 0 1 0.0
total 154 177 87.0


line stmt bran cond sub pod time code
1              
2             use 5.024;
3 1     1   248302 use strict;
  1         13  
4 1     1   6 use warnings;
  1         2  
  1         21  
5 1     1   6 use feature qw/postderef signatures/;
  1         2  
  1         26  
6 1     1   5 no warnings qw/experimental/;
  1         2  
  1         95  
7 1     1   7 use Path::Tiny 0.108;
  1         2  
  1         49  
8 1     1   849 use Carp;
  1         12243  
  1         62  
9 1     1   7 use Try::Tiny;
  1         2  
  1         53  
10 1     1   521 # use Data::Dumper;
  1         2026  
  1         61  
11             # use Vote::Count::Method::CondorcetDropping;
12             use Vote::Count;
13 1     1   395 use Vote::Count::ReadBallots 'read_ballots';
  1         4  
  1         46  
14 1     1   574  
  1         6  
  1         93  
15             our $VERSION='2.02';
16              
17             =head1 NAME
18              
19             Vote::Count::Start
20              
21             =head1 VERSION 2.02
22              
23             =cut
24              
25             # ABSTRACT: Vote::Count Common Setup
26              
27             =head1 SYNOPSIS
28              
29             use Vote::Count::Start;
30              
31             my $Election = StartElection(
32             BallotFile => $filepath,
33             FloorRule => 'TopCount',
34             FloorValue => 2,
35             LogPath -> '/some/path',
36             ...
37             );
38              
39             $Election->WriteLog();
40              
41             =head1 Description
42              
43             Does common startup steps useful accross methods. It includes a lot of the boiler plate for common usage. Use for resolving elections where the rules don't require customization, or as an example for writing more customized methods.
44              
45             =over
46              
47             * Reads Ballots from a file/path
48              
49             * Calculates and logs Top Count
50              
51             * Calculates and logs Approval
52              
53             * Applies a Floor Rule
54              
55             * Calculatures and logs a Borda Count
56              
57             * Generates a Condorcet Matrix and logs the Win/Loss Summary and the Scores
58              
59             * Conducts IRV (default options) and logs the result
60              
61             * Returns a Vote::Count Object
62              
63             =back
64              
65             =head1 Method StartElection
66              
67             Returns a Vote::Count object performing the above operations.
68              
69             =head2 Parameter BallotSet or BallotFile
70              
71             It is mandatory to provide either a reference to a BallotSet or to provide a BallotFile for ReadBallots to create a BallotSet.
72              
73             =head2 Paramater FloorRule, FloorValue (optional)
74              
75             A FloorRule and optional value (see Vote::Count::Floor). If no FloorRule is provide none will be used.
76              
77             =head2 Other Options
78              
79             Any other option to Vote::Count can just be passed in the arguments list
80              
81             =cut
82              
83             use Exporter::Easy ( EXPORT => ['StartElection'] );
84 1     1   8  
  1         2  
  1         5  
85             # checks for ballotfile and updates the ballotset in
86             # args. no return value because %ARGS is passed by reference
87             # and updated directly if needed.
88             if ( $ARGS->{'BallotFile'} ) {
89 2     2   3 $ARGS->{'BallotSet'} = read_ballots $ARGS->{'BallotFile'};
  2         4  
  2         4  
90 2 100       8 }
91 1         5 # If
92             unless ( defined( $ARGS->{'BallotSet'}{'choices'} ) ) {
93             croak "A Valid BallotSet or BallotFile was not provided "
94 2 50       8 . $ARGS->{'BallotFile'} . "\n";
95             }
96 0         0 }
97              
98             unless ( defined $ARGS{'FloorRule'} ) {
99             return $self->Active();
100 2     2   6 }
  2         3  
  2         7  
  2         3  
101 2 100       7 $self->logv(''); # log a blank line.
102 1         28 my $flr = $ARGS{'FloorRule'};
103             my $floorset = {};
104 1         5 if ( $flr eq 'TopCount' ) {
105 1         5 $floorset = $self->TopCountFloor( $ARGS{'FloorValue'} );
106 1         3 }
107 1 50       10 elsif ( $flr eq 'TCA' ) {
    50          
    50          
108 0         0 $floorset = $self->TCA();
109             }
110             elsif ( $flr eq 'Approval' ) {
111 0         0 $floorset = $self->ApprovalFloor( $ARGS{'FloorValue'} );
112             }
113             else {
114 1         8 croak "Undefined Floor rule $flr.\n";
115             }
116             $self->logv(''); # add blank line to output
117 0         0 return $floorset;
118             }
119 1         5  
120 1         4 my $Plurality = $Election->TopCount();
121             $Election->logv(
122             ' ',
123 2     2   4 'Initial Top Count (Plurality)',
  2         3  
  2         4  
124 2         9 $Plurality->RankTable()
125 2         11 );
126             my $PluralityTop = $Plurality->Leader();
127             if ( $PluralityTop->{'winner'} ) {
128             $Election->logt( "Plurality Winner: " . $PluralityTop->{'winner'} );
129             return $PluralityTop->{'winner'};
130 2         12 }
131 2 50       6 else {
132 2         12 $Election->logt(
133 2         22 "Plurality Tie: " . join( ', ', $PluralityTop->{'tied'}->@* ) );
134             return '';
135             }
136             }
137 0         0  
138 0         0 my $Approval = $Election->Approval();
139             $Election->logv( "\nApproval", $Approval->RankTable() );
140             my $AWinner = $Approval->Leader();
141             if ( $AWinner->{'winner'} ) {
142 2     2   4 $Election->logt( "Approval Winner: " . $AWinner->{'winner'} );
  2         4  
  2         3  
143 2         9 return $AWinner->{'winner'};
144 2         7 }
145 2         12 else {
146 2 50       6 $Election->logt(
147 0         0 "Approval Tie: " . join( ', ', $AWinner->{'tied'}->@* ) );
148 0         0 return '';
149             }
150             }
151              
152 2         11 my $Borda = $Election->Approval();
153 2         16 $Election->logv( "Borda Count", $Borda->RankTable(), );
154             my $AWinner = $Borda->Leader();
155             if ( $AWinner->{'winner'} ) {
156             $Election->logt( "Borda Winner: " . $AWinner->{'winner'}, '' );
157 2     2   4 return $AWinner->{'winner'};
  2         5  
  2         2  
158 2         7 }
159 2         8 else {
160 2         12 $Election->logt( "Borda Tie: " . join( ', ', $AWinner->{'tied'}->@* ),
161 2 50       8 '' );
162 0         0 return '';
163 0         0 }
164             }
165              
166 2         14 my $majority = $Election->TopCountMajority();
167             if ( $majority->{'winner'} ) {
168 2         22 $Election->logv( "Majority Winner: " . $majority->{'winner'} );
169             return $majority->{'winner'};
170             }
171             else { return ''; }
172 2     2   4 }
  2         4  
  2         3  
173 2         7  
174 2 50       12 my $matrix = $Election->PairMatrix();
175 0         0 $Election->logv(
176 0         0 "Pairing Results:",
177             $matrix->MatrixTable(),
178 2         13 "\nSmith Set: " . join( ', ', sort( keys $matrix->SmithSet()->%* ) )
179             );
180             if ( $matrix->CondorcetWinner() ) {
181 2     2   6 $Election->logv( "Condoret Winner: " . $matrix->CondorcetWinner() );
  2         2  
  2         3  
182 2         52 return $matrix->CondorcetWinner();
183 2         9 }
184             else { return '' }
185             }
186              
187             my $IRVResult = try { $Election->RunIRV() }
188 2 100       14 catch { croak "RunIRV exploded" };
189 1         4 }
190 1         4  
191             my $winners = {};
192 1         5 _ballotset( \%ARGS );
193             delete $ARGS{'BallotFile'};
194             my $FloorValue = delete $ARGS{'FloorValue'};
195 2     2   4 my $FloorRule = delete $ARGS{'FloorRule'};
  2         3  
  2         4  
  2         3  
196 2     2   216 my $Election = Vote::Count->new(%ARGS);
197 2     0   29 $winners->{'plurality'} = _do_plurality($Election);
  0         0  
198             $winners->{'approval'} = _do_approval($Election);
199             my $floorset = _dofloor( $Election, 'FloorRule' => $FloorRule, 'FloorValue' => $FloorValue );
200 2     2 0 1501 $Election->SetActive($floorset);
  2         7  
  2         3  
201 2         5 $winners->{'majority'} = _do_majority($Election);
202 2         9 $winners->{'borda'} = _do_borda($Election);
203 2         6 $winners->{'condorcet'} = _do_matrix($Election);
204 2         5 $winners->{'irv'} = _do_irv( $Election, $floorset );
205 2         4 # todo generate a summary from the winners hash.
206 2         74 $Election->{'startdata'} = $winners;
207 2         7 # Active gets modified from default, so reset to floorset
208 2         9 $Election->SetActive($floorset);
209 2         8 return ($Election);
210 2         8 }
211 2         7  
212 2         9 #FOOTER
213 2         14  
214 2         7 =pod
215              
216 2         47 BUG TRACKER
217              
218 2         9 L<https://github.com/brainbuz/Vote-Count/issues>
219 2         9  
220             AUTHOR
221              
222             John Karr (BRAINBUZ) brainbuz@cpan.org
223              
224             CONTRIBUTORS
225              
226             Copyright 2019-2021 by John Karr (BRAINBUZ) brainbuz@cpan.org.
227              
228             LICENSE
229              
230             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>.
231              
232             SUPPORT
233              
234             This software is provided as is, per the terms of the GNU Public License. Professional support and customisation services are available from the author.
235              
236             =cut
237