File Coverage

blib/lib/Vote/Count/Floor.pm
Criterion Covered Total %
statement 102 102 100.0
branch 27 28 96.4
condition n/a
subroutine 14 14 100.0
pod 4 4 100.0
total 147 148 99.3


line stmt bran cond sub pod time code
1 39     39   22064 use strict;
  39         121  
  39         1285  
2 39     39   537 use warnings;
  39         107  
  39         993  
3 39     39   939 use 5.024;
  39         143  
4 39     39   294 use feature qw /postderef signatures/;
  39         96  
  39         4645  
5              
6             use namespace::autoclean;
7 39     39   301 use Moose::Role;
  39         113  
  39         409  
8 39     39   4120 # use Data::Dumper;
  39         319  
  39         479  
9              
10             no warnings 'experimental';
11 39     39   227462  
  39         173  
  39         47924  
12             our $VERSION='2.02';
13              
14             =head1 NAME
15              
16             Vote::Count::Floor
17              
18             =head1 VERSION 2.02
19              
20             =cut
21              
22             # ABSTRACT: Floor Rules for RCV elections.
23              
24             # load the roles providing the underlying ops.
25             with 'Vote::Count::Approval', 'Vote::Count::TopCount',;
26              
27             has 'FloorRounding' => (
28             is => 'rw',
29             isa => 'Str',
30             default => 'up'
31             );
32              
33             if ( $I->FloorRounding eq 'down' ) {
34 32     32   113 return int($num);
  32         60  
  32         46  
  32         51  
35 32 100       920 }
    100          
    100          
    100          
36 7         58 elsif ( $I->FloorRounding eq 'up' ) {
37             return int($num) if ( $num == int($num) );
38             return int( $num + 1 );
39 17 100       77 }
40 10         50 elsif ( $I->FloorRounding eq 'round' ) {
41             return int( $num + 0.5 );
42             }
43 4         31 elsif ( $I->FloorRounding eq 'nextint' ) {
44             return int( $num + 1 );
45             }
46 3         24 else { die 'unknown FloorRounding method requested: ' . $I->FloorRounding }
47             }
48 1         26  
49             my $pct = $floorpct >= 1 ? $floorpct / 100 : $floorpct;
50             # warn "floorpct = $floorpct $pct cast = ${\ $I->VotesCast() }";
51 15     15   25 # warn "FloorMin = ${\ $I->_FloorRnd( $I->VotesCast() * $pct )}";
  15         27  
  15         28  
  15         22  
52 15 100       59 return $I->_FloorRnd( $I->VotesCast() * $pct );
53             }
54              
55 15         48 my @active = ();
56             my @remove = ();
57             for my $s ( keys $ranked->%* ) {
58 17     17   31 if ( $ranked->{$s} >= $cutoff ) { push @active, $s }
  17         26  
  17         29  
  17         28  
  17         26  
59 17         32 else {
60 17         28 push @remove, $s;
61 17         69 $I->logv("Removing: $s: $ranked->{$s}, minimum is $cutoff.");
62 179 100       308 }
  98         176  
63             }
64 81         127 if (@remove) {
65 81         302 $I->logt(
66             "Floor Rule Eliminated: ",
67             join( ', ', @remove ),
68 17 100       71 "Remaining: ", join( ', ', @active ),
69 16         108 );
70             }
71             else {
72             $I->logt('None Eliminated');
73             }
74             return { map { $_ => 1 } @active };
75             }
76 1         11  
77             # Approval Floor is Approval votes vs total
78 17         47 # votes cast -- not total of approval votes.
  98         270  
79             my $votescast = $self->VotesCast();
80             $self->logt( "Applying Floor Rule of $floorpct\% "
81             . "Approval Count. vs Ballots Cast of $votescast." );
82             my $raw =
83 8     8 1 250 $self->BallotSetType() eq 'rcv'
  8         14  
  8         16  
  8         17  
  8         13  
84 8         32 ? do { $self->Approval(); $self->LastApprovalBallots() }
85 8         83 : $self->Approval( undef, $rangecutoff )->RawCount();
86             return $self->_DoFloor( $raw, $self->_FloorMin($floorpct) );
87             }
88              
89 8 100       58 $self->logt("Applying Floor Rule of $floorpct\% First Choice Votes.");
  5         29  
  5         165  
90             my $raw =
91 8         55 $self->BallotSetType() eq 'rcv'
92             ? do { $self->TopCount(); $self->LastTopCountUnWeighted() }
93             : $self->TopCount();
94 4     4 1 2001 return $self->_DoFloor( $raw, $self->_FloorMin($floorpct) );
  4         9  
  4         91  
  4         9  
95 4         26 }
96              
97             if ( $floor > 1 ) {
98 4 50       25 my $m = "Floor value $floor is greater than 1";
  4         27  
  4         131  
99             $self->logt($m);
100 4         23 die "$m\n";
101             }
102             $self->logt(
103 6     6 1 1061 'Applying Floor Rule: Approval Must at least ',
  6         14  
  6         14  
  6         11  
104 6 100       27 "$floor times the Most First Choice votes. "
105 1         9 );
106 1         5 my $tc = $self->TopCount();
107 1         12 # arraytop returns a list in case of tie.
108             my $winner = shift( $tc->ArrayTop->@* );
109             my $tcraw = $tc->RawCount()->{$winner};
110 5         69 my $cutoff = $self->_FloorRnd( $tcraw * $floor );
111             $self->logv( "The most first choice votes for any choice is $tcraw.",
112             "Cutoff will be $cutoff" );
113 5         27 return $self->_DoFloor( $self->Approval()->RawCount(), $cutoff );
114             }
115 5         26  
116 5         21 my $newset = {};
117 5         38 if ( $rule eq 'ApprovalFloor' ) {
118 5         79 $newset = $self->ApprovalFloor(@args);
119             }
120 5         33 elsif ( $rule eq 'TopCountFloor' ) {
121             $newset = $self->TopCountFloor(@args);
122             }
123 6     6 1 70 elsif ( $rule eq 'TCA' ) {
  6         8  
  6         11  
  6         10  
  6         7  
124 6         12 $newset = $self->TCA(@args);
125 6 100       34 }
    100          
    100          
126 2         12 else {
127             die "Bad rule provided to ApplyFloor, $rule";
128             }
129 2         14 $self->SetActive($newset);
130             return $newset;
131             }
132 1         5  
133             =head1 Floor Rules
134              
135 1         19 In real elections it is common to have choices with very little support, with write-ins there can be a large number of these choices, with iterative dropping like IRV it can take many rounds to work through them. A Floor Rule sets a criteria to remove the weakly supported choices early in a single operation.
136              
137 5         28 =head1 SYNOPSIS
138 5         30  
139             my $Election = Vote::Count->new( BallotSet => $someballotset );
140             my $ChoicesAfterFloor = $Election->ApprovalFloor();
141             $Election->SetActive( $ChoicesAfterFloor ); # To apply the floor
142             $Election->ApplyFloor( 'TopCountFloor', @options ); # One Step
143              
144             =head1 Rounding
145              
146             The default rounding is up. If a calculated cutoff is 11.2, the cutoff will become greater than or equal to 12. Set FloorRounding to 'down' to change this to round down for 11.9 to become 11. Set FloorRounding to 'round' to change this to round .5 or greater up. If the comparison needs to be Greater than, a FloorRounding of 'nextint' will use the next higher integer.
147              
148             # When creating the Election.
149             my $Election = Vote::Count->new( FloorRounding => 'round', ... );
150             # Before applying the floor.
151             $Election->FloorRounding( 'down');
152              
153             =head1 The Floor Methods
154              
155             All Methods in this Module apply a floor rule, log the eliminations and return the set of remaining choices as a HashRef. Use the ApplyFloor Method to immediately apply the results.
156              
157             =head2 ApplyFloor
158              
159             Takes as an argument the Method Name as a string of the rule to apply ( ApprovalFloor, TopCountFloor, TCA), followed by any optional arguments for the rule. Sets the Active Set as defined by that rule and returns the new Active Set as a hashref.
160              
161             # Apply a TopCount Floor of 10%.
162             my $newactive = $Election->ApplyFloor( 'TopCountFloor', 10);
163              
164             =head2 ApprovalFloor, TopCountFloor
165              
166             Requires a percent of votes cast in Approval or TopCount. The default is 5% for Approval and 2% for TopCount.
167              
168             # TopCountFloor with 3% threshold.
169             my $Floored = $Election->TopCountFloor( 3 );
170              
171             Both of these methods take an optional parameter which is the percentage for the floor. If the parameter is 1 or greater the parameter will be interpreted as a percentage, if it is less than 1 it will be interpreted as a decimal fraction, .1 and 10 will both result in a 10% floor.
172              
173             For Range Ballots using ApprovalFloor there is an additional optional value for cutoff that sets the score below which choices are not considered approved of.
174              
175             # Applies 5% floor with cutoff 5 (appropriate for Range 0-10)
176             my $active = $Range->ApprovalFloor( 5, 5 );
177              
178             =head2 TCA (TopCount-Approval)
179              
180             Aggressive but (effectively) safe for Condorcet Methods. It requires the Approval for a choice be at least half of the leading Top Count Vote.
181              
182             This rule takes an optional argument to change the floor from .5.
183              
184             # uses default of 1/2
185             my $active = $Election->TCA();
186             # requires approval equal leader
187             my $active = $Election->TCA( 1 );
188              
189             =head3 TCA Rule Validation and Implication
190              
191             If there is a Loop or Condorcet Winner, either it will be/include the Top Count Leader or it must be a choice which defeats the Top Count leader. To defeat the Top Count Leader a Choice's Approval must be greater than the Lead Top Count. To be able to defeat a choice it is necessary to have more than half of the approval of that choice. Thus to be able to defeat a choice which can defeat the Top Count Leader it will be necessary to have more than half of the Approval of a choice with an Approval greater than the lead Top Count.
192              
193             There is a small possibility for a situation with a deeply nested knotted result that this rule could eliminate a member of the Dominant Set. For the common simple dropping rules (Approval, Top Count, Greatest Loss, Borda) this choice would never win.
194              
195             For IRV any choice with an Approval that is not greater than the current TopCount of any other choice will always be eliminated prior to that choice. Unfortunately, with IRV any change to dropping order can alter the result. If it is used in IRV the Election Rules must specify it. Also because it is a high Approval based Floor, it can be construed as adding a small risk of Later Harm violation. If the reason for choosing IRV was Later Harm, then the only safe floor is a TopCount floor.
196              
197             =cut
198              
199             1;
200              
201             #FOOTER
202              
203             =pod
204              
205             BUG TRACKER
206              
207             L<https://github.com/brainbuz/Vote-Count/issues>
208              
209             AUTHOR
210              
211             John Karr (BRAINBUZ) brainbuz@cpan.org
212              
213             CONTRIBUTORS
214              
215             Copyright 2019-2021 by John Karr (BRAINBUZ) brainbuz@cpan.org.
216              
217             LICENSE
218              
219             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>.
220              
221             SUPPORT
222              
223             This software is provided as is, per the terms of the GNU Public License. Professional support and customisation services are available from the author.
224              
225             =cut
226