[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.3, Mon Sep 12 14:53:13 2005 UTC revision 1.4, Mon Sep 12 20:45:51 2005 UTC
# Line 9  Line 9 
9    
10  sub new  sub new
11  {  {
12      my($class, $ssa, $fig, $colors, $aliases) = @_;      my($class, $ssa, $fig, $show_clusters, $aliases) = @_;
13    
14      $ssa =~ s/ /_/g;      $ssa =~ s/ /_/g;
15    
# Line 102  Line 102 
102                  $pegH->{$i}->{$j} = [@pegs];                  $pegH->{$i}->{$j} = [@pegs];
103              }              }
104          }          }
105            my $colorsH  = $show_clusters  ? &set_colors($fig,$pegH)  : {};
         my $colorsH  = $colors  ? &set_colors($fig,$pegH)  : {};  
106          my $aliasesH = $aliases ? &set_aliases($fig,$pegH) : {};          my $aliasesH = $aliases ? &set_aliases($fig,$pegH) : {};
107          my $reactions = $subsystem->get_reactions;          my $reactions = $subsystem->get_reactions;
108          my $self = { Roles => $role_info,          my $self = { Roles => $role_info,
# Line 127  Line 126 
126      }      }
127  }  }
128    
129    sub set_aliases {
130        my($fig,$pegH) = @_;
131        my($genomeI,$roleI,$pegs,$peg,$roleH);
132    
133        my $aliasesH = {};
134    
135        foreach $genomeI (keys(%$pegH))
136        {
137            $roleH = $pegH->{$genomeI};
138            foreach $roleI (keys(%$roleH))
139            {
140                $pegs = $roleH->{$roleI};
141                foreach $peg (@$pegs)
142                {
143                    if (! $aliasesH->{$peg})
144                    {
145                        $aliasesH->{$peg} = scalar &ext_id($fig,$peg);
146                    }
147                }
148            }
149        }
150        return $aliasesH;
151    }
152    
153    sub set_colors {
154        my($fig,$pegH) = @_;
155        my($genomeI,$roleI,$pegs,$peg,$roleH,$peg,%pegs_in_genome);
156    
157        my $colorsH = {};
158    
159        foreach $genomeI (keys(%$pegH))
160        {
161            undef %pegs_in_genome;
162            $roleH = $pegH->{$genomeI};
163            foreach $roleI (keys(%$roleH))
164            {
165                $pegs = $roleH->{$roleI};
166                foreach $peg (@$pegs)
167                {
168                    $pegs_in_genome{$peg} = 1;
169                }
170            }
171    
172            my @pegs = keys(%pegs_in_genome);
173            my($tuple,$peg,$color);
174            my $colors_for_one_genome = &set_colors_for_genome($fig,\@pegs);
175    
176            while (($peg,$color) = each %$colors_for_one_genome)
177            {
178                $colorsH->{$peg} = $colors_for_one_genome->{$peg};
179            }
180        }
181        return $colorsH;
182    }
183    
184    sub set_colors_for_genome {
185        my($fig,$pegs) = @_;
186        my($peg,@clusters,$cluster,@colors,$color,%seen,%conn,$x,$peg1,@pegs,$i);
187    
188        my $color_of = {};
189        foreach $peg (@$pegs) { $color_of->{$peg} = '#FFFFFF' }
190    
191        @pegs = keys(%$color_of);  #  Use of keys makes @pegs entries unique
192    
193        foreach $peg (@pegs)
194        {
195            $conn{$peg} = [grep { $color_of->{$_} && ($_ ne $peg) } $fig->close_genes($peg,5000)];
196        }
197    
198        @clusters = ();
199        while ($peg = shift @pegs)
200        {
201            if (! $seen{$peg})
202            {
203                $cluster = [$peg];
204                $seen{$peg} = 1;
205                for ($i=0; ($i < @$cluster); $i++)
206                {
207                    my @tmp = grep { ! $seen{$_} } @{$conn{$cluster->[$i]}};
208                    if (@tmp > 0)
209                    {
210                        foreach my $peg1 (@tmp) { $seen{$peg1} = 1 }
211                        push(@$cluster,@tmp);
212                    }
213                }
214                push(@clusters,$cluster);
215            }
216        }
217    
218        @colors =  &cool_colors();
219    
220        @clusters = grep { @$_ > 1 } sort { @$a <=> @$b } @clusters;
221    
222        if (@clusters > @colors) { splice(@clusters,0,(@clusters - @colors)) }  # make sure we have enough colors
223    
224        my($cluster);
225        foreach $cluster (@clusters)
226        {
227            $color = shift @colors;
228            foreach $peg (@$cluster)
229            {
230                $color_of->{$peg} = $color;
231            }
232        }
233        return $color_of;
234    }
235    
236    sub cool_colors {
237     # just an array of "websafe" colors or whatever colors we want to use. Feel free to remove bad colors (hence the lines not being equal length!)
238     return (
239     '#C0C0C0', '#FF40C0', '#FF8040', '#FF0080', '#FFC040', '#40C0FF', '#40FFC0', '#C08080', '#C0FF00', '#00FF80', '#00C040',
240     "#6B8E23", "#483D8B", "#2E8B57", "#008000", "#006400", "#800000", "#00FF00", "#7FFFD4",
241     "#87CEEB", "#A9A9A9", "#90EE90", "#D2B48C", "#8DBC8F", "#D2691E", "#87CEFA", "#E9967A", "#FFE4C4", "#FFB6C1",
242     "#E0FFFF", "#FFA07A", "#DB7093", "#9370DB", "#008B8B", "#FFDEAD", "#DA70D6", "#DCDCDC", "#FF00FF", "#6A5ACD",
243     "#00FA9A", "#228B22", "#1E90FF", "#FA8072", "#CD853F", "#DC143C", "#FF6347", "#98FB98", "#4682B4",
244     "#D3D3D3", "#7B68EE", "#2F4F4F", "#FF7F50", "#FF69B4", "#BC8F8F", "#A0522D", "#DEB887", "#00DED1",
245     "#6495ED", "#800080", "#FFD700", "#F5DEB3", "#66CDAA", "#FF4500", "#4B0082", "#CD5C5C",
246     "#EE82EE", "#7CFC00", "#FFFF00", "#191970", "#FFFFE0", "#DDA0DD", "#00BFFF", "#DAA520", "#008080",
247     "#00FF7F", "#9400D3", "#BA55D3", "#D8BFD8", "#8B4513", "#3CB371", "#00008B", "#5F9EA0",
248     "#4169E1", "#20B2AA", "#8A2BE2", "#ADFF2F", "#556B2F",
249     "#F0FFFF", "#B0E0E6", "#FF1493", "#B8860B", "#FF0000", "#F08080", "#7FFF00", "#8B0000",
250     "#40E0D0", "#0000CD", "#48D1CC", "#8B008B", "#696969", "#AFEEEE", "#FF8C00", "#EEE8AA", "#A52A2A",
251     "#FFE4B5", "#B0C4DE", "#FAF0E6", "#9ACD32", "#B22222", "#FAFAD2", "#808080", "#0000FF",
252     "#000080", "#32CD32", "#FFFACD", "#9932CC", "#FFA500", "#F0E68C", "#E6E6FA", "#F4A460", "#C71585",
253     "#BDB76B", "#00FFFF", "#FFDAB9", "#ADD8E6", "#778899",
254     );
255    }
256    
257    sub ext_id {
258        my($fig,$peg) = @_;
259    
260        my @tmp;
261        my @aliases = $fig->feature_aliases($peg);
262        if      ((@tmp = grep { $_ =~ /^uni\|/ } @aliases) > 0)
263        {
264            @aliases =  @tmp;
265        }
266        elsif   ((@tmp = grep { $_ =~ /^sp\|/ } @aliases) > 0)
267        {
268            @aliases = @tmp;
269        }
270        elsif   ((@tmp = grep { $_ =~ /^gi\|/ } @aliases) > 0)
271        {
272            @aliases = @tmp;
273        }
274        elsif   ((@tmp = grep { $_ =~ /^kegg\|/ } @aliases) > 0)
275        {
276            @aliases = @tmp;
277        }
278        else
279        {
280            @aliases = ();
281        }
282    
283        if (wantarray())
284        {
285            return @aliases;
286        }
287        else
288        {
289            return $aliases[0];
290        }
291    }
292    
293    
294  sub subsystem_curator {  sub subsystem_curator {
295      my($self) = @_;      my($self) = @_;
296    
# Line 230  Line 394 
394      return undef;      return undef;
395  }  }
396    
397    sub get_color_of {
398        my($self,$peg)  = @_;
399    
400        return $self->{Colors}->{$peg};
401    }
402    
403  1;  1;
404    
405    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3