File Coverage

blib/lib/Vote/Count/Helper/Table.pm
Criterion Covered Total %
statement 44 52 84.6
branch n/a
condition n/a
subroutine 9 10 90.0
pod 2 2 100.0
total 55 64 85.9


line stmt bran cond sub pod time code
1 2     2   1073 use strict;
  2         5  
  2         64  
2 2     2   13 use warnings;
  2         5  
  2         60  
3 2     2   42 use 5.024;
  2         9  
4              
5             no warnings 'experimental';
6 2     2   11 use feature qw /postderef signatures/;
  2         4  
  2         81  
7 2     2   10 use Sort::Hash;
  2         7  
  2         192  
8 2     2   14 use Vote::Count::TextTableTiny qw/generate_table/;
  2         5  
  2         129  
9 2     2   15  
  2         5  
  2         171  
10             our $VERSION='2.02';
11              
12             # ABSTRACT: Non OO Components for the Vote::Charge implementation of STV.
13              
14             =head1 NAME
15              
16             Vote::Count::Helper::Table
17              
18             =head1 VERSION 2.02
19              
20             =head1 Description
21              
22             Table Formatting Helpers for use within Vote::Count.
23              
24             =cut
25              
26             =pod
27              
28             =head1 SYNOPSIS
29              
30             use Vote::Count::Helper::Table 'ChargeTable';
31             # $chargesPerChoice and $chargedPerChoice are from Vote::Count::Charge::Cascade
32             say ChargeTable( $chargesPerChoice, $chargedPerChoice );
33              
34             use Vote::Count::Helper::Table 'WeightedTable';
35             # When weighted voting is used will generate a table
36             # with the Top Count and Approval totals
37             say WeightedTable( $STV_Election );
38              
39             =cut
40              
41             use Exporter::Easy (
42             OK => [ 'WeightedTable', 'ChargeTable' ],
43 2         17 );
44 2     2   444  
  2         1424  
45             =head2 ChargeTable
46              
47             Arguments: $chargesPerChoice, $chargedPerChoice
48              
49             chargesPerChoice is a HashRef with the choices as keys, and the values the charge assessed each ballot supporting the choice.
50              
51             chargedPerChoice is a HashRef with the choices as keys and the values a HashRef with the keys value, count, surplus, where value is the total vote value charged for the choice, count is the number of ballots that contributed, and surplus the value above quota charged.
52              
53             =cut
54              
55             my @rows = (['Choice','Charge','Value Charged', 'Votes Charged','Surplus'] );
56 0     0 1 0 for my $c ( sort keys $chargesPerChoice->%* ) {
  0         0  
  0         0  
  0         0  
57 0         0 push @rows, [
58 0         0 $c, $chargesPerChoice->{$c},
59             $chargedPerChoice->{$c}{'value'},
60             $chargedPerChoice->{$c}{'count'},
61             $chargedPerChoice->{$c}{'surplus'}
62             ]
63 0         0 }
64             return generate_table(
65             rows => \@rows,
66 0         0 style => 'markdown',
67             align => [qw/ l l r r r/]
68             ) . "\n";
69             }
70              
71             =head2 WeightedTable
72              
73             Formats the current Vote Totals by Approval and Top Count when weighted voting is in use, for STV/Vote Charge methods.
74              
75             =cut
76              
77             my $approval = $I->Approval()->RawCount();
78             my $tc = $I->TopCount();
79 1     1 1 7 my $tcr = $tc->RawCount();
  1         2  
  1         2  
80 1         8 my $vv = $I->VoteValue();
81 1         16 my %data =();
82 1         4 my @active = $I->GetActiveList();
83 1         31 for my $choice ( @active ) {
84 1         3 $data{ $choice } = {
85 1         4 'votevalue' => $tcr->{ $choice },
86 1         3 'votes' => sprintf( "%.2f",$tcr->{ $choice } / $vv),
87             'approvalvalue' => $approval->{ $choice },
88             'approval' => sprintf( "%.2f", $approval->{ $choice } / $vv),
89             };
90             }
91 8         85 my @rows = ( [ 'Rank', 'Choice', 'Votes', 'VoteValue', 'Approval', 'Approval Value' ] );
92             my %byrank = $tc->HashByRank()->%*;
93             for my $r ( sort { $a <=> $b } ( keys %byrank ) ) {
94 1         5 my @choice = sort $byrank{$r}->@*;
95 1         6 for my $choice (@choice) {
96 1         7 # my $votes = $tcr->{$choice};
  6         24  
97 5         21 my $D = $data{$choice};
98 5         11 my @row = (
99             $r, $choice, $D->{'votes'}, $D->{'votevalue'},
100 8         12 $D->{'approval'}, $D->{'approvalvalue'} );
101             push @rows, ( \@row );
102             }
103 8         27 }
104 8         22 return generate_table(
105             rows => \@rows,
106             style => 'markdown',
107 1         9 align => [qw/ l l r r r r/]
108             ) . "\n";
109             }
110             1;
111              
112             #FOOTER
113              
114             =pod
115              
116             BUG TRACKER
117              
118             L<https://github.com/brainbuz/Vote-Count/issues>
119              
120             AUTHOR
121              
122             John Karr (BRAINBUZ) brainbuz@cpan.org
123              
124             CONTRIBUTORS
125              
126             Copyright 2019-2021 by John Karr (BRAINBUZ) brainbuz@cpan.org.
127              
128             LICENSE
129              
130             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>.
131              
132             SUPPORT
133              
134             This software is provided as is, per the terms of the GNU Public License. Professional support and customisation services are available from the author.
135              
136             =cut
137