File Coverage

blib/lib/Vote/Count/Start.pm
Criterion Covered Total %
statement 116 129 89.9
branch 14 22 63.6
condition n/a
subroutine 21 22 95.4
pod 0 1 0.0
total 151 174 86.7


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