File Coverage

blib/lib/Bio/RNA/Treekin/PopulationDataRecord.pm
Criterion Covered Total %
statement 56 78 71.7
branch 5 12 41.6
condition 1 6 16.6
subroutine 15 19 78.9
pod 7 7 100.0
total 84 122 68.8


line stmt bran cond sub pod time code
1             # Bio/RNA/Treekin/PopulationDataRecord.pm
2             package Bio::RNA::Treekin::PopulationDataRecord;
3             our $VERSION = '0.04';
4              
5 4     4   87 use 5.006;
  4         24  
6 4     4   23 use strict;
  4         10  
  4         88  
7 4     4   20 use warnings;
  4         8  
  4         98  
8              
9 4     4   20 use Moose;
  4         8  
  4         30  
10 4     4   30731 use MooseX::StrictConstructor;
  4         9  
  4         38  
11 4     4   13410 use namespace::autoclean;
  4         9  
  4         45  
12              
13 4     4   350 use autodie qw(:all);
  4         65  
  4         29  
14 4     4   23194 use Scalar::Util qw(reftype looks_like_number);
  4         9  
  4         257  
15 4     4   57 use List::Util qw(max all);
  4         10  
  4         290  
16              
17 4     4   28 use overload '""' => \&stringify;
  4         8  
  4         37  
18              
19             has 'time' => (is => 'ro', required => 1);
20              
21             has '_populations' => (
22             is => 'ro',
23             required => 1,
24             init_arg => 'populations',
25             );
26              
27             # Return a deep copy of this object.
28             sub clone {
29 0     0 1 0 my $self = shift;
30 0         0 my $clone = __PACKAGE__->new(
31             time => $self->time,
32             populations => [ $self->populations ],
33             );
34 0         0 return $clone;
35             }
36              
37             # Return number of minima for which there is population data.
38             sub min_count {
39 321     321 1 573 my $self = shift;
40 321         506 my $min_count = @{ $self->_populations }; # number of data points
  321         13227  
41              
42 321         1367 return $min_count;
43             }
44              
45             # Use to adjust the min count, e.g. when the passed data array was
46             # constructed before the number of minima was known. It may not be
47             # shrinked as data might be lost.
48             sub set_min_count {
49 4     4 1 12 my ($self, $new_min_count) = @_;
50              
51 4         8 my $current_min_count = @{ $self->_populations };
  4         129  
52 4 50       19 confess 'Can only increase min_count'
53             if $current_min_count > $new_min_count;
54              
55             # Set additional states to population of 0.
56 4         18 for my $i ( $current_min_count..($new_min_count-1) ) {
57 14         483 $self->_populations->[$i] = 0.;
58             }
59              
60 4         116 return;
61             }
62              
63             # Return populations of all mins. Use of_min() instead to get the
64             # population of a specific min.
65             # Returns a list of all minima's populations.
66             sub populations {
67 0     0 1 0 my $self = shift;
68 0         0 return @{ $self->_populations };
  0         0  
69             }
70              
71             # Get population for the given minimum.
72             sub of_min {
73 306     306 1 168294 my ($self, $min) = @_;
74              
75 306 50 33     1144 confess "Minimum $min is out of bounds"
76             if $min < 1 or $min > $self->min_count;
77              
78             # Minimum 1 is the first one (index 0)
79 306         10015 my $population = $self->_populations->[$min-1];
80 306         1675 return $population;
81             }
82              
83             # Transform (reorder and resize) the population data according to a given
84             # mapping and resize to a given minimum count. All minima that are not
85             # mapped to a new position are discarded (replaced by zero).
86             # NOTE: Ensure that no two minima are mapped to the same position or crap
87             # will happen.
88             # Arguments:
89             # maps_to_min_ref: Hash ref that specifies for each kept minimum (key) to
90             # which new minimum (value) it is supposed to be mapped.
91             # new_min_count: New size (number of mins) of the record after the
92             # transformation. Defaults to the maximum value of maps_to_min_ref.
93             # Void.
94             sub transform {
95 0     0 1 0 my ($self, $maps_to_min_ref, $new_min_count) = @_;
96              
97             # If not explicitely given, use max value a min was mapped to as min count.
98 0   0     0 $new_min_count //= max values %$maps_to_min_ref;
99              
100 0         0 my @new_pops = (0) x $new_min_count; # new array with right size
101 0         0 my @source_mins = grep { defined $maps_to_min_ref->{$_} }
  0         0  
102             1..$self->min_count; # filter unmapped
103 0         0 my @source_indices = map { $_ - 1 } @source_mins;
  0         0  
104 0         0 my @target_indices = map { $maps_to_min_ref->{$_} - 1 } @source_mins;
  0         0  
105              
106             # Sanity check.
107             confess "Cannot reorder as some minima are not mapped correctly"
108 0 0   0   0 unless all {$_ >= 0 and $_ < $new_min_count} @target_indices;
  0 0       0  
109              
110             # Copy population data to the correct positions and overwrite original.
111 0         0 @new_pops[@target_indices] = @{$self->_populations}[@source_indices];
  0         0  
112 0         0 @{ $self->_populations } = @new_pops;
  0         0  
113              
114 0         0 return;
115             }
116              
117             sub _parse_population_data_line {
118 161     161   423 my ($self, $population_data_line) = @_;
119              
120 161         2409 my ($time, @populations) = split /\s+/, $population_data_line;
121              
122             # Sanity checks.
123 161 100       727 confess "No population data found in line:\n$population_data_line\n"
124             unless @populations;
125 160 50       572 confess "Time value '$time' is not a number"
126             unless looks_like_number $time;
127             # For the sake of performance, we do not test the numberness of the data.
128              
129             # Pack args for constructor.
130 160         436 my @args = (
131             time => $time,
132             populations => \@populations,
133             );
134              
135 160         662 return @args;
136             }
137              
138             around BUILDARGS => sub {
139             my $orig = shift;
140             my $class = shift;
141              
142             return $class->$orig(@_) if @_ != 1 or reftype $_[0];
143              
144             # We have a population data line here.
145             my $population_data_line = shift;
146             my @args
147             = $class->_parse_population_data_line($population_data_line);
148              
149             return $class->$orig(@args);
150             };
151              
152             # Convert this data record back to a line as found in the Treekin file.
153             sub stringify {
154 132     132 1 232 my $self = shift;
155              
156             # Format data like treekin C code
157 132         4451 my $self_as_string = sprintf "%22.20e ", $self->time;
158             $self_as_string
159 132         308 .= join q{ }, map {sprintf "%e", $_} @{ $self->_populations };
  1076         5294  
  132         4319  
160              
161             # There seems to be a trailing space in the treekin C code
162             # (printf "%e ") but there is none in the treekin simulator output.
163             # $self_as_string .= q{ };
164              
165 132         839 return $self_as_string;
166             }
167              
168             __PACKAGE__->meta->make_immutable;
169              
170              
171             1; # End of Bio::RNA::Treekin::PopulationDataRecord
172              
173             __END__
174              
175              
176             =pod
177              
178             =encoding UTF-8
179              
180             =head1 NAME
181              
182             Bio::RNA::Treekin::PopulationDataRecord - Parse, query, and manipulate a
183             single data line from a I<Treekin> file.
184              
185             =head1 SYNOPSIS
186              
187             use Bio::RNA::Treekin;
188              
189             my $pop_data = Bio::RNA::Treekin::PopulationDataRecord->new(
190             '<single population data line from Treekin file>');
191              
192             print "Populations at time", $pop_data->time, ":\n";
193             print " min $_: ", $pop_data->of_min($_), "\n"
194             for 1..$pop_data->min_count;
195              
196             my @big_pops = grep {$pop_data->of_min($_) > 0.1} 1..$pop_data->min_count;
197             print 'Minima ', join(q{, }, @big_pops), ' have a population greater 0.1\n';
198              
199              
200              
201             =head1 DESCRIPTION
202              
203             This class provides a population data record that stores the information from
204             a single data line of a I<Treekin> file.
205              
206              
207             =head1 METHODS
208              
209              
210             =head2 Bio::RNA::Treekin::PopulationDataRecord->new($treekin_file_line)
211              
212             Construct a new population data record from a single data line of a I<Treekin>
213             file.
214              
215             =head2 Bio::RNA::Treekin::PopulationDataRecord->new(arg => $argval, ...)
216              
217             Construct a new population data record.
218              
219             =over
220              
221             =item Required arguments:
222              
223             =over
224              
225             =item time
226              
227             The point in time that the population data describes.
228              
229             =item populations
230              
231             Array ref of the population values for all minima.
232              
233             =back
234              
235             =back
236              
237              
238             =head2 $pop_data->min_count
239              
240             Return the number of minima in this data record. This count is not stored
241             explicitely, but inferred from the number of populations supplied during
242             construction.
243              
244             =head2 $pop_data->time
245              
246             Return the point in time (in arbitrary time units) that the population data
247             describes.
248              
249             =head2 $pop_data->clone
250              
251             Return a deep copy of this data record.
252              
253             =head2 $pop_data->set_min_count($new_min_count)
254              
255             Increase the number of minima to C<$new_min_count>. The newly added minima
256             will have population values of 0.
257              
258             Currently, the number of minima cannot be decreased to avoid data loss.
259              
260             =head2 $pop_data->populations
261              
262             Return a list of all population values for minima 1, 2, ..., n in this ordner.
263              
264             =head2 $pop_data->of_min($minimum)
265              
266             Return the population value of the given C<$minimum> at the C<time> of this
267             record.
268              
269             =head2 $pop_data->transform($maps_to_min_ref, $new_min_count)
270              
271             Transform (reorder and resize) the population data according to a given
272             mapping (C<$maps_to_min_ref>) and resize to a given number of minima
273             (C<$new_min_count>). All minima that are not mapped to a new position are
274             discarded (replaced by zero).
275              
276             NOTE: Ensure that no two minima are mapped to the same position or crap
277             will happen.
278              
279             =over
280              
281             =item Arguments:
282              
283             =over
284              
285             =item $maps_to_min_ref:
286              
287             Hash ref that specifies for each kept minimum (key) to which new minimum
288             (value) it is supposed to be mapped.
289              
290             =item $new_min_count:
291              
292             New size (number of mins) of the record after the transformation. Defaults to
293             the maximum value of C<$maps_to_min_ref>.
294              
295             =back
296              
297             =back
298              
299             =head2 $pop_data->stringify
300              
301             =head2 "$pop_data"
302              
303             Convert this data record into a string representation, corresponding to a
304             single line as found in a I<Treekin> file.
305              
306             =head1 AUTHOR
307              
308             Felix Kuehnl, C<< <felix@bioinf.uni-leipzig.de> >>
309              
310              
311             =head1 BUGS
312              
313             Please report any bugs or feature requests by raising an issue at
314             L<https://github.com/xileF1337/Bio-RNA-Treekin/issues>.
315              
316             You can also do so by mailing to C<bug-bio-rna-treekin at rt.cpan.org>,
317             or through the web interface at
318             L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Bio-RNA-Treekin>. I will be
319             notified, and then you'll automatically be notified of progress on your bug as
320             I make changes.
321              
322              
323             =head1 SUPPORT
324              
325             You can find documentation for this module with the perldoc command.
326              
327             perldoc Bio::RNA::Treekin
328              
329              
330             You can also look for information at:
331              
332             =over 4
333              
334             =item * Github: the official repository
335              
336             L<https://github.com/xileF1337/Bio-RNA-Treekin>
337              
338             =item * RT: CPAN's request tracker (report bugs here)
339              
340             L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Bio-RNA-Treekin>
341              
342             =item * AnnoCPAN: Annotated CPAN documentation
343              
344             L<http://annocpan.org/dist/Bio-RNA-Treekin>
345              
346             =item * CPAN Ratings
347              
348             L<https://cpanratings.perl.org/d/Bio-RNA-Treekin>
349              
350             =item * Search CPAN
351              
352             L<https://metacpan.org/release/Bio-RNA-Treekin>
353              
354             =back
355              
356              
357             =head1 LICENSE AND COPYRIGHT
358              
359             Copyright 2019-2021 Felix Kuehnl.
360              
361             This program is free software: you can redistribute it and/or modify
362             it under the terms of the GNU General Public License as published by
363             the Free Software Foundation, either version 3 of the License, or
364             (at your option) any later version.
365              
366             This program is distributed in the hope that it will be useful,
367             but WITHOUT ANY WARRANTY; without even the implied warranty of
368             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
369             GNU General Public License for more details.
370              
371             You should have received a copy of the GNU General Public License
372             along with this program. If not, see L<http://www.gnu.org/licenses/>.
373              
374              
375             =cut
376              
377             # End of Bio/RNA/Treekin/PopulationDataRecord.pm