Bio/Matrix/PSM/PsmHeader.pm

   1
   2 =head1 NAME
   3
   4 Bio::Matrix::PSM::PsmHeader - PSM mast parser implementation
   5
   6 =head1 SYNOPSIS
   7
   8   # See Bio::Matrix::PSM::IO for detailed documentation on how to use
   9   # PSM parsers
  10
  11 =head1 DESCRIPTION
  12
  13 Parser for mast. This driver unlike meme or transfac for example is
  14 dedicated more to PSM sequence matches
  15
  16 =head1 FEEDBACK
  17
  18 =head2 Mailing Lists
  19
  20 User feedback is an integral part of the evolution of this and other
  21 Bioperl modules. Send your comments and suggestions preferably to one
  22 of the Bioperl mailing lists.  Your participation is much appreciated.
  23
  24   bioperl-l@bioperl.org                  - General discussion
  25   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  26
  27 =head2 Support
  28
  29 Please direct usage questions or support issues to the mailing list:
  30
  31 I<bioperl-l@bioperl.org>
  32
  33 rather than to the module maintainer directly. Many experienced and
  34 reponsive experts will be able look at the problem and quickly
  35 address it. Please include a thorough description of the problem
  36 with code and data examples if at all possible.
  37
  38 =head2 Reporting Bugs
  39
  40 Report bugs to the Bioperl bug tracking system to help us keep track
  41 the bugs and their resolution. Bug reports can be submitted via the
  42 web:
  43
  44   https://github.com/bioperl/bioperl-live/issues
  45
  46 =head1 AUTHOR - Stefan Kirov
  47
  48 Email skirov@utk.edu
  49
  50 =head1 APPENDIX
  51
  52 =cut
  53
  54
  55 # Let the code begin...
  56 package Bio::Matrix::PSM::PsmHeader;
  57
  58 use Bio::Matrix::PSM::InstanceSite;
  59
  60 use strict;
  61 use base qw(Bio::Root::Root Bio::Matrix::PSM::PsmHeaderI);
  62
  63 #These define what structures within the
  64 @Bio::Matrix::PSM::PsmHeader::MASTHEADER=qw(html version release seq hid
  65                                             length instances unstructured);
  66 @Bio::Matrix::PSM::PsmHeader::MEMEHEADER=qw(html version release hid weight length unstructured);
  67 @Bio::Matrix::PSM::PsmHeader::TRANSFACHEADER=qw(unstructured version release);
  68 @Bio::Matrix::PSM::PsmHeader::PSIBLASTHEADER=qw(seq width ic);
  69 @Bio::Matrix::PSM::PsmHeader::ALLHEADER=qw(header release type version html
  70                                            release weight length id
  71                                            seq instances unstructured);
  72
  73 =head2 new
  74
  75  Title   : new
  76  Usage   : my $header= Bio::Matrix::PSM::PsmHeader->new(-seq=>\%seq,
  77                                                        -mid=>\%mid,
  78                                                        -width=>\%width,
  79                                                        -instances=>\%instances,
  80                                                        -header=>\@header,
  81                                                        -type=>'mast');
  82  Function: Creates a new Bio::Matrix::PSM::PsmHeader object
  83  Throws  :
  84  Example :
  85  Returns :  Bio::Matrix::PSM::PsmHeader object
  86  Args    :  hash
  87
  88
  89 =cut
  90
  91 sub new {
  92     my ($class,@args)=@_;
  93     my $self = $class->SUPER::new(@args);
  94     return $self;
  95 }
  96
  97 #parse version/release info here from the unstructured array
  98 sub _initialize {
  99     my $self = shift;
 100     my $type=ref($self);
 101     $type=~s/\w+:://g;
 102     $self->{_type} = $type;
 103     my $dat=join(" ",grep(/version|release/i,@{$self->{unstructured}}));
 104     if ($dat && ($dat=~/version\b/i)) {
 105         $self->{version}=substr($dat,$+[0]+1);
 106         $self->{version}=~s/\s.+[^\d\.\:\/]//g;
 107         $self->{version}=~s/^\D//;
 108     }
 109     if ($dat && ($dat=~/release\b/i)) {
 110         my $rel=substr($dat,$+[0]+1);
 111         $rel=~s/[^\d\.\:\/\-]//g;
 112         $rel=~s/^\D//;
 113         if ($rel=~/\d\d:\d\d:\d\d/) { #Reformat if time is available too
 114             my $time=substr($rel,$-[0]+1);
 115             my $dat= substr($rel,0,$-[0]);
 116             $self->{release}="$dat $time";
 117         }
 118         else {  $self->{release}=$rel; }
 119     }
 120     return $self;
 121 }
 122
 123 =head2 seq
 124
 125  Title   : seq
 126  Usage   : my %seq= $header->seq();
 127  Function: Returns the sequence data as a hash, indexed by a sequence ID (motif id or accession number)
 128            In case the input data is a motif it would return the consenus seq for each of them (mast).
 129  Throws  :
 130  Example :
 131  Returns :   hash
 132  Args    :
 133
 134
 135 =cut
 136
 137 sub seq {
 138     my $self = shift;
 139     return () unless ($self->_check('seq'));
 140     return %{$self->{seq}};
 141 }
 142
 143 =head2 hid
 144
 145  Title   : hid
 146  Usage   : my @hid= $header->hid();
 147  Function: Returns array with the motif ids
 148  Throws  :
 149  Example :
 150  Returns :   array
 151  Args    :
 152
 153
 154 =cut
 155
 156 sub hid {
 157     my $self = shift;
 158     return unless ($self->_check('hid'));
 159     my @header=@{$self->{hid}};
 160     return @header;
 161 }
 162
 163 =head2 length
 164
 165  Title   : length
 166  Usage   : my %length= $header->length();
 167  Function: Returns the length of the input sequence or motifs as a hash, indexed
 168            by a sequence ID (motif id or accession number)
 169  Throws  :
 170  Example :
 171  Returns :  hash
 172  Args    :
 173
 174
 175 =cut
 176
 177 sub length {
 178      my $self = shift;
 179      return unless ($self->_check('length'));
 180     return $self->{length};
 181 }
 182
 183 =head2 instances
 184
 185  Title   : instances
 186  Usage   : my %instances= $header->instances();
 187  Function: Returns the info about the input data, contained in the header
 188  Throws  :
 189  Example :
 190  Returns : hash
 191  Args    :
 192
 193
 194 =cut
 195
 196 sub instances {
 197       my $self = shift;
 198       return unless ($self->_check('instances'));
 199       return %{$self->{instances}};
 200 }
 201
 202 =head2 weight
 203
 204  Title   : weight
 205  Usage   : my %weights= $header->weight();
 206  Function: Returns the weights of the input sequence as a hash, indexed
 207            by a sequence ID
 208  Throws  :
 209  Example :
 210  Returns :  hash
 211  Args    :
 212
 213
 214 =cut
 215
 216 sub weight {
 217     my $self = shift;
 218     return () unless ($self->_check('weight'));
 219     return %{$self->{weight}};
 220 }
 221
 222
 223 =head2 unstuctured
 224
 225  Title   : unstuctured
 226  Usage   : my @unstructured= $header->unstuctured();
 227  Function: Returns the unstructured data in the header as an array, one line per
 228            array element, all control symbols are removed with \W
 229  Throws  :
 230  Example :
 231  Returns :  array
 232  Args    :
 233
 234
 235 =cut
 236
 237 sub unstructured {
 238     my $self = shift;
 239     return @{$self->{unstructured}};
 240 }
 241
 242 =head2 version
 243
 244  Title   : version
 245  Usage   : my $version= $header->version;
 246  Function: Returns the version of the file being parsed if such exists
 247  Throws  :
 248  Example :
 249  Returns :  string
 250  Args    :
 251
 252
 253 =cut
 254
 255 sub version {
 256     my $self = shift;
 257     return $self->{version};
 258 }
 259
 260 =head2 release
 261
 262  Title   : release
 263  Usage   : my $release= $header->release;
 264  Function: Returns the release of the file being parsed if such exists
 265  Throws  :
 266  Example :
 267  Returns :  string
 268  Args    :
 269
 270
 271 =cut
 272
 273 sub release {
 274     my $self = shift;
 275     return $self->{release};
 276 }
 277
 278 =head2 _check
 279
 280  Title   : _check
 281  Usage   : if ($self->_check('weights') { #do something} else {return 0;}
 282  Function: Checks if the method called is aplicable to the file format
 283  Throws  :
 284  Example :
 285  Returns :  boolean
 286  Args    :  string
 287
 288
 289 =cut
 290
 291 sub _check {
 292     my ($self,$method) = @_;
 293     my $type= $self->{'_type'};
 294     if ($type eq 'meme') {
 295         return 0 unless (grep(/$method/,
 296                                   @Bio::Matrix::PSM::PsmHeader::MEMEHEADER));
 297     } elsif ($type eq 'mast') {
 298         return 0 unless (grep(/$method/,
 299                                   @Bio::Matrix::PSM::PsmHeader::MASTHEADER));
 300     } elsif ($type eq 'transfac') {
 301         return 0 unless (grep(/$method/,
 302                                   @Bio::Matrix::PSM::PsmHeader::TRANSFACHEADER));
 303     } elsif ($type eq 'psiblast') {
 304         return 0 unless (grep(/$method/,
 305                                   @Bio::Matrix::PSM::PsmHeader::PSIBLASTHEADER));
 306     }
 307     return 1;
 308 }
 309
 310 1;