File Coverage

blib/lib/Finnigan/Profile.pm
Criterion Covered Total %
statement 51 127 40.1
branch 9 82 10.9
condition 4 39 10.2
subroutine 13 17 76.4
pod 12 12 100.0
total 89 277 32.1


line stmt bran cond sub pod time code
1             package Finnigan::Profile;
2              
3 2     2   9 use strict;
  2         4  
  2         68  
4 2     2   12 use warnings FATAL => qw( all );
  2         3  
  2         86  
5             our $VERSION = 0.0206;
6              
7 2     2   11 use Carp;
  2         9  
  2         152  
8 2     2   10 use Finnigan;
  2         4  
  2         44  
9 2     2   10 use base 'Finnigan::Decoder';
  2         3  
  2         3485  
10              
11             my $preamble = [
12             "first value" => ['d<', 'Float64'],
13             "step" => ['d<', 'Float64'],
14             "peak count" => ['V', 'UInt32'],
15             "nbins" => ['V', 'UInt32'],
16             ];
17              
18              
19             sub decode {
20 1     1 1 6 my $self = bless Finnigan::Decoder->read($_[1], $preamble), $_[0];
21 1         16 return $self->iterate_object($_[1], $self->{data}->{"peak count"}->{value}, chunks => 'Finnigan::ProfileChunk', $_[2]); # the last arg is layout
22             }
23              
24             sub nchunks { # in place of the erroneous "peak_count"
25 1     1 1 17 shift->{data}->{"peak count"}->{value};
26             }
27              
28             sub peak_count { # deprecated
29 0     0 1 0 shift->{data}->{"peak count"}->{value};
30             }
31              
32             sub nbins {
33 1     1 1 9 shift->{data}->{"nbins"}->{value};
34             }
35              
36             sub first_value {
37 1     1 1 11 shift->{data}->{"first value"}->{value};
38             }
39              
40             sub step {
41 1     1 1 401 my $self = shift;
42 1 50       10 confess "undefined" unless $self;
43 1         8 $self->{data}->{"step"}->{value};
44             }
45              
46             sub chunks {
47 0     0 1 0 shift->{data}->{"chunks"}->{value};
48             }
49              
50             sub chunk { # a syntactic eye-sore remover
51 5     5 1 833 shift->{data}->{"chunks"}->{value};
52             }
53              
54             sub set_converter {
55 1     1 1 400 $_[0]->{converter} = $_[1];
56             }
57              
58             sub set_inverse_converter {
59 0     0 1 0 $_[0]->{"inverse converter"} = $_[1];
60             }
61              
62             sub bins {
63 1     1 1 8 my ($self, $range, $add_zeroes) = @_;
64 1         2 my @list;
65 1         5 my $start = $self->{data}->{"first value"}->{value};
66 1         4 my $step = $self->{data}->{step}->{value};
67 1 50       5 unless ( $range ) {
68 1 50       6 unless ( exists $self->{converter} ) {
69 0         0 $range = [$start, $start + $self->{data}->{nbins}->{value} * $step];
70             }
71             }
72              
73 1 50       6 push @list, [$range->[0], 0] if $add_zeroes;
74 1         2 my $last_bin_written = 0;
75              
76 1         3 my $shift = 0; # this is declared outside the chunk loop to allow
77             # writing the empty bin following the last chunk with
78             # the same amount of shift as in the last chunk
79              
80 1         7 foreach my $i ( 0 .. $self->{data}->{"peak count"}->{value} - 1 ) { # each chunk
81 580         1746 my $chunk = $self->{data}->{chunks}->{value}->[$i];
82 580         1653 my $first_bin = $chunk->{data}->{"first bin"}->{value};
83 580 50       1749 $shift = $chunk->{data}->{fudge} ? $chunk->{data}->{fudge}->{value} : 0;
84 580         1337 my $x = $start + $first_bin * $step;
85              
86 580 50 33     1966 if ( $add_zeroes and $last_bin_written < $first_bin - 1) {
87             # add an empty bin ahead of the chunk, unless there is no gap
88             # between this and the previous chunk
89 0         0 my $x0 = $x - $step;
90 0 0       0 my $x_conv = exists $self->{converter} ? &{$self->{converter}}($x0) + $shift : $x0;
  0         0  
91 0         0 push @list, [$x_conv, 0];
92             }
93              
94 580         1674 foreach my $j ( 0 .. $chunk->{data}->{nbins}->{value} - 1) {
95 3878 50       8767 my $x_conv = exists $self->{converter} ? &{$self->{converter}}($x) + $shift : $x;
  3878         13554  
96 3878         6684 $x += $step;
97 3878 50       8884 if ( $range ) {
98 0 0       0 if ( exists $self->{converter} ) {
99 0 0 0     0 next unless $x_conv >= $range->[0] and $x_conv <= $range->[1];
100             }
101             else {
102             # frequencies have the reverse order
103 0 0 0     0 next unless $x_conv <= $range->[0] and $x_conv >= $range->[1];
104             }
105             }
106 3878         5915 my $bin = $first_bin + $j;
107 3878         15246 push @list, [$x_conv, $chunk->{data}->{signal}->{value}->[$j]];
108 3878         7620 $last_bin_written = $first_bin + $j;
109             }
110              
111 580 0 33     2008 if ( $add_zeroes
      33        
112             and
113             $i < $self->{data}->{"peak count"}->{value} - 1
114             and
115             $last_bin_written < $self->{data}->{chunks}->{value}->[$i+1]->{data}->{"first bin"}->{value} - 1
116             ) {
117             # add an empty bin following the chunk, unless there is no gap
118             # between this and the next chunk
119 0         0 my $bin = $last_bin_written + 1;
120             # $x has been incremented inside the chunk loop
121 0 0       0 my $x_conv = exists $self->{converter} ? &{$self->{converter}}($x) + $shift: $x;
  0         0  
122 0         0 push @list, [$x_conv, 0];
123 0         0 $last_bin_written++;
124             }
125             }
126              
127 1 50 33     8 if ( $add_zeroes and $last_bin_written < $self->{data}->{nbins}->{value} - 1 ) {
128             # add an empty bin following the last chunk, unless there is no gap
129             # left between it and the end of the range ($self->nbins - 1)
130 0         0 my $x = $start + ($last_bin_written + 1) * $step;
131 0 0       0 my $x_conv = exists $self->{converter} ? &{$self->{converter}}($x) + $shift: $x;
  0         0  
132 0         0 push @list, [$x_conv, 0];
133 0 0       0 push @list, [$range->[1], 0] if $add_zeroes;
134             }
135 1         9 return \@list;
136             }
137              
138             sub print_bins {
139 0     0 1   my ($self, $range, $add_zeroes) = @_;
140 0           my @list;
141 0           my $data = $self->{data};
142 0           my $start = $data->{"first value"}->{value};
143 0           my $step = $data->{step}->{value};
144 0           my $chunks = $data->{chunks}->{value};
145              
146 0 0         unless ( $range ) {
147 0 0         unless (exists $self->{converter} ) {
148 0           $range = [$start, $start + $data->{nbins}->{value} * $step];
149             }
150             }
151              
152 0 0         print "$range->[0]\t0\n" if $add_zeroes;
153              
154 0           my $shift = 0; # this is declared outside the chunk loop to allow
155             # writing the empty bin following the last chunk with
156             # the same amount of shift as in the last chunk
157              
158 0           foreach my $i ( 0 .. $data->{"peak count"}->{value} - 1 ) { # each chunk
159 0           my $chunk = $chunks->[$i]->{data};
160 0           my $first_bin = $chunk->{"first bin"}->{value};
161 0 0         $shift = $chunk->{fudge} ? $chunk->{fudge}->{value} : 0;
162 0           my $x = $start + $first_bin * $step;
163 0 0         my $x_conv = exists $self->{converter} ? &{$self->{converter}}($x) + $shift : $x;
  0            
164              
165             # print all points in the chunk that fall within the specified range
166 0           foreach my $j ( 0 .. $chunk->{nbins}->{value} - 1) {
167 0 0         my $x_conv = exists $self->{converter} ? &{$self->{converter}}($x) + $shift : $x;
  0            
168 0           $x += $step;
169 0 0         if ( $range ) {
170 0 0         if ( exists $self->{converter} ) {
171 0 0 0       next unless $x_conv >= $range->[0] and $x_conv <= $range->[1];
172             }
173             else {
174             # frequencies have the reverse order
175 0 0 0       next unless $x_conv <= $range->[0] and $x_conv >= $range->[1];
176             }
177             }
178 0           my $bin = $first_bin + $j;
179 0           print "$x_conv\t" . $chunk->{signal}->{value}->[$j] . "\n";
180             }
181              
182 0 0 0       if ( $add_zeroes and $i < $data->{"peak count"}->{value} - 1 ) {
183 0           my $from = $chunks->[$i]->first_bin + $chunks->[$i]->{data}->{nbins}->{value};
184 0           my $to = $chunks->[$i+1]->first_bin - 1;
185 0 0         if ($to >= $from) {
186 0           foreach my $bin ( $from .. $to ) {
187 0           my $x = $start + $bin * $step;
188 0 0         my $x_conv = exists $self->{converter} ? &{$self->{converter}}($x) + $shift: $x;
  0            
189 0 0         if ( $range ) {
190 0 0         if ( exists $self->{converter} ) {
191 0 0 0       next unless $x_conv >= $range->[0] and $x_conv <= $range->[1];
192             }
193             else {
194             # frequencies have the reverse order
195 0 0 0       next unless $x_conv <= $range->[0] and $x_conv >= $range->[1];
196             }
197             }
198 0           print "$x_conv\t0\n";
199             }
200             }
201             }
202             }
203              
204             # get the last bin number in the last chunk
205 0 0         if ( $add_zeroes ) {
206 0           my $last_chunk = $chunks->[$data->{"peak count"}->{value} - 1];
207 0           my $first_trailer_bin = $last_chunk->{data}->{"first bin"}->{value} + $last_chunk->{data}->{nbins}->{value};
208 0 0         if ( $first_trailer_bin < $data->{nbins}->{value} ) {
209 0           foreach my $bin ( $first_trailer_bin .. $self->{data}->{nbins}->{value} - 1 ) {
210 0           my $x = $start + $bin * $step;
211 0 0         my $x_conv = exists $self->{converter} ? &{$self->{converter}}($x) + $shift : $x;
  0            
212 0 0         if ( $range ) {
213 0 0         if ( exists $self->{converter} ) {
214 0 0 0       next unless $x_conv >= $range->[0] and $x_conv <= $range->[1];
215             }
216             else {
217             # frequencies have the reverse order
218 0 0 0       next unless $x_conv <= $range->[0] and $x_conv >= $range->[1];
219             }
220             }
221 0           print "$x_conv\t0\n";
222             }
223             }
224 0           print "$range->[1]\t0\n";
225             }
226             }
227              
228             1;
229             __END__