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

Annotation of /FigKernelPackages/FIGM.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : olson 1.1 # -*- perl -*-
2 :     #########################################################################
3 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
4 :     # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 :     #
8 :     # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 :     # Public License.
11 :     #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     #########################################################################
18 :    
19 :     package FIGM;
20 :    
21 :     use FIGV;
22 :     use Carp;
23 :     use strict;
24 :     use FIG;
25 :     use FIG_Config;
26 :     use SFXlate;
27 :     use SproutFIG;
28 :     use Tracer;
29 :     use Data::Dumper;
30 :     use vars qw($AUTOLOAD);
31 :     use DB_File;
32 :     use FileHandle;
33 :    
34 :     #
35 :     # Create a new FIGM.
36 :     # Since creating a FIGV is only a data structure manipulation
37 :     # we go ahead and create one for each orgdir listed. We need
38 :     # to poke at the orgdir to find the genome id that it represents
39 :     # anyway.
40 :     #
41 :     sub new {
42 :     my($class, $fig, @org_dirs) = @_;
43 :    
44 :     if (!ref($fig))
45 :     {
46 :     $fig = new FIG;
47 :     }
48 :    
49 :     my $self = {};
50 :     $self->{_fig} = $fig;
51 :     $self->{_org_dirs} = [@org_dirs];
52 :     $self->{_figv_cache} = {};
53 : olson 1.2 $self->{_peer_org_dir} = {};
54 : olson 1.1
55 :     bless $self, $class;
56 :    
57 :     for my $dir (@org_dirs)
58 :     {
59 :     my $figv = new FIGV($dir, undef, $fig);
60 :     if ($figv)
61 :     {
62 :     $self->{_figv_cache}->{$figv->genome_id()} = $figv;
63 : olson 1.2 $self->{_peer_org_dir}->{$figv->genome_id()} = $dir;
64 : olson 1.1 }
65 :     }
66 :    
67 :     return $self;
68 :     }
69 :    
70 :     sub is_complete
71 :     {
72 :     return 1;
73 :     }
74 :    
75 :     #
76 :     # Redirect any method invocations that we don't implement out to the
77 :     # underlying FIG object.
78 :     #
79 :     sub AUTOLOAD
80 :     {
81 :     my($self, @args) = @_;
82 :    
83 :     if (ref($self) ne "FIGM") {
84 :     confess "BAD FIGM object passed to AUTOLOAD";
85 :     }
86 :    
87 :     no strict 'refs';
88 :    
89 :     my $meth = $AUTOLOAD;
90 :     $meth =~ s/.*:://;
91 :     my $fmeth = "FIG::$meth";
92 :    
93 :     my $fig = $self->{_fig};
94 :     # my $args = Dumper(\@args);
95 :     if (wantarray)
96 :     {
97 :     my @res = $fig->$meth(@args);
98 :     # warn "FIGV invoke $meth($args) returns\n", Dumper(\@res);
99 :     return @res;
100 :     }
101 :     else
102 :     {
103 :     my $res = $fig->$meth(@args);
104 :     # warn "FIGV invoke $meth($args) returns\n", Dumper($res);
105 :     return $res;
106 :     }
107 :     }
108 :    
109 :     sub FIG
110 :     {
111 :     my($self) = @_;
112 :     return $self;
113 :     }
114 :    
115 :     sub find_figv
116 :     {
117 :     my($self, $genome) = @_;
118 :    
119 :     my $figv = $self->{_figv_cache}->{$genome};
120 :     if (ref($figv))
121 :     {
122 :     return $figv;
123 :     }
124 :     else
125 :     {
126 :     return $self->{_fig};
127 :     }
128 :     }
129 :    
130 :     sub find_figv_for_fid
131 :     {
132 :     my($self, $fid) = @_;
133 :     if ($fid =~ /^fig\|(\d+.\d+)\./)
134 :     {
135 :     return $self->find_figv($1);
136 :     }
137 :     else
138 :     {
139 :     return $self->{_fig};
140 :     }
141 :     }
142 :    
143 :     sub sort_fids_by_taxonomy
144 :     {
145 :     my($self,@fids) = @_;
146 :    
147 :     return map { $_->[0] }
148 :     sort { $a->[1] cmp $b->[1] }
149 :     map { [$_,$self->taxonomy_of($self->genome_of($_))] }
150 :     @fids;
151 :     }
152 :    
153 :     sub genomes
154 :     {
155 :     my($self, $complete) = @_;
156 :    
157 :     my $fig = $self->{_fig};
158 :     my @base = $fig->genomes($complete);
159 :    
160 :     return @base, keys %{$self->{_figv_cache}};
161 :     }
162 :    
163 : paczian 1.3 sub genome_list
164 :     {
165 :     my($self) = @_;
166 :    
167 :     my $genome_list = [];
168 :    
169 :     foreach my $id (keys %{$self->{_figv_cache}}) {
170 :     push(@$genome_list, [ $id, $self->genus_species($id), $self->genome_domain($id) ]);
171 :     }
172 :    
173 :     push(@$genome_list, @{$self->{_fig}->genome_list});
174 :    
175 :     return $genome_list;
176 :     }
177 :    
178 : olson 1.1 sub get_basic_statistics
179 :     {
180 :     my($self, $genome) = @_;
181 :    
182 :     my $figv = $self->find_figv($genome);
183 :    
184 :     return $figv->get_basic_statistics($genome);
185 :     }
186 :    
187 :    
188 :     sub get_peg_statistics {
189 :     my ($self, $genome) = @_;
190 :    
191 :     my $figv = $self->find_figv($genome);
192 :     return $figv->get_peg_statistics($genome);
193 :     }
194 :    
195 :     #
196 :     # To retrieve a subsystem in FIGV, we create the subsystem as normal via $fig->get_subsystem,
197 :     # then insert the row for the virtual org dir we are processing.
198 :     #
199 :     # The FIGM solution needs work.
200 :     #
201 :    
202 :     sub get_subsystem
203 :     {
204 :     my($self,$ssa) = @_;
205 :    
206 :     my $fig = $self->{_fig};
207 :    
208 : paczian 1.4 # get the subsystem data from the seed
209 : olson 1.1 my $ss = $fig->get_subsystem($ssa);
210 : paczian 1.4
211 :     # get the roles
212 :     my @roles = $ss->get_roles();
213 :     my @non_aux_roles = grep { ! $ss->is_aux_role($_) } @roles;
214 :    
215 : olson 1.17 my $vcodes;
216 :     my $bindings;
217 :     my $variant;
218 :    
219 :     # go through all figvs in this figm
220 :     foreach my $org_id (keys(%{$self->{_figv_cache}}))
221 :     {
222 :     my $figv = $self->{_figv_cache}->{$org_id};
223 :     $bindings = {};
224 :    
225 :     if ($figv->need_bindings_recomputed($ssa))
226 :     {
227 :     if (!$vcodes)
228 :     {
229 :     $vcodes = &collect_vcodes($ss, \@non_aux_roles);
230 :     }
231 :     # recalculate the bindings for this subsystem
232 :     foreach my $role (@roles) {
233 :     my @pegs = $figv->seqs_with_role($role, undef, $org_id);
234 :     $bindings->{$role} = \@pegs;
235 :     }
236 :    
237 :     # calculate the variant
238 :     my $variant = '-1';
239 :     my @roles_in_this_genome = ();
240 :     foreach my $role (@non_aux_roles) {
241 :     if (scalar(@{$bindings->{$role}})) {
242 :     push(@roles_in_this_genome,$role);
243 :     }
244 :     }
245 :    
246 :     #
247 :     # Use the key for this genome to find the best variant code in the
248 :     # SEED subsystem from %vcode.
249 :     #
250 :    
251 :     my $key = join("\t",sort @roles_in_this_genome);
252 :     my $n;
253 :     my $bestN = 0;
254 :     my $bestK = undef;
255 :     my $matches = $vcodes->{$key};
256 :    
257 :     unless ($matches) {
258 :     foreach my $key1 (keys(%$vcodes)) {
259 :     if (&not_minus_1($vcodes->{$key1}) && (length($key) > length($key1)) && ($n = &contains($key,$key1)) && ($n > $bestN)) {
260 :     $bestN = $n;
261 :     $bestK = $key1;
262 :     }
263 :     }
264 :     if ($bestK) {
265 :     $matches = $vcodes->{$bestK};
266 :     }
267 :     }
268 :    
269 :     if ($matches) {
270 :     my @vcs = sort { ($vcodes->{$b} <=> $vcodes->{$a}) or ($b cmp $a) } keys(%$matches);
271 :     $variant = $vcs[0];
272 :     }
273 :    
274 :     $figv->update_bindings_and_variant($ssa, $bindings, $variant);
275 :     $figv->clear_need_bindings_recomputed($ssa);
276 :     }
277 :     else
278 :     {
279 :     ($variant, $bindings) = $figv->get_variant_and_bindings($ssa);
280 :     }
281 :     $ss->add_virtual_genome($figv->genus_species($org_id), $org_id, $variant, $bindings);
282 :     }
283 :    
284 :     return $ss;
285 :     }
286 :    
287 :     #
288 : dejongh 1.12 # determine the variants implemented in the subsystem
289 : olson 1.17 #
290 :     # collect into %vcodes.
291 :     # key is a tab-joined list of roles implemented in this genome
292 :     # value is a hash of variant codes for the key.
293 :     #
294 :     sub collect_vcodes
295 :     {
296 :     my($ss, $non_aux_roles) = @_;
297 :    
298 :     my $vcodes = {};
299 : dejongh 1.12 foreach my $genome ($ss->get_genomes) {
300 :     my @roles_in_genome = ();
301 :     my $vcode = $ss->get_variant_code($ss->get_genome_index($genome));
302 :     next if (($vcode eq '0') || ($vcode =~ /\*/));
303 :    
304 : olson 1.17 foreach my $role (@$non_aux_roles) {
305 : dejongh 1.12 my @pegs = $ss->get_pegs_from_cell($genome,$role);
306 :     if (@pegs > 0) {
307 :     push(@roles_in_genome,$role);
308 :     }
309 :     }
310 :    
311 :     my $key = join("\t",sort @roles_in_genome);
312 : olson 1.17 $vcodes->{$key}->{$vcode}++;
313 : paczian 1.4 }
314 : olson 1.17 return $vcodes;
315 : olson 1.1 }
316 :    
317 : paczian 1.4 # returns undef if $k2 is not a subset of $k1. If it is, it returns the size of $k2
318 :     sub contains {
319 :     my($k1,$k2) = @_;
320 :    
321 :     my %s1 = map { $_ => 1 } split(/\t/,$k1);
322 :     my @s2 = split(/\t/,$k2);
323 :     my $i;
324 :     for ($i=0; ($i < @s2) && $s1{$s2[$i]}; $i++) {}
325 :     return ($i < @s2) ? undef : scalar @s2;
326 :     }
327 :    
328 :     sub not_minus_1 {
329 :     my($hits) = @_;
330 :    
331 :     my @poss = keys(%$hits);
332 :     my $i;
333 :     for ($i=0; ($i < @poss) && ($poss[$i] eq "-1"); $i++) {}
334 :     return ($i < @poss);
335 :     }
336 :    
337 : olson 1.1 sub active_subsystems
338 :     {
339 :     my($self, $genome, $all) = @_;
340 :    
341 :     my $figv = $self->find_figv($genome);
342 :     return $figv->active_subsystems($genome, $all);
343 :     }
344 :    
345 : dejongh 1.11 sub seqs_with_role {
346 :     my($self,$role,$who,$genome) = @_;
347 :    
348 :     my $figv = $self->find_figv($genome);
349 :     return $figv->seqs_with_role($role,$who,$genome);
350 :     }
351 :    
352 : paczian 1.8 sub subsystems_for_peg_complete {
353 :     my ($self, $peg) = @_;
354 : paczian 1.10
355 : paczian 1.8 my $figv = $self->find_figv_for_fid($peg);
356 :     return $figv->subsystems_for_peg_complete($peg);
357 :     }
358 :    
359 : paczian 1.10 sub subsystems_for_pegs_complete {
360 : paczian 1.16 my ($self, $peg, $include_aux) = @_;
361 : paczian 1.10
362 :     # divide the pegs into rast organisms and have one entry for all seed orgs
363 :     my $orgs = { 'other' => [] };
364 :     foreach my $p (@$peg) {
365 :     my ($org) = $p =~ /^fig\|(\d+\.\d+)/;
366 :     if (exists($self->{_figv_cache}->{$org})) {
367 :     if (exists($orgs->{$org})) {
368 :     push(@{$orgs->{$org}}, $p);
369 :     } else {
370 :     $orgs->{$org} = [ $p ];
371 :     }
372 :     } else {
373 :     push(@{$orgs->{'other'}}, $p);
374 :     }
375 :     }
376 :    
377 :     # initialize the return variable
378 :     my %results;
379 :    
380 :     # get the ss for each organism and push it
381 :     foreach my $key (keys(%$orgs)) {
382 :     if ($key eq 'other') {
383 : paczian 1.16 my %ret = $self->{_fig}->subsystems_for_pegs_complete($orgs->{$key}, $include_aux);
384 : paczian 1.10 foreach my $key (keys(%ret)) {
385 :     $results{$key} = $ret{$key};
386 :     }
387 :     } else {
388 :     foreach my $p (@{$orgs->{$key}}) {
389 :     my @ret = $self->{_figv_cache}->{$key}->subsystems_for_peg_complete($p);
390 :     foreach my $entry (@ret) {
391 :     push(@{$results{$entry->[3]}}, [ $entry->[0], $entry->[1], $entry->[2] ]);
392 :     }
393 :     }
394 :     }
395 :     }
396 :    
397 :     return %results;
398 :     }
399 :    
400 : paczian 1.8 sub protein_subsystem_to_roles {
401 :     my ($self,$peg,$subsystem) = @_;
402 :    
403 :     my $figv = $self->find_figv_for_fid($peg);
404 :     return $figv->protein_subsystem_to_roles($peg,$subsystem);
405 :     }
406 :    
407 : olson 1.1 sub genus_species {
408 :     my($self,$genome) = @_;
409 :    
410 :     my $figv = $self->find_figv($genome);
411 :     return $figv->genus_species($genome);
412 :     }
413 :    
414 :     sub get_genome_assignment_data {
415 :     my($self,$genome) = @_;
416 :    
417 :     my $figv = $self->find_figv($genome);
418 :     return $figv->get_genome_assignment_data($genome);
419 :     }
420 :    
421 :     sub org_of {
422 :     my($self,$peg) = @_;
423 :    
424 :     if ($peg =~ /^fig\|(\d+\.\d+)\.peg\.\d+/)
425 :     {
426 :     return $self->genus_species($1);
427 :     }
428 :     return "";
429 :     }
430 :    
431 :     sub get_genome_subsystem_data {
432 :     my($self,$genome) = @_;
433 :     my $figv = $self->find_figv($genome);
434 :     return $figv->get_genome_subsystem_data($genome);
435 :     }
436 :    
437 :     sub get_genome_subsystem_count
438 :     {
439 :     my($self,$genome) = @_;
440 :    
441 :     my $figv = $self->find_figv($genome);
442 :     return $figv->get_genome_subsystem_count($genome);
443 :     }
444 :    
445 :     sub orgname_of_orgid {
446 :     my($self,$genome) = @_;
447 :    
448 :     return $self->genus_species($genome);
449 :     }
450 :    
451 :     sub orgid_of_orgname {
452 :     my($self,$genome_name) = @_;
453 :    
454 :     my @genomes = $self->genomes('complete');
455 :     my $i;
456 :     for ($i=0; ($i < @genomes) && ($genome_name ne $self->genus_species($genomes[$i])); $i++) {}
457 :     return ($i == @genomes) ? undef : $genomes[$i];
458 :     }
459 :    
460 :     sub genus_species_domain {
461 :     my($self,$genome) = @_;
462 :    
463 :     return [$self->genus_species($genome),$self->genome_domain($genome)];
464 :     }
465 :    
466 : paczian 1.3 #sub protein_subsystem_to_roles {
467 :     #die;
468 :     #}
469 : olson 1.1
470 :     sub contig_lengths {
471 :     my ($self, $genome) = @_;
472 :     my $figv = $self->find_figv($genome);
473 :     return $figv->contig_lengths($genome);
474 :     }
475 :    
476 :     sub contig_ln {
477 :     my ($self, $genome, $contig) = @_;
478 :    
479 :     my $figv = $self->find_figv($genome);
480 :     return $figv->contig_ln($genome, $contig);
481 :     }
482 :    
483 :     sub contigs_of
484 :     {
485 :     my ($self, $genome) = @_;
486 :     my $figv = $self->find_figv($genome);
487 :     return $figv->contigs_of($genome);
488 :     }
489 :    
490 :     =head3 dna_seq
491 :    
492 :     usage: $seq = dna_seq($genome,@locations)
493 :    
494 :     Returns the concatenated subsequences described by the list of locations. Each location
495 :     must be of the form
496 :    
497 :     Contig_Beg_End
498 :    
499 :     where Contig must be the ID of a contig for genome $genome. If Beg > End the location
500 :     describes a stretch of the complementary strand.
501 :    
502 :     =cut
503 :     #: Return Type $;
504 :     sub dna_seq {
505 :     my($self,$genome,@locations) = @_;
506 :    
507 :     my $figv = $self->find_figv($genome);
508 :     return $figv->dna_seq($genome, @locations);
509 :     }
510 :    
511 :     sub genome_szdna {
512 :     my ($self, $genome) = @_;
513 :    
514 :     my $figv = $self->find_figv($genome);
515 :     return $figv->genome_szdna($genome);
516 :     }
517 :    
518 :     sub genome_version {
519 :     my ($self, $genome) = @_;
520 :    
521 :     my $figv = $self->find_figv($genome);
522 :     return $figv->genome_version($genome);
523 :     }
524 :    
525 :     sub genome_pegs {
526 :     my ($self, $genome) = @_;
527 :     my $figv = $self->find_figv($genome);
528 :     return $figv->genome_pegs($genome);
529 :     }
530 :    
531 :     sub genome_rnas {
532 :     my ($self, $genome) = @_;
533 :    
534 :     my $figv = $self->find_figv($genome);
535 :     return $figv->genome_rnas($genome);
536 :     }
537 :    
538 :     sub genome_domain {
539 :     my ($self, $genome) = @_;
540 :     my $figv = $self->find_figv($genome);
541 :     return $figv->genome_domain($genome);
542 :     }
543 :    
544 :     sub genes_in_region {
545 :     my($self,$genome,$contig,$beg,$end) = @_;
546 :     my $figv = $self->find_figv($genome);
547 :     return $figv->genes_in_region($genome,$contig,$beg,$end);
548 :     }
549 :    
550 :     sub overlaps {
551 :     my($b1,$e1,$b2,$e2) = @_;
552 :    
553 :     if ($b1 > $e1) { ($b1,$e1) = ($e1,$b1) }
554 :     if ($b2 > $e2) { ($b2,$e2) = ($e2,$b2) }
555 :     return &FIG::between($b1,$b2,$e1) || &FIG::between($b2,$b1,$e2);
556 :     }
557 :    
558 :     sub all_contigs {
559 :     my($self,$genome) = @_;
560 :     my $figv = $self->find_figv($genome);
561 :     return $figv->all_contigs($genome);
562 :     }
563 :    
564 :     sub all_features {
565 :     my($self,$genome,$type) = @_;
566 :     my $figv = $self->find_figv($genome);
567 :     return $figv->all_features($genome,$type);
568 :     }
569 :    
570 :     sub all_features_detailed_fast {
571 :     my($self,$genome, $regmin, $regmax, $contig) = @_;
572 :     my $figv = $self->find_figv($genome);
573 :     return $figv->all_features_detailed_fast($genome, $regmin, $regmax, $contig);
574 :     }
575 :    
576 :     sub compute_clusters {
577 :     # Get the parameters.
578 :     my ($self, $pegList, $subsystem, $distance) = @_;
579 :     if (! defined $distance) {
580 :     $distance = 5000;
581 :     }
582 :    
583 :     my($peg,%by_contig);
584 : olson 1.17
585 :     my @locs = $self->feature_location_bulk($pegList);
586 :    
587 :     for my $ent (@locs)
588 : olson 1.1 {
589 : olson 1.17 my($peg, $loc) = @$ent;
590 :     if ($loc)
591 : olson 1.1 {
592 :     my ($contig,$beg,$end) = &FIG::boundaries_of($loc);
593 :     my $genome = &FIG::genome_of($peg);
594 :     push(@{$by_contig{"$genome\t$contig"}},[($beg+$end)/2,$peg]);
595 : olson 1.17 }
596 : olson 1.1 }
597 : olson 1.17
598 :     # foreach $peg (@$pegList)
599 :     # {
600 :     # my $loc;
601 :     # if ($loc = $self->feature_location($peg))
602 :     # {
603 :     # my ($contig,$beg,$end) = &FIG::boundaries_of($loc);
604 :     # my $genome = &FIG::genome_of($peg);
605 :     # push(@{$by_contig{"$genome\t$contig"}},[($beg+$end)/2,$peg]);
606 :     # }
607 :     # }
608 : olson 1.1
609 :     my @clusters = ();
610 :     foreach my $tuple (keys(%by_contig))
611 :     {
612 :     my $x = $by_contig{$tuple};
613 :     my @pegs = sort { $a->[0] <=> $b->[0] } @$x;
614 :     while ($x = shift @pegs)
615 :     {
616 :     my $clust = [$x->[1]];
617 :     while ((@pegs > 0) && (abs($pegs[0]->[0] - $x->[0]) <= $distance))
618 :     {
619 :     $x = shift @pegs;
620 :     push(@$clust,$x->[1]);
621 :     }
622 :    
623 :     if (@$clust > 1)
624 :     {
625 :     push(@clusters,$clust);
626 :     }
627 :     }
628 :     }
629 :     return sort { @$b <=> @$a } @clusters;
630 :     }
631 :    
632 :     sub boundaries_of {
633 :     my($self,@args) = @_;
634 :    
635 :     my $fig = $self->{_fig};
636 :     return $fig->boundaries_of(@args);
637 :     }
638 :    
639 :     sub feature_location {
640 :     my($self,$fid) = @_;
641 :    
642 :     my $figv = $self->find_figv_for_fid($fid);
643 :     return scalar $figv->feature_location($fid);
644 :     }
645 :    
646 : olson 1.17 sub feature_location_bulk {
647 :     my($self,$fids) = @_;
648 :    
649 :     my $fig = $self->{_fig};
650 :    
651 :     my @ids;
652 :     my @out;
653 :     for my $fid (@$fids)
654 :     {
655 :     my $figv = $self->find_figv_for_fid($fid);
656 :     if ($figv)
657 :     {
658 :     push(@out, [$fid, scalar $figv->feature_location($fid)]);
659 :     }
660 :     else
661 :     {
662 :     push(@ids, $fid);
663 :     }
664 :     }
665 :     push(@out, $fig->feature_location_bulk(\@ids));
666 :     return @out;
667 :     }
668 :    
669 : olson 1.1 sub function_of {
670 :     my($self,$fid) = @_;
671 :    
672 :     my $fig = $self->{_fig};
673 :    
674 :     my $figv = $self->find_figv_for_fid($fid);
675 :     return $figv->function_of($fid);
676 :     }
677 :    
678 : olson 1.18 sub function_of_bulk
679 :     {
680 :     my($self, $fid_list) = @_;
681 :    
682 :     my @for_fig;
683 :    
684 :     my $out = {};
685 :    
686 :     my $fallback_fig = $self->{_fig};
687 :    
688 :     for my $fid (@$fid_list)
689 :     {
690 :     my $fid_fig = $self->find_figv_for_fid($fid);
691 :     if ($fid_fig == $fallback_fig)
692 :     {
693 :     push(@for_fig, $fid);
694 :     }
695 :     else
696 :     {
697 :     my $fn = $fid_fig->function_of($fid);
698 :     $out->{$fid} = $fn if defined($fn);
699 :     }
700 :     }
701 :    
702 :     my $others = $fallback_fig->function_of_bulk(\@for_fig);
703 :     $out->{$_} = $others->{$_} for keys %$others;
704 :     return $out;
705 :     }
706 :    
707 : olson 1.1 sub assign_function
708 :     {
709 :     my($self,$fid, $user, $function, $confidence) = @_;
710 :    
711 :     my $fig = $self->{_fig};
712 :    
713 :     my $figv = $self->find_figv_for_fid($fid);
714 :     return $figv->assign_function($fid, $user, $function, $confidence);
715 :     }
716 :    
717 :     sub add_annotation
718 :     {
719 :     my($self, $feature_id,$user,$annotation, $time_made) = @_;
720 :    
721 :     my $fig = $self->{_fig};
722 :    
723 :     my $figv = $self->find_figv_for_fid($feature_id);
724 :     return $figv->add_annotation($feature_id,$user,$annotation, $time_made);
725 :     }
726 :    
727 :     sub feature_aliases {
728 :     my($self,$fid) = @_;
729 :     my $figv = $self->find_figv_for_fid($fid);
730 :     return $figv->feature_aliases($fid);
731 :     }
732 :    
733 :     sub feature_annotations {
734 :     my($self,$fid,$rawtime) = @_;
735 :     my $figv = $self->find_figv_for_fid($fid);
736 :     return $figv->feature_annotations($fid);
737 :     }
738 :    
739 :     sub get_translation {
740 :     my($self,$peg) = @_;
741 :     my $figv = $self->find_figv_for_fid($peg);
742 :     return $figv->get_translation($peg);
743 :     }
744 :    
745 :     sub translation_length
746 :     {
747 :     my($self, $peg) = @_;
748 :     my $figv = $self->find_figv_for_fid($peg);
749 :     return $figv->translation_length($peg);
750 :     }
751 :    
752 :     sub translatable
753 :     {
754 :     my($self, $peg) = @_;
755 :     my $figv = $self->find_figv_for_fid($peg);
756 :     return $figv->translatable($peg);
757 :     }
758 :    
759 :     sub pick_gene_boundaries {
760 :     return &FIG::pick_gene_boundaries(@_);
761 :     }
762 :    
763 :     sub call_start {
764 :     return &FIG::call_start(@_);
765 :     }
766 :    
767 :     sub is_real_feature
768 :     {
769 :     my($self, $fid) = @_;
770 :    
771 :     my $figv = $self->find_figv_for_fid($fid);
772 :     return $figv->is_real_feature($fid);
773 :    
774 :     }
775 :    
776 : olson 1.2 sub is_deleted_fid
777 :     {
778 :     my($self, $fid) = @_;
779 :    
780 :     my $figv = $self->find_figv_for_fid($fid);
781 :     return $figv->is_deleted_fid($fid);
782 :    
783 :     }
784 :    
785 : olson 1.1 sub pegs_of
786 :     {
787 :     my($self, $genome) = @_;
788 :     my $figv = $self->find_figv($genome);
789 :     return $figv->pegs_of($genome);
790 :     }
791 :    
792 :    
793 :     sub rnas_of
794 :     {
795 :     my($self, $genome) = @_;
796 :     my $figv = $self->find_figv($genome);
797 :     return $figv->pegs_of($genome);
798 :     }
799 :    
800 :     sub is_virtual_feature
801 :     {
802 :     my($self, $peg) = @_;
803 :     my $figv = $self->find_figv_for_fid($peg);
804 :    
805 :     return ref($figv) =~ /FIGV/ ? 1 : 0;
806 :     }
807 :    
808 :     sub bbhs
809 :     {
810 :     my($self,$peg,$cutoff) = @_;
811 :    
812 :     my $figv = $self->find_figv_for_fid($peg);
813 :    
814 :     return $figv->bbhs($peg, $cutoff);
815 :     }
816 :    
817 : olson 1.2 =head3 sims
818 :    
819 :     Retrieve sims. We partition the sims into sets based on their genome id, associating
820 :     them with the figv for the genome that they are part of. For the figv pegs
821 :     we use the sims_for_figm method that will retrieve the sims for the peer
822 :     organims we've configured, as well as the usual figv sims.
823 :    
824 :     =cut
825 :    
826 : olson 1.1 sub sims
827 :     {
828 :     my($self,$pegarg,$max,$maxP,$select, $max_expand, $filters) = @_;
829 :    
830 : olson 1.2 my %pegs_per_genome;
831 :     my @other;
832 :    
833 :     for my $peg (ref($pegarg) ? @$pegarg : ($pegarg))
834 :     {
835 :     if ($peg =~ /^fig\|(\d+\.\d+)/)
836 :     {
837 :     push(@{$pegs_per_genome{$1}}, $peg);
838 :     }
839 :     else
840 :     {
841 :     push(@other, $peg);
842 :     }
843 :     }
844 :    
845 :     my @out;
846 :    
847 :     while (my($genome, $pegs) = each(%pegs_per_genome))
848 :     {
849 :     my $figv = $self->find_figv($genome);
850 :    
851 : paczian 1.3 my @sims;
852 :    
853 :     if (ref($figv) eq "FIGV")
854 :     {
855 :     @sims= $figv->sims_for_figm([keys %{$self->{_figv_cache}}], $pegs, $max, $maxP, $select, $max_expand, $filters);
856 :     }
857 :     else
858 :     {
859 :     @sims= $figv->sims($pegs, $max, $maxP, $select, $max_expand, $filters);
860 :     }
861 :    
862 : olson 1.2 push(@out, @sims);
863 :     }
864 :     push(@out, $self->{_fig}->sims(\@other, $max, $maxP, $select, $max_expand, $filters));
865 :    
866 :     return @out;
867 : olson 1.1 }
868 :    
869 :     sub coupled_to
870 :     {
871 :     my($self,$peg) = @_;
872 :    
873 :     my $figv = $self->find_figv_for_fid($peg);
874 :     return $figv->coupled_to($peg);
875 :     }
876 :    
877 : paczian 1.9 sub coupled_to_batch
878 :     {
879 :     my($self, @pegs) = @_;
880 :    
881 :     return () unless @pegs;
882 :    
883 :     # divide the pegs into rast organisms and have one entry for all seed orgs
884 :     my $orgs = { 'other' => [] };
885 :     foreach my $peg (@pegs) {
886 :     my ($org) = $peg =~ /^fig\|(\d+\.\d+)/;
887 :     if (exists($self->{_figv_cache}->{$org})) {
888 :     if (exists($orgs->{$org})) {
889 :     push(@{$orgs->{$org}}, $peg);
890 :     } else {
891 :     $orgs->{$org} = [ $peg ];
892 :     }
893 :     } else {
894 :     push(@{$orgs->{'other'}}, $peg);
895 :     }
896 :     }
897 :    
898 :     # initialize the return variable
899 :     my $ret = [];
900 :    
901 :     # get the fc for each organism and push it
902 :     foreach my $key (keys(%$orgs)) {
903 :     if ($key eq 'other') {
904 :     push(@$ret, $self->{_fig}->coupled_to_batch(@{$orgs->{$key}}));
905 :     } else {
906 :     push(@$ret, $self->{_figv_cache}->{$key}->coupled_to_batch(@{$orgs->{$key}}));
907 :     }
908 :     }
909 :    
910 :     return @$ret;
911 :     }
912 :    
913 : olson 1.1 sub coupling_evidence
914 :     {
915 :     my($self,$peg1, $peg2) = @_;
916 :     my $figv = $self->find_figv_for_fid($peg1);
917 :     return $figv->coupling_evidence($peg1, $peg2);
918 :     }
919 :    
920 :     sub coupling_and_evidence
921 :     {
922 :     my($self,$peg1) = @_;
923 :     my $figv = $self->find_figv_for_fid($peg1);
924 :     return $figv->coupling_and_evidence($peg1);
925 :    
926 :     }
927 :    
928 :     sub in_pch_pin_with
929 :     {
930 :     my($self, $peg1, $diverse) = @_;
931 :    
932 :     my @all = $self->in_pch_pin_with_and_evidence($peg1);
933 :    
934 :     if ($diverse)
935 :     {
936 :     return map { $_->[0] } grep { $_->[1] == 1 } @all;
937 :     }
938 :     else
939 :     {
940 :     return map { $_->[0] } @all;
941 :     }
942 :     }
943 :    
944 :     sub in_pch_pin_with_and_evidence
945 :     {
946 :     my($self,$peg1) = @_;
947 :    
948 :     my $figv = $self->find_figv_for_fid($peg1);
949 :     return $figv->in_pch_pin_with_and_evidence($peg1);
950 :     }
951 :    
952 :     sub get_attributes {
953 :     my($self, $id, $attr) = @_;
954 :    
955 :     my $fig = $self->{_fig};
956 :    
957 :     if ($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+$/ or $id =~ /^(\d+\.\d+)/)
958 :     {
959 :     my $figv = $self->find_figv($1);
960 :     return $figv->get_attributes($id, $attr);
961 :     }
962 :     else
963 :     {
964 :     return $fig->get_attributes($id, $attr);
965 :     }
966 :     }
967 :    
968 :     sub taxonomy_of {
969 :     my($self,$genome) = @_;
970 :     my $figv = $self->find_figv($genome);
971 :     return $figv->taxonomy_of($genome);
972 :     }
973 :    
974 :     sub build_tree_of_complete {
975 :     my($self,$min_for_label) = @_;
976 :     return $self->build_tree_of_all($min_for_label, "complete");
977 :     }
978 :    
979 :     sub build_tree_of_all {
980 :     my($self, $min_for_label, $complete)=@_;
981 :     my(@last,@tax,$i,$prefix,$lev,$genome,$tax);
982 :    
983 :     $min_for_label = $min_for_label ? $min_for_label : 10;
984 :     open(TMP,">/tmp/tree$$") || die "could not open /tmp/tree$$";
985 :     print TMP "1. root\n";
986 :    
987 :     @last = ();
988 :    
989 :    
990 :     foreach $genome (grep { ! $self->is_environmental($_) } $self->sort_genomes_by_taxonomy($self->genomes($complete)))
991 :     {
992 :     $tax = $self->taxonomy_of($genome);
993 :     @tax = split(/\s*;\s*/,$tax);
994 :     push(@tax,$genome);
995 :     for ($i=0; ((@last > $i) && (@tax > $i) && ($last[$i] eq $tax[$i])); $i++) {}
996 :     while ($i < @tax)
997 :     {
998 :     $lev = $i+2;
999 :     $prefix = " " x (4 * ($lev-1));
1000 :     print TMP "$prefix$lev\. $tax[$i]\n";
1001 :     $i++;
1002 :     }
1003 :     @last = @tax;
1004 :     }
1005 :     close(TMP);
1006 :     my $tree = &tree_utilities::build_tree_from_outline("/tmp/tree$$");
1007 :     $tree->[0] = 'All';
1008 :     &FIG::limit_labels($tree,$min_for_label);
1009 :     unlink("/tmp/tree$$");
1010 :     return ($tree,&tree_utilities::tips_of_tree($tree));
1011 :     }
1012 :    
1013 :     sub sort_genomes_by_taxonomy {
1014 :     my($self,@genomes) = @_;
1015 :    
1016 :     return map { $_->[0] }
1017 :     sort { $a->[1] cmp $b->[1] }
1018 :     map { [$_,$self->taxonomy_of($_)] }
1019 :     @genomes;
1020 :     }
1021 :    
1022 :     sub taxonomic_groups_of_complete {
1023 :     my($self,$min_for_labels) = @_;
1024 :    
1025 :     my($tree,undef) = $self->build_tree_of_complete($min_for_labels);
1026 :     return &FIG::taxonomic_groups($tree);
1027 :     }
1028 :    
1029 :     =head2 Search Database
1030 :    
1031 :     Searches the database for objects that match the query string in some way.
1032 :    
1033 :     Returns a list of results if the query is ambiguous or an unique identifier
1034 :     otherwise.
1035 :    
1036 :     =cut
1037 :    
1038 :    
1039 : dejongh 1.5 =head3 scenario_directory
1040 : olson 1.1
1041 : dejongh 1.5 FIG->scenario_directory($organism);
1042 : olson 1.1
1043 : dejongh 1.6 Returns the scenario directory of an organism. If the organism is 'All', returns
1044 :     the directory containing all possible paths through scenarios.
1045 : olson 1.1
1046 :     =over 4
1047 :    
1048 :     =item $organism
1049 :    
1050 : dejongh 1.6 The seed-taxonomy id of the organism, e.g. 83333.1, or 'All'.
1051 : olson 1.1
1052 :     =back
1053 :    
1054 :     =cut
1055 :    
1056 : dejongh 1.5 sub scenario_directory {
1057 : olson 1.1 my ($self, $organism) = @_;
1058 :    
1059 :     my $figv = $self->find_figv($organism);
1060 : dejongh 1.5 my $directory = $figv->scenario_directory($organism);
1061 : olson 1.1 return $directory;
1062 :     }
1063 :    
1064 : paczian 1.4 sub find_role_in_org {
1065 : paczian 1.14 my ($self, $role, $organism, $user, $cutoff) = @_;
1066 : paczian 1.4
1067 :     my $figv = $self->find_figv($organism);
1068 : paczian 1.14 return $figv->find_role_in_org($role, $organism, $user, $cutoff);
1069 : paczian 1.4 }
1070 :    
1071 :     sub organism_directory {
1072 :     my ($self, $organism) = @_;
1073 :    
1074 :     my $figv = $self->find_figv($organism);
1075 :     return $figv->organism_directory($organism);
1076 :     }
1077 :    
1078 : paczian 1.7 sub delete_feature {
1079 :     my($self,$user,$fid) = @_;
1080 :    
1081 :     my ($organism) = $fid =~ /fig\|(\d+\.\d+)/;
1082 :     my $figv = $self->find_figv($organism);
1083 :     return $figv->delete_feature($user, $fid);
1084 :     }
1085 :    
1086 :     sub add_feature {
1087 :     my( $self, $user, $organism, $type, $location, $aliases, $sequence) = @_;
1088 :    
1089 :     my $figv = $self->find_figv($organism);
1090 :     return $figv->add_feature($user, $organism, $type, $location, $aliases, $sequence);
1091 :     }
1092 :    
1093 : paczian 1.13 sub genome_info {
1094 :     my ($self) = @_;
1095 :    
1096 :     my $info = $self->{_fig}->genome_info;
1097 :     foreach my $id (keys(%{$self->{_figv_cache}})) {
1098 :     my $f = $self->{_figv_cache}->{$id};
1099 :     push(@$info, [ $id, "Private: ".$f->genus_species($id), $f->genome_szdna($id), $f->genome_domain($id), $f->genome_pegs($id), $f->genome_rnas($id), $f->is_complete($id), $f->taxonomy_of($id) ]);
1100 :     }
1101 :    
1102 :     return $info;
1103 :     }
1104 :    
1105 : paczian 1.15 sub check_db_peg_to_fams {
1106 :     my ($self, $peg_to_fams_hash) = @_;
1107 :    
1108 :     foreach my $id (keys(%{$self->{_figv_cache}})) {
1109 :     my $f = $self->{_figv_cache}->{$id};
1110 :     $f->check_db_peg_to_fams($peg_to_fams_hash);
1111 :     }
1112 :    
1113 :     return $peg_to_fams_hash;
1114 :     }
1115 :    
1116 :     sub check_db_genome_to_fams {
1117 :     my ($self, $genome_to_fams_hash) = @_;
1118 :    
1119 :     foreach my $id (keys(%{$self->{_figv_cache}})) {
1120 :     my $f = $self->{_figv_cache}->{$id};
1121 :     $f->check_db_peg_to_fams($genome_to_fams_hash);
1122 :     }
1123 :    
1124 :     return $genome_to_fams_hash;
1125 :     }
1126 :    
1127 : olson 1.1 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3