branch-1-6/Bio/Matrix/IO/scoring.pm

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