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

package Finnigan::Profile;

use strict;
use warnings FATAL => qw( all );
our $VERSION = 0.0206;

use Carp;
use Finnigan;
use base 'Finnigan::Decoder';

my $preamble = [
                "first value" => ['d<', 'Float64'],
                "step"        => ['d<', 'Float64'],
                "peak count"  => ['V',  'UInt32'],
                "nbins"       => ['V',  'UInt32'],
               ];


sub decode {
  my $self = bless Finnigan::Decoder->read($_[1], $preamble), $_[0];
  return $self->iterate_object($_[1], $self->{data}->{"peak count"}->{value}, chunks => 'Finnigan::ProfileChunk', $_[2]); # the last arg is layout
}

sub nchunks { # in place of the erroneous "peak_count"
  shift->{data}->{"peak count"}->{value};
}

sub peak_count { # deprecated
  shift->{data}->{"peak count"}->{value};
}

sub nbins {
  shift->{data}->{"nbins"}->{value};
}

sub first_value {
  shift->{data}->{"first value"}->{value};
}

sub step {
  my $self = shift;
  confess "undefined" unless $self;
  $self->{data}->{"step"}->{value};
}

sub chunks {
  shift->{data}->{"chunks"}->{value};
}

sub chunk { # a syntactic eye-sore remover
  shift->{data}->{"chunks"}->{value};
}

sub set_converter {
  $_[0]->{converter} = $_[1];
}

sub set_inverse_converter {
  $_[0]->{"inverse converter"} = $_[1];
}

sub bins {
  my ($self, $range, $add_zeroes) = @_;
  my @list;
  my $start = $self->{data}->{"first value"}->{value};
  my $step = $self->{data}->{step}->{value};
  unless ( $range ) {
    unless ( exists $self->{converter} ) {
      $range = [$start, $start + $self->{data}->{nbins}->{value} * $step];
    }
  }

  push @list, [$range->[0], 0] if $add_zeroes;
  my $last_bin_written = 0;

  my $shift = 0; # this is declared outside the chunk loop to allow
                 # writing the empty bin following the last chunk with
                 # the same amount of shift as in the last chunk

  foreach my $i ( 0 .. $self->{data}->{"peak count"}->{value} - 1 ) { # each chunk
    my $chunk = $self->{data}->{chunks}->{value}->[$i];
    my $first_bin = $chunk->{data}->{"first bin"}->{value};
    $shift = $chunk->{data}->{fudge} ? $chunk->{data}->{fudge}->{value} : 0;
    my $x = $start + $first_bin * $step;

    if ( $add_zeroes and $last_bin_written < $first_bin - 1) {
      # add an empty bin ahead of the chunk, unless there is no gap
      # between this and the previous chunk
      my $x0 = $x - $step;
      my $x_conv = exists $self->{converter} ? &{$self->{converter}}($x0) + $shift : $x0;
      push @list, [$x_conv, 0];
    }

    foreach my $j ( 0 .. $chunk->{data}->{nbins}->{value} - 1) {
      my $x_conv = exists $self->{converter} ? &{$self->{converter}}($x) + $shift : $x;
      $x += $step;
      if ( $range ) {
        if ( exists $self->{converter} ) {
          next unless $x_conv >= $range->[0] and $x_conv <= $range->[1];
        }
        else {
          # frequencies have the reverse order
          next unless $x_conv <= $range->[0] and $x_conv >= $range->[1];
        }
      }
      my $bin = $first_bin + $j;
      push @list, [$x_conv, $chunk->{data}->{signal}->{value}->[$j]];
      $last_bin_written = $first_bin + $j;
    }

    if ( $add_zeroes
         and
         $i < $self->{data}->{"peak count"}->{value} - 1
         and
         $last_bin_written < $self->{data}->{chunks}->{value}->[$i+1]->{data}->{"first bin"}->{value} - 1
       ) {
      # add an empty bin following the chunk, unless there is no gap
      # between this and the next chunk
      my $bin = $last_bin_written + 1;
      # $x has been incremented inside the chunk loop
      my $x_conv = exists $self->{converter} ? &{$self->{converter}}($x) + $shift: $x;
      push @list, [$x_conv, 0];
      $last_bin_written++;
    }
  }

  if ( $add_zeroes and $last_bin_written < $self->{data}->{nbins}->{value} - 1 ) {
    # add an empty bin following the last chunk, unless there is no gap
    # left between it and the end of the range ($self->nbins - 1)
    my $x = $start + ($last_bin_written + 1) * $step;
    my $x_conv = exists $self->{converter} ? &{$self->{converter}}($x) + $shift: $x;
    push @list, [$x_conv, 0];
    push @list, [$range->[1], 0] if $add_zeroes;
  }
  return \@list;
}

sub print_bins {
  my ($self, $range, $add_zeroes) = @_;
  my @list;
  my $data = $self->{data};
  my $start = $data->{"first value"}->{value};
  my $step = $data->{step}->{value};
  my $chunks = $data->{chunks}->{value};

  unless ( $range ) {
    unless (exists $self->{converter} ) {
      $range = [$start, $start + $data->{nbins}->{value} * $step];
    }
  }

  print "$range->[0]\t0\n" if $add_zeroes;

  my $shift = 0; # this is declared outside the chunk loop to allow
                 # writing the empty bin following the last chunk with
                 # the same amount of shift as in the last chunk

  foreach my $i ( 0 .. $data->{"peak count"}->{value} - 1 ) { # each chunk
    my $chunk = $chunks->[$i]->{data};
    my $first_bin = $chunk->{"first bin"}->{value};
    $shift = $chunk->{fudge} ? $chunk->{fudge}->{value} : 0;
    my $x = $start + $first_bin * $step;
    my $x_conv = exists $self->{converter} ? &{$self->{converter}}($x) + $shift : $x;

    # print all points in the chunk that fall within the specified range
    foreach my $j ( 0 .. $chunk->{nbins}->{value} - 1) {
      my $x_conv = exists $self->{converter} ? &{$self->{converter}}($x) + $shift : $x;
      $x += $step;
      if ( $range ) {
        if ( exists $self->{converter} ) {
          next unless $x_conv >= $range->[0] and $x_conv <= $range->[1];
        }
        else {
          # frequencies have the reverse order
          next unless $x_conv <= $range->[0] and $x_conv >= $range->[1];
        }
      }
      my $bin = $first_bin + $j;
      print "$x_conv\t" . $chunk->{signal}->{value}->[$j] . "\n";
    }

    if ( $add_zeroes and $i < $data->{"peak count"}->{value} - 1 ) {
      my $from = $chunks->[$i]->first_bin + $chunks->[$i]->{data}->{nbins}->{value};
      my $to = $chunks->[$i+1]->first_bin - 1;
      if ($to >= $from) {
        foreach my $bin ( $from .. $to ) {
          my $x = $start + $bin * $step;
          my $x_conv = exists $self->{converter} ? &{$self->{converter}}($x) + $shift: $x;
          if ( $range ) {
            if ( exists $self->{converter} ) {
              next unless $x_conv >= $range->[0] and $x_conv <= $range->[1];
            }
            else {
              # frequencies have the reverse order
              next unless $x_conv <= $range->[0] and $x_conv >= $range->[1];
            }
          }
          print "$x_conv\t0\n";
        }
      }
    }
  }

  # get the last bin number in the last chunk
  if ( $add_zeroes ) {
    my $last_chunk = $chunks->[$data->{"peak count"}->{value} - 1];
    my $first_trailer_bin = $last_chunk->{data}->{"first bin"}->{value} + $last_chunk->{data}->{nbins}->{value};
    if ( $first_trailer_bin < $data->{nbins}->{value} ) {
      foreach my $bin ( $first_trailer_bin .. $self->{data}->{nbins}->{value} - 1 ) {
        my $x = $start + $bin * $step;
        my $x_conv = exists $self->{converter} ? &{$self->{converter}}($x) + $shift : $x;
        if ( $range ) {
          if ( exists $self->{converter} ) {
            next unless $x_conv >= $range->[0] and $x_conv <= $range->[1];
          }
          else {
            # frequencies have the reverse order
            next unless $x_conv <= $range->[0] and $x_conv >= $range->[1];
          }
        }
        print "$x_conv\t0\n";
      }
    }
    print "$range->[1]\t0\n";
  }
}

1;
__END__