|
0
|
1 # BioPerl module for Bio::Tools::Promoterwise
|
|
|
2 #
|
|
|
3 # Cared for by Shawn Hoon <shawnh@fugu-sg.org>
|
|
|
4 #
|
|
|
5 # Copyright Shawn Hoon
|
|
|
6 #
|
|
|
7 # You may distribute this module under the same terms as perl itself
|
|
|
8
|
|
|
9 # POD documentation - main docs before the code
|
|
|
10
|
|
|
11 =head1 NAME
|
|
|
12
|
|
|
13 Bio::Tools::Promoterwise - DESCRIPTION of Object
|
|
|
14
|
|
|
15 =head1 SYNOPSIS
|
|
|
16
|
|
|
17
|
|
|
18 use Bio::Tools::Promoterwise;
|
|
|
19
|
|
|
20 my $pw = Bio::Tools::Promoterwise->new(-file=>"out",
|
|
|
21 -query1_seq=>$seq1,
|
|
|
22 -query2_seq=>$seq2);
|
|
|
23 while (my $fp = $pw->next_result){
|
|
|
24 print "Hit Length: ".$fp->feature1->length."\n";
|
|
|
25 print "Hit Start: ".$fp->feature1->start."\n";
|
|
|
26 print "Hit End: ".$fp->feature1->end."\n";
|
|
|
27 print "Hsps: \n";
|
|
|
28 my @first_hsp = $fp->feature1->sub_SeqFeature;
|
|
|
29 my @second_hsp = $fp->feature2->sub_SeqFeature;
|
|
|
30 foreach my $i (0..$#first_hsp){
|
|
|
31 print $first_hsp[$i]->start. " ".$first_hsp[$i]->end." ".
|
|
|
32 $second_hsp[$i]->start. " ".$second_hsp[$i]->end."\n";
|
|
|
33 }
|
|
|
34 }
|
|
|
35
|
|
|
36 =head1 DESCRIPTION
|
|
|
37
|
|
|
38 Promoteriwise is an alignment algorithm that relaxes the constraint
|
|
|
39 that local alignments have to be co-linear. Otherwise it provides a
|
|
|
40 similar model to DBA, which is designed for promoter sequence
|
|
|
41 alignments. Promoterwise is written by Ewan Birney. It is part of
|
|
|
42 the wise2 package available at:
|
|
|
43 ftp://ftp.ebi.ac.uk/pub/software/unix/wise2/
|
|
|
44
|
|
|
45 This module is the parser for the Promoterwise output in tab format.
|
|
|
46
|
|
|
47 =head1 FEEDBACK
|
|
|
48
|
|
|
49 =head2 Mailing Lists
|
|
|
50
|
|
|
51 User feedback is an integral part of the evolution of this and other
|
|
|
52 Bioperl modules. Send your comments and suggestions preferably to
|
|
|
53 the Bioperl mailing list. Your participation is much appreciated.
|
|
|
54
|
|
|
55 bioperl-l@bioperl.org - General discussion
|
|
|
56 http://bioperl.org/MailList.shtml - About the mailing lists
|
|
|
57
|
|
|
58 =head2 Reporting Bugs
|
|
|
59
|
|
|
60 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
61 of the bugs and their resolution. Bug reports can be submitted via
|
|
|
62 email or the web:
|
|
|
63
|
|
|
64 bioperl-bugs@bioperl.org
|
|
|
65 http://bugzilla.bioperl.org/
|
|
|
66
|
|
|
67 =head1 AUTHOR - Shawn Hoon
|
|
|
68
|
|
|
69 Email shawnh@fugu-sg.org
|
|
|
70
|
|
|
71 Describe contact details here
|
|
|
72
|
|
|
73 =head1 CONTRIBUTORS
|
|
|
74
|
|
|
75 Additional contributors names and emails here
|
|
|
76
|
|
|
77 =head1 APPENDIX
|
|
|
78
|
|
|
79 The rest of the documentation details each of the object methods.
|
|
|
80 Internal methods are usually preceded with a _
|
|
|
81
|
|
|
82 =cut
|
|
|
83
|
|
|
84
|
|
|
85 # Let the code begin...
|
|
|
86
|
|
|
87
|
|
|
88 package Bio::Tools::Promoterwise;
|
|
|
89 use vars qw(@ISA);
|
|
|
90 use strict;
|
|
|
91
|
|
|
92 use Bio::Root::Root;
|
|
|
93 use Bio::SeqFeature::FeaturePair;
|
|
|
94 use Bio::SeqFeature::Generic;
|
|
|
95 use Bio::Root::IO;
|
|
|
96
|
|
|
97 @ISA = qw(Bio::Root::Root Bio::Root::IO );
|
|
|
98
|
|
|
99 =head2 new
|
|
|
100
|
|
|
101 Title : new
|
|
|
102 Usage : my $obj = new Bio::Tools::Promoterwise();
|
|
|
103 Function: Builds a new Bio::Tools::Promoterwise object
|
|
|
104 Returns : L<Bio::Tools::Promoterwise>
|
|
|
105 Args : -fh/-file => $val, # for initing input, see Bio::Root::IO
|
|
|
106
|
|
|
107
|
|
|
108 =cut
|
|
|
109
|
|
|
110 sub new {
|
|
|
111 my($class,@args) = @_;
|
|
|
112
|
|
|
113 my $self = $class->SUPER::new(@args);
|
|
|
114 $self->_initialize_io(@args);
|
|
|
115 my ($query1,$query2) = $self->_rearrange([qw(QUERY1_SEQ QUERY2_SEQ)],@args);
|
|
|
116 $self->query1_seq($query1) if ($query1);
|
|
|
117 $self->query2_seq($query2) if ($query2);
|
|
|
118
|
|
|
119 return $self;
|
|
|
120 }
|
|
|
121
|
|
|
122 =head2 next_result
|
|
|
123
|
|
|
124 Title : next_result
|
|
|
125 Usage : my $r = $rpt_masker->next_result
|
|
|
126 Function: Get the next result set from parser data
|
|
|
127 Returns : an L<Bio::SeqFeature::FeaturePair>
|
|
|
128 Args : none
|
|
|
129
|
|
|
130
|
|
|
131 =cut
|
|
|
132
|
|
|
133 sub next_result {
|
|
|
134 my ($self) = @_;
|
|
|
135 $self->_parse unless $self->_parsed;
|
|
|
136 return $self->_next_result;
|
|
|
137 }
|
|
|
138
|
|
|
139 sub _parse{
|
|
|
140 my ($self) = @_;
|
|
|
141 my (%hash,@fp);
|
|
|
142 while ($_=$self->_readline()) {
|
|
|
143 chomp;
|
|
|
144 my @array = split;
|
|
|
145 push @{$hash{$array[$#array]}}, \@array;
|
|
|
146 }
|
|
|
147 foreach my $key(keys %hash){
|
|
|
148 my $sf1 = Bio::SeqFeature::Generic->new(-primary=>"conserved_element",
|
|
|
149 -source_tag=>"promoterwise");
|
|
|
150 $sf1->attach_seq($self->query1_seq) if $self->query1_seq;
|
|
|
151 my $sf2 = Bio::SeqFeature::Generic->new(-primary=>"conserved_element",
|
|
|
152 -source_tag=>"promoterwise");
|
|
|
153 $sf2->attach_seq($self->query2_seq) if $self->query2_seq;
|
|
|
154 foreach my $info(@{$hash{$key}}){
|
|
|
155 my ($score,$id1,$start_1,$end_1, $strand_1,$id2,$start_2,$end_2,
|
|
|
156 $strand_2,$group)= @{$info};
|
|
|
157 if(!$sf1->strand && !$sf2->strand){
|
|
|
158 $sf1->strand($strand_1);
|
|
|
159 $sf2->strand($strand_2);
|
|
|
160 $sf1->seq_id($id1);
|
|
|
161 $sf2->seq_id($id2);
|
|
|
162 $sf1->score($score);
|
|
|
163 $sf2->score($score);
|
|
|
164 }
|
|
|
165 my $sub1 = Bio::SeqFeature::Generic->new(-start=>$start_1,
|
|
|
166 -seq_id=>$id1,
|
|
|
167 -end =>$end_1,
|
|
|
168 -strand=>$strand_1,
|
|
|
169 -primary=>"conserved_element",
|
|
|
170 -source_tag=>"promoterwise",
|
|
|
171 -score=>$score);
|
|
|
172 $sub1->attach_seq($self->query1_seq) if $self->query1_seq;
|
|
|
173
|
|
|
174 my $sub2 = Bio::SeqFeature::Generic->new(-start=>$start_2,
|
|
|
175 -seq_id=>$id2,
|
|
|
176 -end =>$end_2,
|
|
|
177 -strand=>$strand_2,
|
|
|
178 -primary=>"conserved_element",
|
|
|
179 -source_tag=>"promoterwise",
|
|
|
180 -score=>$score);
|
|
|
181 $sub2->attach_seq($self->query2_seq) if $self->query2_seq;
|
|
|
182 $sf1->add_SeqFeature($sub1,'EXPAND');
|
|
|
183 $sf2->add_SeqFeature($sub2,'EXPAND');
|
|
|
184 }
|
|
|
185
|
|
|
186 my $fp = Bio::SeqFeature::FeaturePair->new(-feature1=>$sf1,
|
|
|
187 -feature2=>$sf2);
|
|
|
188 push @fp, $fp;
|
|
|
189 }
|
|
|
190 $self->_feature_pairs(\@fp);
|
|
|
191 $self->_parsed(1);
|
|
|
192 return;
|
|
|
193 }
|
|
|
194
|
|
|
195 sub _feature_pairs {
|
|
|
196 my ($self,$fp) = @_;
|
|
|
197 if($fp){
|
|
|
198 $self->{'_feature_pairs'} = $fp;
|
|
|
199 }
|
|
|
200 return $self->{'_feature_pairs'};
|
|
|
201 }
|
|
|
202
|
|
|
203 sub _next_result {
|
|
|
204 my ($self) = @_;
|
|
|
205 return undef unless (exists($self->{'_feature_pairs'}) && @{$self->{'_feature_pairs'}});
|
|
|
206 return shift(@{$self->{'_feature_pairs'}});
|
|
|
207 }
|
|
|
208 sub _parsed {
|
|
|
209 my ($self,$flag) = @_;
|
|
|
210 if($flag){
|
|
|
211 $self->{'_flag'} = 1;
|
|
|
212 }
|
|
|
213 return $self->{'_flag'};
|
|
|
214 }
|
|
|
215
|
|
|
216 sub query1_seq {
|
|
|
217 my ($self,$val) = @_;
|
|
|
218 if($val){
|
|
|
219 $self->{'query1_seq'} = $val;
|
|
|
220 }
|
|
|
221 return $self->{'query1_seq'};
|
|
|
222 }
|
|
|
223 sub query2_seq {
|
|
|
224 my ($self,$val) = @_;
|
|
|
225 if($val){
|
|
|
226 $self->{'query2_seq'} = $val;
|
|
|
227 }
|
|
|
228 return $self->{'query2_seq'};
|
|
|
229 }
|
|
|
230 1;
|
