File Coverage

Bio/Matrix/IO/scoring.pm
Criterion Covered Total %
statement 34 47 72.3
branch 21 28 75.0
condition n/a
subroutine 4 5 80.0
pod 2 2 100.0
total 61 82 74.3


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Matrix::IO::scoring
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Jason Stajich
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
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 1     1   3 use strict;
  1         1  
  1         24  
76              
77 1     1   293 use Bio::Matrix::Scoring;
  1         1  
  1         24  
78 1     1   4 use base qw(Bio::Matrix::IO);
  1         1  
  1         426  
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
97             Args : none
98              
99              
100             =cut
101              
102             sub next_matrix{
103 2     2 1 4 my ($self) = @_;
104 2         3 local ($_);
105 2         1 my (@matrix,@cols,@rows,%extras,$inmatrix);
106 2         10 while( defined ( $_ = $self->_readline ) ) {
107 65 50       118 next if ( /^\s*$/);
108 65 100       143 if( /^\#/ ) {
    100          
    50          
109 15 50       16 if( $inmatrix ) {
110 0         0 $self->_pushback($_);
111 0         0 last;
112             }
113 15 100       68 if( m/Entropy\s+\=\s+(\S+)\,\s+
    100          
    100          
    100          
    100          
    50          
    50          
114             Expected\s+\=\s+(\S+)/ox ) {
115 1         2 $extras{'-entropy'} = $1;
116 1         3 $extras{'-expected'} = $2;
117             } elsif ( m/Expected\s+score\s+\=\s+(\S+)\,
118             \s+Entropy\s+\=\s+(\S+)/xo ){
119 1         2 $extras{'-entropy'} = $2;
120 1         3 $extras{'-expected'} = $1;
121             } elsif( m/(PAM\s+\d+)\s+substitution.+
122             scale\s+\=\s+(\S+)\s+\=\s+(\S+)/ox ) {
123 1         2 $extras{'-matrix_name'} = $1;
124 1         2 $extras{'-scale'} = $2;
125 1         2 $extras{'-scale_value'} = $3;
126             } elsif( /Blocks Database\s+\=\s+(\S+)/o ) {
127 1         3 $extras{'-database'} = $1;
128             } elsif( m/(\S+)\s+Bit\s+Units/ox ) {
129 1         4 $extras{'-scale'} = $1;
130             } elsif( m/Lowest score\s+\=\s+(\S+)\,\s+
131             Highest score\s+\=\s+(\S+)/ox ) {
132 0         0 $extras{'-lowest_score'} = $1;
133 0         0 $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 0         0 $extras{$1} = $2;
138 0         0 $extras{$3} = $4;
139             }
140             } elsif( s/^\s+(\S+)/$1/ ) {
141 2         10 @cols = split;
142 2 50       4 if( $cols[0] ne 'A' ) {
143 0         0 $self->warn("Unrecognized first line of matrix, we might not have parsed it correctly");
144             }
145 2         4 $inmatrix = 1;
146             } elsif( $inmatrix ) {
147 48 50       76 if( ! /^(\S+)/ ) { $inmatrix = 0; next }
  0         0  
  0         0  
148 48         220 my ($rowname,@row) = split;
149 48         64 push @rows, $rowname;
150 48         231 push @matrix, [@row];
151             } else {
152 0         0 print;
153             }
154             }
155 2         14 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
168              
169              
170             =cut
171              
172             sub write_matrix{
173 0     0 1   my ($self,@args) = @_;
174 0           $self->warn("cannot actually use this function yet - it isn't finished");
175 0           return;
176             }
177              
178              
179             1;