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

Diff of /FigKernelPackages/UnvSubsys.pm

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

revision 1.4, Mon Sep 12 20:45:51 2005 UTC revision 1.11, Wed Sep 28 17:21:54 2005 UTC
# Line 9  Line 9 
9    
10  sub new  sub new
11  {  {
12      my($class, $ssa, $fig, $show_clusters, $aliases) = @_;      my($class, $ssa, $fig, $active_subsetR, $focus, $show_clusters, $aliases, $peg_colors) = @_;
13    
14      $ssa =~ s/ /_/g;      $ssa =~ s/ /_/g;
15    
# Line 33  Line 33 
33          ###          ###
34          ### ColSubsets = pointer to a list of [SubsetName,[RoleIndexesFrom0]]          ### ColSubsets = pointer to a list of [SubsetName,[RoleIndexesFrom0]]
35          ###          ###
36            ### RowSubSets = pointer to a list of [SubsetName,[GenomeIndexesFrom0]]
37            ###
38          ### Genomes is a pointer to a list of [Genome,Variant]          ### Genomes is a pointer to a list of [Genome,Variant]
39          ###          ###
40          ### ToGenomeIndexHash = a pointer to a hash: key=Genome value=GenomeIndex          ### ToGenomeIndexHash = a pointer to a hash: key=Genome value=GenomeIndex
# Line 46  Line 48 
48          ###          ###
49          ### ReactionHash is a hash: key=Role value=[reaction-ids]          ### ReactionHash is a hash: key=Role value=[reaction-ids]
50    
51      if (ref($fig) eq "FIG")      if ((ref($fig) eq "FIG") || ((ref($fig) eq 'SFXlate') && ($fig = $fig->{'fig'})))
52      {      {
   
   
53          my $subsystem = new Subsystem($ssa,$fig,0);          my $subsystem = new Subsystem($ssa,$fig,0);
54          my $curator = $subsystem->get_curator;          my $curator = $subsystem->get_curator;
55          my $notes = $subsystem->get_notes;          my $notes = $subsystem->get_notes;
# Line 102  Line 102 
102                  $pegH->{$i}->{$j} = [@pegs];                  $pegH->{$i}->{$j} = [@pegs];
103              }              }
104          }          }
105          my $colorsH  = $show_clusters  ? &set_colors($fig,$pegH)  : {};  
106          my $aliasesH = $aliases ? &set_aliases($fig,$pegH) : {};          my $row_subsets    = &row_subsets($fig,$genomeH,$genomes_info);
107            my $active_genomes = &active_genomes($fig,$row_subsets,$active_subsetR,$focus,$genomeH,$genomes_info);
108    
109            my $colorsH;
110            if ($peg_colors)
111            {
112                $colorsH = {};
113                foreach $_ (@$peg_colors)
114                {
115                    my($peg,$color) = @$_;
116                    $colorsH->{$peg} = $color;
117                }
118            }
119            elsif ($show_clusters)
120            {
121                $colorsH  = &set_colors($fig,$pegH,$active_genomes);
122            }
123            else
124            {
125                $colorsH = {};
126            }
127    
128            my $aliasesH = $aliases ? &set_aliases($fig,$pegH,$active_genomes) : {};
129          my $reactions = $subsystem->get_reactions;          my $reactions = $subsystem->get_reactions;
130          my $self = { Roles => $role_info,          my $self = { Roles => $role_info,
131                       RoleIndex => $roleH,                       RoleIndex => $roleH,
132                       RoleSubsets => $subset_info,                       RoleSubsets => $subset_info,
133                       Genomes => $genomes_info,                       Genomes => $genomes_info,
134                       GenomeIndex => $genomeH,                       GenomeIndex => $genomeH,
135                         GenomeSubsets => $row_subsets,
136                       PegHash => $pegH,                       PegHash => $pegH,
137                       Colors => $colorsH,                       Colors => $colorsH,
138                       Aliases => $aliasesH,                       Aliases => $aliasesH,
# Line 126  Line 149 
149      }      }
150  }  }
151    
152    sub get_subset_namesR {
153        my($self) = @_;
154    
155        return map { $_->[0] } @{$self->{GenomeSubsets}};
156    }
157    
158    sub get_subsetR {
159        my($self,$set) = @_;
160        my($i);
161    
162        my $sets = $self->{GenomeSubsets};
163        for ($i=0; ($i < @$sets) && ($sets->[$i]->[0] ne $set); $i++) {}
164        if ($i < @$sets)
165        {
166            return map { $self->{Genomes}->[$_]->[0] } @{$sets->[$i]->[1]}
167        }
168        return undef;
169    }
170    
171    sub get_subsetsR {
172        my($self) = @_;
173    
174        my $sets = $self->{GenomeSubsets};
175        my @pairs = ();
176        my $pair;
177        foreach $pair (@$sets)
178        {
179            my($id,$members) = @$pair;
180            push(@pairs,[$id,[map { $self->{Genomes}->[$_]->[0] } @$members]]);
181        }
182        return @pairs;
183    }
184    
185    sub row_subsets {
186        my ($fig,$genomeH,$genomes_info) = @_;
187    
188        my $subsets = [];
189        my $taxonomic_groups = $fig->taxonomic_groups_of_complete(5);
190    
191        my($pair,$id,$members);
192        foreach $pair (@$taxonomic_groups)
193        {
194            ($id,$members) = @$pair;
195            my @mem = grep { defined($_) } map { $genomeH->{$_} } @$members;
196            if (@mem > 0)
197            {
198                push(@$subsets,[$id,[@mem]]);
199            }
200        }
201        return $subsets;
202    }
203    
204  sub set_aliases {  sub set_aliases {
205      my($fig,$pegH) = @_;      my($fig,$pegH,$active_genomes) = @_;
206      my($genomeI,$roleI,$pegs,$peg,$roleH);      my($genomeI,$roleI,$pegs,$peg,$roleH);
207    
208      my $aliasesH = {};      my $aliasesH = {};
209    
210      foreach $genomeI (keys(%$pegH))      foreach $genomeI (grep { $active_genomes->{$_} } keys(%$pegH))
211      {      {
212          $roleH = $pegH->{$genomeI};          $roleH = $pegH->{$genomeI};
213          foreach $roleI (keys(%$roleH))          foreach $roleI (keys(%$roleH))
# Line 151  Line 226 
226  }  }
227    
228  sub set_colors {  sub set_colors {
229      my($fig,$pegH) = @_;      my($fig,$pegH,$active_genomes) = @_;
230      my($genomeI,$roleI,$pegs,$peg,$roleH,$peg,%pegs_in_genome);      my($genomeI,$roleI,$pegs,$peg,$roleH,$peg,%pegs_in_genome);
231    
232      my $colorsH = {};      my $colorsH = {};
233        foreach $genomeI (grep { $active_genomes->{$_} } keys(%$pegH))
     foreach $genomeI (keys(%$pegH))  
234      {      {
235          undef %pegs_in_genome;          undef %pegs_in_genome;
236          $roleH = $pegH->{$genomeI};          $roleH = $pegH->{$genomeI};
# Line 172  Line 246 
246          my @pegs = keys(%pegs_in_genome);          my @pegs = keys(%pegs_in_genome);
247          my($tuple,$peg,$color);          my($tuple,$peg,$color);
248          my $colors_for_one_genome = &set_colors_for_genome($fig,\@pegs);          my $colors_for_one_genome = &set_colors_for_genome($fig,\@pegs);
   
249          while (($peg,$color) = each %$colors_for_one_genome)          while (($peg,$color) = each %$colors_for_one_genome)
250          {          {
251              $colorsH->{$peg} = $colors_for_one_genome->{$peg};              $colorsH->{$peg} = $colors_for_one_genome->{$peg};
# Line 400  Line 473 
473      return $self->{Colors}->{$peg};      return $self->{Colors}->{$peg};
474  }  }
475    
476    sub active_genomes {
477        my($fig,$row_subsets,$active_subsetR,$focus,$genomeH,$genomes_info) = @_;
478        my($i,@bestL);
479    
480        my $active_genomes = {};
481    
482        if ($active_subsetR)
483        {
484            for ($i=0; ($i < @$row_subsets) && ($row_subsets->[$i]->[0] ne $active_subsetR); $i++) {}
485            if ($i < @$row_subsets)
486            {
487                @bestL = @{$row_subsets->[$i]->[1]};
488            }
489            else
490            {
491                $active_subsetR = 'All';
492                @bestL = map { $genomeH->{$_} } keys(%$genomeH);
493            }
494        }
495        else
496        {
497            if ((! $focus) || (! $fig->is_complete($focus)))
498            {
499                $active_subsetR = 'All';
500                @bestL = map { $genomeH->{$_} } keys(%$genomeH);
501            }
502            else
503            {
504                my $bestN   = undef;
505                @bestL   = ();
506                my $tuple;
507                foreach $tuple (@$row_subsets)
508                {
509                    my($id,$genomeIs) = @$tuple;
510                    for ($i=0; ($i < @$genomeIs) && ($genomes_info->[$genomeIs->[$i]]->[0] ne $focus); $i++) {}
511                    if ($i < @$genomeIs)
512                    {
513                        if ((! $bestN) || (@$genomeIs < @bestL))
514                        {
515                            $bestN  = $id;
516                            @bestL = @$genomeIs;
517                        }
518                    }
519                    else
520                    {
521    #                   print &Dumper($id);
522                    }
523                }
524                $active_subsetR = $bestN;
525            }
526        }
527    
528        my %active_genomes = map { $_ => 1 } @bestL;
529        return \%active_genomes;
530    }
531    
532  1;  1;
533    
534    

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.11

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3