File Coverage

blib/lib/Vote/Count/Borda.pm
Criterion Covered Total %
statement 88 88 100.0
branch 16 16 100.0
condition n/a
subroutine 17 18 94.4
pod 1 2 50.0
total 122 124 98.3


line stmt bran cond sub pod time code
1 39     39   21077 use strict;
  39         103  
  39         1201  
2 39     39   187 use warnings;
  39         77  
  39         1048  
3 39     39   967 use 5.024;
  39         140  
4 39     39   202 use feature qw /postderef signatures/;
  39         68  
  39         3772  
5              
6             package Vote::Count::Borda;
7              
8 39     39   249 use Moose::Role;
  39         82  
  39         273  
9              
10             our $VERSION='2.01';
11              
12             =head1 NAME
13              
14             Vote::Count::Borda
15              
16             =head1 VERSION 2.01
17              
18             =cut
19              
20             # ABSTRACT: Provides Borda Count to Vote::Count objects
21              
22 39     39   196171 no warnings 'experimental';
  39         89  
  39         1719  
23 39     39   228 use List::Util qw( min max );
  39         75  
  39         2974  
24 39     39   279 use Vote::Count::RankCount;
  39         94  
  39         1121  
25 39     39   232 use Try::Tiny;
  39         74  
  39         2155  
26 39     39   236 use Data::Dumper;
  39         75  
  39         42950  
27              
28             has 'bordaweight' => (
29             is => 'rw',
30             isa => 'CodeRef',
31             builder => '_buildbordaweight',
32             lazy => 1,
33             );
34              
35             has 'bordadepth' => (
36             is => 'rw',
37             isa => 'Int',
38             default => 0,
39             );
40              
41             # Many real world Borda implmentations use 1
42             # for unranked default. The way unranked choices are valued
43             # relies on NonApproval (from Approval), which does not
44             # support overriding the Active Set. Because this is a low
45             # priority function the limitation is acceptable.
46             has 'unrankdefault' => (
47             is => 'rw',
48             isa => 'Int',
49             default => 0,
50             );
51              
52             =pod
53              
54             =head1 Synopsis
55              
56             my $RCV = Vote::Count->new(
57             BallotSet => read_ballots('t/data/data1.txt'),
58             bordadepth => 5
59             );
60             my $bordacount = $RCV->Borda();
61              
62             =head1 Borda Count
63              
64             Scores Choices based on their position on the Ballot. The first choice candidate gets a score equal to the number of choices, each lower choice receives 1 less.
65              
66             The Borda Count is trying to Cardinally value Preferential choices, for this reason where the Borda Count is an appropriate method it is a better to use a Range Ballot instead of Preferential so that the voters may assign the Cardinal values.
67              
68             =head1 Variations on the Borda Count
69              
70             One major criticism of the count is that when there are many choices the difference between a first and second choice becomes negligible. A large number of alternative weightings have been used to address this.
71              
72             =head2 Borda Depth (bordadepth parameter)
73              
74             One of the simpler variations is to fix the depth, when the depth is set to a certain number the weighting is as if the ballot had that many choices, and choices ranked lower than the depth are scored 0. If there are eight choices and a depth of 3, a first choice is worth 3, a 3rd 1, and later choices are ignored
75              
76             =head2 Borda Weight (bordaweight parameter)
77              
78             Some of the popular alternate weighting systems include:
79              
80             =over
81              
82             =item * different scaling such as 1/x where x is the position of the choice (1 is worth 1, 3 is 1/3).
83              
84             =item * Another popular alternative is to score for one less than the number of choices -- in a five choice race first is worth 4 and last is worth 0.
85              
86             =back
87              
88             When Creating a VoteCount object a custom Borda weight may be set by passing a coderef for bordaweight. The coderef takes two arguments. The first argument is the position of the choice in question. The second argument is optional for passing the depth of the ballot to the coderef. Some popular options such inversion (where choice $c becomes $c/1 then inverted to 1/$c) don't need to know the depth. In such cases the coderef should just ignore the second argument.
89              
90             my $testweight = sub {
91             my $x = int shift @_;
92             return $x ? 1/$x : 0 ;
93             };
94              
95             my $VC2 = Vote::Count->new(
96             BallotSet => read_ballots('t/data/data2.txt'),
97             bordaweight => $testweight,
98             );
99              
100             =head2 unrankdefault
101              
102             Jean-Charles de Borda expected voters to rank all available choices. When they fail to do this the unranked choices need to be handled. The default in Vote::Count is to score unranked choices as 0. However, it is also common to score them as 1. Vote::Count permits using any Integer for this valuation.
103              
104             my $VC2 = Vote::Count->new(
105             BallotSet => read_ballots('t/data/data2.txt'),
106             unrankdefault => 1,
107             );
108              
109             =head1 Method Borda
110              
111             Returns a RankCount Object with the scores per the weighting rule, for Ranked Choice Ballots. Optional Parameter is a hashref defining an active set.
112              
113             =cut
114              
115             sub _buildbordaweight {
116             return sub {
117 217     217   317 my ( $x, $y ) = @_;
118 217         449 return ( $y + 1 - $x );
119             }
120 11     11   294 }
121              
122             # Private Method _bordashrinkballot( $BallotSet, $active )
123              
124             # Takes a BallotSet and active list and returns a
125             # BallotSet reduced to only the active choices. When
126             # choices are removed later choices are promoted.
127              
128 25     25   41 sub _bordashrinkballot ( $BallotSet, $active ) {
  25         37  
  25         32  
  25         51  
129 25         46 my $newballots = {};
130 25         123 my %ballots = $BallotSet->{'ballots'}->%*;
131 25         86 for my $b ( keys %ballots ) {
132 174         398 my @newballot = ();
133 174         350 for my $item ( $ballots{$b}{'votes'}->@* ) {
134 408 100   408   17056 try { if ( $active->{$item} ) { push @newballot, $item } }
  310         640  
135 408     0   3656 catch {};
136             }
137 174 100       1831 if ( scalar(@newballot) ) {
138 162         341 $newballots->{$b}{'votes'} = \@newballot;
139             $newballots->{$b}{'count'} =
140 162         395 $ballots{$b}->{'count'};
141             }
142             }
143 25         162 return $newballots;
144             }
145              
146 24     24   36 sub _dobordacount ( $self, $BordaTable, $active ) {
  24         37  
  24         36  
  24         34  
  24         34  
147 24         40 my $BordaCount = {};
148 24         757 my $weight = $self->bordaweight;
149             my $depth =
150             $self->bordadepth
151             ? $self->bordadepth
152 24 100       586 : scalar( keys %{$active} );
  23         52  
153 24         82 for my $c ( keys $BordaTable->%* ) {
154 148         362 for my $rank ( keys $BordaTable->{$c}->%* ) {
155 235 100       475 $BordaCount->{$c} = 0 unless defined $BordaCount->{$c};
156             $BordaCount->{$c} +=
157 235         385 $BordaTable->{$c}{$rank} * $weight->( $rank, $depth );
158             }
159             }
160 24         67 return $BordaCount;
161             }
162              
163 24     24 1 672 sub Borda ( $self, $active = undef ) {
  24         38  
  24         52  
  24         38  
164 24         659 my %BallotSet = $self->BallotSet()->%*;
165 24         61 my %ballots = ();
166 24 100       90 if ( defined $active ) {
167 21 100       574 die q/unrankdefault other than 0 is not compatible with overriding the
168             Active Set. To fix this use the SetActive method to update the active
169             set, then call this (Borda) method without passing an active set./
170             if $self->unrankdefault();
171             }
172 23 100       166 $active = $self->Active() unless defined $active;
173 23         35 %ballots = %{ _bordashrinkballot( \%BallotSet, $active ) };
  23         67  
174 23         441 my %BordaTable = ( map { $_ => {} } keys( $active->%* ) );
  145         268  
175             BORDALOOPACTIVE:
176 23         82 for my $b ( keys %ballots ) {
177 155         305 my @votes = $ballots{$b}->{'votes'}->@* ;
178 155         214 my $bcount = $ballots{$b}->{'count'};
179 155         303 for ( my $i = 0 ; $i < scalar(@votes) ; $i++ ) {
180 302         409 my $c = $votes[$i];
181 302         739 $BordaTable{$c}->{ $i + 1 } += $bcount;
182             }
183             }
184 23         77 my $BordaCounted = _dobordacount( $self, \%BordaTable, $active );
185 23 100       582 if ( $self->unrankdefault() ) {
186 2         9 my $unranked = $self->NonApproval()->RawCount();
187 2         12 for my $u ( keys $unranked->%* ) {
188 16         382 $BordaCounted->{$u} += $unranked->{$u} * $self->unrankdefault()
189             }
190             }
191 23         128 return Vote::Count::RankCount->Rank($BordaCounted);
192             }
193              
194 3     3 0 16 sub borda { Borda(@_) }
195              
196             1;
197              
198             #FOOTER
199              
200             =pod
201              
202             BUG TRACKER
203              
204             L<https://github.com/brainbuz/Vote-Count/issues>
205              
206             AUTHOR
207              
208             John Karr (BRAINBUZ) brainbuz@cpan.org
209              
210             CONTRIBUTORS
211              
212             Copyright 2019-2021 by John Karr (BRAINBUZ) brainbuz@cpan.org.
213              
214             LICENSE
215              
216             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>.
217              
218             SUPPORT
219              
220             This software is provided as is, per the terms of the GNU Public License. Professional support and customisation services are available from the author.
221              
222             =cut
223