File Coverage

blib/lib/Vote/Count/Helper/NthApproval.pm
Criterion Covered Total %
statement 34 34 100.0
branch 5 6 83.3
condition n/a
subroutine 7 7 100.0
pod 0 1 0.0
total 46 48 95.8


line stmt bran cond sub pod time code
1 2     2   14022 use strict;
  2         7  
  2         72  
2 2     2   9 use warnings;
  2         4  
  2         61  
3 2     2   49 use 5.024;
  2         10  
4              
5             package Vote::Count::Helper::NthApproval;
6 2     2   10 use Moose::Role;
  2         6  
  2         31  
7 2     2   11123 no warnings 'experimental';
  2         5  
  2         110  
8 2     2   12 use feature qw /postderef signatures/;
  2         5  
  2         825  
9             # use Vote::Count::TextTableTiny qw/generate_table/;
10              
11             our $VERSION='2.01';
12              
13             # ABSTRACT: Nth Approval Defeat rule for STV elections.
14              
15             =head1 NAME
16              
17             Vote::Count::Helper::NthApproval
18              
19             =head1 VERSION 2.01
20              
21             =cut
22              
23             =pod
24              
25             =head1 SYNOPSIS
26              
27             package MySTVElection;
28             use Moose;
29             extends 'Vote::Count::Charge';
30             with 'Vote::Count::Charge::NthApproval';
31             for my $defeat ( NthApproval( $STV_Election ) ) {
32             $STV_Election->Defeat( $defeat );
33             }
34              
35             =head1 NthApproval
36              
37             Finds the choice that would fill the last seat if the remaining seats were to be filled by highest Top Count, and sets the Vote Value for that Choice as the requirement. All Choices that do not have a weighted Approval greater than that requirement are returned, they will never be elected and are safe to defeat immediately.
38              
39             Results are logged to the verbose log.
40              
41             This rule is not strictly LNH safe.
42              
43             =cut
44              
45 4     4 0 87 sub NthApproval ( $I ) {
  4         9  
  4         8  
46 4         58 my $tc = $I->TopCount();
47 4         31 my $ac = $I->Approval();
48 4         123 my $seats = $I->Seats() - $I->Elected();
49 4         11 my @defeat = ();
50 4         34 my $bottomrunning = $tc->HashByRank()->{$seats}[0];
51 4         18 my $bar = $tc->RawCount()->{$bottomrunning};
52 4         20 for my $A ( $I->GetActiveList ) {
53 25 100       46 next if $A eq $bottomrunning;
54 21         29 my $avv = $ac->{'rawcount'}{$A};
55 21 100       48 push @defeat, ($A) if $avv <= $bar;
56             }
57 4 50       14 if (@defeat) {
58 4         23 $I->logv( qq/
59             Seats: $seats Choice $seats: $bottomrunning ( $bar )
60 4         28 Choices Not Over $bar by Weighted Approval: ${\ join( ', ', @defeat ) }
61             /);
62             }
63 4         84 return @defeat;
64             }
65              
66             1;
67              
68             #FOOTER
69              
70             =pod
71              
72             BUG TRACKER
73              
74             L<https://github.com/brainbuz/Vote-Count/issues>
75              
76             AUTHOR
77              
78             John Karr (BRAINBUZ) brainbuz@cpan.org
79              
80             CONTRIBUTORS
81              
82             Copyright 2019-2021 by John Karr (BRAINBUZ) brainbuz@cpan.org.
83              
84             LICENSE
85              
86             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>.
87              
88             SUPPORT
89              
90             This software is provided as is, per the terms of the GNU Public License. Professional support and customisation services are available from the author.
91              
92             =cut
93