lib/Bio/Matrix/IO/scoring.pm

   1 #
   2 # BioPerl module for Bio::Matrix::IO::scoring
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Jason Stajich <jason-at-bioperl-dot-org>
   7 #
   8 # Copyright Jason Stajich
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11
  12 # POD documentation - main docs before the code
  13
  14 =head1 NAME
  15
  16 Bio::Matrix::IO::scoring - A parser for PAM/BLOSUM matricies
  17
  18 =head1 SYNOPSIS
  19
  20   use Bio::Matrix::IO;
  21   my $parser = Bio::Matrix::IO->new(-format => 'scoring',
  22                                    -file   => 'BLOSUM50');
  23   my $matrix = $parser->next_matrix;
  24
  25 =head1 DESCRIPTION
  26
  27 Describe the object here
  28
  29 =head1 FEEDBACK
  30
  31 =head2 Mailing Lists
  32
  33 User feedback is an integral part of the evolution of this and other
  34 Bioperl modules. Send your comments and suggestions preferably to
  35 the Bioperl mailing list.  Your participation is much appreciated.
  36
  37   bioperl-l@bioperl.org                  - General discussion
  38   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  39
  40 =head2 Support
  41
  42 Please direct usage questions or support issues to the mailing list:
  43
  44 I<bioperl-l@bioperl.org>
  45
  46 rather than to the module maintainer directly. Many experienced and
  47 reponsive experts will be able look at the problem and quickly
  48 address it. Please include a thorough description of the problem
  49 with code and data examples if at all possible.
  50
  51 =head2 Reporting Bugs
  52
  53 Report bugs to the Bioperl bug tracking system to help us keep track
  54 of the bugs and their resolution. Bug reports can be submitted via
  55 the web:
  56
  57   https://github.com/bioperl/bioperl-live/issues
  58
  59 =head1 AUTHOR - Jason Stajich
  60
  61 Email jason-at-bioperl-dot-org
  62
  63 =head1 APPENDIX
  64
  65 The rest of the documentation details each of the object methods.
  66 Internal methods are usually preceded with a _
  67
  68 =cut
  69
  70
  71 # Let the code begin...
  72
  73
  74 package Bio::Matrix::IO::scoring;
  75 use strict;
  76
  77 use Bio::Matrix::Scoring;
  78 use base qw(Bio::Matrix::IO);
  79
  80 =head2 new
  81
  82  Title   : new
  83  Usage   : my $obj = Bio::Matrix::IO::scoring->new();
  84  Function: Builds a new Bio::Matrix::IO::scoring object
  85  Returns : an instance of Bio::Matrix::IO::scoring
  86  Args    :
  87
  88
  89 =cut
  90
  91 =head2 next_matrix
  92
  93  Title   : next_matrix
  94  Usage   : my $matrux = $parser->next_matrix
  95  Function: parses a scoring matrix (BLOSUM,PAM styles)
  96  Returns : L<Bio::Matrix::Scoring>
  97  Args    : none
  98
  99
 100 =cut
 101
 102 sub next_matrix{
 103    my ($self) = @_;
 104    local ($_);
 105    my (@matrix,@cols,@rows,%extras,$inmatrix);
 106    while( defined ( $_ = $self->_readline ) ) {
 107        next if ( /^\s*$/);
 108        if( /^\#/ ) {
 109            if( $inmatrix ) {
 110                $self->_pushback($_);
 111                last;
 112            }
 113            if( m/Entropy\s+\=\s+(\S+)\,\s+
 114                Expected\s+\=\s+(\S+)/ox ) {
 115                $extras{'-entropy'} = $1;
 116                $extras{'-expected'} = $2;
 117            } elsif ( m/Expected\s+score\s+\=\s+(\S+)\,
 118                      \s+Entropy\s+\=\s+(\S+)/xo ){
 119                $extras{'-entropy'} = $2;
 120                $extras{'-expected'} = $1;
 121            } elsif( m/(PAM\s+\d+)\s+substitution.+
 122                     scale\s+\=\s+(\S+)\s+\=\s+(\S+)/ox ) {
 123                $extras{'-matrix_name'} = $1;
 124                $extras{'-scale'}       = $2;
 125                $extras{'-scale_value'} = $3;
 126            } elsif( /Blocks Database\s+\=\s+(\S+)/o ) {
 127                $extras{'-database'} = $1;
 128            } elsif( m/(\S+)\s+Bit\s+Units/ox ) {
 129                $extras{'-scale'} = $1;
 130            } elsif( m/Lowest score\s+\=\s+(\S+)\,\s+
 131                     Highest score\s+\=\s+(\S+)/ox ) {
 132                $extras{'-lowest_score'} = $1;
 133                $extras{'-highest_score'} = $2;
 134            } elsif( m/(Lambda)\s+\=\s+(\S+)\s+bits\,
 135                     \s+(H)\s+\=\s+(\S+)/ox ) {
 136                # This is a DNA matrix
 137                $extras{$1} = $2;
 138                $extras{$3} = $4;
 139            }
 140        } elsif( s/^\s+(\S+)/$1/ ) {
 141            @cols = split;
 142            if( $cols[0] ne 'A' ) {
 143                $self->warn("Unrecognized first line of matrix, we might not have parsed it correctly");
 144            }
 145            $inmatrix = 1;
 146        } elsif( $inmatrix ) {
 147            if( ! /^(\S+)/ ) { $inmatrix = 0; next }
 148            my ($rowname,@row) = split;
 149            push @rows, $rowname;
 150            push @matrix, [@row];
 151        } else {
 152            print;
 153        }
 154    }
 155    my $matrix = Bio::Matrix::Scoring->new(-values     => \@matrix,
 156                                          -rownames   => \@rows,
 157                                          -colnames   => \@cols,
 158                                          %extras);
 159 }
 160
 161 =head2 write_matrix
 162
 163  Title   : write_matrix
 164  Usage   : $matio->write_matrix($matrix)
 165  Function: Write out a matrix in the BLOSUM/PAM format
 166  Returns : none
 167  Args    : L<Bio::Matrix::Scoring>
 168
 169
 170 =cut
 171
 172 sub write_matrix{
 173    my ($self,@args) = @_;
 174    $self->warn("cannot actually use this function yet - it isn't finished");
 175    return;
 176 }
 177
 178
 179 1;