annotate SVExtTools.pm @ 1:4f6952e0af48 default tip

CREST - add crest.loc.sample
author Jim Johnson <jj@umn.edu>
date Wed, 08 Feb 2012 16:08:01 -0600
parents acc8d8bfeb9a
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
1 package SVExtToolsI;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
2
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
3 # this package has three major tools that the program is going to use:
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
4 # 1. Assembler, cap3 is used for this purpose
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
5 # 2. Mapper, blat server version is used and highly recommended
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
6 # 3. Aligner, any one will work, but the program need to parse the output
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
7 sub new {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
8 my $class = shift;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
9 my %param = @_;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
10 my $self = {};
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
11 $self->{PRG} = undef;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
12 $self->{OPTIONS} = undef;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
13 foreach my $k (keys %param) {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
14 my $k1 = $k;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
15 $k1 = substr($k, 1) if($k =~ m/^-/);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
16 $self->{$k1} = $param{$k};
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
17 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
18
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
19 bless $self, ref($class) || $class;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
20 return $self;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
21 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
22
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
23 sub program {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
24 my ($self, $value) = @_;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
25 $self->{PRG} = $value if($value);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
26 return $self->{PRG};
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
27 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
28
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
29 sub options {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
30 my ($self, $value) = @_;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
31 $self->{OPTIONS} = $value if($value);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
32 return $self->{OPTIONS};
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
33 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
34
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
35 sub run {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
36 print STDERR "you need implement your own run method";
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
37 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
38
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
39 package Assembler;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
40 use strict;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
41 use Carp;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
42 use English;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
43 use base qw(SVExtToolsI);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
44
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
45 sub new {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
46 my ($class, @args) = @_;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
47 my $self = $class->SUPER::new(@args);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
48 $self->{PRG} = "cap3" if(!$self->{PRG});
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
49 $self->{OPTIONS} = "" if(!$self->{OPTIONS});
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
50 return $self;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
51 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
52
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
53 # the run function of Assembler returns the contig file and
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
54 # a hashref with the number of reads in each contig
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
55
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
56 sub run {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
57 my($self, $file) = @_;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
58 croak "$self->{PRG} need an input fasta file to do the assembly" if(!$file);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
59 if(-s $file == 0) {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
60 print STDERR "$file is of size 0";
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
61 return;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
62 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
63 system(join(" ", ($self->{PRG}, $file, $self->{OPTIONS})));
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
64 my( $r_count, $r_reads ) = _count_reads("$file.cap.ace");
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
65 return ("$file.cap.contigs", $r_count, $r_reads, "$file.cap.singlets");
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
66 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
67
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
68 sub _count_reads {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
69 my $file = shift;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
70 my %count;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
71 my %reads;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
72 open my $ACE, "<$file" or croak "Can't open $file:$OS_ERROR";
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
73 my $contig_name;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
74 while( my $line = <$ACE> ) {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
75 if($line =~ m/^CO\s(.*?)\s\d+\s(\d+)/){
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
76 $contig_name = $1;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
77 $count{$contig_name} = $2;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
78 $reads{$contig_name} = [];
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
79 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
80 if($line =~ m/^RD\s(.*?)\s/) {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
81 push @{$reads{$contig_name}}, $1;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
82 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
83 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
84 close($ACE);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
85 return (\%count, \%reads);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
86 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
87
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
88 package Mapper;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
89 use strict;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
90 use Carp;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
91 use Data::Dumper;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
92 use English;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
93 use Bio::SearchIO;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
94 use Bio::SeqIO;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
95 use base qw(SVExtToolsI);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
96
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
97 sub new {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
98 my ($class, @args) = @_;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
99 my $self = $class->SUPER::new(@args);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
100 $self->{PRG} = "gfClient sjblat 50000" if(!$self->{PRG});
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
101 $self->{OPTIONS} = "-out=psl -nohead" if(!$self->{OPTIONS});
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
102 $self->{MAX_SCORE_DIFF} = 20 if(!$self->{MAX_SCORE_DIFF});
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
103 $self->{MAX_NUM_HITS} = 10 if(!$self->{MAX_NUM_HITS});
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
104 return $self;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
105 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
106
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
107 sub max_score_diff {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
108 my $self = shift;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
109 my $value = shift;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
110 $self->{MAX_SCORE_DIFF} = $value if($value);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
111 return $self->{MAX_SCORE_DIFF};
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
112 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
113
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
114 sub max_num_hits {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
115 my $self = shift;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
116 my $value = shift;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
117 $self->{MAX_NUM_HITS} = $value if($value);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
118 return $self->{MAX_NUM_HITS};
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
119 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
120
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
121 sub run {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
122 my $self = shift;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
123 my %param = @_;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
124 croak "Missing QUERY parameter for $self->{PRG}" if(!$param{-QUERY});
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
125 my $output = $param{-OUTPUT} || $param{-QUERY} . ".psl";
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
126 my $options = $param{-OPTIONS} || $self->{OPTIONS};
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
127 system(join(" ", ($self->{PRG}, $self->{BIT2_DIR}, $param{-QUERY}, $output, $options)));
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
128 system("sort -k 10g -k 1nr $output -o $output.sorted");
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
129 open my $SORTED, "<$output.sorted" or croak "can't open $output.sorted:$OS_ERROR";
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
130 open my $PSL, ">$output" or croak "can't open $output:$OS_ERROR";
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
131 my $n = 0;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
132 while( my $line = <$SORTED>) {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
133 print $PSL $line;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
134 $n++;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
135 last if($n > 10);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
136 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
137 close($PSL);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
138 close($SORTED);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
139 return $self->select_target($output);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
140 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
141
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
142
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
143 sub select_target {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
144 my $self = shift;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
145 my $file = shift;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
146 my %targets;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
147 my $parser = Bio::SearchIO->new( -file => $file, -format => 'psl');
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
148 while( my $result = $parser->next_result ) {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
149 my $qname = $result->query_name;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
150 $targets{$qname} = [];
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
151 # $result->sort_hits(sub {$Bio::Search::Result::ResultI::b -> matches('id') <=>
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
152 # $Bio::Search::Result::ResultI::a ->matches('id')});
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
153 my $n_hits = 0;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
154 my $max_score = 0;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
155 # my $perfect_only;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
156 while( my $hit = $result->next_hit ) {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
157 while( my $hsp = $hit->next_hsp) {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
158 my ($n_matches) = $hsp->matches;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
159 last if($max_score - $n_matches > $self->{MAX_SCORE_DIFF});
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
160 #last if($perfect_only && $hit->query_length != $n_matches);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
161 my @blocks;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
162 foreach my $bl (@{$hsp->gap_blocks('hit')}) {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
163 push @blocks, [$bl->[0], $bl->[0] + $bl->[1]];
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
164 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
165 push @{$targets{$qname}}, {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
166 tchr => $hit->name,
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
167 tstart => $hsp->start('hit'),
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
168 tend => $hsp->end('hit'),
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
169 qstart => $hsp->start('query'),
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
170 qend => $hsp->end('query'),
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
171 qstrand => $hsp->strand('query') == 1 ? '+' : '-',
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
172 matches => $n_matches,
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
173 blocks => \@blocks,
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
174 perfect => $hit->query_length == $n_matches ? 1 : 0,
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
175 };
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
176 #$perfect_only = 1 if($hit->query_length == $n_matches);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
177 $max_score = $n_matches if($max_score < $n_matches);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
178 $n_hits++;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
179 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
180 $hit->rewind;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
181 last if($n_hits >= $self->{MAX_NUM_HITS});
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
182 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
183 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
184 return \%targets;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
185 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
186
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
187 package Aligner;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
188 use strict;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
189 use Carp;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
190 use English;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
191 use Bio::SearchIO;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
192 use Bio::SeqIO;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
193 use base qw(SVExtToolsI);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
194
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
195 sub new {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
196 my ($class, @args) = @_;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
197 my $self = $class->SUPER::new(@args);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
198 $self->{PRG} = "blat" if(!$self->{PRG});
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
199 $self->{OPTIONS} = "-tileSize=9 -stepSize=1 -out=psl -nohead -minScore=15"
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
200 if(!$self->{OPTIONS});
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
201 return $self;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
202 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
203
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
204 # return best hit for each query reads
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
205 sub run {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
206 my $self = shift;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
207 my %param = @_;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
208 croak "Missing TARGET parameter for $self->{PRG}" if(!$param{-TARGET});
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
209 croak "Missing QUERY parameter for $self->{PRG}" if(!$param{-QUERY});
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
210 my $output = $param{-OUTPUT} || $param{-QUERY} . ".psl";
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
211 system( join(" ", ($self->{PRG}, $param{-TARGET}, $param{-QUERY}, $output, $self->{OPTIONS})));
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
212 return $output if($param{-FILE});
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
213 return _find_best_hit($output);
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
214 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
215
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
216 sub _find_best_hit {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
217 my $file = shift;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
218 my $parser = Bio::SearchIO->new( -file => $file, -format => 'psl');
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
219 my %best_hit;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
220 while( my $result = $parser->next_result ) {
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
221 $result->sort_hits(sub {$Bio::Search::Result::ResultI::b -> matches('id') <=>
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
222 $Bio::Search::Result::ResultI::a ->matches('id')});
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
223 my $hit = $result->next_hit; # the best hit
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
224 my $hsp = $hit->next_hsp;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
225 $best_hit{$result->query_name} = $hit;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
226 $hit->rewind;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
227 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
228 return \%best_hit;
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
229 }
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
230
acc8d8bfeb9a Uploaded
jjohnson
parents:
diff changeset
231 1;