From 7eedc742bb3fffec2acca3d819ab627cde98b6d3 Mon Sep 17 00:00:00 2001 From: shawnh Date: Mon, 10 Mar 2003 18:21:03 +0000 Subject: [PATCH] jet lag commits svn path=/bioperl-live/trunk/; revision=5734 --- Bio/Tools/Promoterwise.pm | 226 ++++++++++++++++++++++++++++++++++++++++++++++ t/Promoterwise.t | 49 ++++++++++ t/data/promoterwise.out | 11 +++ 3 files changed, 286 insertions(+) create mode 100644 Bio/Tools/Promoterwise.pm create mode 100644 t/Promoterwise.t create mode 100644 t/data/promoterwise.out diff --git a/Bio/Tools/Promoterwise.pm b/Bio/Tools/Promoterwise.pm new file mode 100644 index 000000000..0222593c6 --- /dev/null +++ b/Bio/Tools/Promoterwise.pm @@ -0,0 +1,226 @@ +# BioPerl module for Bio::Tools::Promoterwise +# +# Cared for by Shawn Hoon +# +# Copyright Shawn Hoon +# +# You may distribute this module under the same terms as perl itself + +# POD documentation - main docs before the code + +=head1 NAME + +Bio::Tools::Promoterwise - DESCRIPTION of Object + +=head1 SYNOPSIS + + + use Bio::Tools::Promoterwise; + + my $pw = Bio::Tools::Promoterwise->new(-file=>"out",-query1_seq=>$seq1,-query2_seq=>$seq2); + while (my $fp = $pw->next_result){ + print "Hit Length: ".$fp->feature1->length."\n"; + print "Hit Start: ".$fp->feature1->start."\n"; + print "Hit End: ".$fp->feature1->end."\n"; + print "Hsps: \n"; + my @first_hsp = $fp->feature1->sub_SeqFeature; + my @second_hsp = $fp->feature2->sub_SeqFeature; + foreach my $i (0..$#first_hsp){ + print $first_hsp[$i]->start. " ".$first_hsp[$i]->end." ". + $second_hs p[$i]->start. " ".$second_hsp[$i]->end."\n"; + } + } + +=head1 DESCRIPTION + +Promoteriwise is an alignment algorithm that relaxes the constraint that local alignments have to be co-linear. Otherwise it provides a similar +model to DBA, which is designed for promoter sequence alignments. +Promoterwise is written by Ewan Birney. +It is part of the wise2 package available at: +http://www.sanger.ac.uk/software/wise2.w + +This module is the parser for the Promoterwise output in tab format. + +=head1 FEEDBACK + +=head2 Mailing Lists + +User feedback is an integral part of the evolution of this and other +Bioperl modules. Send your comments and suggestions preferably to +the Bioperl mailing list. Your participation is much appreciated. + + bioperl-l@bioperl.org - General discussion + http://bioperl.org/MailList.shtml - About the mailing lists + +=head2 Reporting Bugs + +Report bugs to the Bioperl bug tracking system to help us keep track +of the bugs and their resolution. Bug reports can be submitted via +email or the web: + + bioperl-bugs@bioperl.org + http://bugzilla.bioperl.org/ + +=head1 AUTHOR - Shawn Hoon + +Email shawnh@fugu-sg.org + +Describe contact details here + +=head1 CONTRIBUTORS + +Additional contributors names and emails here + +=head1 APPENDIX + +The rest of the documentation details each of the object methods. +Internal methods are usually preceded with a _ + +=cut + + +# Let the code begin... + + +package Bio::Tools::Promoterwise; +use vars qw(@ISA); +use strict; + +use Bio::Root::Root; +use Bio::SeqFeature::FeaturePair; +use Bio::SeqFeature::Generic; +use Bio::Root::IO; + +@ISA = qw(Bio::Root::Root Bio::Root::IO ); + +=head2 new + + Title : new + Usage : my $obj = new Bio::Tools::Promoterwise(); + Function: Builds a new Bio::Tools::Promoterwise object + Returns : L + Args : -fh/-file => $val, # for initing input, see Bio::Root::IO + + +=cut + +sub new { + my($class,@args) = @_; + + my $self = $class->SUPER::new(@args); + $self->_initialize_io(@args); + my ($query1,$query2) = $self->_rearrange([qw(QUERY1_SEQ QUERY2_SEQ)],@args); + $self->query1_seq($query1) if ($query1); + $self->query2_seq($query2) if ($query2); + + return $self; +} + +=head2 next_result + + Title : next_result + Usage : my $r = $rpt_masker->next_result + Function: Get the next result set from parser data + Returns : an L + Args : none + + +=cut +sub next_result { + my ($self) = @_; + $self->_parse unless $self->_parsed; + return $self->_next_result; +} +sub _parse{ + my ($self) = @_; + my (%hash,@fp); + while ($_=$self->_readline()) { + chomp; + my @array = split; + push @{$hash{$array[$#array]}}, \@array; + } + foreach my $key(keys %hash){ + my ($sf1,$sf2); + my $sf1 = Bio::SeqFeature::Generic->new(-primary=>"conserved_element", + -source_tag=>"promoterwise"); + $sf1->attach_seq($self->query1_seq) if $self->query1_seq; + my $sf2 = Bio::SeqFeature::Generic->new(-primary=>"conserved_element", + -source_tag=>"promoterwise"); + $sf2->attach_seq($self->query2_seq) if $self->query2_seq; + + foreach my $info(@{$hash{$key}}){ + my ($score,$id1,$start_1,$end_1, $strand_1,$id2,$start_2,$end_2,$strand_2,$group)= @{$info}; + if(!$sf1->strand && !$sf2->strand){ + $sf1->strand($strand_1); + $sf2->strand($strand_2); + $sf1->seq_id($id1); + $sf2->seq_id($id2); + $sf1->score($score); + $sf2->score($score); + } + my $sub1 = Bio::SeqFeature::Generic->new(-start=>$start_1, + -seq_id=>$id1, + -end =>$end_1, + -strand=>$strand_1, + -primary=>"conserved_element", + -source_tag=>"promoterwise", + -score=>$score); + $sub1->attach_seq($self->query1_seq) if $self->query1_seq; + + my $sub2 = Bio::SeqFeature::Generic->new(-start=>$start_2, + -seq_id=>$id2, + -end =>$end_2, + -strand=>$strand_2, + -primary=>"conserved_element", + -source_tag=>"promoterwise", + -score=>$score); + $sub2->attach_seq($self->query2_seq) if $self->query2_seq; + $sf1->add_SeqFeature($sub1,'EXPAND'); + $sf2->add_SeqFeature($sub2,'EXPAND'); + } + + my $fp = Bio::SeqFeature::FeaturePair->new(-feature1=>$sf1, + -feature2=>$sf2); + push @fp, $fp; + } + $self->_feature_pairs(\@fp); + $self->_parsed(1); + return; +} + +sub _feature_pairs { + my ($self,$fp) = @_; + if($fp){ + $self->{'_feature_pairs'} = $fp; + } + return $self->{'_feature_pairs'}; +} + +sub _next_result { + my ($self) = @_; + return undef unless (exists($self->{'_feature_pairs'}) && @{$self->{'_feature_pairs'}}); + return shift(@{$self->{'_feature_pairs'}}); +} +sub _parsed { + my ($self,$flag) = @_; + if($flag){ + $self->{'_flag'} = 1; + } + return $self->{'_flag'}; +} + +sub query1_seq { + my ($self,$val) = @_; + if($val){ + $self->{'query1_seq'} = $val; + } + return $self->{'query1_seq'}; +} +sub query2_seq { + my ($self,$val) = @_; + if($val){ + $self->{'query2_seq'} = $val; + } + return $self->{'query2_seq'}; +} +1; diff --git a/t/Promoterwise.t b/t/Promoterwise.t new file mode 100644 index 000000000..b47b1276c --- /dev/null +++ b/t/Promoterwise.t @@ -0,0 +1,49 @@ +#!/usr/local/bin/perl +# -*-Perl-*- +## Bioperl Test Harness Script for Modules + +use strict; +BEGIN { + eval { require Test; }; + if( $@ ) { + use lib 't'; + } + use Test; + use vars qw($NTESTS); + $NTESTS = 6; + plan tests => $NTESTS; +} +use Bio::Tools::Promoterwise; +use Bio::Root::IO; +use Bio::Seq; + +END { + for ( $Test::ntest..$NTESTS ) { + skip("promoterwise parser not working properly. Skipping.",1); + } +} + +my $file = Bio::Root::IO->catfile(qw(t data promoterwise.out)); +my $parser = Bio::Tools::Promoterwise->new(-file=>$file); +ok $parser->isa('Bio::Tools::Promoterwise'); +my @fp; +while (my $fp = $parser->next_result){ + push @fp,$fp; +} +my $first = $fp[0]->feature1; +my $second = $fp[0]->feature2; + +my @sub = $first->sub_SeqFeature; +my @sub2 = $second->sub_SeqFeature; + +ok $sub[0]->start,4; +ok $sub2[0]->start,29; +ok $sub[0]->end,18; +ok $sub2[0]->end,43; +ok $sub[0]->score,1596.49 + + + + + + diff --git a/t/data/promoterwise.out b/t/data/promoterwise.out new file mode 100644 index 000000000..30699f3d0 --- /dev/null +++ b/t/data/promoterwise.out @@ -0,0 +1,11 @@ +1596.49 MUSSPSYN 4 18 1 4.143962167-143965267 29 43 1 group_0_0 +1596.49 MUSSPSYN 19 242 1 4.143962167-143965267 45 268 1 group_0_0 +1596.49 MUSSPSYN 244 365 1 4.143962167-143965267 527 648 1 group_0_0 +1596.49 MUSSPSYN 367 457 1 4.143962167-143965267 967 1057 1 group_0_0 +1596.49 MUSSPSYN 459 611 1 4.143962167-143965267 1772 1924 1 group_0_0 +1596.49 MUSSPSYN 613 840 1 4.143962167-143965267 2252 2479 1 group_0_0 +1596.49 MUSSPSYN 842 964 1 4.143962167-143965267 2566 2688 1 group_0_0 +1596.49 MUSSPSYN 1146 1152 1 4.143962167-143965267 2693 2699 1 group_0_0 +1596.49 MUSSPSYN 1154 1159 1 4.143962167-143965267 2700 2705 1 group_0_0 +1596.49 MUSSPSYN 1161 1161 1 4.143962167-143965267 2706 2706 1 group_0_0 +1596.49 MUSSPSYN 1163 1172 1 4.143962167-143965267 2707 2716 1 group_0_0 -- 2.11.4.GIT