File Coverage

lib/App/SimulateReads/Role/WeightedRaffle.pm
Criterion Covered Total %
statement 30 31 96.7
branch 7 10 70.0
condition 3 3 100.0
subroutine 6 6 100.0
pod 0 2 0.0
total 46 52 88.4


line stmt bran cond sub pod time code
1             package App::SimulateReads::Role::WeightedRaffle;
2             # ABSTRACT: Extends class with weighted raffle.
3              
4 6     6   3087 use App::SimulateReads::Base 'role';
  6         17  
  6         45  
5              
6             requires '_build_weights';
7              
8             our $VERSION = '0.06'; # VERSION
9              
10             #-------------------------------------------------------------------------------
11             # Moose attributes
12             #-------------------------------------------------------------------------------
13             has 'weights' => (
14             is => 'ro',
15             isa => 'My:Weights',
16             builder => '_build_weights',
17             lazy_build => 1
18             );
19             has 'num_weights' => (
20             is => 'ro',
21             isa => 'My:IntGt0',
22             builder => '_build_num_weights',
23             lazy_build => 1
24             );
25             has 'max_weight' => (
26             is => 'ro',
27             isa => 'My:IntGt0',
28             builder => '_build_max_weight',
29             lazy_build => 1
30             );
31              
32             #=== CLASS METHOD ============================================================
33             # CLASS: My::Role::WeightedRaffle (Role)
34             # METHOD: _build_num_weights (BUILDER)
35             # PARAMETERS: Void
36             # RETURNS: Int > 0
37             # DESCRIPTION: Builds num_weights
38             # THROWS: If weights is not builded, throws an error
39             # COMMENTS: none
40             # SEE ALSO: n/a
41             #===============================================================================
42             sub _build_num_weights {
43 4     4   11 my $self = shift;
44 4         157 my $weights = $self->weights;
45 4 50       25 croak "Not found a weights object\n" unless defined $weights;
46 4         149 return scalar @$weights;
47             } ## --- end sub _build_num_weights
48              
49             #=== CLASS METHOD ============================================================
50             # CLASS: My::Role::WeightedRaffle (Role)
51             # METHOD: _build_max_weight (BUILDER)
52             # PARAMETERS: Void
53             # RETURNS: Int > 0
54             # DESCRIPTION: Builds max_weight
55             # THROWS: If weights is not builded, throws an error
56             # COMMENTS: none
57             # SEE ALSO: n/a
58             #===============================================================================
59             sub _build_max_weight {
60 4     4   39 my $self = shift;
61 4         242 my $weights = $self->weights;
62 4 50       36 croak "Not found a weights object\n" unless defined $weights;
63 4         172 return $weights->[-1]{up};
64             } ## --- end sub _build_max_weight
65              
66             #=== CLASS METHOD ============================================================
67             # CLASS: My::Role::WeightedRaffle (Role)
68             # METHOD: calculate_weights
69             # PARAMETERS: $line HashRef[Int]
70             # RETURNS: My:Weights
71             # DESCRIPTION: Calculates weight based in a hash -> key => weight, giving:
72             # [ { down, up, feature }, { down, up, feature } .. ]
73             # THROWS: no exceptions
74             # COMMENTS: none
75             # SEE ALSO: n/a
76             #===============================================================================
77             sub calculate_weights {
78 20     20 0 60 my ($self, $line) = @_;
79              
80 20         30 my @weights;
81 20         40 my $left = 0;
82              
83 20         60 for my $feature (keys %$line) {
84             my %weight = (
85             down => $left,
86 100         295 up => $left + $line->{$feature} - 1,
87             feature => $feature
88             );
89 100         140 $left += $line->{$feature};
90 100         185 push @weights => \%weight;
91             }
92              
93 20         590 return \@weights;
94             } ## --- end sub calculate_weights
95              
96             #=== CLASS METHOD ============================================================
97             # CLASS: My::Role::WeightedRaffle (Role)
98             # METHOD: weighted_raffle
99             # PARAMETERS: Void
100             # RETURNS: $self->_search()
101             # DESCRIPTION: Makes a binary search on the intervals between the weights. The
102             # bigger the interval bigger the weight. It begins by making a
103             # raffle on the sum of weights, then calls _search that searches
104             # for the feature whose value hit the interval
105             # THROWS: no exceptions
106             # COMMENTS: none
107             # SEE ALSO: _search
108             #===============================================================================
109             sub weighted_raffle {
110 1710     1710 0 2469 my $self = shift;
111 1710         53527 my $range = int(rand($self->max_weight + 1));
112 1710         46982 return $self->_search(0, $self->num_weights - 1, $range);
113             } ## --- end sub weighted_raffle
114            
115             #=== CLASS METHOD ============================================================
116             # CLASS: My::Role::WeightedRaffle (Role)
117             # METHOD: _search (PRIVATE)
118             # PARAMETERS: $min_index Int >= 0, $max_index Int > 0, $range Int > 0
119             # RETURNS: $weight->{feature} when found
120             # DESCRIPTION: Binary search
121             # THROWS: If $min_index greater the $max_index, which may not occur, throws
122             # an exception
123             # COMMENTS: none
124             # SEE ALSO: weighted_raffle
125             #===============================================================================
126             sub _search {
127 3381     3381   5773 my ($self, $min_index, $max_index, $range) = @_;
128              
129 3381 50       5666 if ($min_index > $max_index) {
130 0         0 croak "Random feature not found";
131             }
132              
133 3381         5946 my $selected_index = int(($min_index + $max_index) / 2);
134 3381         87476 my $weight = $self->weights->[$selected_index];
135              
136 3381 100 100     11249 if ($range >= $weight->{down} && $range <= $weight->{up}) {
    100          
137 1710         5712 return $weight->{feature};
138             }
139             elsif ($range > $weight->{down}) {
140 1020         2231 return $self->_search($selected_index + 1,
141             $max_index, $range);
142             } else {
143 651         1606 return $self->_search($min_index,
144             $selected_index - 1, $range);
145             }
146             } ## --- end sub _search
147              
148             __END__
149              
150             =pod
151              
152             =encoding UTF-8
153              
154             =head1 NAME
155              
156             App::SimulateReads::Role::WeightedRaffle - Extends class with weighted raffle.
157              
158             =head1 VERSION
159              
160             version 0.06
161              
162             =head1 AUTHOR
163              
164             Thiago L. A. Miller <tmiller@mochsl.org.br>
165              
166             =head1 COPYRIGHT AND LICENSE
167              
168             This software is Copyright (c) 2017 by Teaching and Research Institute from Sírio-Libanês Hospital.
169              
170             This is free software, licensed under:
171              
172             The GNU General Public License, Version 3, June 2007
173              
174             =cut