File Coverage

lib/App/Sandy/WeightedRaffle.pm
Criterion Covered Total %
statement 32 34 94.1
branch 6 8 75.0
condition 3 3 100.0
subroutine 7 7 100.0
pod 0 2 0.0
total 48 54 88.8


line stmt bran cond sub pod time code
1             package App::Sandy::WeightedRaffle;
2             # ABSTRACT: Weighted raffle interface.
3              
4 6     6   48 use App::Sandy::Base 'class';
  6         17  
  6         62  
5              
6             with 'App::Sandy::Role::BSearch';
7              
8             our $VERSION = '0.24'; # VERSION
9              
10             has 'keys' => (
11             traits => ['Array'],
12             is => 'ro',
13             isa => 'ArrayRef',
14             required => 1,
15             handles => { _get_key => 'get' }
16             );
17              
18             has 'weights' => (
19             is => 'ro',
20             isa => 'ArrayRef[My:IntGt0]',
21             required => 1
22             );
23              
24             has '_weights' => (
25             is => 'ro',
26             isa => 'My:Weights',
27             builder => '_build_weights',
28             lazy_build => 1
29             );
30              
31             has '_num_weights' => (
32             is => 'ro',
33             isa => 'My:IntGt0',
34             builder => '_build_num_weights',
35             lazy_build => 1
36             );
37              
38             has '_max_weight' => (
39             is => 'ro',
40             isa => 'My:IntGe0',
41             builder => '_build_max_weight',
42             lazy_build => 1
43             );
44              
45             sub BUILD {
46 20     20 0 95 my $self = shift;
47              
48 20         620 my $weights = $self->weights;
49 20         550 my $keys = $self->keys;
50              
51 20 50       545 if (scalar(@$weights) != scalar(@$keys)) {
52 0         0 croak "Number of weights must be equal to the number of keys";
53             }
54             }
55              
56             sub _build_num_weights {
57 4     4   19 my $self = shift;
58 4         158 my $weights = $self->_weights;
59 4         113 return scalar @$weights;
60             }
61              
62             sub _build_max_weight {
63 4     4   38 my $self = shift;
64 4         292 my $weights = $self->_weights;
65 4         131 return $weights->[-1]{up};
66             }
67              
68             sub _build_weights {
69 4     4   33 my $self = shift;
70 4         218 my $weights = $self->weights;
71              
72 4         11 my @weights_offset;
73 4         45 my $left = 0;
74              
75 4         55 for (my $i = 0; $i < @$weights; $i++) {
76 20         218 my %weight = (
77             down => $left,
78             up => $left + $weights->[$i] - 1
79             );
80              
81 20         64 $left += $weights->[$i];
82 20         186 push @weights_offset => \%weight;
83             }
84              
85 4         143 return \@weights_offset;
86             }
87              
88             sub weighted_raffle {
89 6840     6840 0 13950 my ($self, $rng) = @_;
90              
91             # Raffle between 0 and max weight
92 6840         198592 my $range = $rng->get_n($self->_max_weight + 1);
93              
94             # Look for the index where the range is
95 6840         194623 my $index = $self->with_bsearch($range, $self->_weights,
96             $self->_num_weights, \&_cmp);
97              
98 6840 50       15556 if (not defined $index) {
99 0         0 croak "Random index not found at range = $range";
100             }
101              
102             # Do it!
103 6840         246073 return $self->_get_key($index);
104             }
105              
106             sub _cmp {
107             # State the function to compare at bsearch
108 14592     14592   23389 my ($range, $weight) = @_;
109              
110 14592 100 100     52527 if ($range >= $weight->{down} && $range <= $weight->{up}) {
    100          
111 6840         15076 return 0;
112             }
113             elsif ($range > $weight->{down}) {
114 5542         13030 return 1;
115             } else {
116 2210         5454 return -1;
117             }
118             }
119              
120             __END__
121              
122             =pod
123              
124             =encoding UTF-8
125              
126             =head1 NAME
127              
128             App::Sandy::WeightedRaffle - Weighted raffle interface.
129              
130             =head1 VERSION
131              
132             version 0.24
133              
134             =head1 AUTHORS
135              
136             =over 4
137              
138             =item *
139              
140             Thiago L. A. Miller <tmiller@mochsl.org.br>
141              
142             =item *
143              
144             J. Leonel Buzzo <lbuzzo@mochsl.org.br>
145              
146             =item *
147              
148             Felipe R. C. dos Santos <fsantos@mochsl.org.br>
149              
150             =item *
151              
152             Helena B. Conceição <hconceicao@mochsl.org.br>
153              
154             =item *
155              
156             Rodrigo Barreiro <rbarreiro@mochsl.org.br>
157              
158             =item *
159              
160             Gabriela Guardia <gguardia@mochsl.org.br>
161              
162             =item *
163              
164             Fernanda Orpinelli <forpinelli@mochsl.org.br>
165              
166             =item *
167              
168             Rafael Mercuri <rmercuri@mochsl.org.br>
169              
170             =item *
171              
172             Rodrigo Barreiro <rbarreiro@mochsl.org.br>
173              
174             =item *
175              
176             Pedro A. F. Galante <pgalante@mochsl.org.br>
177              
178             =back
179              
180             =head1 COPYRIGHT AND LICENSE
181              
182             This software is Copyright (c) 2023 by Teaching and Research Institute from Sírio-Libanês Hospital.
183              
184             This is free software, licensed under:
185              
186             The GNU General Public License, Version 3, June 2007
187              
188             =cut