File Coverage

blib/lib/Vote/Count/Helper/FullCascadeCharge.pm
Criterion Covered Total %
statement 51 52 98.0
branch 9 10 90.0
condition n/a
subroutine 9 9 100.0
pod 0 1 0.0
total 69 72 95.8


line stmt bran cond sub pod time code
1 5     5   645 use strict;
  5         12  
  5         190  
2 5     5   29 use warnings;
  5         10  
  5         156  
3 5     5   112 use 5.024;
  5         19  
4              
5             package Vote::Count::Helper::FullCascadeCharge;
6 5     5   92 no warnings 'experimental';
  5         11  
  5         236  
7 5     5   44 use feature qw /postderef signatures/;
  5         13  
  5         598  
8 5     5   43 use Sort::Hash;
  5         59  
  5         284  
9 5     5   1975 use Vote::Count::TextTableTiny qw/generate_table/;
  5         15  
  5         473  
10              
11             our $VERSION='2.01';
12              
13             # ABSTRACT: Non OO Components for the Vote::Charge implementation of STV FullCascadeCharge.
14              
15             =head1 NAME
16              
17             Vote::Count::Helper::FullCascadeCharge
18              
19             =head1 VERSION 2.01
20              
21             =head1 SYNOPSIS
22              
23             use Vote::Count::Helper::FullCascadeCharge;
24             my $charged = FullCascadeCharge(
25             $Election->GetBallots(), $quota, $cost, $active, $votevalue );
26              
27             =head1 FullCascadeCharge
28              
29             Performs a full Cascading Charge of the Ballots. It takes a list of choices to be elected, with the Vote Value to be charged for each of these. It walks through the Ballots and looks at each choice on the ballot in order. If the choice is elected the vote is charged (up to the remaining vote value) the specified charge and then continues to the next choice on the ballot. If the choice is in the active list (hopeful) it stops processing the choice on the ballot and moves on to the next ballot, otherwise it will continue until the ballot exhausts its choices or vote value.
30              
31             Parameters are Ballots, Quota, Cost (HashRef of elected choices and the charge to each), Active Set (HashRef), and the VoteValue assigned initially to the Ballots.
32              
33             Return Value is a HashRef where the keys are the Elected Choices, the values are a HashRef with the keys: value, count, surplus. The value key is the total Vote Value charged for that choice, the count is the number of Ballots which contributed any amount to that charge, and finally the surplus is the amount of value over or under (negative) the quota.
34              
35             The method is non-OO. This permits isolation of values, which may be needed for performing estimations to establish the Costs.
36              
37             The Ballots are passed as a HashRef and the votevalue will be modified, if you do not want the Ballots modified, provide a copy of them (Storable 'dclone' is recommended)
38              
39             =cut
40              
41             use Exporter::Easy (
42 5         41 EXPORT => [ 'FullCascadeCharge' ],
43 5     5   2494 );
  5         5957  
44              
45 34     34 0 7084 sub FullCascadeCharge ( $ballots, $quota, $cost, $active, $votevalue ) {
  34         60  
  34         50  
  34         54  
  34         50  
  34         55  
  34         47  
46 34         2862 for my $b ( keys $ballots->%* ) {
47 23414         35991 $ballots->{$b}{'votevalue'} = $votevalue;
48             }
49             my %chargedval =
50 34         868 map { $_ => { value => 0, count => 0, surplus => 0 } } ( keys $cost->%* );
  89         385  
51             FullChargeBALLOTLOOP1:
52 34         885 for my $V ( values $ballots->%* ) {
53 23414 50       40830 unless ( $V->{'votevalue'} > 0 ) { next FullChargeBALLOTLOOP1 }
  0         0  
54             FullChargeBALLOTLOOP2:
55 23414         36367 for my $C ( $V->{'votes'}->@* ) {
56 35745 100       65799 if ( $active->{$C} ) { last FullChargeBALLOTLOOP2 }
  17943 100       26340  
57             elsif ( $cost->{$C} ) {
58 17703         22127 my $charge = do {
59 17703 100       30354 if ( $V->{'votevalue'} >= $cost->{$C} ) { $cost->{$C} }
  12335         18907  
60 5368         8068 else { $V->{'votevalue'} }
61             };
62 17703         24961 $V->{'votevalue'} -= $charge;
63 17703         29064 $chargedval{$C}{'value'} += $charge * $V->{'count'};
64 17703         26348 $chargedval{$C}{'count'} += $V->{'count'};
65 17703 100       32478 unless ( $V->{'votevalue'} > 0 ) { last FullChargeBALLOTLOOP2 }
  5370         8791  
66             }
67             }
68             }
69 34         145 for my $E ( keys %chargedval ) {
70 89         164 $chargedval{$E}{'surplus'} = $chargedval{$E}{'value'} - $quota;
71             }
72 34         163 return \%chargedval;
73             }
74              
75             1;
76              
77             #FOOTER
78              
79             =pod
80              
81             BUG TRACKER
82              
83             L<https://github.com/brainbuz/Vote-Count/issues>
84              
85             AUTHOR
86              
87             John Karr (BRAINBUZ) brainbuz@cpan.org
88              
89             CONTRIBUTORS
90              
91             Copyright 2019-2021 by John Karr (BRAINBUZ) brainbuz@cpan.org.
92              
93             LICENSE
94              
95             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>.
96              
97             SUPPORT
98              
99             This software is provided as is, per the terms of the GNU Public License. Professional support and customisation services are available from the author.
100              
101             =cut
102