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

Diff of /FigKernelPackages/FIGV.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6, Tue Nov 28 23:16:55 2006 UTC revision 1.7, Wed Nov 29 09:18:26 2006 UTC
# Line 126  Line 126 
126      }      }
127  }  }
128    
129    sub get_genome_assignment_data {
130        my($self,$genome) = @_;
131    
132        my $fig     = $self->{_fig};
133        my $newG    = $self->{_genome};
134        my $newGdir = $self->{_orgdir};
135    
136        if ($genome eq $newG)
137        {
138            my %assign = map { ( $_ =~ /^(fig\|\d+\.\d+\.peg\.\d+)\t(\S.*\S)/) ? ($1 => $2) : () }
139                                 `cat $newGdir/proposed*functions`;
140            return [map { [$_,$assign{$_}] } sort { &FIG::by_fig_id($a,$b) } keys(%assign)];
141        }
142        else
143        {
144            return $fig->get_genome_assignment_data($genome);
145        }
146    }
147    
148    sub org_of {
149        my($self,$peg) = @_;
150    
151        if ($peg =~ /^fig\|(\d+\.\d+)\.peg\.\d+/)
152        {
153            return $self->genus_species($1);
154        }
155        return "";
156    }
157    
158    sub get_genome_subsystem_data {
159        my($self,$genome) = @_;
160    
161        my $fig     = $self->{_fig};
162        my $newG    = $self->{_genome};
163        my $newGdir = $self->{_orgdir};
164    
165        if ($genome eq $newG)
166        {
167            return [map { ($_ =~ /^(\S[^\t]+\S)\t(\S[^\t]*\S)\t(\S+)/) ? [$1,$2,$3] : () }
168                    `cat $newGdir/Subsystems/bindings`];
169        }
170        else
171        {
172            return $fig->get_genome_subsystem_data($genome);
173        }
174    }
175    
176    sub orgname_of_orgid {
177        my($self,$genome) = @_;
178    
179        return $self->genus_species($genome);
180    }
181    
182    sub orgid_of_orgname {
183        my($self,$genome_name) = @_;
184    
185        my @genomes = $self->genomes('complete');
186        my $i;
187        for ($i=0; ($i < @genomes) && ($genome_name ne $self->genus_species($genomes[$i])); $i++) {}
188        return ($i == @genomes) ? undef : $genomes[$i];
189    }
190    
191    sub genus_species_domain {
192        my($self,$genome) = @_;
193    
194        return [$self->genus_species($genome),$self->genome_domain($genome)];
195    }
196    
197    sub protein_subsystem_to_roles {
198        my ($self,$peg,$subsystem) = @_;
199    
200        my $fig     = $self->{_fig};
201        my $newG    = $self->{_genome};
202        my $newGdir = $self->{_orgdir};
203    
204        if (&FIG::genome_of($peg) ne $newG)
205        {
206            return $fig->protein_subsystem_to_roles($peg,$subsystem);
207        }
208        else
209        {
210            my @roles = map { (($_ =~ /^([^\t]+)\t([^\t]+)\t(\S+)$/) && ($1 eq $subsystem) && ($3 eq $peg)) ?
211                              $2 : () } `cat $newGdir/Subsystems/bindings`;
212            my %roles = map { $_ => 1 } @roles;
213            return [sort keys(%roles)];
214        }
215    }
216    
217    sub contig_lengths {
218        my ($self, $genome) = @_;
219    
220        my $fig     = $self->{_fig};
221        my $newG    = $self->{_genome};
222        my $newGdir = $self->{_orgdir};
223    
224        if ($genome ne $newG)
225        {
226            return $fig->contig_lengths($genome);
227        }
228        else
229        {
230            my $contig_lengths = {};
231            if (open(CONTIGS,"<$newGdir/contigs"))
232            {
233                $/ = "\n>";
234                while (defined(my $x = <CONTIGS>))
235                {
236                    if ($x =~ />?(\S+)[^\n]*\n(.*)/s)
237                    {
238                        my $id = $1;
239                        my $seq = $2;
240                        $seq =~ s/\s//gs;
241                        $contig_lengths->{$id} = length($seq);
242                    }
243                }
244                close(CONTIGS);
245                $/ = "\n";
246            }
247            return $contig_lengths;
248        }
249    }
250    
251    sub genome_szdna {
252        my ($self, $genome) = @_;
253    
254        my $fig     = $self->{_fig};
255        my $newG    = $self->{_genome};
256        my $newGdir = $self->{_orgdir};
257    
258        if ($genome ne $newG)
259        {
260            return $fig->genome_szdna($genome);
261        }
262        else
263        {
264            my $contig_lens = $self->contig_lengths($genome);
265            my $tot = 0;
266            while ( my($contig,$len) = each %$contig_lens)
267            {
268                $tot += $len;
269            }
270            return $tot;
271        }
272    }
273    
274    sub genome_version {
275        my ($self, $genome) = @_;
276    
277        my $fig     = $self->{_fig};
278        my $newG    = $self->{_genome};
279        my $newGdir = $self->{_orgdir};
280    
281        if ($genome ne $newG)
282        {
283            return $fig->genome_version($genome);
284        }
285        else
286        {
287            return "$genome.0";
288        }
289    }
290    
291    sub genome_pegs {
292        my ($self, $genome) = @_;
293    
294        my $fig     = $self->{_fig};
295        my $newG    = $self->{_genome};
296        my $newGdir = $self->{_orgdir};
297    
298        if ($genome ne $newG)
299        {
300            return $fig->genome_pegs($genome);
301        }
302        else
303        {
304            my @tmp = $self->all_features($genome,"peg");
305            my $n = @tmp;
306            return $n;
307        }
308    }
309    
310    sub genome_rnas {
311        my ($self, $genome) = @_;
312    
313        my $fig     = $self->{_fig};
314        my $newG    = $self->{_genome};
315        my $newGdir = $self->{_orgdir};
316    
317        if ($genome ne $newG)
318        {
319            return $fig->genome_rnas($genome);
320        }
321        else
322        {
323            my @tmp = $self->all_features($genome,"rna");
324            my $n = @tmp;
325            return $n;
326        }
327    }
328    
329    sub genome_domain {
330        my ($self, $genome) = @_;
331    
332        my $fig     = $self->{_fig};
333        my $newG    = $self->{_genome};
334        my $newGdir = $self->{_orgdir};
335    
336        if ($genome ne $newG)
337        {
338            return $fig->genome_domain($genome);
339        }
340        else
341        {
342            my $tax = $self->taxonomy_of($genome);
343            return ($tax =~ /^([^ \t;]+)/) ? $1 : "unknown";
344        }
345    }
346    
347  sub genes_in_region {  sub genes_in_region {
348      my($self,$genome,$contig,$beg,$end) = @_;      my($self,$genome,$contig,$beg,$end) = @_;
# Line 175  Line 392 
392      return &FIG::between($b1,$b2,$e1) || &FIG::between($b2,$b1,$e2);      return &FIG::between($b1,$b2,$e1) || &FIG::between($b2,$b1,$e2);
393  }  }
394    
395    sub all_contigs {
396        my($self,$genome) = @_;
397    
398        my $fig     = $self->{_fig};
399        my $newG    = $self->{_genome};
400        my $newGdir = $self->{_orgdir};
401    
402        if ($genome ne $newG)
403        {
404            return $fig->all_contigs($genome);
405        }
406        else
407        {
408            &load_tbl($self);
409            my %contigs;
410            my $tblH = $self->{_tbl};
411            while ( my($fid,$tuple) = each %$tblH)
412            {
413                if ($tuple->[0]->[0] =~ /^(\S+)_\d+_\d+$/)
414                {
415                    $contigs{$1} = 1;
416                }
417            }
418            return keys(%contigs);
419        }
420    }
421    
422    sub all_features {
423        my($self,$genome,$type) = @_;
424    
425        my $fig     = $self->{_fig};
426        my $newG    = $self->{_genome};
427        my $newGdir = $self->{_orgdir};
428    
429        if ($genome ne $newG)
430        {
431            return $fig->all_features($genome,$type);
432        }
433        else
434        {
435            &load_tbl($self);
436            my $tblH = $self->{_tbl};
437            return sort { &FIG::by_fig_id($a,$b) }
438                   grep { ($_ =~ /^fig\|\d+\.\d+\.([^\.]+)/) && ($1 eq $type) }
439                   keys(%$tblH);
440        }
441    }
442    
443    sub all_features_detailed_fast {
444        my($self,$genome) = @_;
445    
446        my $fig     = $self->{_fig};
447        my $newG    = $self->{_genome};
448        my $newGdir = $self->{_orgdir};
449    
450        if ($genome ne $newG)
451        {
452            return $fig->all_features_detailed_fast($genome);
453        }
454        else
455        {
456            &load_tbl($self);
457            my $tblH = $self->{_tbl};
458            my $feat_details = [];
459            while ( my($fid,$tuple) = each %$tblH)
460            {
461                if ($fid =~ /^fig\|\d+\.\d+\.(\S+)\.\d+/)
462                {
463                    my $type = $1;
464                    if ($tuple->[0]->[0] =~ /^\S+_(\d+)_(\d+)$/)
465                    {
466                        my($min,$max);
467                        if ($1 < $2)
468                        {
469                            $min = $1;
470                            $max = $2;
471                        }
472                        else
473                        {
474                            $min = $2;
475                            $max = $1;
476                        }
477                        push(@$feat_details,[$fid,$tuple->[0]->[0],join(",",@{$tuple->[1]}),$type,$min,$max,$self->function_of($fid),'master','']);
478                    }
479                }
480            }
481            return $feat_details;
482        }
483    }
484    
485    sub compute_clusters {
486        # Get the parameters.
487        my ($self, $pegList, $subsystem, $distance) = @_;
488        if (! defined $distance) {
489            $distance = 5000;
490        }
491    
492        my($peg,%by_contig);
493        foreach $peg (@$pegList)
494        {
495            my $loc;
496            if ($loc = $self->feature_location($peg))
497            {
498                my ($contig,$beg,$end) = &FIG::boundaries_of($loc);
499                my $genome = &FIG::genome_of($peg);
500                push(@{$by_contig{"$genome\t$contig"}},[($beg+$end)/2,$peg]);
501            }
502        }
503    
504        my @clusters = ();
505        foreach my $tuple (keys(%by_contig))
506        {
507            my $x = $by_contig{$tuple};
508            my @pegs = sort { $a->[0] <=> $b->[0] } @$x;
509            while ($x = shift @pegs)
510            {
511                my $clust = [$x->[1]];
512                while ((@pegs > 0) && (abs($pegs[0]->[0] - $x->[0]) <= $distance))
513                {
514                    $x = shift @pegs;
515                    push(@$clust,$x->[1]);
516                }
517    
518                if (@$clust > 1)
519                {
520                    push(@clusters,$clust);
521                }
522            }
523        }
524        return sort { @$b <=> @$a }  @clusters;
525    }
526    
527    
528  sub feature_location {  sub feature_location {
529      my($self,$fid) = @_;      my($self,$fid) = @_;
530    

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3