[Bio] / FigKernelPackages / SproutSearch.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/SproutSearch.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.11 - (view) (download) (as text)

1 : olson 1.11 #
2 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 :     #
7 :     # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 :     # Public License.
10 :     #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 : olson 1.1 package SproutSearch;
19 : olson 1.2 use strict;
20 : olson 1.1 use FIG_Config;
21 :     use File::Basename;
22 : olson 1.3 use Data::Dumper;
23 : olson 1.8 use Tracer;
24 :    
25 : redwards 1.5 my $uselc=1;
26 :     eval {
27 :     require List::Compare;
28 :     };
29 :     undef $uselc if ($@);
30 :    
31 : overbeek 1.9 # my $genome_list = qq(
32 :     # 93061.1 Staphylococcus aureus NCTC 8325
33 :     # 1314.1 Streptococcus pyogenes M5
34 :     # 192222.1 Campylobacter jejuni subsp. jejuni NCTC 11168
35 :     # 169963.1 Listeria monocytogenes EGD-e
36 :     # 265669.1 Listeria monocytogenes str. 4b F2365
37 :     # 159288.1 Staphylococcus aureus EMRSA-16 (Str. 252)
38 :     # 159289.1 Staphylococcus aureus MSSA (Str. 476)
39 :     # 196620.1 Staphylococcus aureus subsp. aureus MW2
40 :     # 158878.1 Staphylococcus aureus subsp. aureus Mu50
41 :     # 158879.1 Staphylococcus aureus subsp. aureus N315
42 :     # 216600.1 Streptococcus pneumoniae 23F
43 :     # 171101.1 Streptococcus pneumoniae R6
44 :     # 170187.1 Streptococcus pneumoniae TIGR4
45 :     # 160490.1 Streptococcus pyogenes M1 GAS
46 :     # 198466.1 Streptococcus pyogenes MGAS315
47 :     # 186103.1 Streptococcus pyogenes MGAS8232
48 :     # 193567.1 Streptococcus pyogenes SSI-1
49 :     # 243277.1 Vibrio cholerae O1 biovar eltor str. N16961
50 :     # 223926.1 Vibrio parahaemolyticus RIMD 2210633
51 :     # 216895.1 Vibrio vulnificus CMCP6
52 :     # 196600.1 Vibrio vulnificus YJ016
53 :     # );
54 :    
55 :     # TSetup("3 SproutSearch ", "ERROR");
56 :    
57 :    
58 :     # my $genera = ["Staphylococcus",
59 :     # "Campylobacter",
60 :     # "Listeria",
61 :     # "Vibrio",
62 :     # "Streptococcus"];
63 :    
64 :     my($genome_list, $genera, %genus_orgs, %genera);
65 :    
66 :     # for my $a (split(/\n/, $genome_list))
67 :     # {
68 :    
69 :     # if ($a =~ /^(\d+\.\d+)\s+(\S+)/)
70 :     # {
71 :     # if ($genera{$2})
72 :     # {
73 :     # $genus_orgs{$2}->{$1}++;
74 :     # }
75 :     # }
76 :     # }
77 : olson 1.1
78 : overbeek 1.9 sub configure_groups
79 :     {
80 :     my($sprout) = @_;
81 : olson 1.2
82 : overbeek 1.9 my %groups = $sprout->GetGroups();
83 : olson 1.2
84 : overbeek 1.9 $genera = [];
85 :     for my $group (keys %groups)
86 : olson 1.2 {
87 : overbeek 1.9 push(@$genera, $group);
88 :     $genera{$group}++;
89 :    
90 :     my $org_list = $groups{$group};
91 :    
92 :     map { $genus_orgs{$group}->{$_}++ } @$org_list;
93 : olson 1.2 }
94 :     }
95 :    
96 : olson 1.1 sub new
97 :     {
98 :     my($class, $fig, $genus_defs) = @_;
99 :    
100 :     my $self = {
101 :     genus_defs => $genus_defs,
102 :     genome_filters => undef,
103 :     fig => $fig,
104 :     options => {
105 :     regexp => 0,
106 :     },
107 : olson 1.7 index_dir => "$FIG_Config::sproutData/Indexes",
108 : olson 1.1 };
109 :    
110 : overbeek 1.9 if (!$genera)
111 :     {
112 :     configure_groups($fig->{sprout});
113 :     }
114 :    
115 :    
116 : olson 1.1 return bless($self, $class);
117 :     }
118 :    
119 :     sub option
120 :     {
121 :     my($self, $name, $val) = @_;
122 :    
123 :     if (defined($val))
124 :     {
125 : overbeek 1.9 my $old = $self->{options}->{name};
126 : olson 1.1 $self->{options}->{$name} = $val;
127 : overbeek 1.9 return $old;
128 : olson 1.1 }
129 :     else
130 :     {
131 :     return $self->{options}->{$name};
132 :     }
133 :     }
134 :    
135 :     sub add_genome_filter
136 :     {
137 :     my($self, @genomes) = @_;
138 :    
139 :     map { $self->{genome_filters}->{$_}++ } @genomes;
140 :     }
141 :    
142 :     sub add_genus_filters
143 :     {
144 :     my($self, @genera) = @_;
145 :    
146 : olson 1.2 for my $genus (@genera)
147 : olson 1.1 {
148 :     $self->add_genome_filter(@{$self->{genus_defs}->{$genus}});
149 :     }
150 :     }
151 :    
152 :    
153 :     #
154 :     # A sprout search returns a set of objects that somehow match the search.
155 :     #
156 :     # These objects can be features, genomes, or subsystems.
157 :     #
158 :    
159 :     sub search
160 :     {
161 :     my($self, $search_string) = @_;
162 :    
163 : olson 1.4 my $features = [];
164 :     my $genomes = [];
165 :     my $subsystems = [];
166 :     #
167 :     # First determine if this is a feature id.
168 :     #
169 :    
170 :     $search_string =~ s/^\s+//;
171 :     $search_string =~ s/\s+$//;
172 :    
173 :     if ($search_string =~ /^fig\|/)
174 :     {
175 : overbeek 1.10 # my @annos = $self->{fig}->feature_annotations($search_string);
176 : olson 1.6 return ([$search_string], [], [], []);
177 : olson 1.4 }
178 :    
179 :     #
180 :     # Compute filtering stuff.
181 :     #
182 :     my @genomes = $self->{genome_filters} ? @{$self->{genome_filters}} : ();
183 :     my @filter_genus = $self->{genus_filters} ? @{$self->{genus_filters}} : ();
184 :    
185 :     #
186 :     # If neither genus nor genome is set, set to include all genera.
187 :     #
188 :    
189 :     for my $genus (@filter_genus)
190 :     {
191 :     if ($genus_orgs{$genus})
192 :     {
193 :     push(@genomes, keys %{$genus_orgs{$genus}});
194 :     }
195 :     }
196 :    
197 :     my %genomes;
198 :     map { $genomes{$_}++} @genomes;
199 :    
200 :     #
201 :     # Now, any returned peg must be in %genomes to be displayed.
202 :     #
203 :    
204 :     my @words = $search_string =~ /\S+/g;
205 :    
206 :     my @result_sets;
207 : olson 1.6 my $stats;
208 : olson 1.4
209 :     for my $word (@words)
210 :     {
211 :     my $set = $self->search_word($word);
212 :     push(@result_sets, $set);
213 : olson 1.6 push(@$stats, [$word, int(@$set)]);
214 : olson 1.4 }
215 : overbeek 1.10 open(O, ">/tmp/oo");
216 :     print O Dumper(@result_sets);
217 :     close(O);
218 : olson 1.4
219 :     my $out;
220 :     if (@result_sets > 1)
221 :     {
222 : overbeek 1.10 if ($uselc)
223 :     {
224 :     my $lc = new List::Compare(@result_sets);
225 :     $out = [$lc->get_intersection()];
226 :     }
227 :     else
228 :     {
229 :     # here's a quick intesector
230 :     # @results_sets has references to arrays
231 :     my %result_count;
232 :     my $array_count;
233 :     foreach my $arr (@result_sets)
234 :     {
235 :     $array_count++;
236 :     foreach (@$arr)
237 :     {
238 :     $result_count{$_}++
239 :     }
240 :     } # can we do this with maps. Probably.
241 :    
242 :     $out = [];
243 :     foreach (keys %result_count)
244 :     {
245 :     # this requires that the elment is in all arrays
246 :     push @$out, $_ if ($result_count{$_} == $array_count);
247 :     }
248 : redwards 1.5 }
249 : olson 1.4 }
250 :     else
251 :     {
252 : overbeek 1.10 #warn "result sets else: ", Dumper(@result_sets);
253 : olson 1.4 $out = $result_sets[0];
254 :     }
255 : overbeek 1.10
256 :     #warn "Returning out=$out\n";
257 : overbeek 1.9 return ($out, $genomes, $subsystems, $stats, [@words]);
258 :     }
259 :    
260 :     sub search_phrase
261 :     {
262 :     my($self, $search_string) = @_;
263 :    
264 :     my $features = [];
265 :     my $genomes = [];
266 :     my $subsystems = [];
267 :    
268 :     #
269 :     # First determine if this is a feature id.
270 :     #
271 :    
272 :     $search_string =~ s/^\s+//;
273 :     $search_string =~ s/\s+$//;
274 :    
275 :     if ($search_string =~ /^fig\|/)
276 :     {
277 :     my @annos = $self->{fig}->feature_annotations($search_string);
278 :     return ([$search_string], [], [], []);
279 :     }
280 :    
281 :     #
282 :     # Compute filtering stuff.
283 :     #
284 :     my @genomes = $self->{genome_filters} ? @{$self->{genome_filters}} : ();
285 :     my @filter_genus = $self->{genus_filters} ? @{$self->{genus_filters}} : ();
286 :    
287 :     #
288 :     # If neither genus nor genome is set, set to include all genera.
289 :     #
290 :    
291 :     for my $genus (@filter_genus)
292 :     {
293 :     if ($genus_orgs{$genus})
294 :     {
295 :     push(@genomes, keys %{$genus_orgs{$genus}});
296 :     }
297 :     }
298 :    
299 :     my %genomes;
300 :     map { $genomes{$_}++} @genomes;
301 :    
302 :     #
303 :     # Now, any returned peg must be in %genomes to be displayed.
304 :     #
305 :    
306 :     my $phrase = $search_string;
307 :     $phrase =~ s/\s+/;/g;
308 :     $phrase =~ s/\./\\./g;
309 :    
310 :     my @result_sets;
311 :     my $stats;
312 :    
313 :     my $was_re = $self->option("regexp", 1);
314 :    
315 :     my $set = $self->search_word($phrase);
316 :    
317 :     $self->option("regexp", $was_re);
318 :    
319 :     push(@result_sets, $set);
320 :     push(@$stats, [$phrase, int(@$set)]);
321 :    
322 :     my $out = $set;
323 :    
324 :     return ($out, $genomes, $subsystems, $stats, [$search_string]);
325 : olson 1.4 }
326 :    
327 :     sub search_word
328 :     {
329 :     my($self, $word) = @_;
330 :    
331 :     #
332 :     # Do a glimpse search on word, returning a list of ids.
333 :     #
334 :    
335 : overbeek 1.10 #
336 :     # First check if it's in the inverted index.
337 :     #
338 :    
339 :     if (1 or $ENV{USE_DB})
340 :     {
341 :     my $stmt = $self->{inverted_stmt};
342 :    
343 :     if (!$stmt)
344 :     {
345 :     my $dbh = $self->{fig}->{fig}->db_handle()->{_dbh};
346 :     $stmt = $dbh->prepare("select distinct peg from sprout_search_terms where word = ?");
347 :     $self->{inverted_stmt} = $stmt;
348 :     }
349 :    
350 :     $stmt->execute($word);
351 :     my $res = $stmt->fetchall_arrayref();
352 :    
353 :     if ($res and @$res > 0)
354 :     {
355 :     my $n = @$res;
356 :     #warn "inverted index found $n hits for $word\n";
357 :     my $ret = [map { $_->[0] } @$res];
358 :     return $ret;
359 :     }
360 :     }
361 :    
362 :    
363 :     my @glimpse_args = ('-w', '-h', '-y', '-i', '-H', $self->{index_dir});
364 : olson 1.4
365 :     if ($self->option("regexp"))
366 :     {
367 :     }
368 :     else
369 :     {
370 :     push(@glimpse_args, '-k');
371 :     }
372 :    
373 :     push(@glimpse_args, $word);
374 :    
375 : olson 1.8 Trace("Glimpse: $FIG_Config::ext_bin/glimpse @glimpse_args") if T(3);
376 :    
377 : olson 1.4 open(GL, "-|", "$FIG_Config::ext_bin/glimpse", @glimpse_args) or die "Cannot open glimpse:$ !";
378 :    
379 :     my %set;
380 :    
381 : olson 1.6 #
382 :     # See if we appear to be searching for an EC # (or an IP address :-)
383 :     # If we are, require that word to be present in the output as a word (not a substring)
384 :     #
385 :    
386 :     my $re = '^(fig\|[^\t]*)\t';
387 :    
388 :     if ($word =~ /^\d+\.\d+\.\d+\.\d+$/)
389 :     {
390 :     my $wordre = $word;
391 :     $wordre =~ s/\./\\\./g;
392 :    
393 :     $re .= ".*\\b$wordre\\b";
394 :     }
395 :     # print "word=$word re=$re\n";
396 :    
397 : olson 1.4 while (<GL>)
398 :     {
399 :     chomp;
400 : olson 1.6 if (/$re/)
401 : olson 1.4 {
402 : overbeek 1.9 # warn "$_\n";
403 : olson 1.4 $set{$1}++;
404 :     }
405 :    
406 :     }
407 :     close(GL);
408 :    
409 :     return [keys(%set)];
410 :     }
411 :    
412 :     sub search_old
413 :     {
414 :     my($self, $search_string) = @_;
415 :    
416 : olson 1.1 #
417 :     # First determine if this is a feature id.
418 :     #
419 :    
420 :     if ($search_string =~ /^fig\|/)
421 :     {
422 :     my @annos = $self->{fig}->feature_annotations($search_string);
423 : olson 1.2 return ([[$search_string, $annos[0]->{text}, undef]], [], []);
424 : olson 1.1 }
425 :    
426 :     #
427 :     # Is it an alias?
428 :     #
429 :    
430 :     if (my @feats = $self->{fig}->{sprout}->FeaturesByAlias($search_string))
431 :     {
432 :     my $featret = [];
433 :     for my $feat (@feats)
434 :     {
435 :     my @annos = $self->{fig}->feature_annotations($feat);
436 : overbeek 1.9 # warn "$feat ", Dumper(@annos);
437 : olson 1.3 push(@$featret, [$feat, $annos[0]->[3], undef]);
438 : olson 1.1 }
439 :     return ($featret, undef, undef);
440 :     }
441 :    
442 :     #
443 :     # Compute filtering stuff.
444 :     #
445 : olson 1.2 my @genomes = $self->{genome_filters} ? @{$self->{genome_filters}} : ();
446 :     my @filter_genus = $self->{genus_filters} ? @{$self->{genus_filters}} : ();
447 : olson 1.1
448 :     #
449 :     # If neither genus nor genome is set, set to include all genera.
450 :     #
451 :    
452 :     for my $genus (@filter_genus)
453 :     {
454 :     if ($genus_orgs{$genus})
455 :     {
456 :     push(@genomes, keys %{$genus_orgs{$genus}});
457 :     }
458 :     }
459 :    
460 :     my %genomes;
461 :     map { $genomes{$_}++} @genomes;
462 :    
463 :     #
464 :     # Now, any returned peg must be in %genomes to be displayed.
465 :     #
466 :    
467 : olson 1.7 my $index_dir = $self->{index_dir};
468 : olson 1.1
469 :     my @glimpse_args = ('-y', '-i', '-H', $index_dir);
470 :    
471 :     if ($self->option("regexp"))
472 :     {
473 :     }
474 :     else
475 :     {
476 :     push(@glimpse_args, '-k');
477 :     }
478 :    
479 :    
480 :     push(@glimpse_args, $search_string);
481 :    
482 :     warn "args: @glimpse_args\n";
483 :    
484 :     open(GL, "-|", "$FIG_Config::ext_bin/glimpse", @glimpse_args) or die "Cannot open glimpse:$ !";
485 :    
486 :     my (@annos, @alias, @org, @path);
487 :    
488 :     #
489 :     # The general scheme here is that we match hits from the glimpse output based
490 :     # on the table that they hit.
491 :     #
492 :    
493 :     #
494 :     # Output lists.
495 :     #
496 :     # Features are of the form [$fid, $annotation, $alias]
497 :     #
498 :     # Genomes are of the form [$gid, $name].
499 :     #
500 :    
501 :     my $features = [];
502 :     my $genomes = [];
503 :     my $subsystems = [];
504 :    
505 :     while (<GL>)
506 :     {
507 :     chomp;
508 :     s/\r//;
509 :    
510 :     #
511 :     # Detect the filename part of the output.
512 :     #
513 :     if (/(^[^:]+):\s+(.*)$/)
514 :     {
515 :     my $file = $1;
516 :     my $rest = $2;
517 :    
518 :     my $table = basename($file);
519 :     $table =~ s/\.dtx$//;
520 :    
521 :     if ($table eq "Annotation")
522 :     {
523 :     my($key, $time, $anno) = split(/\t/, $rest, 3);
524 : olson 1.2 my $peg;
525 :    
526 :     if ($key !~ /^fig\|/)
527 :     {
528 :     #
529 :     # Need to find the fig id that this annotation is the target of.
530 :     #
531 :    
532 :     my $ret = $self->{fig}->{sprout}->Get(['IsTargetOfAnnotation'],
533 :     'IsTargetOfAnnotation(to-link) = ?',
534 :     [$key]);
535 :     my $data = $ret->Fetch();
536 :     my @pegs = $data->Values(['IsTargetOfAnnotation(from-link)']);
537 :     $peg = $pegs[0];
538 :     }
539 :     else
540 :     {
541 :     $peg = $key;
542 :     $peg =~ s/:.*$//;
543 :     }
544 : olson 1.1 $anno =~ s/\\n/\n/g;
545 :    
546 : olson 1.2 if ($self->feature_survives_filter($peg))
547 : olson 1.1 {
548 : olson 1.2 push(@$features, [$peg, $anno, undef]);
549 : olson 1.1 }
550 :     }
551 :     elsif ($table eq "ComesFrom")
552 :     {
553 :     }
554 :     elsif ($table eq "FeatureAlias")
555 :     {
556 :     my($peg, $alias) = split(/\t/, $rest);
557 : olson 1.2 if ($self->feature_survives_filter($peg))
558 : olson 1.1 {
559 : olson 1.2 push(@$features, [$peg, undef, $alias]);
560 : olson 1.1 }
561 :     }
562 :     elsif ($table eq "Genome")
563 :     {
564 :     my($org, $whatisthis, $genus, $species, $tax) = split(/\t/, $rest);
565 :     if ($self->genome_survives_filter($org))
566 :     {
567 :     push(@$genomes, [$org, $genus, $species]);
568 :     }
569 :     }
570 :     }
571 :     }
572 :    
573 :     return ($features, $genomes, $subsystems);
574 :     }
575 :    
576 :     sub genome_survives_filter
577 :     {
578 :     my($self, $gid) = @_;
579 :    
580 :     if (defined($self->{genome_filters}))
581 :     {
582 :     return $self->{genome_filters}->{$gid};
583 :     }
584 :     else
585 :     {
586 :     return 1;
587 :     }
588 :     }
589 :    
590 :     sub feature_survives_filter
591 :     {
592 :     my($self, $feature) = @_;
593 :    
594 :     #
595 :     # Right now, just filter for fig id's.
596 :     #
597 :    
598 :     if ($feature =~ /^fig\|(\d+\.\d+)\./)
599 :     {
600 :     my $genome = $1;
601 :     return $self->genome_survives_filter($genome);
602 :     }
603 :     else
604 :     {
605 :     return 0;
606 :     }
607 :     }
608 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3