[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.9, Wed Sep 21 16:32:42 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($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(10);
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 > 10)
197            {
198                push(@$subsets,[$id,[@mem]]);
199            }
200        }
201        if (@$subsets == 0)
202        {
203            foreach $pair (@$taxonomic_groups)
204            {
205                ($id,$members) = @$pair;
206                my @mem = grep { defined($_) } map { $genomeH->{$_} } @$members;
207                if (@mem > 0)
208                {
209                    push(@$subsets,[$id,[@mem]]);
210                }
211            }
212        }
213        return $subsets;
214    }
215    
216  sub set_aliases {  sub set_aliases {
217      my($fig,$pegH) = @_;      my($fig,$pegH,$active_genomes) = @_;
218      my($genomeI,$roleI,$pegs,$peg,$roleH);      my($genomeI,$roleI,$pegs,$peg,$roleH);
219    
220      my $aliasesH = {};      my $aliasesH = {};
221    
222      foreach $genomeI (keys(%$pegH))      foreach $genomeI (grep { $active_genomes->{$_} } keys(%$pegH))
223      {      {
224          $roleH = $pegH->{$genomeI};          $roleH = $pegH->{$genomeI};
225          foreach $roleI (keys(%$roleH))          foreach $roleI (keys(%$roleH))
# Line 151  Line 238 
238  }  }
239    
240  sub set_colors {  sub set_colors {
241      my($fig,$pegH) = @_;      my($fig,$pegH,$active_genomes) = @_;
242      my($genomeI,$roleI,$pegs,$peg,$roleH,$peg,%pegs_in_genome);      my($genomeI,$roleI,$pegs,$peg,$roleH,$peg,%pegs_in_genome);
243    
244      my $colorsH = {};      my $colorsH = {};
245    
246      foreach $genomeI (keys(%$pegH))      foreach $genomeI (grep { $active_genomes->{$_} } keys(%$pegH))
247      {      {
248          undef %pegs_in_genome;          undef %pegs_in_genome;
249          $roleH = $pegH->{$genomeI};          $roleH = $pegH->{$genomeI};
# Line 400  Line 487 
487      return $self->{Colors}->{$peg};      return $self->{Colors}->{$peg};
488  }  }
489    
490    sub active_genomes {
491        my($row_subsets,$active_subsetR,$focus,$genomeH,$genomes_info) = @_;
492        my($i,@bestL);
493    
494        my $active_genomes = {};
495        if ($active_subsetR)
496        {
497            for ($i=0; ($i < @$row_subsets) && ($row_subsets->[$i]->[0] ne $active_subsetR); $i++) {}
498            if ($i < @$row_subsets)
499            {
500                @bestL = @{$row_subsets->[$i]->[1]};
501            }
502            else
503            {
504                $active_subsetR = 'All';
505                @bestL = keys(%$genomeH);
506            }
507        }
508        else
509        {
510            if (! $focus)
511            {
512                $active_subsetR = 'All';
513                @bestL = keys(%$genomeH);
514            }
515            else
516            {
517                my $bestN   = undef;
518                @bestL   = ();
519    
520                my $tuple;
521                foreach $tuple (@$row_subsets)
522                {
523                    my($id,$genomeIs) = @$tuple;
524                    for ($i=0; ($i < @$genomeIs) && ($genomes_info->[$genomeIs->[$i]]->[0] ne $focus); $i++) {}
525                    if ($i < @$genomeIs)
526                    {
527                        if ((! $bestN) || (@$genomeIs < @bestL))
528                        {
529                            $bestN  = $id;
530                            @bestL = @$genomeIs;
531                        }
532                    }
533                }
534                $active_subsetR = $bestN;
535            }
536        }
537    
538        my %active_genomes = map { $_ => 1 } @bestL;
539        return \%active_genomes;
540    }
541    
542  1;  1;
543    
544    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3